Added: X2UtImageInfo unit
Added: X2UtPersist unit tests Changed: iif functions have default AIfFalse parameters Fixed: crash in TX2UtCustomPersist.Write when an object has no runtime type information
This commit is contained in:
parent
b86e2def4a
commit
af655e8083
223
UnitTests/Units/PersistTest.pas
Normal file
223
UnitTests/Units/PersistTest.pas
Normal file
@ -0,0 +1,223 @@
|
|||||||
|
unit PersistTest;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
Classes,
|
||||||
|
|
||||||
|
TestFramework;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TPersistTest = class(TTestCase)
|
||||||
|
published
|
||||||
|
procedure WriteNoTypeInfo;
|
||||||
|
procedure WriteSimpleTypes;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
SysUtils,
|
||||||
|
|
||||||
|
X2UtPersist;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TX2UtPersistTest = class(TX2CustomPersist)
|
||||||
|
private
|
||||||
|
FOutput: TStrings;
|
||||||
|
protected
|
||||||
|
function BeginSection(const AName: String): Boolean; override;
|
||||||
|
procedure EndSection(); override;
|
||||||
|
|
||||||
|
function ReadFloat(const AName: String; out AValue: Extended): Boolean; override;
|
||||||
|
function ReadInt64(const AName: String; out AValue: Int64): Boolean; override;
|
||||||
|
function ReadInteger(const AName: String; out AValue: Integer): Boolean; override;
|
||||||
|
function ReadString(const AName: String; out AValue: String): Boolean; override;
|
||||||
|
|
||||||
|
function WriteFloat(const AName: String; AValue: Extended): Boolean; override;
|
||||||
|
function WriteInt64(const AName: String; AValue: Int64): Boolean; override;
|
||||||
|
function WriteInteger(const AName: String; AValue: Integer): Boolean; override;
|
||||||
|
function WriteString(const AName: String; const AValue: String): Boolean; override;
|
||||||
|
public
|
||||||
|
constructor Create();
|
||||||
|
destructor Destroy(); override;
|
||||||
|
|
||||||
|
procedure Write(AObject: TObject); override;
|
||||||
|
|
||||||
|
property Output: TStrings read FOutput;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TTypeInfoLess = class(TObject)
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TSimpleTypes = class(TPersistent)
|
||||||
|
private
|
||||||
|
FBooleanValue: Boolean;
|
||||||
|
FFloatValue: Double;
|
||||||
|
FInt64Value: Int64;
|
||||||
|
FIntValue: Integer;
|
||||||
|
FStringValue: String;
|
||||||
|
public
|
||||||
|
constructor Create();
|
||||||
|
published
|
||||||
|
property BooleanValue: Boolean read FBooleanValue write FBooleanValue;
|
||||||
|
property FloatValue: Double read FFloatValue write FFloatValue;
|
||||||
|
property Int64Value: Int64 read FInt64Value write FInt64Value;
|
||||||
|
property IntValue: Integer read FIntValue write FIntValue;
|
||||||
|
property StringValue: String read FStringValue write FStringValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{ TSimpleTypes }
|
||||||
|
constructor TSimpleTypes.Create();
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
|
||||||
|
FIntValue := 42;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{ TPersistTest }
|
||||||
|
procedure TPersistTest.WriteNoTypeInfo;
|
||||||
|
var
|
||||||
|
testObject: TTypeInfoLess;
|
||||||
|
|
||||||
|
begin
|
||||||
|
testObject := TTypeInfoLess.Create;
|
||||||
|
try
|
||||||
|
with TX2UtPersistTest.Create do
|
||||||
|
try
|
||||||
|
Write(testObject);
|
||||||
|
|
||||||
|
CheckEquals('', Output.Text);
|
||||||
|
finally
|
||||||
|
Free;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FreeAndNil(testObject);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPersistTest.WriteSimpleTypes;
|
||||||
|
var
|
||||||
|
testObject: TSimpleTypes;
|
||||||
|
|
||||||
|
begin
|
||||||
|
testObject := TSimpleTypes.Create;
|
||||||
|
try
|
||||||
|
with TX2UtPersistTest.Create do
|
||||||
|
try
|
||||||
|
Write(testObject);
|
||||||
|
|
||||||
|
CheckEquals('Integer:42'#13#10, Output.Text);
|
||||||
|
finally
|
||||||
|
Free;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FreeAndNil(testObject);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TX2UtPersistTest }
|
||||||
|
constructor TX2UtPersistTest.Create();
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
|
||||||
|
FOutput := TStringList.Create();
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
destructor TX2UtPersistTest.Destroy();
|
||||||
|
begin
|
||||||
|
FreeAndNil(FOutput);
|
||||||
|
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2UtPersistTest.Write(AObject: TObject);
|
||||||
|
begin
|
||||||
|
Output.Clear();
|
||||||
|
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistTest.BeginSection(const AName: String): Boolean;
|
||||||
|
begin
|
||||||
|
Result := inherited BeginSection(AName);
|
||||||
|
if Result then
|
||||||
|
Output.Add(AName + ' {');
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2UtPersistTest.EndSection();
|
||||||
|
begin
|
||||||
|
Output.Add('}');
|
||||||
|
inherited EndSection();
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistTest.ReadFloat(const AName: String; out AValue: Extended): Boolean;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistTest.ReadInt64(const AName: String; out AValue: Int64): Boolean;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistTest.ReadInteger(const AName: String; out AValue: Integer): Boolean;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistTest.ReadString(const AName: String; out AValue: String): Boolean;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistTest.WriteFloat(const AName: String; AValue: Extended): Boolean;
|
||||||
|
begin
|
||||||
|
Output.Add(Format('Float:%.2f', [AValue]));
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistTest.WriteInt64(const AName: String; AValue: Int64): Boolean;
|
||||||
|
begin
|
||||||
|
Output.Add(Format('Int64:%d', [AValue]));
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistTest.WriteInteger(const AName: String; AValue: Integer): Boolean;
|
||||||
|
begin
|
||||||
|
Output.Add(Format('Integer:%d', [AValue]));
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistTest.WriteString(const AName, AValue: String): Boolean;
|
||||||
|
begin
|
||||||
|
Output.Add(Format('String:%s', [AValue]));
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterTest(TPersistTest.Suite);
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
170
UnitTests/X2UtUnitTests.bdsproj
Normal file
170
UnitTests/X2UtUnitTests.bdsproj
Normal file
@ -0,0 +1,170 @@
|
|||||||
|
<?xml version="1.0" encoding="utf-8"?>
|
||||||
|
<BorlandProject>
|
||||||
|
<PersonalityInfo>
|
||||||
|
<Option>
|
||||||
|
<Option Name="Personality">Delphi.Personality</Option>
|
||||||
|
<Option Name="ProjectType">VCLApplication</Option>
|
||||||
|
<Option Name="Version">1.0</Option>
|
||||||
|
<Option Name="GUID">{8BEE0E67-704C-4611-9014-0F8CC2FB0289}</Option>
|
||||||
|
</Option>
|
||||||
|
</PersonalityInfo>
|
||||||
|
<Delphi.Personality>
|
||||||
|
<Source>
|
||||||
|
<Source Name="MainSource">X2UtUnitTests.dpr</Source>
|
||||||
|
</Source>
|
||||||
|
<FileVersion>
|
||||||
|
<FileVersion Name="Version">7.0</FileVersion>
|
||||||
|
</FileVersion>
|
||||||
|
<Compiler>
|
||||||
|
<Compiler Name="A">8</Compiler>
|
||||||
|
<Compiler Name="B">0</Compiler>
|
||||||
|
<Compiler Name="C">1</Compiler>
|
||||||
|
<Compiler Name="D">1</Compiler>
|
||||||
|
<Compiler Name="E">0</Compiler>
|
||||||
|
<Compiler Name="F">0</Compiler>
|
||||||
|
<Compiler Name="G">1</Compiler>
|
||||||
|
<Compiler Name="H">1</Compiler>
|
||||||
|
<Compiler Name="I">1</Compiler>
|
||||||
|
<Compiler Name="J">1</Compiler>
|
||||||
|
<Compiler Name="K">0</Compiler>
|
||||||
|
<Compiler Name="L">1</Compiler>
|
||||||
|
<Compiler Name="M">0</Compiler>
|
||||||
|
<Compiler Name="N">1</Compiler>
|
||||||
|
<Compiler Name="O">1</Compiler>
|
||||||
|
<Compiler Name="P">1</Compiler>
|
||||||
|
<Compiler Name="Q">0</Compiler>
|
||||||
|
<Compiler Name="R">0</Compiler>
|
||||||
|
<Compiler Name="S">0</Compiler>
|
||||||
|
<Compiler Name="T">0</Compiler>
|
||||||
|
<Compiler Name="U">0</Compiler>
|
||||||
|
<Compiler Name="V">1</Compiler>
|
||||||
|
<Compiler Name="W">1</Compiler>
|
||||||
|
<Compiler Name="X">1</Compiler>
|
||||||
|
<Compiler Name="Y">1</Compiler>
|
||||||
|
<Compiler Name="Z">1</Compiler>
|
||||||
|
<Compiler Name="ShowHints">True</Compiler>
|
||||||
|
<Compiler Name="ShowWarnings">True</Compiler>
|
||||||
|
<Compiler Name="UnitAliases">WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;</Compiler>
|
||||||
|
<Compiler Name="NamespacePrefix"></Compiler>
|
||||||
|
<Compiler Name="GenerateDocumentation">False</Compiler>
|
||||||
|
<Compiler Name="DefaultNamespace"></Compiler>
|
||||||
|
<Compiler Name="SymbolDeprecated">True</Compiler>
|
||||||
|
<Compiler Name="SymbolLibrary">True</Compiler>
|
||||||
|
<Compiler Name="SymbolPlatform">False</Compiler>
|
||||||
|
<Compiler Name="SymbolExperimental">True</Compiler>
|
||||||
|
<Compiler Name="UnitLibrary">True</Compiler>
|
||||||
|
<Compiler Name="UnitPlatform">False</Compiler>
|
||||||
|
<Compiler Name="UnitDeprecated">True</Compiler>
|
||||||
|
<Compiler Name="UnitExperimental">True</Compiler>
|
||||||
|
<Compiler Name="HResultCompat">True</Compiler>
|
||||||
|
<Compiler Name="HidingMember">True</Compiler>
|
||||||
|
<Compiler Name="HiddenVirtual">True</Compiler>
|
||||||
|
<Compiler Name="Garbage">True</Compiler>
|
||||||
|
<Compiler Name="BoundsError">True</Compiler>
|
||||||
|
<Compiler Name="ZeroNilCompat">True</Compiler>
|
||||||
|
<Compiler Name="StringConstTruncated">True</Compiler>
|
||||||
|
<Compiler Name="ForLoopVarVarPar">True</Compiler>
|
||||||
|
<Compiler Name="TypedConstVarPar">True</Compiler>
|
||||||
|
<Compiler Name="AsgToTypedConst">True</Compiler>
|
||||||
|
<Compiler Name="CaseLabelRange">True</Compiler>
|
||||||
|
<Compiler Name="ForVariable">True</Compiler>
|
||||||
|
<Compiler Name="ConstructingAbstract">True</Compiler>
|
||||||
|
<Compiler Name="ComparisonFalse">True</Compiler>
|
||||||
|
<Compiler Name="ComparisonTrue">True</Compiler>
|
||||||
|
<Compiler Name="ComparingSignedUnsigned">True</Compiler>
|
||||||
|
<Compiler Name="CombiningSignedUnsigned">True</Compiler>
|
||||||
|
<Compiler Name="UnsupportedConstruct">True</Compiler>
|
||||||
|
<Compiler Name="FileOpen">True</Compiler>
|
||||||
|
<Compiler Name="FileOpenUnitSrc">True</Compiler>
|
||||||
|
<Compiler Name="BadGlobalSymbol">True</Compiler>
|
||||||
|
<Compiler Name="DuplicateConstructorDestructor">True</Compiler>
|
||||||
|
<Compiler Name="InvalidDirective">True</Compiler>
|
||||||
|
<Compiler Name="PackageNoLink">True</Compiler>
|
||||||
|
<Compiler Name="PackageThreadVar">True</Compiler>
|
||||||
|
<Compiler Name="ImplicitImport">True</Compiler>
|
||||||
|
<Compiler Name="HPPEMITIgnored">True</Compiler>
|
||||||
|
<Compiler Name="NoRetVal">True</Compiler>
|
||||||
|
<Compiler Name="UseBeforeDef">True</Compiler>
|
||||||
|
<Compiler Name="ForLoopVarUndef">True</Compiler>
|
||||||
|
<Compiler Name="UnitNameMismatch">True</Compiler>
|
||||||
|
<Compiler Name="NoCFGFileFound">True</Compiler>
|
||||||
|
<Compiler Name="ImplicitVariants">True</Compiler>
|
||||||
|
<Compiler Name="UnicodeToLocale">True</Compiler>
|
||||||
|
<Compiler Name="LocaleToUnicode">True</Compiler>
|
||||||
|
<Compiler Name="ImagebaseMultiple">True</Compiler>
|
||||||
|
<Compiler Name="SuspiciousTypecast">True</Compiler>
|
||||||
|
<Compiler Name="PrivatePropAccessor">True</Compiler>
|
||||||
|
<Compiler Name="UnsafeType">False</Compiler>
|
||||||
|
<Compiler Name="UnsafeCode">False</Compiler>
|
||||||
|
<Compiler Name="UnsafeCast">False</Compiler>
|
||||||
|
<Compiler Name="OptionTruncated">True</Compiler>
|
||||||
|
<Compiler Name="WideCharReduced">True</Compiler>
|
||||||
|
<Compiler Name="DuplicatesIgnored">True</Compiler>
|
||||||
|
<Compiler Name="UnitInitSeq">True</Compiler>
|
||||||
|
<Compiler Name="LocalPInvoke">True</Compiler>
|
||||||
|
<Compiler Name="MessageDirective">True</Compiler>
|
||||||
|
<Compiler Name="CodePage"></Compiler>
|
||||||
|
</Compiler>
|
||||||
|
<Linker>
|
||||||
|
<Linker Name="MapFile">0</Linker>
|
||||||
|
<Linker Name="OutputObjs">0</Linker>
|
||||||
|
<Linker Name="GenerateHpps">False</Linker>
|
||||||
|
<Linker Name="ConsoleApp">1</Linker>
|
||||||
|
<Linker Name="DebugInfo">True</Linker>
|
||||||
|
<Linker Name="RemoteSymbols">False</Linker>
|
||||||
|
<Linker Name="GenerateDRC">False</Linker>
|
||||||
|
<Linker Name="MinStackSize">16384</Linker>
|
||||||
|
<Linker Name="MaxStackSize">1048576</Linker>
|
||||||
|
<Linker Name="ImageBase">4194304</Linker>
|
||||||
|
<Linker Name="ExeDescription"></Linker>
|
||||||
|
</Linker>
|
||||||
|
<Directories>
|
||||||
|
<Directories Name="OutputDir"></Directories>
|
||||||
|
<Directories Name="UnitOutputDir"></Directories>
|
||||||
|
<Directories Name="PackageDLLOutputDir"></Directories>
|
||||||
|
<Directories Name="PackageDCPOutputDir"></Directories>
|
||||||
|
<Directories Name="SearchPath">..\</Directories>
|
||||||
|
<Directories Name="Packages">vcl;rtl;dbrtl;vcldb;vclx;dss;dsnapcrba;dsnapcon;inetdb;webdsnap;websnap;dbxcds;Irc;parsdpk;hotspotter</Directories>
|
||||||
|
<Directories Name="Conditionals"></Directories>
|
||||||
|
<Directories Name="DebugSourceDirs"></Directories>
|
||||||
|
<Directories Name="UsePackages">False</Directories>
|
||||||
|
</Directories>
|
||||||
|
<Parameters>
|
||||||
|
<Parameters Name="RunParams">ip-to-country.csv countries.csv geo.db</Parameters>
|
||||||
|
<Parameters Name="HostApplication"></Parameters>
|
||||||
|
<Parameters Name="Launcher"></Parameters>
|
||||||
|
<Parameters Name="UseLauncher">False</Parameters>
|
||||||
|
<Parameters Name="DebugCWD"></Parameters>
|
||||||
|
<Parameters Name="Debug Symbols Search Path"></Parameters>
|
||||||
|
<Parameters Name="LoadAllSymbols">True</Parameters>
|
||||||
|
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
|
||||||
|
</Parameters>
|
||||||
|
<VersionInfo>
|
||||||
|
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
|
||||||
|
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
|
||||||
|
<VersionInfo Name="MajorVer">1</VersionInfo>
|
||||||
|
<VersionInfo Name="MinorVer">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Release">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Build">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Debug">False</VersionInfo>
|
||||||
|
<VersionInfo Name="PreRelease">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Special">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Private">False</VersionInfo>
|
||||||
|
<VersionInfo Name="DLL">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Locale">1043</VersionInfo>
|
||||||
|
<VersionInfo Name="CodePage">1252</VersionInfo>
|
||||||
|
</VersionInfo>
|
||||||
|
<VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="CompanyName"></VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="FileDescription"></VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="InternalName"></VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="ProductName"></VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="Comments"></VersionInfoKeys>
|
||||||
|
</VersionInfoKeys>
|
||||||
|
</Delphi.Personality>
|
||||||
|
</BorlandProject>
|
@ -34,6 +34,10 @@
|
|||||||
-K$00400000
|
-K$00400000
|
||||||
-LE"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl"
|
-LE"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl"
|
||||||
-LN"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl"
|
-LN"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl"
|
||||||
|
-U"..\"
|
||||||
|
-O"..\"
|
||||||
|
-I"..\"
|
||||||
|
-R"..\"
|
||||||
-w-SYMBOL_PLATFORM
|
-w-SYMBOL_PLATFORM
|
||||||
-w-UNIT_PLATFORM
|
-w-UNIT_PLATFORM
|
||||||
-w-UNSAFE_TYPE
|
-w-UNSAFE_TYPE
|
||||||
|
@ -5,8 +5,10 @@ uses
|
|||||||
GUITestRunner,
|
GUITestRunner,
|
||||||
Variants,
|
Variants,
|
||||||
BitsTest in 'Units\BitsTest.pas',
|
BitsTest in 'Units\BitsTest.pas',
|
||||||
HashesTest in 'Units\HashesTest.pas';
|
HashesTest in 'Units\HashesTest.pas',
|
||||||
//SettingsTest in 'Units\SettingsTest.pas',
|
PersistTest in 'Units\PersistTest.pas';
|
||||||
|
|
||||||
|
//SettingsTest in 'Units\SettingsTest.pas',
|
||||||
//IniParserTest in 'Units\IniParserTest.pas';
|
//IniParserTest in 'Units\IniParserTest.pas';
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
144
UnitTests/X2UtUnitTests.mes
Normal file
144
UnitTests/X2UtUnitTests.mes
Normal file
@ -0,0 +1,144 @@
|
|||||||
|
[GeneralSettings]
|
||||||
|
HandleExceptions=0
|
||||||
|
AppendMapFileToBinary=1
|
||||||
|
NoOwnMadExceptSettings=0
|
||||||
|
CheckFileCrc=1
|
||||||
|
CheckForFrozenMainThread=0
|
||||||
|
FreezeTimeout=60000
|
||||||
|
AutomaticallySaveBugReport=0
|
||||||
|
AutoSaveBugReportIfNotSent=1
|
||||||
|
AutomaticallyMailBugReport=0
|
||||||
|
AutoMailProgressBox=0
|
||||||
|
CopyBugReportToClipboard=0
|
||||||
|
SuspendAllRunningThreads=0
|
||||||
|
ShowPleaseWaitBox=1
|
||||||
|
PleaseWaitIcon=plwait1
|
||||||
|
AutomaticallyContinueApplication=0
|
||||||
|
AutomaticallyRestartApplication=0
|
||||||
|
AutomaticallyCloseApplication=0
|
||||||
|
MailAddress=
|
||||||
|
SendInBackground=0
|
||||||
|
Send32Icon=send321
|
||||||
|
MailAsSmtpServer=0
|
||||||
|
MailAsSmtpClient=0
|
||||||
|
UploadViaHttp=0
|
||||||
|
MailViaMapi=0
|
||||||
|
MailViaMailto=0
|
||||||
|
SmtpServer=
|
||||||
|
SmtpPort=25
|
||||||
|
SmtpAccount=
|
||||||
|
SmtpPassword=
|
||||||
|
HttpServer=
|
||||||
|
HttpPort=80
|
||||||
|
HttpAccount=
|
||||||
|
HttpPassword=
|
||||||
|
BugReportFile=bugreport.txt
|
||||||
|
AttachBugReport=0
|
||||||
|
AttachBugReportFile=1
|
||||||
|
DeleteBugReportFile=1
|
||||||
|
BugReportSendAs=bugreport.txt
|
||||||
|
BugReportZip=
|
||||||
|
ScreenShotDepth=0
|
||||||
|
ScreenShotAppOnly=0
|
||||||
|
ScreenShotSendAs=screenshot.png
|
||||||
|
ScreenShotZip=
|
||||||
|
AdditionalAttachments=
|
||||||
|
AppendBugReports=1
|
||||||
|
BugReportFileSize=100000
|
||||||
|
DontSaveDuplicateExceptions=1
|
||||||
|
DontSaveDuplicateFreezings=1
|
||||||
|
DuplicateExceptionDefinition=1
|
||||||
|
DuplicateFreezeDefinition=2
|
||||||
|
ShowExceptionBox=1
|
||||||
|
OkBtnText=&OK
|
||||||
|
DetailsBtnText=&Details
|
||||||
|
PleaseWaitTitle=Information
|
||||||
|
PleaseWaitText=Please wait a moment...
|
||||||
|
MailSubject=bug report
|
||||||
|
MailBody=please find the bug report attached
|
||||||
|
SendBoxTitle=Sending bug report...
|
||||||
|
PrepareAttachMsg=Preparing attachments...
|
||||||
|
MxLookupMsg=Searching for mail server...
|
||||||
|
ConnectMsg=Connecting to server...
|
||||||
|
AuthMsg=Authentication...
|
||||||
|
SendMailMsg=Sending mail...
|
||||||
|
FieldsMsg=Setting fields...
|
||||||
|
SendAttachMsg=Sending attachments...
|
||||||
|
SendFinalizeMsg=Finalizing...
|
||||||
|
MailFailureMsg=Sorry, sending the bug report didn't work.
|
||||||
|
VersionVariable=
|
||||||
|
[ExceptionBox]
|
||||||
|
ShowButtonMailBugReport=0
|
||||||
|
ShowButtonSaveBugReport=0
|
||||||
|
ShowButtonPrintBugReport=0
|
||||||
|
ShowButtonShowBugReport=1
|
||||||
|
ShowButtonContinueApplication=1
|
||||||
|
ShowButtonRestartApplication=1
|
||||||
|
ShowButtonCloseApplication=1
|
||||||
|
IconButtonSendBugReport=send1
|
||||||
|
IconButtonSaveBugReport=save1
|
||||||
|
IconButtonPrintBugReport=print1
|
||||||
|
IconButtonShowBugReport=show1
|
||||||
|
IconButtonContinueApplication=continue1
|
||||||
|
IconButtonCantContinueApplication=cantContinue1
|
||||||
|
IconButtonRestartApplication=restart1
|
||||||
|
IconButtonCloseApplication=close1
|
||||||
|
FocusedButton=3
|
||||||
|
SendAssistant=SendAssistant
|
||||||
|
SaveAssistant=SaveAssistant
|
||||||
|
PrintAssistant=PrintAssistant
|
||||||
|
AutomaticallyShowBugReport=0
|
||||||
|
NoOwnerDrawButtons=0
|
||||||
|
BigExceptionIcon=big1
|
||||||
|
TitleBar=%25appname%25
|
||||||
|
ExceptionMessage=An error occurred in the application.
|
||||||
|
FrozenMessage=The application seems to be frozen.
|
||||||
|
BitFaultMsg=The file "%25modname%25" seems to be corrupt!
|
||||||
|
MailBugReportText=send bug report
|
||||||
|
SaveBugReportText=save bug report
|
||||||
|
PrintBugReportText=print bug report
|
||||||
|
ShowBugReportText=show bug report
|
||||||
|
ContinueApplicationText=continue application
|
||||||
|
RestartApplicationText=restart application
|
||||||
|
CloseApplicationText=close application
|
||||||
|
[BugReport]
|
||||||
|
ListThreads=1
|
||||||
|
ListModules=1
|
||||||
|
ListHardware=1
|
||||||
|
ShowCpuRegisters=0
|
||||||
|
ShowStackDump=0
|
||||||
|
Disassembly=0
|
||||||
|
HideUglyItems=0
|
||||||
|
ShowRelativeAddrs=1
|
||||||
|
ShowRelativeLines=1
|
||||||
|
FormatDisassembly=0
|
||||||
|
LimitDisassembly=5
|
||||||
|
EnabledPlugins=modules|processes|hardware
|
||||||
|
[Filters]
|
||||||
|
Filter1ExceptionClasses=EDBEditError
|
||||||
|
Filter1DontCreateBugReport=1
|
||||||
|
Filter1DontCreateScreenshot=1
|
||||||
|
Filter1DontSuspendThreads=1
|
||||||
|
Filter1DontCallHandlers=1
|
||||||
|
Filter1ShowBox=3
|
||||||
|
Filter1Assis=
|
||||||
|
Filter2ExceptionClasses=
|
||||||
|
Filter2DontCreateBugReport=0
|
||||||
|
Filter2DontCreateScreenshot=0
|
||||||
|
Filter2DontSuspendThreads=0
|
||||||
|
Filter2DontCallHandlers=0
|
||||||
|
Filter2ShowBox=0
|
||||||
|
Filter2Assis=
|
||||||
|
GeneralDontCreateBugReport=0
|
||||||
|
GeneralDontCreateScreenshot=0
|
||||||
|
GeneralDontSuspendThreads=0
|
||||||
|
GeneralDontCallHandlers=0
|
||||||
|
GeneralShowBox=0
|
||||||
|
GeneralAssis=
|
||||||
|
[Assistants]
|
||||||
|
Assistant1=SendAssistant|Send Assistant|ContactForm|DetailsForm|ScrShotForm
|
||||||
|
Assistant2=SaveAssistant|Save Assistant|ContactForm|DetailsForm
|
||||||
|
Assistant3=PrintAssistant|Print Assistant|ContactForm|DetailsForm
|
||||||
|
Forms1=TPF0%0eTMEContactForm%0bContactForm%07Message%0c%13%00%00%00Contact Information%08MinWidth%04%00%00%00%00%08OnAction%0c%1b%00%00%00madExcept.HandleContactForm%05Timer%04%00%00%00%00%00%09INVButton%0bContinueBtn%07Caption%0c%08%00%00%00Continue%07Enabled%09%0bNoOwnerDraw%08%00%00%09INVButton%07SkipBtn%07Caption%0c%04%00%00%00Skip%07Enabled%08%0bNoOwnerDraw%08%00%00%09INVButton%08AbortBtn%07Caption%0c%05%00%00%00Abort%07Enabled%09%0bNoOwnerDraw%08%00%00%08INVLabel%06Label1%07Caption%0c%0a%00%00%00your name:%07Enabled%09%07Spacing%04%00%00%00%00%00%00%07INVEdit%08NameEdit%07Enabled%09%05Lines%04%01%00%00%00%08Optional%09%0aOutputName%0c%0c%00%00%00contact name%0aOutputType%07%09nvoHeader%07Spacing%04%00%00%00%00%04Text%0c%00%00%00%00%00%00%08INVLabel%06Label2%07Caption%0c%0b%00%00%00your email:%07Enabled%09%07Spacing%04%00%00%00%00%00%00%07INVEdit%09EmailEdit%07Enabled%09%05Lines%04%01%00%00%00%08Optional%08%0aOutputName%0c%0d%00%00%00contact email%0aOutputType%07%09nvoHeader%07Spacing%04%00%00%00%00%04Text%0c%00%00%00%00%00%00%0bINVCheckBox%08MemCheck%07Checked%08%07Enabled%09%0aOutputName%0c%00%00%00%00%07Spacing%04%00%00%00%00%04Text%0c%09%00%00%00some text%00%00%00
|
||||||
|
Forms2=TPF0%0eTMEDetailsForm%0bDetailsForm%07Message%0c%0d%00%00%00Error Details%08MinWidth%04%00%00%00%00%08OnAction%0c%00%00%00%00%05Timer%04%00%00%00%00%00%09INVButton%0bContinueBtn%07Caption%0c%08%00%00%00Continue%07Enabled%09%0bNoOwnerDraw%08%00%00%09INVButton%07SkipBtn%07Caption%0c%04%00%00%00Skip%07Enabled%09%0bNoOwnerDraw%08%00%00%09INVButton%08AbortBtn%07Caption%0c%05%00%00%00Abort%07Enabled%09%0bNoOwnerDraw%08%00%00%08INVLabel%06Label1%07Caption%0c'%00%00%00in which situation did the error occur?%07Enabled%09%07Spacing%04%00%00%00%00%00%00%07INVEdit%0bDetailsMemo%07Enabled%09%05Lines%04%09%00%00%00%08Optional%08%0aOutputName%0c%0d%00%00%00error details%0aOutputType%07%0dnvoOwnSection%07Spacing%04%00%00%00%00%04Text%0c%00%00%00%00%00%00%00
|
||||||
|
Forms3=TPF0%0eTMEScrShotForm%0bScrShotForm%0dActiveControl%07%0bContinueBtn%07Message%0c%18%00%00%00Screenshot Configuration%08MinWidth%04%00%00%00%00%08OnAction%0c%1e%00%00%00madExcept.HandleScreenshotForm%05Timer%04%fa%00%00%00%00%09INVButton%0bContinueBtn%07Caption%0c%08%00%00%00Continue%07Enabled%09%0bNoOwnerDraw%08%00%00%09INVButton%07SkipBtn%07Caption%0c%04%00%00%00Skip%07Enabled%08%0bNoOwnerDraw%08%00%00%09INVButton%08AbortBtn%07Caption%0c%05%00%00%00Abort%07Enabled%09%0bNoOwnerDraw%08%00%00%0bINVCheckBox%0bAttachCheck%07Checked%09%07Enabled%09%0aOutputName%0c%00%00%00%00%07Spacing%04%00%00%00%00%04Text%0c%09%00%00%00some text%00%00%08INVImage%0aScrShotImg%06Border%09%09Clickable%09%07Enabled%09%04File%0c%00%00%00%00%06Height%04%00%00%00%00%07Spacing%04%00%00%00%00%05Width%04%00%00%00%00%00%00%08INVLabel%06Label1%07Caption%0c%15%00%00%00(click to edit image)%07Enabled%09%07Spacing%04%00%00%00%00%00%00%00
|
@ -177,7 +177,7 @@ begin
|
|||||||
cBack := ColorToRGB(ABackground);
|
cBack := ColorToRGB(ABackground);
|
||||||
cFore := ColorToRGB(AForeground);
|
cFore := ColorToRGB(AForeground);
|
||||||
iBack := 256 - AAlpha;
|
iBack := 256 - AAlpha;
|
||||||
iFore := Succ(AAlpha);
|
iFore := AAlpha;
|
||||||
|
|
||||||
Result := RGB(((GetRValue(cBack) * iBack) +
|
Result := RGB(((GetRValue(cBack) * iBack) +
|
||||||
(GetRValue(cFore) * iFore)) shr 8,
|
(GetRValue(cFore) * iFore)) shr 8,
|
||||||
|
@ -238,9 +238,6 @@ type
|
|||||||
FCursor: TX2HashCursor;
|
FCursor: TX2HashCursor;
|
||||||
FKeyManager: TX2CustomHashManager;
|
FKeyManager: TX2CustomHashManager;
|
||||||
FValueManager: TX2CustomHashManager;
|
FValueManager: TX2CustomHashManager;
|
||||||
|
|
||||||
FKeys: TObject;
|
|
||||||
FValues: TObject;
|
|
||||||
protected
|
protected
|
||||||
function CreateCursor(): TX2HashCursor; virtual;
|
function CreateCursor(): TX2HashCursor; virtual;
|
||||||
function CreateKeyManager(): TX2CustomHashManager; virtual; abstract;
|
function CreateKeyManager(): TX2CustomHashManager; virtual; abstract;
|
||||||
|
304
X2UtImageInfo.pas
Normal file
304
X2UtImageInfo.pas
Normal file
@ -0,0 +1,304 @@
|
|||||||
|
unit X2UtImageInfo;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
Windows,
|
||||||
|
SysUtils,
|
||||||
|
Classes,
|
||||||
|
Graphics;
|
||||||
|
|
||||||
|
type
|
||||||
|
TX2ImageType = (itUnknown, itBMP, itGIF, itJPG, itPNG);
|
||||||
|
TX2ImageInfo = record
|
||||||
|
ImgType: TX2ImageType;
|
||||||
|
Width: Cardinal;
|
||||||
|
Height: Cardinal;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetImageInfo(const AFilename: String): TX2ImageInfo; overload;
|
||||||
|
function GetImageInfo(const AStream: TStream): TX2ImageInfo; overload;
|
||||||
|
|
||||||
|
function GetImageSize(const AFilename: String): TSize; overload;
|
||||||
|
function GetImageSize(const AStream: TStream): TSize; overload;
|
||||||
|
|
||||||
|
function GetImageType(const AFilename: String): TX2ImageType; overload;
|
||||||
|
function GetImageType(const AStream: TStream): TX2ImageType; overload;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
Math,
|
||||||
|
Types;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TGetDimensionsProc = procedure(const ASource: TStream; var AImageInfo: TX2ImageInfo);
|
||||||
|
|
||||||
|
TCardinal = record
|
||||||
|
case Byte of
|
||||||
|
0: (Value: Cardinal);
|
||||||
|
1: (Byte1, Byte2, Byte3, Byte4: Byte);
|
||||||
|
end;
|
||||||
|
|
||||||
|
TWord = record
|
||||||
|
case Byte of
|
||||||
|
0: (Value: Word);
|
||||||
|
1: (Byte1, Byte2: Byte);
|
||||||
|
end;
|
||||||
|
|
||||||
|
TPNGIHDRChunk = packed record
|
||||||
|
Width: Cardinal;
|
||||||
|
Height: Cardinal;
|
||||||
|
Bitdepth: Byte;
|
||||||
|
Colortype: Byte;
|
||||||
|
Compression: Byte;
|
||||||
|
Filter: Byte;
|
||||||
|
Interlace: Byte;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TGIFHeader = packed record
|
||||||
|
Signature: array[0..2] of Char;
|
||||||
|
Version: array[0..2] of Char;
|
||||||
|
Width: Word;
|
||||||
|
Height: Word;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJPGChunk = record
|
||||||
|
ID: Word;
|
||||||
|
Length: Word;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJPGHeader = packed record
|
||||||
|
Reserved: Byte;
|
||||||
|
Height: Word;
|
||||||
|
Width: Word;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
const
|
||||||
|
SIG_BMP: array[0..1] of Char = ('B', 'M');
|
||||||
|
SIG_GIF: array[0..2] of Char = ('G', 'I', 'F');
|
||||||
|
SIG_JPG: array[0..2] of Char = (#255, #216, #255);
|
||||||
|
SIG_PNG: array[0..7] of Char = (#137, #80, #78, #71, #13, #10, #26, #10);
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
function SwapBytes(const ASource: Cardinal): Cardinal; overload;
|
||||||
|
var
|
||||||
|
mwSource: TCardinal;
|
||||||
|
mwDest: TCardinal;
|
||||||
|
|
||||||
|
begin
|
||||||
|
mwSource.Value := ASource;
|
||||||
|
mwDest.Byte1 := mwSource.Byte4;
|
||||||
|
mwDest.Byte2 := mwSource.Byte3;
|
||||||
|
mwDest.Byte3 := mwSource.Byte2;
|
||||||
|
mwDest.Byte4 := mwSource.Byte1;
|
||||||
|
Result := mwDest.Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SwapBytes(const ASource: Word): Word; overload;
|
||||||
|
var
|
||||||
|
mwSource: TWord;
|
||||||
|
mwDest: TWord;
|
||||||
|
|
||||||
|
begin
|
||||||
|
mwSource.Value := ASource;
|
||||||
|
mwDest.Byte1 := mwSource.Byte2;
|
||||||
|
mwDest.Byte2 := mwSource.Byte1;
|
||||||
|
Result := mwDest.Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure GetBMPDimensions(const ASource: TStream; var AImageInfo: TX2ImageInfo);
|
||||||
|
var
|
||||||
|
bmpFileHeader: TBitmapFileHeader;
|
||||||
|
bmpInfoHeader: TBitmapInfoHeader;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FillChar(bmpFileHeader, SizeOf(TBitmapFileHeader), #0);
|
||||||
|
FillChar(bmpInfoHeader, SizeOf(TBitmapInfoHeader), #0);
|
||||||
|
|
||||||
|
ASource.Read(bmpFileHeader, SizeOf(TBitmapFileHeader));
|
||||||
|
ASource.Read(bmpInfoHeader, SizeOf(TBitmapInfoHeader));
|
||||||
|
|
||||||
|
AImageInfo.Width := bmpInfoHeader.biWidth;
|
||||||
|
AImageInfo.Height := bmpInfoHeader.biHeight;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure GetGIFDimensions(const ASource: TStream; var AImageInfo: TX2ImageInfo);
|
||||||
|
var
|
||||||
|
gifHeader: TGIFHeader;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FillChar(gifHeader, SizeOf(TGIFHeader), #0);
|
||||||
|
ASource.Read(gifHeader, SizeOf(TGIFHeader));
|
||||||
|
|
||||||
|
AImageInfo.Width := gifHeader.Width;
|
||||||
|
AImageInfo.Height := gifHeader.Height;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure GetJPGDimensions(const ASource: TStream; var AImageInfo: TX2ImageInfo);
|
||||||
|
var
|
||||||
|
cSig: array[0..1] of Char;
|
||||||
|
jpgChunk: TJPGChunk;
|
||||||
|
jpgHeader: TJPGHeader;
|
||||||
|
iSize: Integer;
|
||||||
|
iRead: Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FillChar(cSig, SizeOf(cSig), #0);
|
||||||
|
|
||||||
|
// Read signature
|
||||||
|
ASource.Read(cSig, SizeOf(cSig));
|
||||||
|
iSize := SizeOf(TJPGChunk);
|
||||||
|
|
||||||
|
repeat
|
||||||
|
// Read chunk header
|
||||||
|
FillChar(jpgChunk, iSize, #0);
|
||||||
|
iRead := ASource.Read(jpgChunk, iSize);
|
||||||
|
|
||||||
|
if iRead <> iSize then
|
||||||
|
break;
|
||||||
|
|
||||||
|
if jpgChunk.ID = $C0FF then begin
|
||||||
|
ASource.Read(jpgHeader, SizeOf(TJPGHeader));
|
||||||
|
AImageInfo.Width := SwapBytes(jpgHeader.Width);
|
||||||
|
AImageInfo.Height := SwapBytes(jpgHeader.Height);
|
||||||
|
break;
|
||||||
|
end else
|
||||||
|
ASource.Position := ASource.Position + (SwapBytes(jpgChunk.Length) - 2);
|
||||||
|
until False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure GetPNGDimensions(const ASource: TStream; var AImageInfo: TX2ImageInfo);
|
||||||
|
var
|
||||||
|
cSig: array[0..7] of Char;
|
||||||
|
cChunkLen: Cardinal;
|
||||||
|
cChunkType: array[0..3] of Char;
|
||||||
|
ihdrData: TPNGIHDRChunk;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FillChar(cSig, SizeOf(cSig), #0);
|
||||||
|
FillChar(cChunkType, SizeOf(cChunkType), #0);
|
||||||
|
|
||||||
|
// Read signature
|
||||||
|
ASource.Read(cSig, SizeOf(cSig));
|
||||||
|
|
||||||
|
// Read IHDR chunk length
|
||||||
|
cChunkLen := 0;
|
||||||
|
ASource.Read(cChunkLen, SizeOf(Cardinal));
|
||||||
|
cChunkLen := SwapBytes(cChunkLen);
|
||||||
|
|
||||||
|
if cChunkLen = SizeOf(TPNGIHDRChunk) then begin
|
||||||
|
// Verify IHDR chunk type
|
||||||
|
ASource.Read(cChunkType, SizeOf(cChunkType));
|
||||||
|
|
||||||
|
if AnsiUpperCase(cChunkType) = 'IHDR' then begin
|
||||||
|
// Read IHDR data
|
||||||
|
FillChar(ihdrData, SizeOf(TPNGIHDRChunk), #0);
|
||||||
|
ASource.Read(ihdrData, SizeOf(TPNGIHDRChunk));
|
||||||
|
|
||||||
|
AImageInfo.Width := SwapBytes(ihdrData.Width);
|
||||||
|
AImageInfo.Height := SwapBytes(ihdrData.Height);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function GetImageInfo(const AFilename: String): TX2ImageInfo;
|
||||||
|
var
|
||||||
|
fsImage: TFileStream;
|
||||||
|
|
||||||
|
begin
|
||||||
|
fsImage := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyWrite);
|
||||||
|
try
|
||||||
|
Result := GetImageInfo(fsImage);
|
||||||
|
finally
|
||||||
|
FreeAndNil(fsImage);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function GetImageInfo(const AStream: TStream): TX2ImageInfo;
|
||||||
|
var
|
||||||
|
iPos: Integer;
|
||||||
|
cBuffer: array[0..2] of Char;
|
||||||
|
cPNGBuffer: array[0..4] of Char;
|
||||||
|
GetDimensionsProc: TGetDimensionsProc;
|
||||||
|
|
||||||
|
begin
|
||||||
|
GetDimensionsProc := nil;
|
||||||
|
Result.ImgType := itUnknown;
|
||||||
|
Result.Width := 0;
|
||||||
|
Result.Height := 0;
|
||||||
|
|
||||||
|
FillChar(cBuffer, SizeOf(cBuffer), #0);
|
||||||
|
FillChar(cPNGBuffer, SizeOf(cPNGBuffer), #0);
|
||||||
|
|
||||||
|
iPos := AStream.Position;
|
||||||
|
AStream.Read(cBuffer, SizeOf(cBuffer));
|
||||||
|
|
||||||
|
if cBuffer = SIG_GIF then begin
|
||||||
|
{ GIF }
|
||||||
|
Result.ImgType := itGIF;
|
||||||
|
GetDimensionsProc := GetGIFDimensions;
|
||||||
|
end else if cBuffer = SIG_JPG then begin
|
||||||
|
{ JPG }
|
||||||
|
Result.ImgType := itJPG;
|
||||||
|
GetDimensionsProc := GetJPGDimensions;
|
||||||
|
end else if cBuffer = Copy(SIG_PNG, 1, 3) then begin
|
||||||
|
{ PNG }
|
||||||
|
AStream.Read(cPNGBuffer, SizeOf(cPNGBuffer));
|
||||||
|
|
||||||
|
if cPNGBuffer = Copy(SIG_PNG, 4, 5) then begin
|
||||||
|
Result.ImgType := itPNG;
|
||||||
|
GetDimensionsProc := GetPNGDimensions;
|
||||||
|
end;
|
||||||
|
end else if Copy(cBuffer, 1, 2) = SIG_BMP then begin
|
||||||
|
{ Bitmap }
|
||||||
|
Result.ImgType := itBMP;
|
||||||
|
GetDimensionsProc := GetBMPDimensions;
|
||||||
|
end;
|
||||||
|
|
||||||
|
AStream.Position := iPos;
|
||||||
|
|
||||||
|
if Assigned(GetDimensionsProc) then begin
|
||||||
|
GetDimensionsProc(AStream, Result);
|
||||||
|
AStream.Position := iPos;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function GetImageSize(const AFilename: String): TSize;
|
||||||
|
begin
|
||||||
|
with GetImageInfo(AFilename) do
|
||||||
|
begin
|
||||||
|
Result.cx := Width;
|
||||||
|
Result.cy := Height;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function GetImageSize(const AStream: TStream): TSize;
|
||||||
|
begin
|
||||||
|
with GetImageInfo(AStream) do
|
||||||
|
begin
|
||||||
|
Result.cx := Width;
|
||||||
|
Result.cy := Height;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function GetImageType(const AFilename: String): TX2ImageType;
|
||||||
|
begin
|
||||||
|
Result := GetImageInfo(AFilename).ImgType;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function GetImageType(const AStream: TStream): TX2ImageType;
|
||||||
|
begin
|
||||||
|
Result := GetImageInfo(AStream).ImgType;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
@ -10,10 +10,12 @@ unit X2UtMisc;
|
|||||||
|
|
||||||
interface
|
interface
|
||||||
//:$ Returns IfTrue or IfFalse depending on the Value
|
//:$ Returns IfTrue or IfFalse depending on the Value
|
||||||
function iif(const AValue: Boolean; const AIfTrue, AIfFalse: Integer): Integer; overload;
|
function iif(const AValue: Boolean; const AIfTrue: Integer;
|
||||||
|
const AIfFalse: Integer = 0): Integer; overload;
|
||||||
|
|
||||||
//:$ Returns IfTrue or IfFalse depending on the Value
|
//:$ Returns IfTrue or IfFalse depending on the Value
|
||||||
function iif(const AValue: Boolean; const AIfTrue, AIfFalse: String): String; overload;
|
function iif(const AValue: Boolean; const AIfTrue: String;
|
||||||
|
const AIfFalse: String = ''): String; overload;
|
||||||
|
|
||||||
//:$ Compares two integers
|
//:$ Compares two integers
|
||||||
//:: Returns 0 if the values are equal, 1 if Value1 is greater than Value2 and
|
//:: Returns 0 if the values are equal, 1 if Value1 is greater than Value2 and
|
||||||
|
@ -94,7 +94,9 @@ var
|
|||||||
continue: Boolean;
|
continue: Boolean;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Result := True;
|
Result := (AObject.ClassInfo <> nil);
|
||||||
|
if not Result then
|
||||||
|
Exit;
|
||||||
|
|
||||||
{ Iterate through published properties }
|
{ Iterate through published properties }
|
||||||
propCount := GetPropList(AObject.ClassInfo, tkProperties, nil);
|
propCount := GetPropList(AObject.ClassInfo, tkProperties, nil);
|
||||||
|
Loading…
Reference in New Issue
Block a user