Changeset 93


Ignore:
Timestamp:
Jul 20, 2018, 10:25:06 AM (6 years ago)
Author:
chronos
Message:
Location:
trunk
Files:
7 added
5 deleted
54 edited

Legend:

Unmodified
Added
Removed

  • trunk

    • Property svn:ignore

      •  

        old new  
        66compiled
        77heaptrclog.trc
         8LazFuck.dbg

  • trunk/Forms/UFormMain.pas

    r92 r93  
    152152    procedure TargetLogExecute(Lines: TStrings);
    153153    procedure TargetStateChanged(Sender: TObject);
    154     procedure LoadFromRegistry(Root: HKEY; Key: string);
    155     procedure SaveToRegistry(Root: HKEY; Key: string);
     154    procedure LoadFromRegistry(Context: TRegistryContext);
     155    procedure SaveToRegistry(Context: TRegistryContext);
    156156    procedure UpdateInterface;
    157157    procedure UpdateStatusBar;
    … …  
    189189begin
    190190  Core.Init;
    191   LoadFromRegistry(HKEY(Core.ApplicationInfo.RegistryRoot), Core.ApplicationInfo.RegistryKey);
     191  LoadFromRegistry(Core.ApplicationInfo.GetRegistryContext);
    192192  PageControlMain.TabIndex := 0;
    193   if Core.OpenProjectOnStart and (Core.LastOpenedList.Items.Count > 0) then
    194     ProjectOpen(Core.LastOpenedList.Items[0])
    195     else AProjectNew.Execute;
    196   UpdateInterface;
    197   UpdateToolBarHints;
    198   UpdateTargetList;
    199   DockInit;
    200   Core.PersistentForm1.Load(Self, wsMaximized);
     193  try
     194    if Core.OpenProjectOnStart and (Core.LastOpenedList.Items.Count > 0) then
     195      ProjectOpen(Core.LastOpenedList.Items[0])
     196      else AProjectNew.Execute;
     197  finally
     198    LastOpenedListChange(nil);
     199    UpdateInterface;
     200    UpdateToolBarHints;
     201    UpdateTargetList;
     202    DockInit;
     203    Core.PersistentForm1.Load(Self, True);
     204  end;
    201205end;
    202206
    … …  
    293297end;
    294298
    295 procedure TFormMain.LoadFromRegistry(Root: HKEY; Key: string);
     299procedure TFormMain.LoadFromRegistry(Context: TRegistryContext);
    296300var
    297301  TargetName: string;
    … …  
    299303  with TRegistryEx.Create do
    300304  try
    301     RootKey := Root;
    302     OpenKey(Key, True);
     305    CurrentContext := Context;
    303306    TargetName := ReadStringWithDefault('TargetName', 'Interpretter');
    304307    Core.CurrentTarget := Core.Targets.FindByName(TargetName);
    … …  
    314317end;
    315318
    316 procedure TFormMain.SaveToRegistry(Root: HKEY; Key: string);
     319procedure TFormMain.SaveToRegistry(Context: TRegistryContext);
    317320begin
    318321  with TRegistryEx.Create do
    319322  try
    320     RootKey := Root;
    321     OpenKey(Key, True);
     323    CurrentContext := Context;
    322324    WriteString('TargetName', Core.CurrentTarget.Name);
    323325    WriteBool('OptimizationAddSubEnabled', Core.Optimizations.AddSub);
    … …  
    397399procedure TFormMain.FormDestroy(Sender: TObject);
    398400begin
    399   SaveToRegistry(HKEY(Core.ApplicationInfo.RegistryRoot), Core.ApplicationInfo.RegistryKey);
     401  SaveToRegistry(Core.ApplicationInfo.GetRegistryContext);
    400402end;
    401403

  • trunk/LazFuck.lpi

    r92 r93  
    1919      <OutDir Value="Languages"/>
    2020    </i18n>
    21     <MacroValues Count="1"/>
    22     <BuildModes Count="4">
     21    <BuildModes Count="2">
    2322      <Item1 Name="Debug" Default="True"/>
    2423      <Item2 Name="Release">
    … …  
    3231            <IncludeFiles Value="$(ProjOutDir)"/>
    3332            <OtherUnitFiles Value="Forms;Target"/>
    34             <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     33            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    3534          </SearchPaths>
    3635          <Parsing>
    … …  
    5251              <GenerateDebugInfo Value="False"/>
    5352            </Debugging>
     53            <LinkSmart Value="True"/>
    5454            <Options>
    5555              <Win32>
    … …  
    6060        </CompilerOptions>
    6161      </Item2>
    62       <Item3 Name="Windows 32-bit">
    63         <CompilerOptions>
    64           <Version Value="11"/>
    65           <PathDelim Value="\"/>
    66           <Target>
    67             <Filename Value="lib\$(TargetCPU)-$(TargetOS)\LazFuck"/>
    68           </Target>
    69           <SearchPaths>
    70             <IncludeFiles Value="$(ProjOutDir)"/>
    71             <OtherUnitFiles Value="Forms;Target"/>
    72             <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
    73           </SearchPaths>
    74           <Parsing>
    75             <SyntaxOptions>
    76               <SyntaxMode Value="Delphi"/>
    77               <CStyleOperator Value="False"/>
    78               <AllowLabel Value="False"/>
    79               <CPPInline Value="False"/>
    80             </SyntaxOptions>
    81           </Parsing>
    82           <CodeGeneration>
    83             <SmartLinkUnit Value="True"/>
    84             <TargetCPU Value="i386"/>
    85             <TargetOS Value="win32"/>
    86             <Optimizations>
    87               <OptimizationLevel Value="3"/>
    88             </Optimizations>
    89           </CodeGeneration>
    90           <Linking>
    91             <Debugging>
    92               <GenerateDebugInfo Value="False"/>
    93             </Debugging>
    94             <Options>
    95               <Win32>
    96                 <GraphicApplication Value="True"/>
    97               </Win32>
    98             </Options>
    99           </Linking>
    100         </CompilerOptions>
    101       </Item3>
    102       <Item4 Name="Windows 64-bit">
    103         <CompilerOptions>
    104           <Version Value="11"/>
    105           <PathDelim Value="\"/>
    106           <Target>
    107             <Filename Value="lib\$(TargetCPU)-$(TargetOS)\LazFuck"/>
    108           </Target>
    109           <SearchPaths>
    110             <IncludeFiles Value="$(ProjOutDir)"/>
    111             <OtherUnitFiles Value="Forms;Target"/>
    112             <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
    113           </SearchPaths>
    114           <Parsing>
    115             <SyntaxOptions>
    116               <SyntaxMode Value="Delphi"/>
    117               <CStyleOperator Value="False"/>
    118               <AllowLabel Value="False"/>
    119               <CPPInline Value="False"/>
    120             </SyntaxOptions>
    121           </Parsing>
    122           <CodeGeneration>
    123             <SmartLinkUnit Value="True"/>
    124             <TargetCPU Value="x86_64"/>
    125             <TargetOS Value="win64"/>
    126             <Optimizations>
    127               <OptimizationLevel Value="3"/>
    128             </Optimizations>
    129           </CodeGeneration>
    130           <Linking>
    131             <Debugging>
    132               <GenerateDebugInfo Value="False"/>
    133             </Debugging>
    134             <Options>
    135               <Win32>
    136                 <GraphicApplication Value="True"/>
    137               </Win32>
    138             </Options>
    139           </Linking>
    140         </CompilerOptions>
    141       </Item4>
    142       <SharedMatrixOptions Count="1">
    143         <Item1 ID="509373414797" Modes="Debug" Type="IDEMacro"/>
    144       </SharedMatrixOptions>
    14562    </BuildModes>
    14663    <PublishOptions>
    … …  
    335252      <IncludeFiles Value="$(ProjOutDir)"/>
    336253      <OtherUnitFiles Value="Forms;Target"/>
    337       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     254      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    338255    </SearchPaths>
    339256    <Parsing>
    … …  
    358275      <Debugging>
    359276        <UseHeaptrc Value="True"/>
     277        <UseExternalDbgSyms Value="True"/>
    360278      </Debugging>
    361279      <Options>

  • trunk/Packages/Common/Common.lpk

    r73 r93  
    1111      <PathDelim Value="\"/>
    1212      <SearchPaths>
    13         <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     13        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    1414      </SearchPaths>
     15      <Parsing>
     16        <SyntaxOptions>
     17          <SyntaxMode Value="Delphi"/>
     18          <CStyleOperator Value="False"/>
     19          <AllowLabel Value="False"/>
     20          <CPPInline Value="False"/>
     21        </SyntaxOptions>
     22      </Parsing>
     23      <CodeGeneration>
     24        <Optimizations>
     25          <OptimizationLevel Value="0"/>
     26        </Optimizations>
     27      </CodeGeneration>
     28      <Linking>
     29        <Debugging>
     30          <GenerateDebugInfo Value="False"/>
     31        </Debugging>
     32      </Linking>
     33      <Other>
     34        <CompilerMessages>
     35          <IgnoredMessages idx5024="True"/>
     36        </CompilerMessages>
     37      </Other>
    1538    </CompilerOptions>
    1639    <Description Value="Various libraries"/>
    1740    <License Value="GNU/GPL"/>
    1841    <Version Minor="7"/>
    19     <Files Count="20">
     42    <Files Count="22">
    2043      <Item1>
    2144        <Filename Value="StopWatch.pas"/>
    … …  
    106129        <UnitName Value="UScaleDPI"/>
    107130      </Item20>
     131      <Item21>
     132        <Filename Value="UTheme.pas"/>
     133        <HasRegisterProc Value="True"/>
     134        <UnitName Value="UTheme"/>
     135      </Item21>
     136      <Item22>
     137        <Filename Value="UStringTable.pas"/>
     138        <UnitName Value="UStringTable"/>
     139      </Item22>
    108140    </Files>
    109141    <i18n>

  • trunk/Packages/Common/Common.pas

    r73 r93  
    55unit Common;
    66
     7{$warn 5023 off : no warning about unused units}
    78interface
    89
    … …  
    1112  UMemory, UResetableThread, UPool, ULastOpenedList, URegistry,
    1213  UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort,
    13   UPersistentForm, UFindFile, UScaleDPI, LazarusPackageIntf;
     14  UPersistentForm, UFindFile, UScaleDPI, UTheme, UStringTable,
     15  LazarusPackageIntf;
    1416
    1517implementation
    … …  
    2527  RegisterUnit('UFindFile', @UFindFile.Register);
    2628  RegisterUnit('UScaleDPI', @UScaleDPI.Register);
     29  RegisterUnit('UTheme', @UTheme.Register);
    2730end;
    2831

  • trunk/Packages/Common/Languages

    • Property svn:ignore set to
      *.mo

  • trunk/Packages/Common/Languages/UJobProgressView.po

    r73 r93  
    1515
    1616#: ujobprogressview.soperations
    17 msgid "Operations"
     17msgid "Operations:"
    1818msgstr ""
    1919

  • trunk/Packages/Common/UApplicationInfo.pas

    r73 r93  
    66
    77uses
    8   SysUtils, Registry, Classes, Forms, URegistry;
     8  SysUtils, Classes, Forms, URegistry, Controls;
    99
    1010type
    … …  
    1414  TApplicationInfo = class(TComponent)
    1515  private
     16    FDescription: TCaption;
    1617    FIdentification: Byte;
    1718    FLicense: string;
    … …  
    3334    constructor Create(AOwner: TComponent); override;
    3435    property Version: string read GetVersion;
     36    function GetRegistryContext: TRegistryContext;
    3537  published
    3638    property Identification: Byte read FIdentification write FIdentification;
    … …  
    4547    property EmailContact: string read FEmailContact write FEmailContact;
    4648    property AppName: string read FAppName write FAppName;
     49    property Description: string read FDescription write FDescription;
    4750    property ReleaseDate: TDateTime read FReleaseDate write FReleaseDate;
    4851    property RegistryKey: string read FRegistryKey write FRegistryKey;
    … …  
    5457
    5558implementation
    56                        
     59
    5760procedure Register;
    5861begin
    … …  
    7982end;
    8083
     84function TApplicationInfo.GetRegistryContext: TRegistryContext;
     85begin
     86  Result := TRegistryContext.Create(RegistryRoot, RegistryKey);
     87end;
     88
    8189end.

  • trunk/Packages/Common/UCommon.pas

    r74 r93  
    2828    unfDNSDomainName = 11);
    2929
     30  TFilterMethodMethod = function (FileName: string): Boolean of object;
    3031var
    3132  ExceptionHandler: TExceptionEvent;
    … …  
    6364procedure OpenWebPage(URL: string);
    6465procedure OpenFileInShell(FileName: string);
    65 procedure ExecuteProgram(CommandLine: string);
     66procedure ExecuteProgram(Executable: string; Parameters: array of string);
    6667procedure FreeThenNil(var Obj);
    6768function RemoveQuotes(Text: string): string;
    … …  
    7172function MergeArray(A, B: array of string): TArrayOfString;
    7273function LoadFileToStr(const FileName: TFileName): AnsiString;
     74procedure SearchFiles(AList: TStrings; Dir: string;
     75  FilterMethod: TFilterMethodMethod = nil);
     76function GetStringPart(var Text: string; Separator: string): string;
     77function PosFromIndex(SubStr: string; Text: string;
     78  StartIndex: Integer): Integer;
     79function PosFromIndexReverse(SubStr: string; Text: string;
     80  StartIndex: Integer): Integer;
    7381
    7482
    … …  
    112120  Path := IncludeTrailingPathDelimiter(APath);
    113121
    114   Find := FindFirst(UTF8Decode(Path + AFileSpec), faAnyFile xor faDirectory, SearchRec);
     122  Find := FindFirst(Path + AFileSpec, faAnyFile xor faDirectory, SearchRec);
    115123  while Find = 0 do begin
    116     DeleteFile(Path + UTF8Encode(SearchRec.Name));
     124    DeleteFile(Path + SearchRec.Name);
    117125
    118126    Find := SysUtils.FindNext(SearchRec);
    … …  
    429437end;
    430438
    431 procedure ExecuteProgram(CommandLine: string);
     439procedure ExecuteProgram(Executable: string; Parameters: array of string);
    432440var
    433441  Process: TProcess;
     442  I: Integer;
    434443begin
    435444  try
    436445    Process := TProcess.Create(nil);
    437     Process.CommandLine := CommandLine;
     446    Process.Executable := Executable;
     447    for I := 0 to Length(Parameters) - 1 do
     448      Process.Parameters.Add(Parameters[I]);
    438449    Process.Options := [poNoConsole];
    439450    Process.Execute;
    … …  
    456467procedure OpenFileInShell(FileName: string);
    457468begin
    458   ExecuteProgram('cmd.exe /c start "' + FileName + '"');
     469  ExecuteProgram('cmd.exe', ['/c', 'start', FileName]);
    459470end;
    460471
    … …  
    511522end;
    512523
    513 
     524function DefaultSearchFilter(const FileName: string): Boolean;
     525begin
     526  Result := True;
     527end;
     528
     529procedure SearchFiles(AList: TStrings; Dir: string;
     530  FilterMethod: TFilterMethodMethod = nil);
     531var
     532  SR: TSearchRec;
     533begin
     534  Dir := IncludeTrailingPathDelimiter(Dir);
     535  if FindFirst(Dir + '*', faAnyFile, SR) = 0 then
     536    try
     537      repeat
     538        if (SR.Name = '.') or (SR.Name = '..') or (Assigned(FilterMethod) and (not FilterMethod(SR.Name) or
     539          not FilterMethod(Copy(Dir, 3, Length(Dir)) + SR.Name))) then Continue;
     540        AList.Add(Dir + SR.Name);
     541        if (SR.Attr and faDirectory) <> 0 then
     542          SearchFiles(AList, Dir + SR.Name, FilterMethod);
     543      until FindNext(SR) <> 0;
     544    finally
     545      FindClose(SR);
     546    end;
     547end;
     548
     549function GetStringPart(var Text: string; Separator: string): string;
     550var
     551  P: Integer;
     552begin
     553  P := Pos(Separator, Text);
     554  if P > 0 then begin
     555    Result := Copy(Text, 1, P - 1);
     556    Delete(Text, 1, P - 1 + Length(Separator));
     557  end else begin
     558    Result := Text;
     559    Text := '';
     560  end;
     561  Result := Trim(Result);
     562  Text := Trim(Text);
     563end;
     564
     565function PosFromIndex(SubStr: string; Text: string;
     566  StartIndex: Integer): Integer;
     567var
     568  I, MaxLen: SizeInt;
     569  Ptr: PAnsiChar;
     570begin
     571  Result := 0;
     572  if (StartIndex < 1) or (StartIndex > Length(Text) - Length(SubStr)) then Exit;
     573  if Length(SubStr) > 0 then begin
     574    MaxLen := Length(Text) - Length(SubStr) + 1;
     575    I := StartIndex;
     576    Ptr := @Text[StartIndex];
     577    while (I <= MaxLen) do begin
     578      if (SubStr[1] = Ptr^) and (CompareByte(Substr[1], Ptr^, Length(SubStr)) = 0) then begin
     579        Result := I;
     580        Exit;
     581      end;
     582      Inc(I);
     583      Inc(Ptr);
     584    end;
     585  end;
     586end;
     587
     588function PosFromIndexReverse(SubStr: string; Text: string;
     589  StartIndex: Integer): Integer;
     590var
     591  I: SizeInt;
     592  Ptr: PAnsiChar;
     593begin
     594  Result := 0;
     595  if (StartIndex < 1) or (StartIndex > Length(Text)) then Exit;
     596  if Length(SubStr) > 0 then begin
     597    I := StartIndex;
     598    Ptr := @Text[StartIndex];
     599    while (I > 0) do begin
     600      if (SubStr[1] = Ptr^) and (CompareByte(Substr[1], Ptr^, Length(SubStr)) = 0) then begin
     601        Result := I;
     602        Exit;
     603      end;
     604      Dec(I);
     605      Dec(Ptr);
     606    end;
     607  end;
     608end;
    514609
    515610initialization

  • trunk/Packages/Common/UDebugLog.pas

    r73 r93  
    104104    if ExtractFileDir(FileName) <> '' then
    105105      ForceDirectories(ExtractFileDir(FileName));
    106     if FileExists(FileName) then LogFile := TFileStream.Create(UTF8Decode(FileName), fmOpenWrite)
    107       else LogFile := TFileStream.Create(UTF8Decode(FileName), fmCreate);
     106    if FileExists(FileName) then LogFile := TFileStream.Create(FileName, fmOpenWrite)
     107      else LogFile := TFileStream.Create(FileName, fmCreate);
    108108    LogFile.Seek(0, soFromEnd);
    109109    Text := FormatDateTime('hh:nn:ss.zzz', Now) + ': ' + Text + LineEnding;

  • trunk/Packages/Common/UFindFile.pas

    r73 r93  
    2424
    2525uses
    26   SysUtils, Classes, Graphics, Controls, Forms, Dialogs, FileCtrl;
     26  SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
    2727
    2828type
    … …  
    117117  Attr := 0;
    118118  if ffaReadOnly in FileAttr then Attr := Attr + faReadOnly;
    119   if ffaHidden in FileAttr then Attr := Attr + faHidden;
    120   if ffaSysFile in FileAttr then Attr := Attr + faSysFile;
    121   if ffaVolumeID in FileAttr then Attr := Attr + faVolumeID;
     119  if ffaHidden in FileAttr then Attr := Attr + 2; //faHidden; use constant to avoid platform warning
     120  if ffaSysFile in FileAttr then Attr := Attr + 4; //faSysFile; use constant to avoid platform warning
     121  // Deprecated: if ffaVolumeID in FileAttr then Attr := Attr + faVolumeID;
    122122  if ffaDirectory in FileAttr then Attr := Attr + faDirectory;
    123123  if ffaArchive in FileAttr then Attr := Attr + faArchive;
    124124  if ffaAnyFile in FileAttr then Attr := Attr + faAnyFile;
    125125
    126   if SysUtils.FindFirst(UTF8Decode(inPath + FileMask), Attr, Rec) = 0 then
     126  if SysUtils.FindFirst(inPath + FileMask, Attr, Rec) = 0 then
    127127  try
    128128    repeat
    129       s.Add(inPath + UTF8Encode(Rec.Name));
     129      s.Add(inPath + Rec.Name);
    130130    until SysUtils.FindNext(Rec) <> 0;
    131131  finally
    … …  
    135135  If not InSubFolders then Exit;
    136136
    137   if SysUtils.FindFirst(UTF8Decode(inPath + FilterAll), faDirectory, Rec) = 0 then
     137  if SysUtils.FindFirst(inPath + FilterAll, faDirectory, Rec) = 0 then
    138138  try
    139139    repeat
    140140      if ((Rec.Attr and faDirectory) > 0) and (Rec.Name <> '.')
    141141      and (Rec.Name <> '..') then
    142         FileSearch(IncludeTrailingBackslash(inPath + UTF8Encode(Rec.Name)));
     142        FileSearch(IncludeTrailingBackslash(inPath + Rec.Name));
    143143    until SysUtils.FindNext(Rec) <> 0;
    144144  finally

  • trunk/Packages/Common/UJobProgressView.lfm

    r73 r93  
    11object FormJobProgressView: TFormJobProgressView
    22  Left = 467
    3   Height = 246
     3  Height = 345
    44  Top = 252
    5   Width = 328
     5  Width = 539
    66  BorderIcons = [biSystemMenu]
    7   ClientHeight = 246
    8   ClientWidth = 328
    9   Font.Height = -11
    10   Font.Name = 'MS Sans Serif'
     7  ClientHeight = 345
     8  ClientWidth = 539
     9  DesignTimePPI = 120
    1110  OnClose = FormClose
    1211  OnCloseQuery = FormCloseQuery
    1312  OnCreate = FormCreate
    1413  OnDestroy = FormDestroy
     14  OnHide = FormHide
     15  OnShow = FormShow
    1516  Position = poScreenCenter
    16   LCLVersion = '1.6.0.4'
     17  LCLVersion = '1.8.2.0'
    1718  object PanelOperationsTitle: TPanel
    1819    Left = 0
    19     Height = 24
     20    Height = 32
    2021    Top = 0
    21     Width = 328
    22     Align = alTop
    23     BevelOuter = bvNone
    24     ClientHeight = 24
    25     ClientWidth = 328
     22    Width = 539
     23    Align = alTop
     24    BevelOuter = bvNone
     25    ClientHeight = 32
     26    ClientWidth = 539
    2627    FullRepaint = False
    2728    TabOrder = 0
    2829    object LabelOperation: TLabel
    2930      Left = 8
    30       Height = 13
     31      Height = 20
    3132      Top = 8
    32       Width = 66
     33      Width = 76
    3334      Caption = 'Operations:'
    34       Font.Height = -11
    35       Font.Name = 'MS Sans Serif'
    36       Font.Style = [fsBold]
    3735      ParentColor = False
    3836      ParentFont = False
    … …  
    4139  object PanelLog: TPanel
    4240    Left = 0
    43     Height = 122
    44     Top = 124
    45     Width = 328
     41    Height = 133
     42    Top = 212
     43    Width = 539
    4644    Align = alClient
    4745    BevelOuter = bvSpace
    48     ClientHeight = 122
    49     ClientWidth = 328
     46    ClientHeight = 133
     47    ClientWidth = 539
    5048    TabOrder = 1
    5149    object MemoLog: TMemo
    5250      Left = 8
    53       Height = 106
     51      Height = 117
    5452      Top = 8
    55       Width = 312
     53      Width = 523
    5654      Anchors = [akTop, akLeft, akRight, akBottom]
    5755      ReadOnly = True
    … …  
    6260  object PanelProgress: TPanel
    6361    Left = 0
    64     Height = 38
    65     Top = 50
    66     Width = 328
    67     Align = alTop
    68     BevelOuter = bvNone
    69     ClientHeight = 38
    70     ClientWidth = 328
     62    Height = 54
     63    Top = 106
     64    Width = 539
     65    Align = alTop
     66    BevelOuter = bvNone
     67    ClientHeight = 54
     68    ClientWidth = 539
    7169    TabOrder = 2
    7270    object ProgressBarPart: TProgressBar
    73       Left = 8
    74       Height = 17
    75       Top = 16
    76       Width = 312
     71      Left = 10
     72      Height = 24
     73      Top = 24
     74      Width = 523
    7775      Anchors = [akTop, akLeft, akRight]
    7876      TabOrder = 0
    … …  
    8078    object LabelEstimatedTimePart: TLabel
    8179      Left = 8
    82       Height = 13
     80      Height = 20
    8381      Top = -2
    84       Width = 71
     82      Width = 103
    8583      Caption = 'Estimated time:'
    8684      ParentColor = False
    … …  
    8987  object PanelOperations: TPanel
    9088    Left = 0
    91     Height = 26
    92     Top = 24
    93     Width = 328
    94     Align = alTop
    95     BevelOuter = bvNone
    96     ClientHeight = 26
    97     ClientWidth = 328
     89    Height = 42
     90    Top = 64
     91    Width = 539
     92    Align = alTop
     93    BevelOuter = bvNone
     94    ClientHeight = 42
     95    ClientWidth = 539
    9896    FullRepaint = False
    9997    TabOrder = 3
    10098    object ListViewJobs: TListView
    10199      Left = 8
    102       Height = 16
     100      Height = 32
    103101      Top = 5
    104       Width = 312
     102      Width = 523
    105103      Anchors = [akTop, akLeft, akRight, akBottom]
    106104      AutoWidthLastColumn = True
    … …  
    109107      Columns = <     
    110108        item
    111           Width = 312
     109          Width = 523
    112110        end>
    113111      OwnerData = True
    … …  
    122120  object PanelProgressTotal: TPanel
    123121    Left = 0
    124     Height = 36
    125     Top = 88
    126     Width = 328
    127     Align = alTop
    128     BevelOuter = bvNone
    129     ClientHeight = 36
    130     ClientWidth = 328
     122    Height = 52
     123    Top = 160
     124    Width = 539
     125    Align = alTop
     126    BevelOuter = bvNone
     127    ClientHeight = 52
     128    ClientWidth = 539
    131129    TabOrder = 4
    132130    object LabelEstimatedTimeTotal: TLabel
    133131      Left = 8
    134       Height = 13
     132      Height = 20
    135133      Top = 0
    136       Width = 97
     134      Width = 141
    137135      Caption = 'Total estimated time:'
    138136      ParentColor = False
    … …  
    140138    object ProgressBarTotal: TProgressBar
    141139      Left = 8
    142       Height = 16
    143       Top = 16
    144       Width = 312
     140      Height = 24
     141      Top = 24
     142      Width = 523
    145143      Anchors = [akTop, akLeft, akRight]
    146144      TabOrder = 0
     145    end
     146  end
     147  object PanelText: TPanel
     148    Left = 0
     149    Height = 32
     150    Top = 32
     151    Width = 539
     152    Align = alTop
     153    BevelOuter = bvNone
     154    ClientHeight = 32
     155    ClientWidth = 539
     156    TabOrder = 5
     157    object LabelText: TLabel
     158      Left = 8
     159      Height = 24
     160      Top = 8
     161      Width = 525
     162      Anchors = [akTop, akLeft, akRight]
     163      AutoSize = False
     164      ParentColor = False
    147165    end
    148166  end

  • trunk/Packages/Common/UJobProgressView.pas

    r73 r93  
    77uses
    88  SysUtils, Variants, Classes, Graphics, Controls, Forms, Syncobjs,
    9   Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading,
     9  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading, Math,
    1010  DateUtils;
    1111
    … …  
    1313  EstimatedTimeShowTreshold = 4;
    1414  EstimatedTimeShowTresholdTotal = 1;
    15   MemoLogHeight = 200;
    1615  UpdateInterval = 100; // ms
    1716
    … …  
    2423    FLock: TCriticalSection;
    2524    FOnChange: TNotifyEvent;
     25    FText: string;
    2626    FValue: Integer;
    2727    FMax: Integer;
    2828    procedure SetMax(const AValue: Integer);
     29    procedure SetText(AValue: string);
    2930    procedure SetValue(const AValue: Integer);
    3031  public
    … …  
    3536    property Value: Integer read FValue write SetValue;
    3637    property Max: Integer read FMax write SetMax;
     38    property Text: string read FText write SetText;
    3739    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    3840  end;
    … …  
    6971  end;
    7072
     73  TJobs = class(TObjectList)
     74  end;
     75
    7176  TJobThread = class(TListedThread)
    7277    procedure Execute; override;
    … …  
    8085  TFormJobProgressView = class(TForm)
    8186    ImageList1: TImageList;
     87    LabelText: TLabel;
    8288    Label2: TLabel;
    8389    LabelOperation: TLabel;
    … …  
    8692    ListViewJobs: TListView;
    8793    MemoLog: TMemo;
     94    PanelText: TPanel;
    8895    PanelProgressTotal: TPanel;
    8996    PanelOperationsTitle: TPanel;
    … …  
    94101    ProgressBarTotal: TProgressBar;
    95102    TimerUpdate: TTimer;
     103    procedure FormHide(Sender: TObject);
     104    procedure FormShow(Sender: TObject);
     105    procedure ReloadJobList;
    96106    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    97107    procedure FormDestroy(Sender: TObject);
    … …  
    100110    procedure FormCreate(Sender: TObject);
    101111    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     112    procedure UpdateHeight;
    102113  public
    103114    JobProgressView: TJobProgressView;
    … …  
    118129    TotalStartTime: TDateTime;
    119130    Log: TStringList;
     131    FForm: TFormJobProgressView;
    120132    procedure SetTerminate(const AValue: Boolean);
    121133    procedure UpdateProgress;
    122     procedure ReloadJobList;
    123     procedure StartJobs;
    124     procedure UpdateHeight;
    125134    procedure JobProgressChange(Sender: TObject);
    126135  public
    127     Form: TFormJobProgressView;
    128     Jobs: TObjectList; // TListObject<TJob>
     136    Jobs: TJobs;
    129137    CurrentJob: TJob;
    130138    CurrentJobIndex: Integer;
    … …  
    132140    destructor Destroy; override;
    133141    procedure Clear;
    134     procedure AddJob(Title: string; Method: TJobProgressViewMethod;
    135       NoThreaded: Boolean = False; WaitFor: Boolean = False);
    136     procedure Start(AAutoClose: Boolean = True);
     142    function AddJob(Title: string; Method: TJobProgressViewMethod;
     143      NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob;
     144    procedure Start;
    137145    procedure Stop;
    138146    procedure TermSleep(Delay: Integer);
     147    property Form: TFormJobProgressView read FForm;
    139148    property Terminate: Boolean read FTerminate write SetTerminate;
    140149  published
    … …  
    166175  STotalEstimatedTime = 'Total estimated time: %s';
    167176  SFinished = 'Finished';
    168   SOperations = 'Operations';
     177  SOperations = 'Operations:';
    169178
    170179procedure Register;
    … …  
    172181  RegisterComponents('Common', [TJobProgressView]);
    173182end;
     183
     184{ TJobThread }
    174185
    175186procedure TJobThread.Execute;
    … …  
    190201end;
    191202
    192 procedure TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod;
    193   NoThreaded: Boolean = False; WaitFor: Boolean = False);
     203{ TFormJobProgressView }
     204
     205procedure TFormJobProgressView.UpdateHeight;
    194206var
    195   NewJob: TJob;
    196 begin
    197   NewJob := TJob.Create;
    198   NewJob.ProgressView := Self;
    199   NewJob.Title := Title;
    200   NewJob.Method := Method;
    201   NewJob.NoThreaded := NoThreaded;
    202   NewJob.WaitFor := WaitFor;
    203   NewJob.Progress.Max := 100;
    204   NewJob.Progress.Reset;
    205   NewJob.Progress.OnChange := JobProgressChange;
    206   Jobs.Add(NewJob);
     207  H: Integer;
     208  PanelOperationsVisible: Boolean;
     209  PanelOperationsHeight: Integer;
     210  PanelProgressVisible: Boolean;
     211  PanelProgressTotalVisible: Boolean;
     212  PanelLogVisible: Boolean;
     213  MemoLogHeight: Integer = 200;
     214  I: Integer;
     215  ItemRect: TRect;
     216  MaxH: Integer;
     217begin
     218    H := PanelOperationsTitle.Height;
     219    PanelOperationsVisible := JobProgressView.Jobs.Count > 0;
     220    if PanelOperationsVisible <> PanelOperations.Visible then
     221      PanelOperations.Visible := PanelOperationsVisible;
     222    if ListViewJobs.Items.Count > 0 then begin
     223      Maxh := 0;
     224      for I := 0 to ListViewJobs.Items.Count - 1 do
     225      begin
     226        ItemRect := ListViewJobs.Items[i].DisplayRect(drBounds);
     227        Maxh := Max(Maxh, ItemRect.Top + (ItemRect.Bottom - ItemRect.Top));
     228      end;
     229      PanelOperationsHeight := Scale96ToScreen(12) + Maxh;
     230    end else PanelOperationsHeight := Scale96ToScreen(8);
     231    if PanelOperationsHeight <> PanelOperations.Height then
     232      PanelOperations.Height := PanelOperationsHeight;
     233    if PanelOperationsVisible then
     234      H := H + PanelOperations.Height;
     235
     236    PanelProgressVisible := (JobProgressView.Jobs.Count > 0) and not JobProgressView.Finished;
     237    if PanelProgressVisible <> PanelProgress.Visible then
     238      PanelProgress.Visible := PanelProgressVisible;
     239    if PanelProgressVisible then
     240      H := H + PanelProgress.Height;
     241    PanelProgressTotalVisible := (JobProgressView.Jobs.Count > 1) and not JobProgressView.Finished;
     242    if PanelProgressTotalVisible <> PanelProgressTotal.Visible then
     243      PanelProgressTotal.Visible := PanelProgressTotalVisible;
     244    if PanelProgressTotalVisible then
     245      H := H + PanelProgressTotal.Height;
     246    Constraints.MinHeight := H;
     247    PanelLogVisible := MemoLog.Lines.Count > 0;
     248    if PanelLogVisible <> PanelLog.Visible then
     249      PanelLog.Visible := PanelLogVisible;
     250    if PanelLogVisible then
     251      H := H + Scale96ToScreen(MemoLogHeight);
     252    if PanelText.Visible then
     253      H := H + PanelText.Height;
     254    if Height <> H then begin
     255      Height := H;
     256      Top := (Screen.Height - H) div 2;
     257    end;
     258end;
     259
     260procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);
     261var
     262  ProgressBarPartVisible: Boolean;
     263  ProgressBarTotalVisible: Boolean;
     264begin
     265  JobProgressView.UpdateProgress;
     266  if Visible and (not ProgressBarPart.Visible) and
     267  Assigned(JobProgressView.CurrentJob) and
     268  (JobProgressView.CurrentJob.Progress.Value > 0) then begin
     269    ProgressBarPartVisible := True;
     270    if ProgressBarPartVisible <> ProgressBarPart.Visible then
     271      ProgressBarPart.Visible := ProgressBarPartVisible;
     272    ProgressBarTotalVisible := True;
     273    if ProgressBarTotalVisible <> ProgressBarTotal.Visible then
     274      ProgressBarTotal.Visible := ProgressBarTotalVisible;
     275  end;
     276  if not Visible then begin
     277    TimerUpdate.Interval := UpdateInterval;
     278    if not JobProgressView.OwnerDraw then Show;
     279  end;
     280  if Assigned(JobProgressView.CurrentJob) then begin
     281    LabelText.Caption := JobProgressView.CurrentJob.Progress.Text;
     282    if LabelText.Caption <> '' then begin
     283      PanelText.Visible := True;
     284      UpdateHeight;
     285    end;
     286  end;
     287end;
     288
     289procedure TFormJobProgressView.FormDestroy(Sender:TObject);
     290begin
     291end;
     292
     293procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);
     294begin
     295  if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then
     296  with TJob(JobProgressView.Jobs[Item.Index]) do begin
     297    Item.Caption := Title;
     298    if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1
     299      else if Finished then Item.ImageIndex := 0
     300      else Item.ImageIndex := 2;
     301    Item.Data := JobProgressView.Jobs[Item.Index];
     302  end;
     303end;
     304
     305procedure TFormJobProgressView.FormClose(Sender: TObject;
     306  var CloseAction: TCloseAction);
     307begin
     308end;
     309
     310procedure TFormJobProgressView.FormCreate(Sender: TObject);
     311begin
     312  Caption := SPleaseWait;
     313  try
     314    //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) +
     315    //  DirectorySeparator + 'horse.avi';
     316    //Animate1.Active := True;
     317  except
     318
     319  end;
     320end;
     321
     322procedure TFormJobProgressView.ReloadJobList;
     323begin
     324  // Workaround for not showing first line
     325  //Form.ListViewJobs.Items.Count := Jobs.Count + 1;
     326  //Form.ListViewJobs.Refresh;
     327
     328  if ListViewJobs.Items.Count <> JobProgressView.Jobs.Count then
     329    ListViewJobs.Items.Count := JobProgressView.Jobs.Count;
     330  ListViewJobs.Refresh;
     331  Application.ProcessMessages;
     332  UpdateHeight;
     333end;
     334
     335procedure TFormJobProgressView.FormShow(Sender: TObject);
     336begin
     337  ReloadJobList;
     338end;
     339
     340procedure TFormJobProgressView.FormHide(Sender: TObject);
     341begin
     342  JobProgressView.Jobs.Clear;
     343  ReloadJobList;
     344end;
     345
     346procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     347begin
     348  CanClose := JobProgressView.Finished;
     349  JobProgressView.Terminate := True;
     350  Caption := SPleaseWait + STerminate;
     351end;
     352
     353
     354{ TJobProgressView }
     355
     356function TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod;
     357  NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob;
     358begin
     359  Result := TJob.Create;
     360  Result.ProgressView := Self;
     361  Result.Title := Title;
     362  Result.Method := Method;
     363  Result.NoThreaded := NoThreaded;
     364  Result.WaitFor := WaitFor;
     365  Result.Progress.Max := 100;
     366  Result.Progress.Reset;
     367  Result.Progress.OnChange := JobProgressChange;
     368  Jobs.Add(Result);
    207369  //ReloadJobList;
    208370end;
    209371
    210 procedure TJobProgressView.Start(AAutoClose: Boolean = True);
    211 begin
    212   AutoClose := AAutoClose;
    213   StartJobs;
    214 end;
    215 
    216 procedure TJobProgressView.StartJobs;
     372procedure TJobProgressView.Start;
    217373var
    218374  I: Integer;
    … …  
    229385    Form.MemoLog.Clear;
    230386
     387    Form.PanelText.Visible := False;
    231388    Form.LabelEstimatedTimePart.Visible := False;
    232389    Form.LabelEstimatedTimeTotal.Visible := False;
    … …  
    258415      Form.ProgressBarPart.Visible := False;
    259416      //Show;
    260       ReloadJobList;
     417      Form.ReloadJobList;
    261418      Application.ProcessMessages;
    262419      if NoThreaded then begin
    … …  
    296453    //if Visible then Hide;
    297454    Form.MemoLog.Lines.Assign(Log);
    298     if (Form.MemoLog.Lines.Count = 0) and AutoClose then begin
     455    if (Form.MemoLog.Lines.Count = 0) and FAutoClose then begin
    299456      Form.Hide;
    300457    end;
    301     Clear;
     458    if not Form.Visible then Clear;
    302459    Form.Caption := SFinished;
    303460    //LabelEstimatedTimePart.Visible := False;
    304461    Finished := True;
    305462    CurrentJobIndex := -1;
    306     ReloadJobList;
    307   end;
    308 end;
    309 
    310 procedure TJobProgressView.UpdateHeight;
    311 var
    312   H: Integer;
    313   PanelOperationsVisible: Boolean;
    314   PanelOperationsHeight: Integer;
    315   PanelProgressVisible: Boolean;
    316   PanelProgressTotalVisible: Boolean;
    317   PanelLogVisible: Boolean;
    318 begin
    319   with Form do begin
    320   H := PanelOperationsTitle.Height;
    321   PanelOperationsVisible := Jobs.Count > 0;
    322   if PanelOperationsVisible <> PanelOperations.Visible then
    323     PanelOperations.Visible := PanelOperationsVisible;
    324   PanelOperationsHeight := 8 + 18 * Jobs.Count;
    325   if PanelOperationsHeight <> PanelOperations.Height then
    326     PanelOperations.Height := PanelOperationsHeight;
    327   if PanelOperationsVisible then
    328     H := H + PanelOperations.Height;
    329 
    330   PanelProgressVisible := (Jobs.Count > 0) and not Finished;
    331   if PanelProgressVisible <> PanelProgress.Visible then
    332     PanelProgress.Visible := PanelProgressVisible;
    333   if PanelProgressVisible then
    334     H := H + PanelProgress.Height;
    335   PanelProgressTotalVisible := (Jobs.Count > 1) and not Finished;
    336   if PanelProgressTotalVisible <> PanelProgressTotal.Visible then
    337     PanelProgressTotal.Visible := PanelProgressTotalVisible;
    338   if PanelProgressTotalVisible then
    339     H := H + PanelProgressTotal.Height;
    340   Constraints.MinHeight := H;
    341   PanelLogVisible := MemoLog.Lines.Count > 0;
    342   if PanelLogVisible <> PanelLog.Visible then
    343     PanelLog.Visible := PanelLogVisible;
    344   if PanelLogVisible then
    345     H := H + MemoLogHeight;
    346   if Height <> H then Height := H;
     463    Form.ReloadJobList;
    347464  end;
    348465end;
    … …  
    352469  if Assigned(FOnOwnerDraw) then
    353470    FOnOwnerDraw(Self);
    354 end;
    355 
    356 procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);
    357 var
    358   ProgressBarPartVisible: Boolean;
    359   ProgressBarTotalVisible: Boolean;
    360 begin
    361   JobProgressView.UpdateProgress;
    362   if Visible and (not ProgressBarPart.Visible) and
    363   Assigned(JobProgressView.CurrentJob) and
    364   (JobProgressView.CurrentJob.Progress.Value > 0) then begin
    365     ProgressBarPartVisible := True;
    366     if ProgressBarPartVisible <> ProgressBarPart.Visible then
    367       ProgressBarPart.Visible := ProgressBarPartVisible;
    368     ProgressBarTotalVisible := True;
    369     if ProgressBarTotalVisible <> ProgressBarTotal.Visible then
    370       ProgressBarTotal.Visible := ProgressBarTotalVisible;
    371   end;
    372   if not Visible then begin
    373     TimerUpdate.Interval := UpdateInterval;
    374     if not JobProgressView.OwnerDraw then Show;
    375   end;
    376 end;
    377 
    378 procedure TFormJobProgressView.FormDestroy(Sender:TObject);
    379 begin
    380 end;
    381 
    382 procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);
    383 begin
    384   if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then
    385   with TJob(JobProgressView.Jobs[Item.Index]) do begin
    386     Item.Caption := Title;
    387     if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1
    388       else if Finished then Item.ImageIndex := 0
    389       else Item.ImageIndex := 2;
    390     Item.Data := JobProgressView.Jobs[Item.Index];
    391   end;
    392 end;
    393 
    394 procedure TFormJobProgressView.FormClose(Sender: TObject;
    395   var CloseAction: TCloseAction);
    396 begin
    397   ListViewJobs.Clear;
    398 end;
    399 
    400 procedure TFormJobProgressView.FormCreate(Sender: TObject);
    401 begin
    402   Caption := SPleaseWait;
    403   try
    404     //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) +
    405     //  DirectorySeparator + 'horse.avi';
    406     //Animate1.Active := True;
    407   except
    408 
    409   end;
    410471end;
    411472
    … …  
    426487    Sleep(Quantum);
    427488  end;
    428 end;
    429 
    430 procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    431 begin
    432   CanClose := JobProgressView.Finished;
    433   JobProgressView.Terminate := True;
    434   Caption := SPleaseWait + STerminate;
    435489end;
    436490
    … …  
    490544end;
    491545
    492 procedure TJobProgressView.ReloadJobList;
    493 begin
    494   UpdateHeight;
    495   // Workaround for not showing first line
    496   Form.ListViewJobs.Items.Count := Jobs.Count + 1;
    497   Form.ListViewJobs.Refresh;
    498 
    499   if Form.ListViewJobs.Items.Count <> Jobs.Count then
    500     Form.ListViewJobs.Items.Count := Jobs.Count;
    501   Form.ListViewJobs.Refresh;
    502   //Application.ProcessMessages;
    503 end;
    504 
    505546constructor TJobProgressView.Create(TheOwner: TComponent);
    506547begin
    507548  inherited;
    508549  if not (csDesigning in ComponentState) then begin
    509     Form := TFormJobProgressView.Create(Self);
    510     Form.JobProgressView := Self;
    511   end;
    512   Jobs := TObjectList.Create;
     550    FForm := TFormJobProgressView.Create(Self);
     551    FForm.JobProgressView := Self;
     552  end;
     553  Jobs := TJobs.Create;
    513554  Log := TStringList.Create;
    514555  //PanelOperationsTitle.Height := 80;
    515   ShowDelay := 0; //1000; // ms
     556  AutoClose := True;
     557  ShowDelay := 0;
    516558end;
    517559
    … …  
    519561begin
    520562  Jobs.Clear;
     563  Log.Clear;
    521564  //ReloadJobList;
    522565end;
    … …  
    528571  inherited;
    529572end;
     573
     574{ TProgress }
    530575
    531576procedure TProgress.SetMax(const AValue: Integer);
    … …  
    536581    if FMax < 1 then FMax := 1;
    537582    if FValue >= FMax then FValue := FMax;
     583  finally
     584    FLock.Release;
     585  end;
     586end;
     587
     588procedure TProgress.SetText(AValue: string);
     589begin
     590  try
     591    FLock.Acquire;
     592    if FText = AValue then Exit;
     593    FText := AValue;
    538594  finally
    539595    FLock.Release;
    … …  
    563619end;
    564620
    565 { TProgress }
    566 
    567621procedure TProgress.Increment;
    568622begin

  • trunk/Packages/Common/ULastOpenedList.pas

    r73 r93  
    66
    77uses
    8   Classes, SysUtils, Registry, URegistry, Menus, XMLConf;
     8  Classes, SysUtils, Registry, URegistry, Menus, XMLConf, DOM;
    99
    1010type
    … …  
    139139    OpenKey(Context.Key, True);
    140140    for I := 0 to Items.Count - 1 do
    141       WriteString('File' + IntToStr(I), UTF8Decode(Items[I]));
     141      WriteString('File' + IntToStr(I), Items[I]);
    142142  finally
    143143    Free;
    … …  
    153153begin
    154154  with XMLConfig do begin
    155     Count := GetValue(Path + '/Count', 0);
     155    Count := GetValue(DOMString(Path + '/Count'), 0);
    156156    if Count > MaxCount then Count := MaxCount;
    157157    Items.Clear;
    158158    for I := 0 to Count - 1 do begin
    159       Value := GetValue(Path + '/File' + IntToStr(I), '');
     159      Value := string(GetValue(DOMString(Path + '/File' + IntToStr(I)), ''));
    160160      if Trim(Value) <> '' then Items.Add(Value);
    161161    end;
    … …  
    170170begin
    171171  with XMLConfig do begin
    172     SetValue(Path + '/Count', Items.Count);
     172    SetValue(DOMString(Path + '/Count'), Items.Count);
    173173    for I := 0 to Items.Count - 1 do
    174       SetValue(Path + '/File' + IntToStr(I), Items[I]);
     174      SetValue(DOMString(Path + '/File' + IntToStr(I)), DOMString(Items[I]));
    175175    Flush;
    176176  end;

  • trunk/Packages/Common/UListViewSort.pas

    r73 r93  
    8181    FOnChange: TNotifyEvent;
    8282    FStringGrid1: TStringGrid;
    83     procedure DoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    84     procedure DoOnResize(Sender: TObject);
     83    procedure GridDoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
     84    procedure GridDoOnResize(Sender: TObject);
    8585  public
    8686    constructor Create(AOwner: TComponent); override;
    … …  
    110110{ TListViewFilter }
    111111
    112 procedure TListViewFilter.DoOnKeyUp(Sender: TObject; var Key: Word;
     112procedure TListViewFilter.GridDoOnKeyUp(Sender: TObject; var Key: Word;
    113113  Shift: TShiftState);
    114114begin
    … …  
    117117end;
    118118
    119 procedure TListViewFilter.DoOnResize(Sender: TObject);
     119procedure TListViewFilter.GridDoOnResize(Sender: TObject);
    120120begin
    121121  FStringGrid1.DefaultRowHeight := FStringGrid1.Height;
    … …  
    135135  FStringGrid1.Options := [goFixedHorzLine, goFixedVertLine, goVertLine,
    136136    goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll];
    137   FStringGrid1.OnKeyUp := DoOnKeyUp;
    138   FStringGrid1.OnResize := DoOnResize;
     137  FStringGrid1.OnKeyUp := GridDoOnKeyUp;
     138  FStringGrid1.OnResize := GridDoOnResize;
    139139end;
    140140
    … …  
    142142var
    143143  I: Integer;
     144  R: TRect;
    144145begin
    145146  with FStringGrid1 do begin
    146     //Columns.Clear;
    147147    while Columns.Count > ListView.Columns.Count do Columns.Delete(Columns.Count - 1);
    148148    while Columns.Count < ListView.Columns.Count do Columns.Add;
    149149    for I := 0 to ListView.Columns.Count - 1 do begin
    150150      Columns[I].Width := ListView.Columns[I].Width;
     151      if Selection.Left = I then begin
     152        R := CellRect(I, 0);
     153        Editor.Left := R.Left + 2;
     154        Editor.Width := R.Width - 4;
     155      end;
    151156    end;
    152157  end;
    … …  
    197202  if AMsg.Msg = WM_NOTIFY then
    198203  begin
    199     Code := PHDNotify(vMsgNotify.NMHdr)^.Hdr.Code;
     204    Code := NMHDR(PHDNotify(vMsgNotify.NMHdr)^.Hdr).Code;
    200205    case Code of
    201206      HDN_ENDTRACKA, HDN_ENDTRACKW:
    … …  
    353358  TP1: TPoint;
    354359  XBias, YBias: Integer;
    355   OldColor: TColor;
     360  PenColor: TColor;
     361  BrushColor: TColor;
    356362  BiasTop, BiasLeft: Integer;
    357363  Rect1: TRect;
    … …  
    365371  Item.Left := 0;
    366372  GetCheckBias(XBias, YBias, BiasTop, BiasLeft, ListView);
    367   OldColor := ListView.Canvas.Pen.Color;
     373  PenColor := ListView.Canvas.Pen.Color;
     374  BrushColor := ListView.Canvas.Brush.Color;
    368375  //TP1 := Item.GetPosition;
    369376  lRect := Item.DisplayRect(drBounds); // Windows 7 workaround
    … …  
    377384  ItemLeft := Item.Left;
    378385  ItemLeft := 23; // Windows 7 workaround
    379  
     386
    380387  Rect1.Left := ItemLeft - CheckWidth - BiasLeft + 1 + XBias;
    381388  //ShowMessage(IntToStr(Tp1.Y) + ', ' + IntToStr(BiasTop) + ', ' + IntToStr(XBias));
    … …  
    408415  end;
    409416  //ListView.Canvas.Brush.Color := ListView.Color;
    410   ListView.Canvas.Brush.Color := clWindow;
    411   ListView.Canvas.Pen.Color := OldColor;
     417  ListView.Canvas.Brush.Color := BrushColor;
     418  ListView.Canvas.Pen.Color := PenColor;
    412419end;
    413420
    … …  
    476483    FHeaderHandle := ListView_GetHeader(FListView.Handle);
    477484    for I := 0 to FListView.Columns.Count - 1 do begin
     485      {$push}{$warn 5057 off}
    478486      FillChar(Item, SizeOf(THDItem), 0);
     487      {$pop}
    479488      Item.Mask := HDI_FORMAT;
    480489      Header_GetItem(FHeaderHandle, I, Item);

  • trunk/Packages/Common/UMemory.pas

    r59 r93  
    2424    constructor Create;
    2525    destructor Destroy; override;
     26    procedure WriteMemory(Position: Integer; Memory: TMemory);
     27    procedure ReadMemory(Position: Integer; Memory: TMemory);
    2628    property Data: PByte read FData;
    2729    property Size: Integer read FSize write SetSize;
    … …  
    108110end;
    109111
     112procedure TMemory.WriteMemory(Position: Integer; Memory: TMemory);
     113begin
     114  Move(Memory.FData, PByte(@FData + Position)^, Memory.Size);
     115end;
     116
     117procedure TMemory.ReadMemory(Position: Integer; Memory: TMemory);
     118begin
     119  Move(PByte(@FData + Position)^, Memory.FData, Memory.Size);
     120end;
     121
    110122end.
    111123

  • trunk/Packages/Common/UPersistentForm.pas

    r81 r93  
    88
    99uses
    10   Classes, SysUtils, Forms, URegistry, LCLIntf, Registry, Controls, ComCtrls;
     10  Classes, SysUtils, Forms, URegistry, LCLIntf, Registry, Controls, ComCtrls,
     11  ExtCtrls;
    1112
    1213type
    … …  
    2627    FormWindowState: TWindowState;
    2728    Form: TForm;
    28     DefaultFormWindowState: TWindowState;
    2929    procedure LoadFromRegistry(RegistryContext: TRegistryContext);
    3030    procedure SaveToRegistry(RegistryContext: TRegistryContext);
    3131    function CheckEntireVisible(Rect: TRect): TRect;
    3232    function CheckPartVisible(Rect: TRect; Part: Integer): TRect;
    33     procedure Load(Form: TForm; DefaultFormWindowState: TWindowState = wsNormal);
     33    procedure Load(Form: TForm; DefaultMaximized: Boolean = False);
    3434    procedure Save(Form: TForm);
    3535    constructor Create(AOwner: TComponent); override;
    … …  
    7272  end;
    7373
     74  if (Control is TPanel) then begin
     75    with Form, TRegistryEx.Create do
     76    try
     77      RootKey := RegistryContext.RootKey;
     78      OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True);
     79      if (TPanel(Control).Align = alRight) or (TPanel(Control).Align = alLeft) then begin
     80        if ValueExists('Width') then
     81          TPanel(Control).Width := ReadInteger('Width');
     82      end;
     83      if (TPanel(Control).Align = alTop) or (TPanel(Control).Align = alBottom) then begin
     84        if ValueExists('Height') then
     85          TPanel(Control).Height := ReadInteger('Height');
     86      end;
     87    finally
     88      Free;
     89    end;
     90  end;
     91
    7492  if Control is TWinControl then begin
    7593    WinControl := TWinControl(Control);
    … …  
    96114      for I := 0 to TListView(Control).Columns.Count - 1 do begin
    97115        WriteInteger('ColWidth' + IntToStr(I), TListView(Control).Columns[I].Width);
     116      end;
     117    finally
     118      Free;
     119    end;
     120  end;
     121
     122  if (Control is TPanel) then begin
     123    with Form, TRegistryEx.Create do
     124    try
     125      RootKey := RegistryContext.RootKey;
     126      OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True);
     127      if (TPanel(Control).Align = alRight) or (TPanel(Control).Align = alLeft) then begin
     128        WriteInteger('Width', TPanel(Control).Width);
     129      end;
     130      if (TPanel(Control).Align = alTop) or (TPanel(Control).Align = alBottom) then begin
     131        WriteInteger('Height', TPanel(Control).Height);
    98132      end;
    99133    finally
    … …  
    135169      + FormRestoredSize.Top;
    136170    // Other state
    137     FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(DefaultFormWindowState)));
     171    FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(wsNormal)));
    138172  finally
    139173    Free;
    … …  
    216250end;
    217251
    218 procedure TPersistentForm.Load(Form: TForm; DefaultFormWindowState: TWindowState = wsNormal);
     252procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False);
    219253begin
    220254  Self.Form := Form;
    221   Self.DefaultFormWindowState := DefaultFormWindowState;
    222 
    223255  // Set default
    224256  FormNormalSize := Bounds((Screen.Width - Form.Width) div 2,
    … …  
    230262
    231263  if not EqualRect(FormNormalSize, FormRestoredSize) or
    232     (FormWindowState = wsMaximized) then begin
     264    DefaultMaximized then begin
    233265    // Restore to maximized state
    234266    Form.WindowState := wsNormal;

  • trunk/Packages/Common/URegistry.pas

    r59 r93  
    99
    1010type
    11   TRegistryRoot = (rrKeyClassesRoot = HKEY($80000000),
    12     rrKeyCurrentUser = HKEY($80000001),
    13     rrKeyLocalMachine = HKEY($80000002),
    14     rrKeyUsers = HKEY($80000003),
    15     rrKeyPerformanceData = HKEY($80000004),
    16     rrKeyCurrentConfig = HKEY($80000005),
    17     rrKeyDynData = HKEY($80000006));
     11  TRegistryRoot = (rrKeyClassesRoot, rrKeyCurrentUser, rrKeyLocalMachine,
     12    rrKeyUsers, rrKeyPerformanceData, rrKeyCurrentConfig, rrKeyDynData);
    1813
    1914  { TRegistryContext }
    … …  
    2318    Key: string;
    2419    class operator Equal(A, B: TRegistryContext): Boolean;
     20    function Create(RootKey: TRegistryRoot; Key: string): TRegistryContext; overload;
     21    function Create(RootKey: HKEY; Key: string): TRegistryContext; overload;
    2522  end;
    2623
    … …  
    4340  end;
    4441
    45 function RegContext(RootKey: HKEY; Key: string): TRegistryContext;
    46 
     42const
     43  RegistryRootHKEY: array[TRegistryRoot] of HKEY = (HKEY_CLASSES_ROOT,
     44    HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_PERFORMANCE_DATA,
     45    HKEY_CURRENT_CONFIG, HKEY_DYN_DATA);
    4746
    4847implementation
    4948
    50 function RegContext(RootKey: HKEY; Key: string): TRegistryContext;
    51 begin
    52   Result.RootKey := RootKey;
    53   Result.Key := Key;
    54 end;
    5549
    5650{ TRegistryContext }
    … …  
    5953begin
    6054  Result := (A.Key = B.Key) and (A.RootKey = B.RootKey);
     55end;
     56
     57function TRegistryContext.Create(RootKey: TRegistryRoot; Key: string): TRegistryContext;
     58begin
     59  Result.RootKey := RegistryRootHKEY[RootKey];
     60  Result.Key := Key;
     61end;
     62
     63function TRegistryContext.Create(RootKey: HKEY; Key: string): TRegistryContext;
     64begin
     65  Result.RootKey := RootKey;
     66  Result.Key := Key;
    6167end;
    6268

  • trunk/Packages/Common/UResetableThread.pas

    r59 r93  
    156156  FThread.Name := 'ResetableThread';
    157157  FThread.Parent := Self;
    158   FThread.Resume;
     158  FThread.Start;
    159159end;
    160160

  • trunk/Packages/Common/UScaleDPI.pas

    r88 r93  
    215215  I: Integer;
    216216begin
     217  ImgList.BeginUpdate;
    217218  NewWidth := ScaleX(ImgList.Width, FromDPI.X);
    218219  NewHeight := ScaleY(ImgList.Height, FromDPI.Y);
    … …  
    226227    Temp[I] := TBitmap.Create;
    227228    Temp[I].SetSize(NewWidth, NewHeight);
    228     {$ifdef linux}
    229     Temp[I].PixelFormat := pf24bit;
    230     {$else}
    231229    Temp[I].PixelFormat := pf32bit;
    232     {$endif}
    233230    Temp[I].TransparentColor := TempBmp.TransparentColor;
    234231    //Temp[I].TransparentMode := TempBmp.TransparentMode;
    … …  
    252249    Temp[i].Free;
    253250  end;
     251  ImgList.EndUpdate;
    254252end;
    255253
    … …  
    288286  WinControl: TWinControl;
    289287  ToolBarControl: TToolBar;
    290   OldAnchors: TAnchors;
    291   OldAutoSize: Boolean;
     288  //OldAnchors: TAnchors;
     289  //OldAutoSize: Boolean;
    292290begin
    293291  //if Control is TMemo then Exit;
    … …  
    320318        MinWidth := ScaleX(MinWidth, FromDPI.X);
    321319        MinHeight := ScaleY(MinHeight, FromDPI.Y);
    322         Width := ScaleX(Width, FromDPI.X);
     320        // Workaround to bad band width auto sizing
     321        //Width := ScaleX(Width, FromDPI.X);
     322        Width := ScaleX(Control.Width + 28, FromDPI.X);
    323323        //Control.Invalidate;
    324324      end;
     325    // Workaround for bad autosizing of coolbar
     326    if AutoSize then begin
     327      AutoSize := False;
     328      Height := ScaleY(Height, FromDPI.Y);
     329      AutoSize := True;
     330    end;
    325331    EndUpdate;
    326332  end;

  • trunk/Packages/Common/UThreading.pas

    r54 r93  
    3030    Name: string;
    3131    procedure Execute; virtual; abstract;
    32     procedure Resume; virtual; abstract;
    33     procedure Suspend; virtual; abstract;
    3432    procedure Start; virtual; abstract;
    3533    procedure Terminate; virtual; abstract;
    … …  
    8179    procedure Sleep(Delay: Integer); override;
    8280    procedure Execute; override;
    83     procedure Resume; override;
    84     procedure Suspend; override;
    8581    procedure Start; override;
    8682    procedure Terminate; override;
    … …  
    134130    Thread.FreeOnTerminate := False;
    135131    Thread.Method := Method;
    136     Thread.Resume;
     132    Thread.Start;
    137133    while (Thread.State = ttsRunning) or (Thread.State = ttsReady) do begin
    138134      if MainThreadID = ThreadID then Application.ProcessMessages;
    … …  
    155151    Thread.Method := Method;
    156152    Thread.OnFinished := CallBack;
    157     Thread.Resume;
     153    Thread.Start;
    158154    //if Thread.State = ttsExceptionOccured then
    159155    //  raise Exception.Create(Thread.ExceptionMessage);
    … …  
    313309procedure TListedThread.Execute;
    314310begin
    315 end;
    316 
    317 procedure TListedThread.Resume;
    318 begin
    319   FThread.Resume;
    320 end;
    321 
    322 procedure TListedThread.Suspend;
    323 begin
    324   FThread.Suspend;
    325311end;
    326312

  • trunk/Packages/Common/UURI.pas

    r73 r93  
    8989function LeftCutString(var Source: string; out Output: string; Delimiter: string; Allowed: string = ''): Boolean;
    9090var
    91   I, J: Integer;
     91  I: Integer;
    9292  Matched: Boolean;
    9393begin
    … …  
    113113function RightCutString(var Source: string; out Output: string; Delimiter: string; Allowed: string = ''): Boolean;
    114114var
    115   I, J: Integer;
     115  I: Integer;
    116116  Matched: Boolean;
    117117begin
    … …  
    202202
    203203procedure TURI.SetAsString(Value: string);
    204 var
    205   HostAddr: string;
    206   HostPort: string;
    207204begin
    208205  LeftCutString(Value, Scheme, ':');

  • trunk/Packages/Common/UXMLUtils.pas

    r73 r93  
    77uses
    88  {$IFDEF WINDOWS}Windows,{$ENDIF}
    9   Classes, SysUtils, DateUtils, XMLRead, XMLWrite, DOM;
     9  Classes, SysUtils, DateUtils, DOM;
    1010
    1111function XMLTimeToDateTime(XMLDateTime: string): TDateTime;
    12 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString;
     12function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): string;
    1313procedure WriteInteger(Node: TDOMNode; Name: string; Value: Integer);
    1414procedure WriteInt64(Node: TDOMNode; Name: string; Value: Int64);
    … …  
    3030  TimeZoneInfo: TTimeZoneInformation;
    3131begin
     32  {$push}{$warn 5057 off}
    3233  case GetTimeZoneInformation(TimeZoneInfo) of
    33   TIME_ZONE_ID_STANDARD: Result := TimeZoneInfo.Bias + TimeZoneInfo.StandardBias;
    34   TIME_ZONE_ID_DAYLIGHT: Result := TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias;
     34    TIME_ZONE_ID_STANDARD: Result := TimeZoneInfo.Bias + TimeZoneInfo.StandardBias;
     35    TIME_ZONE_ID_DAYLIGHT: Result := TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias;
    3536  else
    3637    Result := 0;
    3738  end;
     39  {$pop}
    3840end;
    3941{$ELSE}
    … …  
    4547function LeftCutString(var Source: string; out Output: string; Delimiter: string; Allowed: string = ''): Boolean;
    4648var
    47   I, J: Integer;
     49  I: Integer;
    4850  Matched: Boolean;
    4951begin
    … …  
    99101      if Pos('Z', XMLDateTime) > 0 then
    100102        LeftCutString(XMLDateTime, Part, 'Z');
    101       SecondFraction := StrToFloat('0' + DecimalSeparator + Part);
     103      SecondFraction := StrToFloat('0' + DefaultFormatSettings.DecimalSeparator + Part);
    102104      Millisecond := Trunc(SecondFraction * 1000);
    103105    end else begin
    … …  
    118120end;
    119121
    120 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString;
     122function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): string;
    121123const
    122124  Neg: array[Boolean] of string =  ('+', '-');
    … …  
    139141  NewNode: TDOMNode;
    140142begin
    141   NewNode := Node.OwnerDocument.CreateElement(Name);
    142   NewNode.TextContent := IntToStr(Value);
     143  NewNode := Node.OwnerDocument.CreateElement(DOMString(Name));
     144  NewNode.TextContent := DOMString(IntToStr(Value));
    143145  Node.AppendChild(NewNode);
    144146end;
    … …  
    148150  NewNode: TDOMNode;
    149151begin
    150   NewNode := Node.OwnerDocument.CreateElement(Name);
    151   NewNode.TextContent := IntToStr(Value);
     152  NewNode := Node.OwnerDocument.CreateElement(DOMString(Name));
     153  NewNode.TextContent := DOMString(IntToStr(Value));
    152154  Node.AppendChild(NewNode);
    153155end;
    … …  
    157159  NewNode: TDOMNode;
    158160begin
    159   NewNode := Node.OwnerDocument.CreateElement(Name);
    160   NewNode.TextContent := BoolToStr(Value);
     161  NewNode := Node.OwnerDocument.CreateElement(DOMString(Name));
     162  NewNode.TextContent := DOMString(BoolToStr(Value));
    161163  Node.AppendChild(NewNode);
    162164end;
    … …  
    166168  NewNode: TDOMNode;
    167169begin
    168   NewNode := Node.OwnerDocument.CreateElement(Name);
    169   NewNode.TextContent := Value;
     170  NewNode := Node.OwnerDocument.CreateElement(DOMString(Name));
     171  NewNode.TextContent := DOMString(Value);
    170172  Node.AppendChild(NewNode);
    171173end;
    … …  
    175177  NewNode: TDOMNode;
    176178begin
    177   NewNode := Node.OwnerDocument.CreateElement(Name);
    178   NewNode.TextContent := DateTimeToXMLTime(Value);
     179  NewNode := Node.OwnerDocument.CreateElement(DOMString(Name));
     180  NewNode.TextContent := DOMString(DateTimeToXMLTime(Value));
    179181  Node.AppendChild(NewNode);
    180182end;
    … …  
    185187begin
    186188  Result := DefaultValue;
    187   NewNode := Node.FindNode(Name);
    188   if Assigned(NewNode) then
    189     Result := StrToInt(NewNode.TextContent);
     189  NewNode := Node.FindNode(DOMString(Name));
     190  if Assigned(NewNode) then
     191    Result := StrToInt(string(NewNode.TextContent));
    190192end;
    191193
    … …  
    195197begin
    196198  Result := DefaultValue;
    197   NewNode := Node.FindNode(Name);
    198   if Assigned(NewNode) then
    199     Result := StrToInt64(NewNode.TextContent);
     199  NewNode := Node.FindNode(DOMString(Name));
     200  if Assigned(NewNode) then
     201    Result := StrToInt64(string(NewNode.TextContent));
    200202end;
    201203
    … …  
    205207begin
    206208  Result := DefaultValue;
    207   NewNode := Node.FindNode(Name);
    208   if Assigned(NewNode) then
    209     Result := StrToBool(NewNode.TextContent);
     209  NewNode := Node.FindNode(DOMString(Name));
     210  if Assigned(NewNode) then
     211    Result := StrToBool(string(NewNode.TextContent));
    210212end;
    211213
    … …  
    215217begin
    216218  Result := DefaultValue;
    217   NewNode := Node.FindNode(Name);
    218   if Assigned(NewNode) then
    219     Result := NewNode.TextContent;
     219  NewNode := Node.FindNode(DOMString(Name));
     220  if Assigned(NewNode) then
     221    Result := string(NewNode.TextContent);
    220222end;
    221223
    … …  
    226228begin
    227229  Result := DefaultValue;
    228   NewNode := Node.FindNode(Name);
    229   if Assigned(NewNode) then
    230     Result := XMLTimeToDateTime(NewNode.TextContent);
     230  NewNode := Node.FindNode(DOMString(Name));
     231  if Assigned(NewNode) then
     232    Result := XMLTimeToDateTime(string(NewNode.TextContent));
    231233end;
    232234

  • trunk/Packages/CoolTranslator/CoolTranslator.pas

    r73 r93  
    33 }
    44
    5 unit CoolTranslator;
     5unit CoolTranslator; 
    66
    77interface
    … …  
    1212implementation
    1313
    14 procedure Register;
     14procedure Register; 
    1515begin
    16   RegisterUnit('UCoolTranslator', @UCoolTranslator.Register);
    17 end;
     16  RegisterUnit('UCoolTranslator', @UCoolTranslator.Register); 
     17end; 
    1818
    1919initialization
    20   RegisterPackage('CoolTranslator', @Register);
     20  RegisterPackage('CoolTranslator', @Register); 
    2121end.

  • trunk/Packages/CoolTranslator/Demo/Languages/TranslatorDemo.cs.po

    r54 r93  
    1010"Content-Transfer-Encoding: 8bit\n"
    1111
    12 #: TFORM1.FORM1.CAPTION
     12#: tform1.form1.caption
    1313msgctxt "TFORM1.FORM1.CAPTION"
    1414msgid "Translator Demo"
    1515msgstr "Ukázka Translatoru"
    1616
    17 #: TMAINFORM.BUTTON1.CAPTION
     17#: tmainform.button1.caption
    1818msgid "Show MainForm.Name"
    1919msgstr "Ukázat MainForm.Name"
    2020
    21 #: TMAINFORM.CAPTION
     21#: tmainform.caption
    2222msgctxt "TMAINFORM.CAPTION"
    2323msgid "Translator Demo"
    2424msgstr "Ukázka Translatoru"
    2525
    26 #: TMAINFORM.LABEL1.CAPTION
     26#: tmainform.label1.caption
    2727msgid "MainForm"
    2828msgstr "HlavníFormulář"
    2929
    30 #: TMAINFORM.LABEL2.CAPTION
     30#: tmainform.label2.caption
    3131msgid "Form name as label caption:"
    3232msgstr "Jméno formuláře jako titulek textu:"
    3333
    34 #: TMAINFORM.LABEL3.CAPTION
     34#: tmainform.label3.caption
    3535msgid "Language list:"
    3636msgstr ""
    3737
    38 #: TMAINFORM.LABEL4.CAPTION
     38#: tmainform.label4.caption
    3939msgid "Excludes:"
    4040msgstr ""

  • trunk/Packages/CoolTranslator/Demo/Languages/TranslatorDemo.de.po

    r54 r93  
    22msgstr "Content-Type: text/plain; charset=UTF-8"
    33
    4 #: TFORM1.FORM1.CAPTION
     4#: tform1.form1.caption
    55msgctxt "TFORM1.FORM1.CAPTION"
    66msgid "Translator Demo"
    77msgstr ""
    88
    9 #: TMAINFORM.BUTTON1.CAPTION
     9#: tmainform.button1.caption
    1010msgid "Show MainForm.Name"
    1111msgstr ""
    1212
    13 #: TMAINFORM.CAPTION
     13#: tmainform.caption
    1414msgctxt "TMAINFORM.CAPTION"
    1515msgid "Translator Demo"
    1616msgstr ""
    1717
    18 #: TMAINFORM.LABEL1.CAPTION
     18#: tmainform.label1.caption
    1919msgid "MainForm"
    2020msgstr ""
    2121
    22 #: TMAINFORM.LABEL2.CAPTION
     22#: tmainform.label2.caption
    2323msgid "Form name as label caption:"
    2424msgstr ""
    2525
    26 #: TMAINFORM.LABEL3.CAPTION
     26#: tmainform.label3.caption
    2727msgid "Language list:"
    2828msgstr ""
    2929
    30 #: TMAINFORM.LABEL4.CAPTION
     30#: tmainform.label4.caption
    3131msgid "Excludes:"
    3232msgstr ""

  • trunk/Packages/CoolTranslator/Demo/Languages/TranslatorDemo.po

    r54 r93  
    22msgstr "Content-Type: text/plain; charset=UTF-8"
    33
    4 #: TFORM1.FORM1.CAPTION
     4#: tform1.form1.caption
    55msgctxt "TFORM1.FORM1.CAPTION"
    66msgid "Translator Demo"
    77msgstr ""
    88
    9 #: TMAINFORM.BUTTON1.CAPTION
     9#: tmainform.button1.caption
    1010msgid "Show MainForm.Name"
    1111msgstr ""
    1212
    13 #: TMAINFORM.CAPTION
     13#: tmainform.caption
    1414msgctxt "TMAINFORM.CAPTION"
    1515msgid "Translator Demo"
    1616msgstr ""
    1717
    18 #: TMAINFORM.LABEL1.CAPTION
     18#: tmainform.label1.caption
    1919msgid "MainForm"
    2020msgstr ""
    2121
    22 #: TMAINFORM.LABEL2.CAPTION
     22#: tmainform.label2.caption
    2323msgid "Form name as label caption:"
    2424msgstr ""
    2525
    26 #: TMAINFORM.LABEL3.CAPTION
     26#: tmainform.label3.caption
    2727msgid "Language list:"
    2828msgstr ""
    2929
    30 #: TMAINFORM.LABEL4.CAPTION
     30#: tmainform.label4.caption
    3131msgid "Excludes:"
    3232msgstr ""

  • trunk/Packages/CoolTranslator/Demo/TranslatorDemo.lpi

    r54 r93  
    5151        <IsPartOfProject Value="True"/>
    5252        <ComponentName Value="MainForm"/>
     53        <HasResources Value="True"/>
    5354        <ResourceBaseClass Value="Form"/>
    5455        <UnitName Value="UMainForm"/>
     56        <IsVisibleTab Value="True"/>
    5557        <EditorIndex Value="0"/>
    5658        <WindowIndex Value="0"/>
    … …  
    7981        <Filename Value="..\UCoolTranslator.pas"/>
    8082        <UnitName Value="UCoolTranslator"/>
    81         <IsVisibleTab Value="True"/>
    8283        <EditorIndex Value="1"/>
    8384        <WindowIndex Value="0"/>
    8485        <TopLine Value="274"/>
    85         <CursorPos X="1" Y="286"/>
     86        <CursorPos X="33" Y="288"/>
    8687        <UsageCount Value="11"/>
    8788        <Loaded Value="True"/>
    … …  
    265266  </ProjectOptions>
    266267  <CompilerOptions>
    267     <Version Value="10"/>
     268    <Version Value="11"/>
    268269    <PathDelim Value="\"/>
    269270    <Target>
    … …  
    275276    </SearchPaths>
    276277    <Linking>
    277       <Debugging>
    278         <GenerateDebugInfo Value="True"/>
    279         <DebugInfoType Value="dsAuto"/>
    280       </Debugging>
    281278      <Options>
    282279        <Win32>
    … …  
    305302    </Exceptions>
    306303  </Debugging>
     304  <EditorMacros Count="0"/>
    307305</CONFIG>

  • trunk/Packages/CoolTranslator/Demo/UMainForm.lfm

    r54 r93  
    88  ClientWidth = 466
    99  OnCreate = FormCreate
    10   LCLVersion = '0.9.31'
     10  LCLVersion = '1.1'
    1111  object ListBox1: TListBox
    1212    Left = 171
    … …  
    2929  object Label1: TLabel
    3030    Left = 10
    31     Height = 14
     31    Height = 13
    3232    Top = 24
    33     Width = 47
     33    Width = 46
    3434    Caption = 'MainForm'
    3535    ParentColor = False
    … …  
    3737  object Label2: TLabel
    3838    Left = 10
    39     Height = 14
     39    Height = 13
    4040    Top = 6
    41     Width = 135
     41    Width = 134
    4242    Caption = 'Form name as label caption:'
    4343    ParentColor = False
    … …  
    4545  object Label3: TLabel
    4646    Left = 171
    47     Height = 14
     47    Height = 13
    4848    Top = 8
    49     Width = 68
     49    Width = 67
    5050    Caption = 'Language list:'
    5151    ParentColor = False
    … …  
    6161  object Label4: TLabel
    6262    Left = 321
    63     Height = 14
     63    Height = 13
    6464    Top = 10
    65     Width = 47
     65    Width = 46
    6666    Caption = 'Excludes:'
    6767    ParentColor = False
    … …  
    6969  object CoolTranslator1: TCoolTranslator
    7070    POFilesFolder = 'Languages'
    71     left = 64
    72     top = 40
     71    left = 72
     72    top = 72
    7373  end
    7474end

  • trunk/Packages/TemplateGenerics/Additional/UBinarySerializer.pas

    r72 r93  
    11unit UBinarySerializer;
    22
    3 {$mode objfpc}{$H+}
     3{$mode delphi}{$H+}
    44
    55interface
    … …  
    1515  TBinarySerializer = class
    1616  private
    17     FStream: TStreamByte;
     17    FGrow: Boolean;
     18    FList: TListByte;
    1819    FEndianness: TEndianness;
    1920    SwapData: Boolean;
     21    procedure SetList(const AValue: TListByte);
    2022    procedure SetEndianness(const AValue: TEndianness);
    2123    procedure ReverseByteOrder(var Buffer; Count: Integer);
    2224  public
     25    Position: Integer;
     26    OwnsList: Boolean;
     27    procedure Write(var Buffer; Count: Integer); //inline;
     28    procedure Read(var Buffer; Count: Integer); //inline;
     29
    2330    procedure Assign(Source: TBinarySerializer);
    2431    procedure WriteByte(Data: Byte);
    … …  
    4855    procedure ReadStream(AStream: TStream; Count: Integer);
    4956    procedure ReadStreamPart(AStream: TStream; Count: Integer);
     57    procedure ReadList(List: TListByte; StartIndex, Count: Integer);
    5058    constructor Create; overload;
    51     constructor Create(AStream: TStreamByte); overload;
    5259    procedure Clear;
    5360    destructor Destroy; override;
    5461    property Endianness: TEndianness read FEndianness write SetEndianness;
    55     property Stream: TStreamByte read FStream write FStream;
     62    property List: TListByte read FList write SetList;
     63    property Grow: Boolean read FGrow write FGrow;
    5664  end;
    5765
    … …  
    6573  StringLength: Longint;
    6674begin
    67   StringLength  := 0;
    68   FStream.ReadBuffer(StringLength, SizeOf(StringLength));
     75  StringLength := 0;
     76  Read(StringLength, SizeOf(StringLength));
    6977  Result := ReadString(StringLength);
    7078end;
    … …  
    7684  OldPosition: Integer;
    7785begin
    78   OldPosition := FStream.Position;
     86  OldPosition := Position;
    7987  Result := '';
    8088  I := 1;
    8189  repeat
    82     if FStream.Position >= FStream.Size then Break;
     90    if Position >= FList.Count then Break;
    8391    Data := Chr(ReadByte);
    8492    if Data <> Terminator[I] then begin
    … …  
    8997  if not (I > Length(Terminator)) then begin
    9098    Result := '';
    91     FStream.Position := OldPosition;
     99    Position := OldPosition;
    92100  end;
    93101end;
    … …  
    96104begin
    97105  Result := 0;
    98   FStream.ReadBuffer(Result, SizeOf(Byte));
     106  Read(Result, SizeOf(Byte));
    99107end;
    100108
    … …  
    102110begin
    103111  Result := 0;
    104   FStream.ReadBuffer(Result, SizeOf(Cardinal));
     112  Read(Result, SizeOf(Cardinal));
    105113  if SwapData then Result := SwapEndian(Result);
    106114end;
    … …  
    109117begin
    110118  Result := 0;
    111   FStream.ReadBuffer(Result, SizeOf(Int64));
     119  Read(Result, SizeOf(Int64));
    112120  if SwapData then Result := SwapEndian(Result);
    113121end;
    … …  
    117125  if Length > 0 then begin
    118126    SetLength(Result, Length);
    119     FStream.ReadBuffer(Result[1], Length);
     127    Read(Result[1], Length);
    120128  end else Result := '';
    121129end;
    … …  
    126134begin
    127135  Count := 0;
    128   FStream.ReadBuffer(Count, 1);
     136  Read(Count, 1);
    129137  Result := ReadString(Count);
    130138end;
    … …  
    136144  if Count > 0 then begin
    137145    SetLength(Buffer, Count);
    138     FStream.ReadBuffer(Buffer[0], Count);
     146    Read(Buffer[0], Count);
    139147    AStream.Size := Count;
    140148    AStream.Position := 0;
    … …  
    149157  if Count > 0 then begin
    150158    SetLength(Buffer, Count);
    151     FStream.ReadBuffer(Buffer[0], Count);
     159    Read(Buffer[0], Count);
    152160    if AStream.Size < (AStream.Position + Count) then
    153161      AStream.Size := AStream.Position + Count;
    154     AStream.Write(Buffer[0], Count);
     162    Write(Buffer[0], Count);
     163  end;
     164end;
     165
     166procedure TBinarySerializer.ReadList(List: TListByte; StartIndex, Count: Integer
     167  );
     168var
     169  Buffer: array of Byte;
     170begin
     171  if Count > (List.Count - StartIndex) then Count := (List.Count - StartIndex); // Limit max. stream size
     172  if Count > 0 then begin
     173    SetLength(Buffer, Count);
     174    Read(Pointer(Buffer)^, Count);
     175    List.ReplaceBuffer(StartIndex, Pointer(Buffer)^, Count);
    155176  end;
    156177end;
    … …  
    164185    SetLength(Buffer, Count);
    165186    AStream.ReadBuffer(Pointer(Buffer)^, Count);
    166     FStream.WriteBuffer(Pointer(Buffer)^, Count);
     187    Write(Pointer(Buffer)^, Count);
    167188  end;
    168189end;
    … …  
    172193  Buffer: array of Byte;
    173194begin
    174   if Count > (List.Count - StartIndex) then Count := (List.Count - StartIndex); // Limit max. stream size
    175   if Count > 0 then begin
    176     SetLength(Buffer, Count);
    177     List.ReadBuffer(Pointer(Buffer)^, Count);
    178     FStream.WriteBuffer(Pointer(Buffer)^, Count);
     195//  if Count > (List.Count - StartIndex) then Count := (List.Count - StartIndex); // Limit max. stream size
     196  if Count > 0 then begin
     197    SetLength(Buffer, Count);
     198    List.GetBuffer(StartIndex, PByte(Buffer)^, Count);
     199    Write(Pointer(Buffer)^, Count);
    179200  end;
    180201end;
    … …  
    184205  inherited;
    185206  Endianness := enLittle;
    186   FStream := nil;
    187 end;
    188 
    189 constructor TBinarySerializer.Create(AStream: TStreamByte);
    190 begin
    191   inherited Create;
    192   Endianness := enLittle;
    193   FStream := AStream;
     207  FList := nil;
     208  FGrow := True;
    194209end;
    195210
    196211procedure TBinarySerializer.Clear;
    197212begin
    198   Stream.Size := 0;
     213  FList.Count := 0;
     214  Position := 0;
    199215end;
    200216
    201217destructor TBinarySerializer.Destroy;
    202218begin
     219  if OwnsList then FList.Free;
    203220  inherited Destroy;
    204221end;
    … …  
    212229begin
    213230  Result := 0;
    214   FStream.ReadBuffer(Result, SizeOf(Double));
     231  Read(Result, SizeOf(Double));
    215232end;
    216233
    … …  
    218235begin
    219236  Result := 0;
    220   FStream.ReadBuffer(Result, SizeOf(Single));
     237  Read(Result, SizeOf(Single));
    221238end;
    222239
    … …  
    224241begin
    225242  Result := 0;
    226   FStream.ReadBuffer(Result, SizeOf(Word));
     243  Read(Result, SizeOf(Word));
    227244  if SwapData then Result := SwapEndian(Result);
     245end;
     246
     247procedure TBinarySerializer.SetList(const AValue: TListByte);
     248begin
     249  if OwnsList then FList.Free;
     250  FList := AValue;
    228251end;
    229252
    … …  
    254277end;
    255278
     279procedure TBinarySerializer.Write(var Buffer; Count: Integer);
     280var
     281  NewCount: Integer;
     282begin
     283  if FGrow then begin
     284    NewCount := Position + Count;
     285    if FList.Count < NewCount then
     286      FList.Count := NewCount;
     287  end;
     288  FList.ReplaceBuffer(Position, Buffer, Count);
     289  Inc(Position, Count);
     290end;
     291
     292procedure TBinarySerializer.Read(var Buffer; Count: Integer);
     293begin
     294  FList.GetBuffer(Position, Buffer, Count);
     295  Inc(Position, Count);
     296end;
     297
    256298procedure TBinarySerializer.Assign(Source: TBinarySerializer);
    257299begin
    258   FStream := Source.FStream;
     300  FList := Source.FList;
    259301end;
    260302
    … …  
    270312procedure TBinarySerializer.WriteByte(Data: Byte);
    271313begin
    272   Data := 0;
    273   FStream.WriteBuffer(Data, SizeOf(Byte));
     314  Write(Data, SizeOf(Byte));
    274315end;
    275316
    … …  
    307348    SetLength(Buffer, Count);
    308349    AStream.ReadBuffer(Pointer(Buffer)^, Count);
    309     FStream.WriteBuffer(Pointer(Buffer)^, Count);
     350    Write(Pointer(Buffer)^, Count);
    310351  end;
    311352end;

  • trunk/Packages/TemplateGenerics/Generic/GenericBitmap.inc

    r54 r93  
    88{$DEFINE TGMatrixRow := TGBitmapRow}
    99{$DEFINE TGMatrix := TGBitmapMatrix}
    10 {$DEFINE TGMatrixSortCompare := TGBitmapSortCompare}
    11 {$DEFINE TGMatrixToStringConverter := TGBitmapToStringConverter}
    12 {$DEFINE TGMatrixFromStringConverter := TGBitmapFromStringConverter}
    13 {$DEFINE TGMatrixMerge := TGBitmapMerge}
    1410{$DEFINE INTERFACE}
    1511{$I 'GenericMatrix.inc'}
    … …  
    4945{$DEFINE TGMatrixRow := TGBitmapRow}
    5046{$DEFINE TGMatrix := TGBitmapMatrix}
    51 {$DEFINE TGMatrixSortCompare := TGBitmapSortCompare}
    52 {$DEFINE TGMatrixToStringConverter := TGBitmapToStringConverter}
    53 {$DEFINE TGMatrixFromStringConverter := TGBitmapFromStringConverter}
    54 {$DEFINE TGMatrixMerge := TGBitmapMerge}
    5547{$DEFINE IMPLEMENTATION}
    5648{$I 'GenericMatrix.inc'}

  • trunk/Packages/TemplateGenerics/Generic/GenericDictionary.inc

    r54 r93  
    1111{$DEFINE TGListItem := TGPair}
    1212{$DEFINE TGList := TGDictionaryList}
    13 {$DEFINE TGListSortCompare := TGDictionarySortCompare}
    14 {$DEFINE TGListToStringConverter := TGDictionaryToStringConverter}
    15 {$DEFINE TGListFromStringConverter := TGDictionaryFromStringConverter}
    16 {$DEFINE TGListItemArray := TGDictionaryItemArray}
    1713{$DEFINE INTERFACE}
    1814{$I 'GenericList.inc'}
    … …  
    4945{$DEFINE TGListItem := TGPair}
    5046{$DEFINE TGList := TGDictionaryList}
    51 {$DEFINE TGListSortCompare := TGDictionarySortCompare}
    52 {$DEFINE TGListToStringConverter := TGDictionaryToStringConverter}
    53 {$DEFINE TGListFromStringConverter := TGDictionaryFromStringConverter}
    54 {$DEFINE TGListItemArray := TGDictionaryItemArray}
    5547{$DEFINE IMPLEMENTATION}
    5648{$I 'GenericList.inc'}

  • trunk/Packages/TemplateGenerics/Generic/GenericList.inc

    r54 r93  
    1212  // - all items operations (Clear, Reverse, Sort)
    1313
    14   TGList = class;
    15 
    16   TGListSortCompare = function(Item1, Item2: TGListItem): Integer of object;
    17   TGListToStringConverter = function(Item: TGListItem): string;
    18   TGListFromStringConverter = function(Text: string): TGListItem;
    19   TGListItemArray = array of TGListItem;
     14  //TGAbstractList = class
     15
     16  //end;
    2017
    2118  // TGList<TGListIndex, TGListItem> = class
    22   TGList = class
     19  TGList = class//(TGAbstractList)
     20  public
     21    type
     22      PItem = ^TGListItem;
     23      TSortCompare = function(Item1, Item2: TGListItem): Integer of object;
     24      TToStringConverter = function(Item: TGListItem): string;
     25      TFromStringConverter = function(Text: string): TGListItem;
     26      TItemArray = array of TGListItem;
    2327  private
    2428    FItems: array of TGListItem;
    … …  
    3438    procedure SetLast(AValue: TGListItem);
    3539    procedure SetFirst(AValue: TGListItem);
    36     procedure QuickSort(L, R : TGListIndex; Compare: TGListSortCompare);
     40    procedure QuickSort(L, R : TGListIndex; Compare: TSortCompare);
     41    procedure DoUpdate;
    3742  protected
    3843    procedure Put(Index: TGListIndex; const AValue: TGListItem); virtual;
    … …  
    5156    function EqualTo(List: TGList): Boolean;
    5257    procedure Exchange(Index1, Index2: TGListIndex);
    53     procedure Explode(Text, Separator: string; Converter: TGListFromStringConverter; SlicesCount: Integer = -1);
     58    procedure Explode(Text, Separator: string; Converter: TFromStringConverter; SlicesCount: Integer = -1);
    5459    function Extract(Item: TGListItem): TGListItem;
    5560    property First: TGListItem read GetFirst write SetFirst;
    5661    procedure Fill(Start, Count: TGListIndex; Value: TGListItem);
    57     function GetArray(Index, ACount: TGListIndex): TGListItemArray;
     62    function GetArray(Index, ACount: TGListIndex): TItemArray;
    5863    procedure GetList(List: TGList; Index, ACount: TGListIndex);
    59     function Implode(Separator: string; Converter: TGListToStringConverter): string;
     64    procedure GetBuffer(Index: TGListIndex; var Buffer; Count: TGListIndex);
     65    function Implode(Separator: string; Converter: TToStringConverter): string;
    6066    function IndexOf(Item: TGListItem; Start: TGListIndex = 0): TGListIndex; virtual;
    6167    function IndexOfList(List: TGList; Start: TGListIndex = 0): TGListIndex;
    … …  
    7379    procedure ReplaceListPart(Index: TGListIndex; Source: TGList;
    7480      SourceIndex, SourceCount: TGListIndex);
    75     procedure Sort(Compare: TGListSortCompare);
     81    procedure ReplaceBuffer(Index: TGListIndex; var Buffer; Count: TGListIndex);
     82    procedure Sort(Compare: TSortCompare);
    7683    procedure SetArray(Values: array of TGListItem);
    7784    procedure BeginUpdate;
    … …  
    8289    property Items[Index: TGListIndex]: TGListItem read Get write Put; default;
    8390    property Last: TGListItem read GetLast write SetLast;
    84   end;
    85  
     91    property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
     92  end;
     93
    8694{$UNDEF INTERFACE}
    8795{$ENDIF}
    … …  
    102110begin
    103111  FCount := 0;
     112  FUpdateCount := 0;
     113end;
     114
     115procedure TGList.GetBuffer(Index: TGListIndex; var Buffer; Count: TGListIndex);
     116var
     117  P: PItem;
     118  I: TGListIndex;
     119begin
     120  if (Index + Count) > FCount then
     121    raise EListError.CreateFmt(SListIndexError, [Index + Count]);
     122  P := PItem(@Buffer);
     123  I := 0;
     124  while I < Count do begin
     125    P^ := Items[Index + I];
     126    Inc(P, 1);
     127    I := I + 1;
     128  end;
     129end;
     130
     131procedure TGList.ReplaceBuffer(Index: TGListIndex; var Buffer; Count: TGListIndex);
     132var
     133  P: PItem;
     134  I: TGListIndex;
     135begin
     136  if (Index + Count) > FCount then
     137    raise EListError.CreateFmt(SListIndexError, [Index + Count]);
     138  P := PItem(@Buffer);
     139  I := 0;
     140  while I < Count do begin
     141    Items[Index + I] := P^;
     142    Inc(P, 1);
     143    I := I + 1;
     144  end;
    104145end;
    105146
    … …  
    200241end;
    201242
    202 function TGList.GetArray(Index, ACount: TGListIndex): TGListItemArray;
     243function TGList.GetArray(Index, ACount: TGListIndex): TItemArray;
    203244var
    204245  I: Integer;
    … …  
    218259end;
    219260
    220 procedure TGList.QuickSort(L, R: TGListIndex; Compare: TGListSortCompare);
     261procedure TGList.QuickSort(L, R: TGListIndex; Compare: TSortCompare);
    221262var
    222263  I, J: TGListIndex;
    … …  
    302343  if (Index < 0) or (Index > FCount) then
    303344    raise EListError.CreateFmt(SListIndexError, [Index]);
    304   InsertCount(Index, 1);
    305   FItems[Index] := Item;
    306   Update;
     345  try
     346    BeginUpdate;
     347    InsertCount(Index, 1);
     348    FItems[Index] := Item;
     349  finally
     350    EndUpdate;
     351  end;
    307352end;
    308353
    … …  
    487532end;
    488533
    489 procedure TGList.Sort(Compare: TGListSortCompare);
     534procedure TGList.Sort(Compare: TSortCompare);
    490535begin
    491536  if FCount > 1 then
    … …  
    525570procedure TGList.EndUpdate;
    526571begin
    527   Dec(FUpdateCount);
    528   Update;
     572  if FUpdateCount > 0 then Dec(FUpdateCount);
     573  if FUpdateCount = 0 then DoUpdate;
     574end;
     575
     576procedure TGList.DoUpdate;
     577begin
     578  if Assigned(FOnUpdate) then FOnUpdate(Self);
    529579end;
    530580
    531581procedure TGList.Update;
    532582begin
    533   if Assigned(FOnUpdate) and (FUpdateCount = 0) then FOnUpdate(Self);
    534 end;
    535 
    536 function TGList.Implode(Separator: string; Converter: TGListToStringConverter): string;
     583  if FUpdateCount = 0 then DoUpdate;
     584end;
     585
     586function TGList.Implode(Separator: string; Converter: TToStringConverter): string;
    537587var
    538588  I: TGListIndex;
    … …  
    548598end;
    549599
    550 procedure TGList.Explode(Text, Separator: string; Converter: TGListFromStringConverter; SlicesCount: Integer = -1);
     600procedure TGList.Explode(Text, Separator: string; Converter: TFromStringConverter; SlicesCount: Integer = -1);
    551601begin
    552602  Clear;

  • trunk/Packages/TemplateGenerics/Generic/GenericListObject.inc

    r54 r93  
    44{$DEFINE TGListItem := TGListObjectItem}
    55{$DEFINE TGList := TGListObjectList}
    6 {$DEFINE TGListSortCompare := TGListObjectSortCompare}
    7 {$DEFINE TGListToStringConverter := TGListObjectToStringConverter}
    8 {$DEFINE TGListFromStringConverter := TGListObjectFromStringConverter}
    9 {$DEFINE TGListItemArray := TGListObjectItemArray}
    106{$DEFINE INTERFACE}
    117{$I 'GenericList.inc'}
    … …  
    4238{$DEFINE TGListItem := TGListObjectItem}
    4339{$DEFINE TGList := TGListObjectList}
    44 {$DEFINE TGListSortCompare := TGListObjectSortCompare}
    45 {$DEFINE TGListToStringConverter := TGListObjectToStringConverter}
    46 {$DEFINE TGListFromStringConverter := TGListObjectFromStringConverter}
    47 {$DEFINE TGListItemArray := TGListObjectItemArray}
    4840{$DEFINE IMPLEMENTATION}
    4941{$I 'GenericList.inc'}
    … …  
    9688    end;
    9789  end;
     90  I := FCount;
    9891  inherited;
     92  // Nil newly allocated items
     93  while I < AValue do begin
     94    FItems[I] := nil;
     95    I := I + 1;
     96  end;
    9997end;
    10098
    … …  
    108106begin
    109107  Clear;
    110   inherited Destroy;
     108  inherited;
    111109end;
    112110

  • trunk/Packages/TemplateGenerics/Generic/GenericListString.inc

    r54 r93  
    44{$DEFINE TGListItem := TGListStringItem}
    55{$DEFINE TGList := TGListStringList}
    6 {$DEFINE TGListSortCompare := TGListStringSortCompare}
    7 {$DEFINE TGListToStringConverter := TGListStringToStringConverter}
    8 {$DEFINE TGListFromStringConverter := TGListStringFromStringConverter}
    9 {$DEFINE TGListItemArray := TGListStringItemArray}
    106{$DEFINE INTERFACE}
    117{$I 'GenericList.inc'}
    … …  
    3935{$DEFINE TGListItem := TGListStringItem}
    4036{$DEFINE TGList := TGListStringList}
    41 {$DEFINE TGListSortCompare := TGListStringSortCompare}
    42 {$DEFINE TGListToStringConverter := TGListStringToStringConverter}
    43 {$DEFINE TGListFromStringConverter := TGListStringFromStringConverter}
    44 {$DEFINE TGListItemArray := TGListStringItemArray}
    4537{$DEFINE IMPLEMENTATION}
    4638{$I 'GenericList.inc'}

  • trunk/Packages/TemplateGenerics/Generic/GenericMatrix.inc

    r72 r93  
     1// Work in progress...
     2
    13{$IFDEF INTERFACE}
    2 
    3   TGMatrix = class;
    4 
    5   TGMatrixSortCompare = function(const Item1, Item2: TGMatrixItem): Integer of object;
    6   TGMatrixToStringConverter = function(Item: TGMatrixItem): string;
    7   TGMatrixFromStringConverter = function(Text: string): TGMatrixItem;
    8   TGMatrixRow = array of TGMatrixItem;
    9   TGMatrixMerge = function(Item1, Item2: TGMatrixItem): TGMatrixItem of object;
    10 
    11   TGMatrixIndex = record
    12     X: TGMatrixIndexX;
    13     Y: TGMatrixIndexY;
    14   end;
    154
    165  // TGMatrix<TGMatrixIndex, TGMatrixIndex, TGMatrixItem> = class
    176  TGMatrix = class
     7  public
     8    type
     9      TSortCompare = function(const Item1, Item2: TGMatrixItem): Integer of object;
     10      TToStringConverter = function(Item: TGMatrixItem): string;
     11      TFromStringConverter = function(Text: string): TGMatrixItem;
     12      TRow = array of TGMatrixItem;
     13      TMerge = function(Item1, Item2: TGMatrixItem): TGMatrixItem of object;
     14
     15      TIndex = record
     16        X: TGMatrixIndexX;
     17        Y: TGMatrixIndexY;
     18      end;
    1819  private
    1920    FItems: array of array of TGMatrixItem;
    20     FCount: TGMatrixIndex;
     21    FCount: TIndex;
    2122    function GetItemXY(X: TGMatrixIndexX; Y: TGMatrixIndexY): TGMatrixItem;
    22     function GetItem(Index: TGMatrixIndex): TGMatrixItem;
    23     function GetCapacity: TGMatrixIndex;
     23    function GetItem(Index: TIndex): TGMatrixItem;
     24    function GetCapacity: TIndex;
    2425    function GetLast: TGMatrixItem;
    2526    function GetFirst: TGMatrixItem;
    26     procedure SetCapacity(const AValue: TGMatrixIndex);
     27    procedure SetCapacity(const AValue: TIndex);
    2728    procedure SetLast(AValue: TGMatrixItem);
    2829    procedure SetFirst(AValue: TGMatrixItem);
    2930    procedure PutItemXY(X: TGMatrixIndexX; Y: TGMatrixIndexY; const AValue: TGMatrixItem); virtual;
    30     procedure PutItem(Index: TGMatrixIndex; const AValue: TGMatrixItem); virtual;
    31     procedure SetCount(const AValue: TGMatrixIndex);
     31    procedure PutItem(Index: TIndex; const AValue: TGMatrixItem); virtual;
     32    procedure SetCount(const AValue: TIndex);
    3233  public
    33     function Add(Item: TGMatrixItem): TGMatrixIndex;
    34     procedure AddMatrix(Values: array of TGMatrixRow);
     34    function Add(Item: TGMatrixItem): TIndex;
     35    procedure AddMatrix(Values: array of TRow);
    3536    procedure AddList(List: TGMatrix);
    3637    procedure Assign(Source: TGMatrix);
    3738    procedure Clear; virtual;
    3839    procedure Contract;
    39     function CreateIndex(X: TGMatrixIndexY; Y: TGMatrixIndexX): TGMatrixIndex;
    40     procedure Delete(Index: TGMatrixIndex); virtual;
    41     procedure DeleteItems(Index, Count: TGMatrixIndex);
     40    function CreateIndex(X: TGMatrixIndexY; Y: TGMatrixIndexX): TIndex;
     41    procedure Delete(Index: TIndex); virtual;
     42    procedure DeleteItems(Index, Count: TIndex);
    4243    function EqualTo(List: TGMatrix): Boolean;
    4344    procedure Expand;
    4445    function Extract(Item: TGMatrixItem): TGMatrixItem;
    45     procedure Exchange(Index1, Index2: TGMatrixIndex);
     46    procedure Exchange(Index1, Index2: TIndex);
    4647    property First: TGMatrixItem read GetFirst write SetFirst;
    4748    procedure FillAll(Value: TGMatrixItem);
    48     procedure Fill(Start, Count: TGMatrixIndex; Value: TGMatrixItem);
    49     function Implode(RowSeparator, ColSeparator: string; Converter: TGMatrixToStringConverter): string;
    50     procedure Explode(Text, Separator: string; Converter: TGMatrixFromStringConverter; SlicesCount: Integer = -1);
    51     function IndexOf(Item: TGMatrixItem; Start: TGMatrixIndex): TGMatrixIndex;
    52     function IndexOfList(List: TGMatrix; Start: TGMatrixIndex): TGMatrixIndex;
    53     procedure Insert(Index: TGMatrixIndex; Item: TGMatrixItem);
    54     procedure InsertList(Index: TGMatrixIndex; List: TGMatrix);
    55     procedure InsertArray(Index: TGMatrixIndex; Values: array of TGMatrixItem);
    56     procedure Move(CurIndex, NewIndex: TGMatrixIndex);
    57     procedure MoveItems(CurIndex, NewIndex, Count: TGMatrixIndex);
    58     procedure Merge(Index: TGMatrixIndex; Source: TGMatrix; Proc: TGMatrixMerge);
    59     procedure Replace(Index: TGMatrixIndex; Source: TGMatrix);
    60     function Remove(Item: TGMatrixItem): TGMatrixIndex;
     49    procedure Fill(Start, Count: TIndex; Value: TGMatrixItem);
     50    function Implode(RowSeparator, ColSeparator: string; Converter: TToStringConverter): string;
     51    procedure Explode(Text, Separator: string; Converter: TFromStringConverter; SlicesCount: Integer = -1);
     52    function IndexOf(Item: TGMatrixItem; Start: TIndex): TIndex;
     53    function IndexOfList(List: TGMatrix; Start: TIndex): TIndex;
     54    procedure Insert(Index: TIndex; Item: TGMatrixItem);
     55    procedure InsertList(Index: TIndex; List: TGMatrix);
     56    procedure InsertArray(Index: TIndex; Values: array of TGMatrixItem);
     57    procedure Move(CurIndex, NewIndex: TIndex);
     58    procedure MoveItems(CurIndex, NewIndex, Count: TIndex);
     59    procedure Merge(Index: TIndex; Source: TGMatrix; Proc: TMerge);
     60    procedure Replace(Index: TIndex; Source: TGMatrix);
     61    function Remove(Item: TGMatrixItem): TIndex;
    6162    procedure Reverse;
    6263    procedure ReverseHorizontal;
    6364    procedure ReverseVertical;
    64     procedure Sort(Compare: TGMatrixSortCompare);
     65    procedure Sort(Compare: TSortCompare);
    6566    procedure SetArray(Values: array of TGMatrixItem);
    66     property Count: TGMatrixIndex read FCount write SetCount;
    67     property Capacity: TGMatrixIndex read GetCapacity write SetCapacity;
     67    property Count: TIndex read FCount write SetCount;
     68    property Capacity: TIndex read GetCapacity write SetCapacity;
    6869    property ItemsXY[X: TGMatrixIndexX; Y: TGMatrixIndexY]: TGMatrixItem
    6970      read GetItemXY write PutItemXY; default;
    70     property Items[Index: TGMatrixIndex]: TGMatrixItem
     71    property Items[Index: TIndex]: TGMatrixItem
    7172      read GetItem write PutItem;
    7273    property Last: TGMatrixItem read GetLast write SetLast;
    … …  
    9192{ TGMatrix }
    9293
    93 procedure TGMatrix.Replace(Index: TGMatrixIndex; Source: TGMatrix);
     94procedure TGMatrix.Replace(Index: TIndex; Source: TGMatrix);
    9495var
    9596  X: TGMatrixIndexX;
    … …  
    107108end;
    108109
    109 procedure TGMatrix.Merge(Index: TGMatrixIndex; Source: TGMatrix; Proc: TGMatrixMerge);
     110procedure TGMatrix.Merge(Index: TIndex; Source: TGMatrix; Proc: TMerge);
    110111var
    111112  X: TGMatrixIndexX;
    … …  
    123124end;
    124125
    125 function TGMatrix.CreateIndex(X: TGMatrixIndexY; Y: TGMatrixIndexX): TGMatrixIndex;
     126function TGMatrix.CreateIndex(X: TGMatrixIndexY; Y: TGMatrixIndexX): TIndex;
    126127begin
    127128  Result.X := X;
    … …  
    129130end;
    130131
    131 function TGMatrix.GetCapacity: TGMatrixIndex;
     132function TGMatrix.GetCapacity: TIndex;
    132133begin
    133134  Result.Y := Length(FItems);
    … …  
    135136end;
    136137
    137 procedure TGMatrix.SetCapacity(const AValue: TGMatrixIndex);
     138procedure TGMatrix.SetCapacity(const AValue: TIndex);
    138139var
    139140  Y: TGMatrixIndexY;
    … …  
    160161end;
    161162
    162 function TGMatrix.GetItem(Index: TGMatrixIndex): TGMatrixItem;
     163function TGMatrix.GetItem(Index: TIndex): TGMatrixItem;
    163164begin
    164165  if (Index.X < 0) or (Index.X >= Count.X) or
    … …  
    176177end;
    177178
    178 procedure TGMatrix.PutItem(Index: TGMatrixIndex; const AValue: TGMatrixItem);
     179procedure TGMatrix.PutItem(Index: TIndex; const AValue: TGMatrixItem);
    179180begin
    180181  if (Index.X < 0) or (Index.X >= Count.X) or
    … …  
    184185end;
    185186
    186 procedure TGMatrix.SetCount(const AValue: TGMatrixIndex);
     187procedure TGMatrix.SetCount(const AValue: TIndex);
    187188begin
    188189  Capacity := AValue;
    … …  
    192193procedure TGMatrix.Assign(Source: TGMatrix);
    193194var
    194   Index: TGMatrixIndex;
     195  Index: TIndex;
    195196begin
    196197  Count := Source.Count;
    … …  
    208209procedure TGMatrix.Expand;
    209210var
    210   IncSize: TGMatrixIndex;
    211   NewCapacity: TGMatrixIndex;
     211  IncSize: TIndex;
     212  NewCapacity: TIndex;
    212213begin
    213214  if (FCount.X = Capacity.X) then begin
    … …  
    230231procedure TGMatrix.Contract;
    231232var
    232   NewCapacity: TGMatrixIndex;
     233  NewCapacity: TIndex;
    233234begin
    234235  if (Capacity.X > 256) and (FCount.X < Capacity.X shr 2) then
    … …  
    245246function TGMatrix.Extract(Item: TGMatrixItem): TGMatrixItem;
    246247var
    247   I: TGMatrixIndex;
     248  I: TIndex;
    248249begin
    249250(*  I := IndexOf(Item);
    … …  
    256257end;
    257258
    258 function TGMatrix.IndexOf(Item: TGMatrixItem; Start: TGMatrixIndex): TGMatrixIndex;
     259function TGMatrix.IndexOf(Item: TGMatrixItem; Start: TIndex): TIndex;
    259260begin
    260261(*  Result := Start;
    … …  
    266267end;
    267268
    268 procedure TGMatrix.Insert(Index: TGMatrixIndex; Item: TGMatrixItem);
     269procedure TGMatrix.Insert(Index: TIndex; Item: TGMatrixItem);
    269270begin
    270271(*  if (Index < 0) or (Index > FCount ) then
    … …  
    278279end;
    279280
    280 procedure TGMatrix.InsertList(Index: TGMatrixIndex; List: TGMatrix);
    281 var
    282   I: TGMatrixIndex;
     281procedure TGMatrix.InsertList(Index: TIndex; List: TGMatrix);
     282var
     283  I: TIndex;
    283284begin
    284285(*  I := 0;
    … …  
    290291end;
    291292
    292 function TGMatrix.IndexOfList(List: TGMatrix; Start: TGMatrixIndex): TGMatrixIndex;
    293 var
    294   I: TGMatrixIndex;
     293function TGMatrix.IndexOfList(List: TGMatrix; Start: TIndex): TIndex;
     294var
     295  I: TIndex;
    295296begin
    296297(*  if List.Count > 0 then begin
    … …  
    346347end;
    347348
    348 procedure TGMatrix.Move(CurIndex, NewIndex: TGMatrixIndex);
     349procedure TGMatrix.Move(CurIndex, NewIndex: TIndex);
    349350var
    350351  Temp: TGMatrixItem;
    … …  
    366367end;
    367368
    368 procedure TGMatrix.MoveItems(CurIndex, NewIndex, Count: TGMatrixIndex);
     369procedure TGMatrix.MoveItems(CurIndex, NewIndex, Count: TIndex);
    369370var
    370371  S: Integer;
    … …  
    391392end;
    392393
    393 function TGMatrix.Remove(Item: TGMatrixItem): TGMatrixIndex;
     394function TGMatrix.Remove(Item: TGMatrixItem): TIndex;
    394395begin
    395396(*  Result := IndexOf(Item);
    … …  
    400401function TGMatrix.EqualTo(List: TGMatrix): Boolean;
    401402var
    402   I: TGMatrixIndex;
     403  I: TIndex;
    403404begin
    404405(*  Result := Count = List.Count;
    … …  
    463464end;
    464465
    465 procedure TGMatrix.Sort(Compare: TGMatrixSortCompare);
     466procedure TGMatrix.Sort(Compare: TSortCompare);
    466467begin
    467468(*  if FCount > 1 then
    … …  
    469470end;
    470471
    471 procedure TGMatrix.AddMatrix(Values: array of TGMatrixRow);
    472 var
    473   I: TGMatrixIndex;
     472procedure TGMatrix.AddMatrix(Values: array of TRow);
     473var
     474  I: TIndex;
    474475begin
    475476(*  I := 0;
    … …  
    482483procedure TGMatrix.SetArray(Values: array of TGMatrixItem);
    483484var
    484   I: TGMatrixIndex;
     485  I: TIndex;
    485486begin
    486487(*  Clear;
    … …  
    492493end;
    493494
    494 procedure TGMatrix.InsertArray(Index: TGMatrixIndex; Values: array of TGMatrixItem);
    495 var
    496   I: TGMatrixIndex;
     495procedure TGMatrix.InsertArray(Index: TIndex; Values: array of TGMatrixItem);
     496var
     497  I: TIndex;
    497498begin
    498499(*  I := 0;
    … …  
    503504end;
    504505
    505 function TGMatrix.Implode(RowSeparator, ColSeparator: string; Converter: TGMatrixToStringConverter): string;
     506function TGMatrix.Implode(RowSeparator, ColSeparator: string; Converter: TToStringConverter): string;
    506507var
    507508  Y: TGMatrixIndexY;
    … …  
    524525end;
    525526
    526 procedure TGMatrix.Explode(Text, Separator: string; Converter: TGMatrixFromStringConverter; SlicesCount: Integer = -1);
     527procedure TGMatrix.Explode(Text, Separator: string; Converter: TFromStringConverter; SlicesCount: Integer = -1);
    527528begin
    528529(*  Clear;
    … …  
    535536end;
    536537
    537 function TGMatrix.Add(Item: TGMatrixItem): TGMatrixIndex;
     538function TGMatrix.Add(Item: TGMatrixItem): TIndex;
    538539begin
    539540(*  if FCount = Capacity then
    … …  
    546547procedure TGMatrix.AddList(List: TGMatrix);
    547548var
    548   I: TGMatrixIndex;
     549  I: TIndex;
    549550begin
    550551(*  I := 0;
    … …  
    561562end;
    562563
    563 procedure TGMatrix.Delete(Index: TGMatrixIndex);
     564procedure TGMatrix.Delete(Index: TIndex);
    564565begin
    565566(*  if (Index < 0) or (Index >= FCount) then
    … …  
    571572end;
    572573
    573 procedure TGMatrix.DeleteItems(Index, Count: TGMatrixIndex);
    574 var
    575   I: TGMatrixIndex;
     574procedure TGMatrix.DeleteItems(Index, Count: TIndex);
     575var
     576  I: TIndex;
    576577begin
    577578(*  I := Index;
    … …  
    583584end;
    584585
    585 procedure TGMatrix.Fill(Start, Count: TGMatrixIndex; Value: TGMatrixItem);
     586procedure TGMatrix.Fill(Start, Count: TIndex; Value: TGMatrixItem);
    586587var
    587588  X: TGMatrixIndexX;
    … …  
    604605end;
    605606
    606 procedure TGMatrix.Exchange(Index1, Index2: TGMatrixIndex);
     607procedure TGMatrix.Exchange(Index1, Index2: TIndex);
    607608var
    608609  Temp: TGMatrixItem;

  • trunk/Packages/TemplateGenerics/Generic/GenericQueue.inc

    r54 r93  
    44{$DEFINE TGListItem := TGQueueItem}
    55{$DEFINE TGList := TGQueueList}
    6 {$DEFINE TGListSortCompare := TGQueueSortCompare}
    7 {$DEFINE TGListToStringConverter := TGQueueToStringConverter}
    8 {$DEFINE TGListFromStringConverter := TGQueueFromStringConverter}
    9 {$DEFINE TGListItemArray := TGQueueItemArray}
    106{$DEFINE INTERFACE}
    117{$I 'GenericList.inc'}
    … …  
    4440{$DEFINE TGListItem := TGQueueItem}
    4541{$DEFINE TGList := TGQueueList}
    46 {$DEFINE TGListSortCompare := TGQueueSortCompare}
    47 {$DEFINE TGListToStringConverter := TGQueueToStringConverter}
    48 {$DEFINE TGListFromStringConverter := TGQueueFromStringConverter}
    49 {$DEFINE TGListItemArray := TGQueueItemArray}
    5042{$DEFINE IMPLEMENTATION}
    5143{$I 'GenericList.inc'}

  • trunk/Packages/TemplateGenerics/Generic/GenericSet.inc

    r54 r93  
    44{$DEFINE TGListItem := TGSetItem}
    55{$DEFINE TGList := TGSetList}
    6 {$DEFINE TGListSortCompare := TGSetSortCompare}
    7 {$DEFINE TGListToStringConverter := TGSetToStringConverter}
    8 {$DEFINE TGListFromStringConverter := TGSetFromStringConverter}
    9 {$DEFINE TGListItemArray := TGSetItemArray}
    106{$DEFINE INTERFACE}
    117{$I 'GenericList.inc'}
    … …  
    3834{$DEFINE TGListItem := TGSetItem}
    3935{$DEFINE TGList := TGSetList}
    40 {$DEFINE TGListSortCompare := TGSetSortCompare}
    41 {$DEFINE TGListToStringConverter := TGSetToStringConverter}
    42 {$DEFINE TGListFromStringConverter := TGSetFromStringConverter}
    43 {$DEFINE TGListItemArray := TGSetItemArray}
    4436{$DEFINE IMPLEMENTATION}
    4537{$I 'GenericList.inc'}

  • trunk/Packages/TemplateGenerics/Generic/GenericStack.inc

    r54 r93  
    44{$DEFINE TGListItem := TGStackItem}
    55{$DEFINE TGList := TGStackList}
    6 {$DEFINE TGListSortCompare := TGStackSortCompare}
    7 {$DEFINE TGListToStringConverter := TGStackToStringConverter}
    8 {$DEFINE TGListFromStringConverter := TGStackFromStringConverter}
    9 {$DEFINE TGListItemArray := TGStackItemArray}
    106{$DEFINE INTERFACE}
    117{$I 'GenericList.inc'}
    … …  
    3935{$DEFINE TGListItem := TGStackItem}
    4036{$DEFINE TGList := TGStackList}
    41 {$DEFINE TGListSortCompare := TGStackSortCompare}
    42 {$DEFINE TGListToStringConverter := TGStackToStringConverter}
    43 {$DEFINE TGListFromStringConverter := TGStackFromStringConverter}
    44 {$DEFINE TGListItemArray := TGStackItemArray}
    4537{$DEFINE IMPLEMENTATION}
    4638{$I 'GenericList.inc'}

  • trunk/Packages/TemplateGenerics/Generic/GenericStream.inc

    r54 r93  
    11{$IFDEF INTERFACE}
    22
    3 TGStreamItemArray = array of TGStreamItem;
    43
    54// TGStream<TGStreamIndex, TGStreamItem> = class
    65TGStream = class
    7   procedure SetSize(AValue: TGStreamIndex);
     6public
     7  type
     8    TItemArray = array of TGStreamItem;
     9private
     10procedure SetSize(AValue: TGStreamIndex);
    811  function GetSize: TGStreamIndex;
    912  procedure SetPosition(AValue: TGStreamIndex);
    … …  
    1518  procedure WriteStream(Stream: TGStream; Count: TGStreamIndex); virtual; abstract;
    1619  function Read: TGStreamItem; virtual; abstract;
    17   function ReadArray(Count: TGStreamIndex): TGStreamItemArray; virtual; abstract;
     20  function ReadArray(Count: TGStreamIndex): TItemArray; virtual; abstract;
    1821  function ReadStream(Stream: TGStream; Count: TGStreamIndex): TGStreamIndex; virtual; abstract;
    1922  function Insert(Count: TGStreamIndex): TGStreamIndex; virtual; abstract;

  • trunk/Packages/TemplateGenerics/Generic/GenericTree.inc

    r54 r93  
    66{$DEFINE TGListItem := TGTreeNode}
    77{$DEFINE TGList := TGTreeNodeList}
    8 {$DEFINE TGListSortCompare := TGTreeSortCompare}
    9 {$DEFINE TGListToStringConverter := TGTreeToStringConverter}
    10 {$DEFINE TGListFromStringConverter := TGTreeFromStringConverter}
    11 {$DEFINE TGListItemArray := TGTreeItemArray}
    128{$DEFINE INTERFACE}
    139{$I 'GenericList.inc'}
    … …  
    4440{$DEFINE TGListItem := TGTreeNode}
    4541{$DEFINE TGList := TGTreeNodeList}
    46 {$DEFINE TGListSortCompare := TGTreeSortCompare}
    47 {$DEFINE TGListToStringConverter := TGTreeToStringConverter}
    48 {$DEFINE TGListFromStringConverter := TGTreeFromStringConverter}
    49 {$DEFINE TGListItemArray := TGTreeItemArray}
    5042{$DEFINE IMPLEMENTATION}
    5143{$I 'GenericList.inc'}

  • trunk/Packages/TemplateGenerics/Specialized/SpecializedDictionary.pas

    r54 r93  
    1818{$DEFINE TGDictionary := TDictionaryStringString}
    1919{$DEFINE TGDictionaryList := TDictionaryStringStringList}
    20 {$DEFINE TGDictionarySortCompare := TDictionaryStringStringSortCompare}
    21 {$DEFINE TGDictionaryToStringConverter := TDictionaryStringStringToStringConverter}
    22 {$DEFINE TGDictionaryFromStringConverter := TDictionaryStringStringFromStringConverter}
    23 {$DEFINE TGDictionaryItemArray := TDictionaryStringStringItemArray}
    2420{$DEFINE INTERFACE}
    2521{$I 'GenericDictionary.inc'}
    … …  
    3228{$DEFINE TGDictionary := TDictionaryIntegerString}
    3329{$DEFINE TGDictionaryList := TDictionaryIntegerStringList}
    34 {$DEFINE TGDictionarySortCompare := TDictionaryIntegerStringSortCompare}
    35 {$DEFINE TGDictionaryToStringConverter := TDictionaryIntegerStringToStringConverter}
    36 {$DEFINE TGDictionaryFromStringConverter := TDictionaryIntegerStringFromStringConverter}
    37 {$DEFINE TGDictionaryItemArray := TDictionaryIntegerStringItemArray}
    3830{$DEFINE INTERFACE}
    3931{$I 'GenericDictionary.inc'}
    … …  
    5345{$DEFINE TGDictionary := TDictionaryStringString}
    5446{$DEFINE TGDictionaryList := TDictionaryStringStringList}
    55 {$DEFINE TGDictionarySortCompare := TDictionaryStringStringSortCompare}
    56 {$DEFINE TGDictionaryToStringConverter := TDictionaryStringStringToStringConverter}
    57 {$DEFINE TGDictionaryFromStringConverter := TDictionaryStringStringFromStringConverter}
    58 {$DEFINE TGDictionaryItemArray := TDictionaryStringStringItemArray}
    5947{$DEFINE IMPLEMENTATION}
    6048{$I 'GenericDictionary.inc'}
    … …  
    6755{$DEFINE TGDictionary := TDictionaryIntegerString}
    6856{$DEFINE TGDictionaryList := TDictionaryIntegerStringList}
    69 {$DEFINE TGDictionarySortCompare := TDictionaryIntegerStringSortCompare}
    70 {$DEFINE TGDictionaryToStringConverter := TDictionaryIntegerStringToStringConverter}
    71 {$DEFINE TGDictionaryFromStringConverter := TDictionaryIntegerStringFromStringConverter}
    72 {$DEFINE TGDictionaryItemArray := TDictionaryIntegerStringItemArray}
    7357{$DEFINE IMPLEMENTATION}
    7458{$I 'GenericDictionary.inc'}

  • trunk/Packages/TemplateGenerics/Specialized/SpecializedList.pas

    r54 r93  
    1515{$DEFINE TGListItem := Integer}
    1616{$DEFINE TGList := TListInteger}
    17 {$DEFINE TGListSortCompare := TListIntegerSortCompare}
    18 {$DEFINE TGListToStringConverter := TListIntegerToStringConverter}
    19 {$DEFINE TGListFromStringConverter := TListIntegerFromStringConverter}
    20 {$DEFINE TGListItemArray := TListIntegerItemArray}
    2117{$DEFINE INTERFACE}
    2218{$I 'GenericList.inc'}
    … …  
    2622{$DEFINE TGListItem := Boolean}
    2723{$DEFINE TGList := TListBoolean}
    28 {$DEFINE TGListSortCompare := TListBooleanSortCompare}
    29 {$DEFINE TGListToStringConverter := TListBooleanToStringConverter}
    30 {$DEFINE TGListFromStringConverter := TListBooleanFromStringConverter}
    31 {$DEFINE TGListItemArray := TListBooleanItemArray}
    3224{$DEFINE INTERFACE}
    3325{$I 'GenericList.inc'}
    … …  
    3729{$DEFINE TGListItem := SmallInt}
    3830{$DEFINE TGList := TListSmallInt}
    39 {$DEFINE TGListSortCompare := TListSmallIntSortCompare}
    40 {$DEFINE TGListToStringConverter := TListSmallIntToStringConverter}
    41 {$DEFINE TGListFromStringConverter := TListSmallIntFromStringConverter}
    42 {$DEFINE TGListItemArray := TListSmallIntItemArray}
    4331{$DEFINE INTERFACE}
    4432{$I 'GenericList.inc'}
    … …  
    4836{$DEFINE TGListItem := Double}
    4937{$DEFINE TGList := TListDouble}
    50 {$DEFINE TGListSortCompare := TListDoubleSortCompare}
    51 {$DEFINE TGListToStringConverter := TListDoubleToStringConverter}
    52 {$DEFINE TGListFromStringConverter := TListDoubleFromStringConverter}
    53 {$DEFINE TGListItemArray := TListDoubleItemArray}
    5438{$DEFINE INTERFACE}
    5539{$INCLUDE '..\Generic\GenericList.inc'}
    … …  
    5943{$DEFINE TGListItem := Pointer}
    6044{$DEFINE TGList := TListPointer}
    61 {$DEFINE TGListSortCompare := TListPointerSortCompare}
    62 {$DEFINE TGListToStringConverter := TListPointerToStringConverter}
    63 {$DEFINE TGListFromStringConverter := TListPointerFromStringConverter}
    64 {$DEFINE TGListItemArray := TListPointerItemArray}
    6545{$DEFINE INTERFACE}
    6646{$I 'GenericList.inc'}
    … …  
    7050{$DEFINE TGListStringItem := string}
    7151{$DEFINE TGListString := TListString}
    72 {$DEFINE TGListStringSortCompare := TListStringSortCompare}
    73 {$DEFINE TGListStringToStringConverter := TListStringToStringConverter}
    74 {$DEFINE TGListStringFromStringConverter := TListStringFromStringConverter}
    75 {$DEFINE TGListItemArray := TListStringItemArray}
    7652{$DEFINE INTERFACE}
    7753{$I 'GenericListString.inc'}
    … …  
    8157{$DEFINE TGListItem := Byte}
    8258{$DEFINE TGList := TListByteBase}
    83 {$DEFINE TGListSortCompare := TListByteSortCompare}
    84 {$DEFINE TGListToStringConverter := TListByteToStringConverter}
    85 {$DEFINE TGListFromStringConverter := TListByteFromStringConverter}
    86 {$DEFINE TGListItemArray := TListByteItemArray}
    8759{$DEFINE INTERFACE}
    8860{$I 'GenericList.inc'}
    … …  
    9567  procedure AddStream(Stream: TStream);
    9668  procedure AddStreamPart(Stream: TStream; ItemCount: TGListIndex);
    97   procedure WriteBuffer(var Buffer; Count: Integer);
    98   procedure ReadBuffer(var Buffer; Count: Integer);
    9969end;
    10070
    … …  
    10373{$DEFINE TGListItem := Char}
    10474{$DEFINE TGList := TListCharBase}
    105 {$DEFINE TGListSortCompare := TListSortCompareChar}
    106 {$DEFINE TGListToStringConverter := TListToStringConverterChar}
    107 {$DEFINE TGListFromStringConverter := TListFromStringConverterChar}
    108 {$DEFINE TGListItemArray := TListStringItemArray}
    10975{$DEFINE INTERFACE}
    11076{$I 'GenericList.inc'}
    … …  
    11581{$DEFINE TGListObjectList := TListObjectList}
    11682{$DEFINE TGListObject := TListObject}
    117 {$DEFINE TGListObjectSortCompare := TListObjectSortCompare}
    118 {$DEFINE TGListObjectToStringConverter := TListObjectToStringConverter}
    119 {$DEFINE TGListObjectFromStringConverter := TListObjectFromStringConverter}
    120 {$DEFINE TGListItemArray := TListObjectItemArray}
    12183{$DEFINE INTERFACE}
    12284{$I 'GenericListObject.inc'}
    … …  
    138100{$DEFINE TGListItem := TMethod}
    139101{$DEFINE TGList := TListMethodBase}
    140 {$DEFINE TGListSortCompare := TListMethodSortCompare}
    141 {$DEFINE TGListToStringConverter := TListMethodToStringConverter}
    142 {$DEFINE TGListFromStringConverter := TListMethodFromStringConverter}
    143 {$DEFINE TGListItemArray := TListMethodItemArray}
    144102{$DEFINE INTERFACE}
    145103{$I 'GenericList.inc'}
    … …  
    154112{$DEFINE TGListItem := TNotifyEvent}
    155113{$DEFINE TGList := TListNotifyEventBase}
    156 {$DEFINE TGListSortCompare := TListNotifyEventSortCompare}
    157 {$DEFINE TGListToStringConverter := TListNotifyEventToStringConverter}
    158 {$DEFINE TGListFromStringConverter := TListNotifyEventFromStringConverter}
    159 {$DEFINE TGListItemArray := TListNotifyEventItemArray}
    160114{$DEFINE INTERFACE}
    161115{$I 'GenericList.inc'}
    … …  
    166120end;
    167121
     122
     123TBaseEvent = procedure of object;
     124
     125// TListSimpleEventBase<Integer, TBaseEvent>
     126{$DEFINE TGListIndex := Integer}
     127{$DEFINE TGListItem := TBaseEvent}
     128{$DEFINE TGList := TListSimpleEventBase}
     129{$DEFINE INTERFACE}
     130{$I 'GenericList.inc'}
     131
     132// TListSimpleEvent<Integer, TSimpleEvent>
     133TListSimpleEvent = class(TListSimpleEventBase)
     134  procedure CallAll;
     135end;
     136
     137
     138// TFileListByte<Integer, Byte>
     139{$DEFINE TGFileListIndex := Integer}
     140{$DEFINE TGFileListItem := Byte}
     141{$DEFINE TGFileListList := TFileListListByte}
     142{$DEFINE TGFileList := TFileListByte}
     143{$DEFINE INTERFACE}
     144{$I 'GenericFileList.inc'}
     145
    168146function StrToStr(Value: string): string;
     147
     148
     149
     150
    169151
    170152implementation
    … …  
    177159{$DEFINE TGListItem := Integer}
    178160{$DEFINE TGList := TListInteger}
    179 {$DEFINE TGListSortCompare := TListIntegerSortCompare}
    180 {$DEFINE TGListToStringConverter := TListIntegerToStringConverter}
    181 {$DEFINE TGListFromStringConverter := TListIntegerFromStringConverter}
    182 {$DEFINE TGListItemArray := TListIntegerItemArray}
    183161{$DEFINE IMPLEMENTATION}
    184162{$I 'GenericList.inc'}
    … …  
    188166{$DEFINE TGListItem := SmallInt}
    189167{$DEFINE TGList := TListSmallInt}
    190 {$DEFINE TGListSortCompare := TListSmallIntSortCompare}
    191 {$DEFINE TGListToStringConverter := TListSmallIntToStringConverter}
    192 {$DEFINE TGListFromStringConverter := TListSmallIntFromStringConverter}
    193 {$DEFINE TGListItemArray := TListSmallIntItemArray}
    194168{$DEFINE IMPLEMENTATION}
    195169{$I 'GenericList.inc'}
    … …  
    199173{$DEFINE TGListItem := Boolean}
    200174{$DEFINE TGList := TListBoolean}
    201 {$DEFINE TGListSortCompare := TListBooleanSortCompare}
    202 {$DEFINE TGListToStringConverter := TListBooleanToStringConverter}
    203 {$DEFINE TGListFromStringConverter := TListBooleanFromStringConverter}
    204 {$DEFINE TGListItemArray := TListBooleanItemArray}
    205175{$DEFINE IMPLEMENTATION}
    206176{$I 'GenericList.inc'}
    … …  
    210180{$DEFINE TGListItem := Double}
    211181{$DEFINE TGList := TListDouble}
    212 {$DEFINE TGListSortCompare := TListDoubleSortCompare}
    213 {$DEFINE TGListToStringConverter := TListDoubleToStringConverter}
    214 {$DEFINE TGListFromStringConverter := TListDoubleFromStringConverter}
    215 {$DEFINE TGListItemArray := TListDoubleItemArray}
    216182{$DEFINE IMPLEMENTATION}
    217183{$I 'GenericList.inc'}
    … …  
    221187{$DEFINE TGListItem := Pointer}
    222188{$DEFINE TGList := TListPointer}
    223 {$DEFINE TGListSortCompare := TListPointerSortCompare}
    224 {$DEFINE TGListToStringConverter := TListPointerToStringConverter}
    225 {$DEFINE TGListFromStringConverter := TListPointerFromStringConverter}
    226 {$DEFINE TGListItemArray := TListPointerItemArray}
    227189{$DEFINE IMPLEMENTATION}
    228190{$I 'GenericList.inc'}
    … …  
    232194{$DEFINE TGListStringItem := string}
    233195{$DEFINE TGListString := TListString}
    234 {$DEFINE TGListStringSortCompare := TListStringSortCompare}
    235 {$DEFINE TGListStringToStringConverter := TListStringToStringConverter}
    236 {$DEFINE TGListStringFromStringConverter := TListStringFromStringConverter}
    237 {$DEFINE TGListItemArray := TListStringItemArray}
    238196{$DEFINE IMPLEMENTATION}
    239197{$I 'GenericListString.inc'}
    … …  
    243201{$DEFINE TGListItem := Byte}
    244202{$DEFINE TGList := TListByteBase}
    245 {$DEFINE TGListSortCompare := TListByteSortCompare}
    246 {$DEFINE TGListToStringConverter := TListByteToStringConverter}
    247 {$DEFINE TGListFromStringConverter := TListByteFromStringConverter}
    248 {$DEFINE TGListItemArray := TListByteItemArray}
    249203{$DEFINE IMPLEMENTATION}
    250204{$I 'GenericList.inc'}
    … …  
    254208{$DEFINE TGListItem := Char}
    255209{$DEFINE TGList := TListCharBase}
    256 {$DEFINE TGListSortCompare := TListSortCompareChar}
    257 {$DEFINE TGListToStringConverter := TListToStringConverterChar}
    258 {$DEFINE TGListFromStringConverter := TListFromStringConverterChar}
    259 {$DEFINE TGListItemArray := TListStringItemArray}
    260210{$DEFINE IMPLEMENTATION}
    261211{$I 'GenericList.inc'}
    … …  
    266216{$DEFINE TGListObjectList := TListObjectList}
    267217{$DEFINE TGListObject := TListObject}
    268 {$DEFINE TGListObjectSortCompare := TListObjectSortCompare}
    269 {$DEFINE TGListObjectToStringConverter := TListObjectToStringConverter}
    270 {$DEFINE TGListObjectFromStringConverter := TListObjectFromStringConverter}
    271 {$DEFINE TGListItemArray := TListObjectItemArray}
    272218{$DEFINE IMPLEMENTATION}
    273219{$I 'GenericListObject.inc'}
    … …  
    277223{$DEFINE TGListItem := TMethod}
    278224{$DEFINE TGList := TListMethodBase}
    279 {$DEFINE TGListSortCompare := TListMethodSortCompare}
    280 {$DEFINE TGListToStringConverter := TListMethodToStringConverter}
    281 {$DEFINE TGListFromStringConverter := TListMethodFromStringConverter}
    282 {$DEFINE TGListItemArray := TListMethodItemArray}
    283225{$DEFINE IMPLEMENTATION}
    284226{$I 'GenericList.inc'}
    … …  
    288230{$DEFINE TGListItem := TNotifyEvent}
    289231{$DEFINE TGList := TListNotifyEventBase}
    290 {$DEFINE TGListSortCompare := TListNotifyEventSortCompare}
    291 {$DEFINE TGListToStringConverter := TListNotifyEventToStringConverter}
    292 {$DEFINE TGListFromStringConverter := TListNotifyEventFromStringConverter}
    293 {$DEFINE TGListItemArray := TListNotifyEventItemArray}
    294 {$DEFINE IMPLEMENTATION}
    295 {$I 'GenericList.inc'}
     232{$DEFINE IMPLEMENTATION}
     233{$I 'GenericList.inc'}
     234
     235// TListSimpleEventBase<Integer, TBaseEvent>
     236{$DEFINE TGListIndex := Integer}
     237{$DEFINE TGListItem := TBaseEvent}
     238{$DEFINE TGList := TListSimpleEventBase}
     239{$DEFINE IMPLEMENTATION}
     240{$I 'GenericList.inc'}
     241
     242// TFileListByte<Integer, Byte>
     243{$DEFINE TGFileListIndex := Integer}
     244{$DEFINE TGFileListItem := Byte}
     245{$DEFINE TGFileListList := TFileListListByte}
     246{$DEFINE TGFileList := TFileListByte}
     247{$DEFINE IMPLEMENTATION}
     248{$I 'GenericFileList.inc'}
    296249
    297250
    … …  
    300253  Result := Value;
    301254end;
     255
     256{ TListSimpleEvent }
     257
     258procedure TListSimpleEvent.CallAll;
     259var
     260  I: TGListIndex;
     261begin
     262  I := 0;
     263  while (I < Count) do begin
     264    TBaseEvent(Items[I])();
     265    I := I + 1;
     266  end;
     267end;
     268
    302269
    303270{ TListChar }
    … …  
    364331  I: TGListIndex;
    365332begin
    366   I := 0;
    367   while (I < Count) do begin
     333  I := Count - 1;
     334  while (I >= 0) do begin
    368335    TNotifyEvent(Items[I])(Sender);
    369     I := I + 1;
     336    I := I - 1;
    370337  end;
    371338end;
    … …  
    445412end;
    446413
    447 procedure TListByte.WriteBuffer(var Buffer; Count: Integer);
    448 begin
    449 
    450 end;
    451 
    452 procedure TListByte.ReadBuffer(var Buffer; Count: Integer);
    453 begin
    454 
    455 end;
    456414
    457415end.

  • trunk/Packages/TemplateGenerics/Specialized/SpecializedMatrix.pas

    r54 r93  
    1818{$DEFINE TGMatrixRow := TMatrixIntegerRow}
    1919{$DEFINE TGMatrix := TMatrixInteger}
    20 {$DEFINE TGMatrixSortCompare := TMatrixIntegerSortCompare}
    21 {$DEFINE TGMatrixToStringConverter := TMatrixIntegerToStringConverter}
    22 {$DEFINE TGMatrixFromStringConverter := TMatrixIntegerFromStringConverter}
    23 {$DEFINE TGMatrixMerge := TMatrixIntegerMerge}
    2420{$DEFINE INTERFACE}
    2521{$I 'GenericMatrix.inc'}
    … …  
    3228{$DEFINE TGMatrixRow := TMatrixByteRow}
    3329{$DEFINE TGMatrix := TMatrixByte}
    34 {$DEFINE TGMatrixSortCompare := TMatrixByteSortCompare}
    35 {$DEFINE TGMatrixToStringConverter := TMatrixByteToStringConverter}
    36 {$DEFINE TGMatrixFromStringConverter := TMatrixByteFromStringConverter}
    37 {$DEFINE TGMatrixMerge := TMatrixByteMerge}
    3830{$DEFINE INTERFACE}
    3931{$I 'GenericMatrix.inc'}
    … …  
    4638{$DEFINE TGMatrixRow := TMatrixObjectRow}
    4739{$DEFINE TGMatrix := TMatrixObject}
    48 {$DEFINE TGMatrixSortCompare := TMatrixObjectSortCompare}
    49 {$DEFINE TGMatrixToStringConverter := TMatrixObjectToStringConverter}
    50 {$DEFINE TGMatrixFromStringConverter := TMatrixObjectFromStringConverter}
    51 {$DEFINE TGMatrixMerge := TMatrixStringMerge}
    5240{$DEFINE INTERFACE}
    5341{$I 'GenericMatrix.inc'}
    … …  
    6553{$DEFINE TGMatrixRow := TMatrixIntegerRow}
    6654{$DEFINE TGMatrix := TMatrixInteger}
    67 {$DEFINE TGMatrixSortCompare := TMatrixIntegerSortCompare}
    68 {$DEFINE TGMatrixToStringConverter := TMatrixIntegerToStringConverter}
    69 {$DEFINE TGMatrixFromStringConverter := TMatrixIntegerFromStringConverter}
    70 {$DEFINE TGMatrixMerge := TMatrixIntegerMerge}
    7155{$DEFINE IMPLEMENTATION}
    7256{$I 'GenericMatrix.inc'}
    … …  
    7963{$DEFINE TGMatrixRow := TMatrixByteRow}
    8064{$DEFINE TGMatrix := TMatrixByte}
    81 {$DEFINE TGMatrixSortCompare := TMatrixByteSortCompare}
    82 {$DEFINE TGMatrixToStringConverter := TMatrixByteToStringConverter}
    83 {$DEFINE TGMatrixFromStringConverter := TMatrixByteFromStringConverter}
    84 {$DEFINE TGMatrixMerge := TMatrixByteMerge}
    8565{$DEFINE IMPLEMENTATION}
    8666{$I 'GenericMatrix.inc'}
    … …  
    9373{$DEFINE TGMatrixRow := TMatrixObjectRow}
    9474{$DEFINE TGMatrix := TMatrixObject}
    95 {$DEFINE TGMatrixSortCompare := TMatrixObjectSortCompare}
    96 {$DEFINE TGMatrixToStringConverter := TMatrixObjectToStringConverter}
    97 {$DEFINE TGMatrixFromStringConverter := TMatrixObjectFromStringConverter}
    98 {$DEFINE TGMatrixMerge := TMatrixStringMerge}
    9975{$DEFINE IMPLEMENTATION}
    10076{$I 'GenericMatrix.inc'}

  • trunk/Packages/TemplateGenerics/Specialized/SpecializedPoint.pas

    r54 r93  
    11unit SpecializedPoint;
    22
    3 {$mode objfpc}{$H+}
     3{$mode Delphi}{$H+}
    44
    55interface

  • trunk/Packages/TemplateGenerics/Specialized/SpecializedQueue.pas

    r54 r93  
    1616{$DEFINE TGQueue := TQueueInteger}
    1717{$DEFINE TGQueueList := TQueueListInteger}
    18 {$DEFINE TGQueueSortCompare := TQueueSortCompareInteger}
    19 {$DEFINE TGQueueToStringConverter := TQueueToStringConverterInteger}
    20 {$DEFINE TGQueueFromStringConverter := TQueueFromStringConverterInteger}
    21 {$DEFINE TGQueueItemArray := TQueueIntegerItemArray}
    2218{$DEFINE INTERFACE}
    2319{$I 'GenericQueue.inc'}
    … …  
    2824{$DEFINE TGQueue := TQueuePointer}
    2925{$DEFINE TGQueueList := TQueueListPointer}
    30 {$DEFINE TGQueueSortCompare := TQueueSortComparePointer}
    31 {$DEFINE TGQueueToStringConverter := TQueueToStringConverterPointer}
    32 {$DEFINE TGQueueFromStringConverter := TQueueFromStringConverterPointer}
    33 {$DEFINE TGQueueItemArray := TQueuePointerItemArray}
    3426{$DEFINE INTERFACE}
    3527{$I 'GenericQueue.inc'}
    … …  
    4032{$DEFINE TGQueue := TQueueByte}
    4133{$DEFINE TGQueueList := TQueueListByte}
    42 {$DEFINE TGQueueSortCompare := TQueueSortCompareByte}
    43 {$DEFINE TGQueueToStringConverter := TQueueToStringConverterByte}
    44 {$DEFINE TGQueueFromStringConverter := TQueueFromStringConverterByte}
    45 {$DEFINE TGQueueItemArray := TQueueByteItemArray}
    4634{$DEFINE INTERFACE}
    4735{$I 'GenericQueue.inc'}
    … …  
    5745{$DEFINE TGQueue := TQueueInteger}
    5846{$DEFINE TGQueueList := TQueueListInteger}
    59 {$DEFINE TGQueueSortCompare := TQueueSortCompareInteger}
    60 {$DEFINE TGQueueToStringConverter := TQueueToStringConverterInteger}
    61 {$DEFINE TGQueueFromStringConverter := TQueueFromStringConverterInteger}
    62 {$DEFINE TGQueueItemArray := TQueueIntegerItemArray}
    6347{$DEFINE IMPLEMENTATION}
    6448{$I '..\Generic\GenericQueue.inc'}
    … …  
    6953{$DEFINE TGQueue := TQueuePointer}
    7054{$DEFINE TGQueueList := TQueueListPointer}
    71 {$DEFINE TGQueueSortCompare := TQueueSortComparePointer}
    72 {$DEFINE TGQueueToStringConverter := TQueueToStringConverterPointer}
    73 {$DEFINE TGQueueFromStringConverter := TQueueFromStringConverterPointer}
    74 {$DEFINE TGQueueItemArray := TQueuePointerItemArray}
    7555{$DEFINE IMPLEMENTATION}
    7656{$I 'GenericQueue.inc'}
    … …  
    8161{$DEFINE TGQueue := TQueueByte}
    8262{$DEFINE TGQueueList := TQueueListByte}
    83 {$DEFINE TGQueueSortCompare := TQueueSortCompareByte}
    84 {$DEFINE TGQueueToStringConverter := TQueueToStringConverterByte}
    85 {$DEFINE TGQueueFromStringConverter := TQueueFromStringConverterByte}
    86 {$DEFINE TGQueueItemArray := TQueueByteItemArray}
    8763{$DEFINE IMPLEMENTATION}
    8864{$I 'GenericQueue.inc'}

  • trunk/Packages/TemplateGenerics/Specialized/SpecializedSet.pas

    r54 r93  
    1616{$DEFINE TGSetList := TSetListInteger}
    1717{$DEFINE TGSet := TSetInteger}
    18 {$DEFINE TGSetSortCompare := TSetSortCompareInteger}
    19 {$DEFINE TGSetToStringConverter := TSetToStringConverterInteger}
    20 {$DEFINE TGSetFromStringConverter := TSetFromStringConverterInteger}
    21 {$DEFINE TGSetItemArray := TSetIntegerItemArray}
    2218{$DEFINE INTERFACE}
    2319{$I 'GenericSet.inc'}
    … …  
    2824{$DEFINE TGSetList := TSetListPointer}
    2925{$DEFINE TGSet := TSetPointer}
    30 {$DEFINE TGSetSortCompare := TSetSortComparePointer}
    31 {$DEFINE TGSetToStringConverter := TSetToStringConverterPointer}
    32 {$DEFINE TGSetFromStringConverter := TSetFromStringConverterPointer}
    33 {$DEFINE TGSetItemArray := TSetPointerItemArray}
    3426{$DEFINE INTERFACE}
    3527{$I 'GenericSet.inc'}
    … …  
    4537{$DEFINE TGSetList := TSetListInteger}
    4638{$DEFINE TGSet := TSetInteger}
    47 {$DEFINE TGSetSortCompare := TSetSortCompareInteger}
    48 {$DEFINE TGSetToStringConverter := TSetToStringConverterInteger}
    49 {$DEFINE TGSetFromStringConverter := TSetFromStringConverterInteger}
    50 {$DEFINE TGSetItemArray := TSetIntegerItemArray}
    5139{$DEFINE IMPLEMENTATION}
    5240{$I 'GenericSet.inc'}
    … …  
    5745{$DEFINE TGSetList := TSetListPointer}
    5846{$DEFINE TGSet := TSetPointer}
    59 {$DEFINE TGSetSortCompare := TSetSortComparePointer}
    60 {$DEFINE TGSetToStringConverter := TSetToStringConverterPointer}
    61 {$DEFINE TGSetFromStringConverter := TSetFromStringConverterPointer}
    62 {$DEFINE TGSetItemArray := TSetPointerItemArray}
    6347{$DEFINE IMPLEMENTATION}
    6448{$I 'GenericSet.inc'}

  • trunk/Packages/TemplateGenerics/Specialized/SpecializedStack.pas

    r54 r93  
    1616{$DEFINE TGStackList := TListStackInteger}
    1717{$DEFINE TGStack := TStackInteger}
    18 {$DEFINE TGStackSortCompare := TStackSortCompareInteger}
    19 {$DEFINE TGStackToStringConverter := TStackToStringConverterInteger}
    20 {$DEFINE TGStackFromStringConverter := TStackFromStringConverterInteger}
    21 {$DEFINE TGStackItemArray := TStackIntegerItemArray}
    2218{$DEFINE INTERFACE}
    2319{$I 'GenericStack.inc'}
    … …  
    2824{$DEFINE TGStackList := TListStackPointer}
    2925{$DEFINE TGStack := TStackPointer}
    30 {$DEFINE TGStackSortCompare := TStackSortComparePointer}
    31 {$DEFINE TGStackToStringConverter := TStackToStringConverterPointer}
    32 {$DEFINE TGStackFromStringConverter := TStackFromStringConverterPointer}
    33 {$DEFINE TGStackItemArray := TStackStringItemArray}
    3426{$DEFINE INTERFACE}
    3527{$I 'GenericStack.inc'}
    … …  
    4638{$DEFINE TGStackList := TListStackInteger}
    4739{$DEFINE TGStack := TStackInteger}
    48 {$DEFINE TGStackSortCompare := TStackSortCompareInteger}
    49 {$DEFINE TGStackToStringConverter := TStackToStringConverterInteger}
    50 {$DEFINE TGStackFromStringConverter := TStackFromStringConverterInteger}
    51 {$DEFINE TGStackItemArray := TStackIntegerItemArray}
    5240{$DEFINE IMPLEMENTATION}
    5341{$I 'GenericStack.inc'}
    … …  
    5846{$DEFINE TGStackList := TListStackPointer}
    5947{$DEFINE TGStack := TStackPointer}
    60 {$DEFINE TGStackSortCompare := TStackSortComparePointer}
    61 {$DEFINE TGStackToStringConverter := TStackToStringConverterPointer}
    62 {$DEFINE TGStackFromStringConverter := TStackFromStringConverterPointer}
    63 {$DEFINE TGStackItemArray := TStackStringItemArray}
    6448{$DEFINE IMPLEMENTATION}
    6549{$I 'GenericStack.inc'}

  • trunk/Packages/TemplateGenerics/Specialized/SpecializedStream.pas

    r54 r93  
    1818{$DEFINE TGStreamList := TListStreamInteger}
    1919{$DEFINE TGStream := TStreamInteger}
    20 {$DEFINE TGStreamSortCompare := TStreamIntegerSortCompare}
    21 {$DEFINE TGStreamToStringConverter := TStreamIntegerToStringConverter}
    22 {$DEFINE TGStreamFromStringConverter := TStreamIntegerFromStringConverter}
    23 {$DEFINE TGStreamItemArray := TStreamIntegerItemArray}
    2420{$DEFINE INTERFACE}
    2521{$I 'GenericStream.inc'}
    … …  
    3026{$DEFINE TGStreamList := TListStreamByte}
    3127{$DEFINE TGStream := TBaseStreamByte}
    32 {$DEFINE TGStreamSortCompare := TStreamByteSortCompare}
    33 {$DEFINE TGStreamToStringConverter := TStreamByteToStringConverter}
    34 {$DEFINE TGStreamFromStringConverter := TStreamByteFromStringConverter}
    35 {$DEFINE TGStreamItemArray := TStreamByteItemArray}
    3628{$DEFINE INTERFACE}
    3729{$I 'GenericStream.inc'}
    … …  
    4234{$DEFINE TGStreamList := TListStreamPointer}
    4335{$DEFINE TGStream := TStreamPointer}
    44 {$DEFINE TGStreamSortCompare := TStreamPointerSortCompare}
    45 {$DEFINE TGStreamToStringConverter := TStreamPointerToStringConverter}
    46 {$DEFINE TGStreamFromStringConverter := TStreamPointerFromStringConverter}
    47 {$DEFINE TGStreamItemArray := TStreamPointerItemArray}
    4836{$DEFINE INTERFACE}
    4937{$I 'GenericStream.inc'}
    … …  
    6957    procedure WriteStream(Stream: TBaseStreamByte; Count: Integer); override;
    7058    function Read: Byte; override;
    71     function ReadArray(Count: Integer): TStreamByteItemArray; override;
     59    function ReadArray(Count: Integer): TItemArray; override;
    7260    function ReadList(List: TListByte; Count: Integer): Integer;
    7361    function ReadBuffer(var Buffer; Count: Integer): Integer; override;
    … …  
    134122end;
    135123
    136 function TMemoryStreamByte.ReadArray(Count: Integer): TStreamByteItemArray;
     124function TMemoryStreamByte.ReadArray(Count: Integer): TItemArray;
    137125begin
    138126  Result := FList.GetArray(FPosition, Count);
    … …  
    211199{$DEFINE TGStreamList := TListStreamInteger}
    212200{$DEFINE TGStream := TStreamInteger}
    213 {$DEFINE TGStreamSortCompare := TStreamIntegerSortCompare}
    214 {$DEFINE TGStreamToStringConverter := TStreamIntegerToStringConverter}
    215 {$DEFINE TGStreamFromStringConverter := TStreamIntegerFromStringConverter}
    216 {$DEFINE TGStreamItemArray := TStreamIntegerItemArray}
    217201{$DEFINE IMPLEMENTATION}
    218202{$I 'GenericStream.inc'}
    … …  
    223207{$DEFINE TGStreamList := TListStreamByte}
    224208{$DEFINE TGStream := TBaseStreamByte}
    225 {$DEFINE TGStreamSortCompare := TStreamByteSortCompare}
    226 {$DEFINE TGStreamToStringConverter := TStreamByteToStringConverter}
    227 {$DEFINE TGStreamFromStringConverter := TStreamByteFromStringConverter}
    228 {$DEFINE TGStreamItemArray := TStreamByteItemArray}
    229209{$DEFINE IMPLEMENTATION}
    230210{$I 'GenericStream.inc'}
    … …  
    235215{$DEFINE TGStreamList := TListStreamPointer}
    236216{$DEFINE TGStream := TStreamPointer}
    237 {$DEFINE TGStreamSortCompare := TStreamPointerSortCompare}
    238 {$DEFINE TGStreamToStringConverter := TStreamPointerToStringConverter}
    239 {$DEFINE TGStreamFromStringConverter := TStreamPointerFromStringConverter}
    240 {$DEFINE TGStreamItemArray := TStreamPointerItemArray}
    241217{$DEFINE IMPLEMENTATION}
    242218{$I 'GenericStream.inc'}

  • trunk/Packages/TemplateGenerics/Specialized/SpecializedTree.pas

    r54 r93  
    1616{$DEFINE TGTreeNode := TTreeNodeInteger}
    1717{$DEFINE TGTreeNodeList := TTreeNodeListInteger}
    18 {$DEFINE TGTreeSortCompare := TTreeSortCompareInteger}
    19 {$DEFINE TGTreeToStringConverter := TTreeToStringConverterInteger}
    20 {$DEFINE TGTreeFromStringConverter := TTreeFromStringConverterInteger}
    21 {$DEFINE TGTreeItemArray := TTreeIntegerItemArray}
    2218{$DEFINE INTERFACE}
    2319{$I 'GenericTree.inc'}
    … …  
    2925{$DEFINE TGTreeNode := TTreeNodeString}
    3026{$DEFINE TGTreeNodeList := TTreeNodeListString}
    31 {$DEFINE TGTreeSortCompare := TTreeSortCompareString}
    32 {$DEFINE TGTreeToStringConverter := TTreeToStringConverterString}
    33 {$DEFINE TGTreeFromStringConverter := TTreeFromStringConverterString}
    34 {$DEFINE TGTreeItemArray := TTreeStringItemArray}
    3527{$DEFINE INTERFACE}
    3628{$I 'GenericTree.inc'}
    … …  
    4234{$DEFINE TGTreeNode := TTreeNodePointer}
    4335{$DEFINE TGTreeNodeList := TTreeNodeListPointer}
    44 {$DEFINE TGTreeSortCompare := TTreeSortComparePointer}
    45 {$DEFINE TGTreeToStringConverter := TTreeToStringConverterPointer}
    46 {$DEFINE TGTreeFromStringConverter := TTreeFromStringConverterPointer}
    47 {$DEFINE TGTreeItemArray := TTreePointerItemArray}
    4836{$DEFINE INTERFACE}
    4937{$I 'GenericTree.inc'}
    … …  
    6048{$DEFINE TGTreeNode := TTreeNodeInteger}
    6149{$DEFINE TGTreeNodeList := TTreeNodeListInteger}
    62 {$DEFINE TGTreeSortCompare := TTreeSortCompareInteger}
    63 {$DEFINE TGTreeToStringConverter := TTreeToStringConverterInteger}
    64 {$DEFINE TGTreeFromStringConverter := TTreeFromStringConverterInteger}
    65 {$DEFINE TGTreeItemArray := TTreeIntegerItemArray}
    6650{$DEFINE IMPLEMENTATION}
    6751{$I 'GenericTree.inc'}
    … …  
    7357{$DEFINE TGTreeNode := TTreeNodeString}
    7458{$DEFINE TGTreeNodeList := TTreeNodeListString}
    75 {$DEFINE TGTreeSortCompare := TTreeSortCompareString}
    76 {$DEFINE TGTreeToStringConverter := TTreeToStringConverterString}
    77 {$DEFINE TGTreeFromStringConverter := TTreeFromStringConverterString}
    78 {$DEFINE TGTreeItemArray := TTreeStringItemArray}
    7959{$DEFINE IMPLEMENTATION}
    8060{$I 'GenericTree.inc'}
    … …  
    8666{$DEFINE TGTreeNode := TTreeNodePointer}
    8767{$DEFINE TGTreeNodeList := TTreeNodeListPointer}
    88 {$DEFINE TGTreeSortCompare := TTreeSortComparePointer}
    89 {$DEFINE TGTreeToStringConverter := TTreeToStringConverterPointer}
    90 {$DEFINE TGTreeFromStringConverter := TTreeFromStringConverterPointer}
    91 {$DEFINE TGTreeItemArray := TTreePointerItemArray}
    9268{$DEFINE IMPLEMENTATION}
    9369{$I 'GenericTree.inc'}

  • trunk/Packages/TemplateGenerics/TemplateGenerics.lpk

    r82 r93  
    1 <?xml version="1.0" encoding="UTF-8"?>
     1<?xml version="1.0"?>
    22<CONFIG>
    33  <Package Version="4">
    44    <PathDelim Value="\"/>
    55    <Name Value="TemplateGenerics"/>
    6     <Type Value="RunAndDesignTime"/>
    76    <AddToProjectUsesSection Value="True"/>
    87    <Author Value="Chronos (robie@centrum.cz)"/>
    … …  
    1716      <CodeGeneration>
    1817        <Optimizations>
     18          <VariablesInRegisters Value="True"/>
    1919          <OptimizationLevel Value="3"/>
    20           <VariablesInRegisters Value="True"/>
    2120        </Optimizations>
    2221      </CodeGeneration>
    2322      <Other>
    2423        <CompilerMessages>
    25           <IgnoredMessages idx5024="True"/>
     24          <UseMsgFile Value="True"/>
    2625        </CompilerMessages>
     26        <CompilerPath Value="$(CompPath)"/>
    2727      </Other>
    2828    </CompilerOptions>
    2929    <Description Value="Generic classes implemented as templates."/>
    3030    <Version Minor="4"/>
    31     <Files Count="27">
     31    <Files Count="28">
    3232      <Item1>
    3333        <Filename Value="ReadMe.txt"/>
    … …  
    4747      </Item4>
    4848      <Item5>
    49         <Filename Value="Generic\GenericQueue.inc"/>
    50         <Type Value="Include"/>
     49        <Filename Value="Generic\GenericFileList.inc"/>
    5150      </Item5>
    5251      <Item6>
    53         <Filename Value="Generic\GenericRange.inc"/>
     52        <Filename Value="Generic\GenericQueue.inc"/>
    5453        <Type Value="Include"/>
    5554      </Item6>
    5655      <Item7>
    57         <Filename Value="Generic\GenericSet.inc"/>
     56        <Filename Value="Generic\GenericRange.inc"/>
    5857        <Type Value="Include"/>
    5958      </Item7>
    6059      <Item8>
    61         <Filename Value="Generic\GenericStack.inc"/>
     60        <Filename Value="Generic\GenericSet.inc"/>
    6261        <Type Value="Include"/>
    6362      </Item8>
    6463      <Item9>
    65         <Filename Value="Generic\GenericTree.inc"/>
     64        <Filename Value="Generic\GenericStack.inc"/>
    6665        <Type Value="Include"/>
    6766      </Item9>
    6867      <Item10>
     68        <Filename Value="Generic\GenericTree.inc"/>
     69        <Type Value="Include"/>
     70      </Item10>
     71      <Item11>
    6972        <Filename Value="Generic\GenericMatrix.inc"/>
    7073        <UnitName Value="GenericMatrix"/>
    71       </Item10>
    72       <Item11>
     74      </Item11>
     75      <Item12>
    7376        <Filename Value="Generic\GenericListString.inc"/>
    7477        <UnitName Value="GenericListString"/>
    75       </Item11>
    76       <Item12>
     78      </Item12>
     79      <Item13>
    7780        <Filename Value="Generic\GenericBitmap.inc"/>
    7881        <UnitName Value="GenericBitmap"/>
    79       </Item12>
    80       <Item13>
     82      </Item13>
     83      <Item14>
    8184        <Filename Value="Generic\GenericPoint.inc"/>
    8285        <Type Value="Include"/>
    83       </Item13>
    84       <Item14>
     86      </Item14>
     87      <Item15>
    8588        <Filename Value="Generic\GenericStream.inc"/>
    8689        <UnitName Value="GenericStream"/>
    87       </Item14>
    88       <Item15>
     90      </Item15>
     91      <Item16>
    8992        <Filename Value="Generic\GenericRectangle.inc"/>
    9093        <UnitName Value="GenericRectangle"/>
    91       </Item15>
    92       <Item16>
     94      </Item16>
     95      <Item17>
    9396        <Filename Value="Specialized\SpecializedList.pas"/>
    9497        <UnitName Value="SpecializedList"/>
    95       </Item16>
    96       <Item17>
     98      </Item17>
     99      <Item18>
    97100        <Filename Value="Specialized\SpecializedDictionary.pas"/>
    98101        <UnitName Value="SpecializedDictionary"/>
    99       </Item17>
    100       <Item18>
     102      </Item18>
     103      <Item19>
    101104        <Filename Value="Specialized\SpecializedStack.pas"/>
    102105        <UnitName Value="SpecializedStack"/>
    103       </Item18>
    104       <Item19>
     106      </Item19>
     107      <Item20>
    105108        <Filename Value="Specialized\SpecializedTree.pas"/>
    106109        <UnitName Value="SpecializedTree"/>
    107       </Item19>
    108       <Item20>
     110      </Item20>
     111      <Item21>
    109112        <Filename Value="Specialized\SpecializedQueue.pas"/>
    110113        <UnitName Value="SpecializedQueue"/>
    111       </Item20>
    112       <Item21>
     114      </Item21>
     115      <Item22>
    113116        <Filename Value="Specialized\SpecializedSet.pas"/>
    114117        <UnitName Value="SpecializedSet"/>
    115       </Item21>
    116       <Item22>
     118      </Item22>
     119      <Item23>
    117120        <Filename Value="Specialized\SpecializedPoint.pas"/>
    118121        <UnitName Value="SpecializedPoint"/>
    119       </Item22>
    120       <Item23>
     122      </Item23>
     123      <Item24>
    121124        <Filename Value="Specialized\SpecializedMatrix.pas"/>
    122125        <UnitName Value="SpecializedMatrix"/>
    123       </Item23>
    124       <Item24>
     126      </Item24>
     127      <Item25>
    125128        <Filename Value="Specialized\SpecializedBitmap.pas"/>
    126129        <UnitName Value="SpecializedBitmap"/>
    127       </Item24>
    128       <Item25>
     130      </Item25>
     131      <Item26>
    129132        <Filename Value="Specialized\SpecializedStream.pas"/>
    130133        <UnitName Value="SpecializedStream"/>
    131       </Item25>
    132       <Item26>
     134      </Item26>
     135      <Item27>
    133136        <Filename Value="Specialized\SpecializedRectangle.pas"/>
    134137        <UnitName Value="SpecializedRectangle"/>
    135       </Item26>
    136       <Item27>
     138      </Item27>
     139      <Item28>
    137140        <Filename Value="Additional\UBinarySerializer.pas"/>
    138141        <UnitName Value="UBinarySerializer"/>
    139       </Item27>
     142      </Item28>
    140143    </Files>
     144    <Type Value="RunAndDesignTime"/>
    141145    <RequiredPkgs Count="2">
    142146      <Item1>

  • trunk/UCore.lfm

    r91 r93  
    2020    EmailContact = 'robie@centrum.cz'
    2121    AppName = 'LazFuck'
    22     ReleaseDate = 42975
     22    ReleaseDate = 43301
    2323    RegistryKey = '\Software\Chronosoft\LazFuck'
    2424    RegistryRoot = rrKeyCurrentUser

  • trunk/UCore.pas

    r91 r93  
    3737    Optimizations: TOptimizations;
    3838    procedure Init;
    39     procedure LoadFromRegistry(Root: HKEY; Key: string);
    40     procedure SaveToRegistry(Root: HKEY; Key: string);
     39    procedure LoadFromRegistry(Context: TRegistryContext);
     40    procedure SaveToRegistry(Context: TRegistryContext);
    4141    property CurrentTarget: TTarget read FCurrentTarget write SetCurrentTarget;
    4242  end;
    … …  
    8383  {$ENDIF}
    8484
    85   LoadFromRegistry(HKEY(ApplicationInfo.RegistryRoot), ApplicationInfo.RegistryKey);
     85  LoadFromRegistry(Core.ApplicationInfo.GetRegistryContext);
    8686end;
    8787
    8888procedure TCore.DataModuleDestroy(Sender: TObject);
    8989begin
    90   SaveToRegistry(HKEY(ApplicationInfo.RegistryRoot), ApplicationInfo.RegistryKey);
     90  SaveToRegistry(Core.ApplicationInfo.GetRegistryContext);
    9191  FreeAndNil(Targets);
    9292  FreeAndNil(Project);
    … …  
    9494end;
    9595
    96 procedure TCore.LoadFromRegistry(Root: HKEY; Key: string);
     96procedure TCore.LoadFromRegistry(Context: TRegistryContext);
    9797begin
    9898  with TRegistryEx.Create do
    9999  try
    100     RootKey := Root;
    101     OpenKey(Key, True);
     100    CurrentContext := Context;
    102101    OpenProjectOnStart := ReadBoolWithDefault('OpenProjectOnStart', True);
    103102    if ValueExists('LanguageCode') then
    … …  
    113112    Free;
    114113  end;
    115   LastOpenedList.LoadFromRegistry(RegContext(Root, Key + '\' + RecentFilesRegKey));
    116   Targets.LoadFromRegistry(Root, Key);
    117   PersistentForm1.RegistryContext := RegContext(Root, Key);
     114  LastOpenedList.LoadFromRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\' + RecentFilesRegKey));
     115  Targets.LoadFromRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\Compiler'));
     116  PersistentForm1.RegistryContext := Context;
    118117end;
    119118
    120 procedure TCore.SaveToRegistry(Root: HKEY; Key: string);
     119procedure TCore.SaveToRegistry(Context: TRegistryContext);
    121120begin
    122   Targets.SaveToRegistry(Root, Key);
    123   LastOpenedList.SaveToRegistry(RegContext(Root, Key + '\' + RecentFilesRegKey));
     121  Targets.SaveToRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\Compiler'));
     122  LastOpenedList.SaveToRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\' + RecentFilesRegKey));
    124123  with TRegistryEx.Create do
    125124  try
    126     RootKey := Root;
    127     OpenKey(Key, True);
     125    CurrentContext := Context;
    128126    WriteBool('OpenProjectOnStart', OpenProjectOnStart);
    129127    WriteBool('DPIAuto', ScaleDPI1.AutoDetect);

  • trunk/UTarget.pas

    r88 r93  
    120120    procedure StepOut; virtual;
    121121    procedure RunToCursor(Pos: Integer); virtual;
    122     procedure LoadFromRegistry(Root: HKEY; Key: string); virtual;
    123     procedure SaveToRegistry(Root: HKEY; Key: string); virtual;
     122    procedure LoadFromRegistry(Context: TRegistryContext); virtual;
     123    procedure SaveToRegistry(Context: TRegistryContext); virtual;
    124124    property State: TRunState read FState write SetState;
    125125    property SourceCode: string write SetSourceCode;
    … …  
    134134
    135135  TTargetList = class(TListObject)
    136     procedure LoadFromRegistry(Root: HKEY; Key: string);
    137     procedure SaveToRegistry(Root: HKEY; Key: string);
     136    procedure LoadFromRegistry(Context: TRegistryContext);
     137    procedure SaveToRegistry(Context: TRegistryContext);
    138138    function FindByName(Name: string): TTarget;
    139139    procedure LoadToMenuItem(MenuItem: TMenuItem; Action: TNotifyEvent;
    … …  
    271271{ TTargetList }
    272272
    273 procedure TTargetList.LoadFromRegistry(Root: HKEY; Key: string);
     273procedure TTargetList.LoadFromRegistry(Context: TRegistryContext);
    274274var
    275275  I: Integer;
    … …  
    277277  with TRegistryEx.Create do
    278278  try
    279     RootKey := Root;
    280     OpenKey(Key + '\Compiler', True);
     279    CurrentContext := Context;
    281280    for I := 0 to Count - 1 do
    282       TTarget(Items[I]).LoadFromRegistry(Root, Key + '\Compiler');
     281      TTarget(Items[I]).LoadFromRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\' + TTarget(Items[I]).Name));
    283282  finally
    284283    Free;
    … …  
    286285end;
    287286
    288 procedure TTargetList.SaveToRegistry(Root: HKEY; Key: string);
     287procedure TTargetList.SaveToRegistry(Context: TRegistryContext);
    289288var
    290289  I: Integer;
    … …  
    292291  with TRegistryEx.Create do
    293292  try
    294     RootKey := Root;
    295     OpenKey(Key + '\Compiler', True);
     293    CurrentContext := Context;
    296294    for I := 0 to Count - 1 do
    297295    with TTarget(Items[I]) do
    298       TTarget(Items[I]).SaveToRegistry(Root, Key + '\Compiler');
     296      TTarget(Items[I]).SaveToRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\' + TTarget(Items[I]).Name));
    299297  finally
    300298    Free;
    … …  
    507505end;
    508506
    509 procedure TTarget.LoadFromRegistry(Root: HKEY; Key: string);
     507procedure TTarget.LoadFromRegistry(Context: TRegistryContext);
    510508begin
    511509  with TRegistryEx.Create do
    512510  try
    513     RootKey := Root;
    514     OpenKey(Key + '\' + Name, True);
     511    CurrentContext := Context;
    515512    CompilerPath := ReadStringWithDefault('CompilerPath', CompilerPath);
    516513    ExecutorPath := ReadStringWithDefault('ExecutorPath', ExecutorPath);
    … …  
    520517end;
    521518
    522 procedure TTarget.SaveToRegistry(Root: HKEY; Key: string);
     519procedure TTarget.SaveToRegistry(Context: TRegistryContext);
    523520begin
    524521  with TRegistryEx.Create do
    525522  try
    526     RootKey := Root;
    527     OpenKey(Key + '\' + Name, True);
     523    CurrentContext := Context;
    528524    if CompilerPath <> '' then WriteString('CompilerPath', CompilerPath)
    529525      else DeleteValue('CompilerPath');
Note: See TracChangeset for help on using the changeset viewer.