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

UnitTests/Units/PersistTest.pas

@@ -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.
+

UnitTests/X2UtUnitTests.bdsproj

@@ -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>

UnitTests/X2UtUnitTests.cfg

@@ -34,6 +34,10 @@
 -K$00400000
 -LE"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-UNIT_PLATFORM
 -w-UNSAFE_TYPE

UnitTests/X2UtUnitTests.dpr

@@ -5,12 +5,14 @@ uses
   GUITestRunner,
   Variants,
   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';
 
 begin
 //  MemChk();
   RunRegisteredTests();
 end.
- 
+ 

UnitTests/X2UtUnitTests.mes

@@ -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

X2UtGraphics.pas

@@ -177,7 +177,7 @@ begin
     cBack   := ColorToRGB(ABackground);
     cFore   := ColorToRGB(AForeground);
     iBack   := 256 - AAlpha;
-    iFore   := Succ(AAlpha);
+    iFore   := AAlpha;
 
     Result  := RGB(((GetRValue(cBack) * iBack) +
                     (GetRValue(cFore) * iFore)) shr 8,

X2UtHashes.pas

@@ -238,9 +238,6 @@ type
     FCursor:            TX2HashCursor;
     FKeyManager:        TX2CustomHashManager;
     FValueManager:      TX2CustomHashManager;
-
-    FKeys:              TObject;
-    FValues:            TObject;
   protected
     function CreateCursor(): TX2HashCursor; virtual;
     function CreateKeyManager(): TX2CustomHashManager; virtual; abstract;

X2UtImageInfo.pas

@@ -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.

X2UtMisc.pas

@@ -10,10 +10,12 @@ unit X2UtMisc;
 
 interface
   //:$ 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
-  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
   //:: Returns 0 if the values are equal, 1 if Value1 is greater than Value2 and

X2UtPersist.pas

@@ -94,8 +94,10 @@ var
   continue:       Boolean;
 
 begin
-  Result  := True;
+  Result  := (AObject.ClassInfo <> nil);
-  
+  if not Result then
+    Exit;
+
   { Iterate through published properties }
   propCount := GetPropList(AObject.ClassInfo, tkProperties, nil);
   if propCount > 0 then