Changeset 15 for trunk/Packages


Ignore:
Timestamp:
Mar 22, 2018, 8:31:19 PM (7 years ago)
Author:
chronos
Message:
  • Modified: Update Common and CollTranslator packages to fix build under Lazarus 1.8.
  • Fixed: Some memory leaks.
Location:
trunk/Packages
Files:
18 edited

Legend:

Unmodified
Added
Removed

  • trunk/Packages/Common/Common.lpk

    r10 r15  
    44    <PathDelim Value="\"/>
    55    <Name Value="Common"/>
     6    <Type Value="RunAndDesignTime"/>
    67    <AddToProjectUsesSection Value="True"/>
    78    <Author Value="Chronos (robie@centrum.cz)"/>
    … …  
    1011      <PathDelim Value="\"/>
    1112      <SearchPaths>
    12         <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     13        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    1314      </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>
    1438    </CompilerOptions>
    1539    <Description Value="Various libraries"/>
    1640    <License Value="GNU/GPL"/>
    1741    <Version Minor="7"/>
    18     <Files Count="20">
     42    <Files Count="21">
    1943      <Item1>
    2044        <Filename Value="StopWatch.pas"/>
    … …  
    105129        <UnitName Value="UScaleDPI"/>
    106130      </Item20>
     131      <Item21>
     132        <Filename Value="UTheme.pas"/>
     133        <HasRegisterProc Value="True"/>
     134        <UnitName Value="UTheme"/>
     135      </Item21>
    107136    </Files>
    108137    <i18n>
    109138      <EnableI18N Value="True"/>
    110139      <OutDir Value="Languages"/>
     140      <EnableI18NForLFM Value="True"/>
    111141    </i18n>
    112     <Type Value="RunAndDesignTime"/>
    113     <RequiredPkgs Count="2">
     142    <RequiredPkgs Count="3">
    114143      <Item1>
    115         <PackageName Value="TemplateGenerics"/>
     144        <PackageName Value="LCL"/>
    116145      </Item1>
    117146      <Item2>
     147        <PackageName Value="TemplateGenerics"/>
     148      </Item2>
     149      <Item3>
    118150        <PackageName Value="FCL"/>
    119151        <MinVersion Major="1" Valid="True"/>
    120       </Item2>
     152      </Item3>
    121153    </RequiredPkgs>
    122154    <UsageOptions>

  • trunk/Packages/Common/Common.pas

    r10 r15  
    88
    99uses
    10   StopWatch, UCommon, UDebugLog, UDelay, UPrefixMultiplier, UURI, UThreading, 
    11   UMemory, UResetableThread, UPool, ULastOpenedList, URegistry, 
    12   UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort, 
    13   UPersistentForm, UFindFile, UScaleDPI, LazarusPackageIntf;
     10  StopWatch, UCommon, UDebugLog, UDelay, UPrefixMultiplier, UURI, UThreading,
     11  UMemory, UResetableThread, UPool, ULastOpenedList, URegistry,
     12  UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort,
     13  UPersistentForm, UFindFile, UScaleDPI, UTheme, LazarusPackageIntf;
    1414
    1515implementation
    … …  
    2525  RegisterUnit('UFindFile', @UFindFile.Register);
    2626  RegisterUnit('UScaleDPI', @UScaleDPI.Register);
     27  RegisterUnit('UTheme', @UTheme.Register);
    2728end;
    2829

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

    r14 r15  
    1414msgstr ""
    1515
     16#: ujobprogressview.soperations
     17msgid "Operations"
     18msgstr ""
     19
    1620#: ujobprogressview.spleasewait
    1721msgid "Please wait..."

  • trunk/Packages/Common/UApplicationInfo.pas

    r10 r15  
    1414  TApplicationInfo = class(TComponent)
    1515  private
     16    FDescription: string;
    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;
    … …  
    7982end;
    8083
     84function TApplicationInfo.GetRegistryContext: TRegistryContext;
     85begin
     86  Result := TRegistryContext.Create(RegistryRoot, RegistryKey);
     87end;
     88
    8189end.

  • trunk/Packages/Common/UCommon.pas

    r10 r15  
    66
    77uses
    8   {$IFDEF Windows}Windows,{$ENDIF}
     8  {$ifdef Windows}Windows,{$endif}
     9  {$ifdef Linux}baseunix,{$endif}
    910  Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf,
    1011  FileUtil; //, ShFolder, ShellAPI;
    … …  
    6263procedure OpenWebPage(URL: string);
    6364procedure OpenFileInShell(FileName: string);
    64 procedure ExecuteProgram(CommandLine: string);
     65procedure ExecuteProgram(Executable: string; Parameters: array of string);
    6566procedure FreeThenNil(var Obj);
     67function RemoveQuotes(Text: string): string;
     68function ComputerName: string;
     69function OccurenceOfChar(What: Char; Where: string): Integer;
     70function GetDirCount(Dir: string): Integer;
     71function MergeArray(A, B: array of string): TArrayOfString;
     72function LoadFileToStr(const FileName: TFileName): AnsiString;
    6673
    6774
    … …  
    105112  Path := IncludeTrailingPathDelimiter(APath);
    106113
    107   Find := FindFirst(UTF8Decode(Path + AFileSpec), faAnyFile xor faDirectory, SearchRec);
     114  Find := FindFirst(Path + AFileSpec, faAnyFile xor faDirectory, SearchRec);
    108115  while Find = 0 do begin
    109     DeleteFileUTF8(Path + UTF8Encode(SearchRec.Name));
     116    DeleteFile(Path + SearchRec.Name);
    110117
    111118    Find := SysUtils.FindNext(SearchRec);
    … …  
    286293  L: LongWord;
    287294begin
    288 
    289295  L := MAX_USERNAME_LENGTH + 2;
    290296  SetLength(Result, L);
    … …  
    301307  end;
    302308end;
    303 
     309{$endif}
     310
     311function ComputerName: string;
     312{$ifdef mswindows}
     313const
     314 INFO_BUFFER_SIZE = 32767;
     315var
     316  Buffer : array[0..INFO_BUFFER_SIZE] of WideChar;
     317  Ret : DWORD;
     318begin
     319  Ret := INFO_BUFFER_SIZE;
     320  If (GetComputerNameW(@Buffer[0],Ret)) then begin
     321    Result := UTF8Encode(WideString(Buffer));
     322  end
     323  else begin
     324    Result := 'ERROR_NO_COMPUTERNAME_RETURNED';
     325  end;
     326end;
     327{$endif}
     328{$ifdef unix}
     329var
     330  Name: UtsName;
     331begin
     332  fpuname(Name);
     333  Result := Name.Nodename;
     334end;
     335{$endif}
     336
     337{$ifdef windows}
    304338function LoggedOnUserNameEx(Format: TUserNameFormat): string;
    305339const
    … …  
    395429end;
    396430
    397 procedure ExecuteProgram(CommandLine: string);
     431procedure ExecuteProgram(Executable: string; Parameters: array of string);
    398432var
    399433  Process: TProcess;
     434  I: Integer;
    400435begin
    401436  try
    402437    Process := TProcess.Create(nil);
    403     Process.CommandLine := CommandLine;
     438    Process.Executable := Executable;
     439    for I := 0 to Length(Parameters) - 1 do
     440      Process.Parameters.Add(Parameters[I]);
    404441    Process.Options := [poNoConsole];
    405442    Process.Execute;
    … …  
    416453
    417454procedure OpenWebPage(URL: string);
    418 var
    419   Process: TProcess;
    420   Browser, Params: string;
    421455begin
    422456  OpenURL(URL);
    423   {try
    424     Process := TProcess.Create(nil);
    425     Browser := '';
    426     //FindDefaultBrowser(Browser, Params);
    427     //Process.Executable := Browser;
    428     //Process.Parameters.Add(Format(Params, [ApplicationInfo.HomePage]);
    429     Process.CommandLine := 'cmd.exe /c start ' + URL;
    430     Process.Options := [poNoConsole];
    431     Process.Execute;
     457end;
     458
     459procedure OpenFileInShell(FileName: string);
     460begin
     461  ExecuteProgram('cmd.exe', ['/c', 'start', FileName]);
     462end;
     463
     464function RemoveQuotes(Text: string): string;
     465begin
     466  Result := Text;
     467  if (Pos('"', Text) = 1) and (Text[Length(Text)] = '"') then
     468    Result := Copy(Text, 2, Length(Text) - 2);
     469end;
     470
     471function OccurenceOfChar(What: Char; Where: string): Integer;
     472var
     473  I: Integer;
     474begin
     475  Result := 0;
     476  for I := 1 to Length(Where) do
     477    if Where[I] = What then Inc(Result);
     478end;
     479
     480function GetDirCount(Dir: string): Integer;
     481begin
     482  Result := OccurenceOfChar(DirectorySeparator, Dir);
     483  if Copy(Dir, Length(Dir), 1) = DirectorySeparator then
     484    Dec(Result);
     485end;
     486
     487function MergeArray(A, B: array of string): TArrayOfString;
     488var
     489  I: Integer;
     490begin
     491  SetLength(Result, Length(A) + Length(B));
     492  for I := 0 to Length(A) - 1 do
     493    Result[I] := A[I];
     494  for I := 0 to Length(B) - 1 do
     495    Result[Length(A) + I] := B[I];
     496end;
     497
     498function LoadFileToStr(const FileName: TFileName): AnsiString;
     499var
     500  FileStream: TFileStream;
     501  Read: Integer;
     502begin
     503  Result := '';
     504  FileStream := TFileStream.Create(FileName, fmOpenRead);
     505  try
     506    if FileStream.Size > 0 then begin
     507      SetLength(Result, FileStream.Size);
     508      Read := FileStream.Read(Pointer(Result)^, FileStream.Size);
     509      SetLength(Result, Read);
     510    end;
    432511  finally
    433     Process.Free;
    434   end;}
    435 end;
    436 
    437 procedure OpenFileInShell(FileName: string);
    438 begin
    439   ExecuteProgram('cmd.exe /c start "' + FileName + '"');
    440 end;
     512    FileStream.Free;
     513  end;
     514end;
     515
     516
    441517
    442518initialization

  • trunk/Packages/Common/UDebugLog.pas

    r10 r15  
    103103  try
    104104    if ExtractFileDir(FileName) <> '' then
    105       ForceDirectoriesUTF8(ExtractFileDir(FileName));
    106     if FileExistsUTF8(FileName) then LogFile := TFileStream.Create(UTF8Decode(FileName), fmOpenWrite)
     105      ForceDirectories(ExtractFileDir(FileName));
     106    if FileExists(FileName) then LogFile := TFileStream.Create(UTF8Decode(FileName), fmOpenWrite)
    107107      else LogFile := TFileStream.Create(UTF8Decode(FileName), fmCreate);
    108108    LogFile.Seek(0, soFromEnd);

  • trunk/Packages/Common/UFindFile.pas

    r10 r15  
    5555  end;
    5656
     57const
     58{$IFDEF WINDOWS}
     59  FilterAll = '*.*';
     60{$ENDIF}
     61{$IFDEF LINUX}
     62  FilterAll = '*';
     63{$ENDIF}
     64
    5765procedure Register;
    5866
    … …  
    7179  inherited Create(AOwner);
    7280  Path := IncludeTrailingBackslash(UTF8Encode(GetCurrentDir));
    73   FileMask := '*.*';
     81  FileMask := FilterAll;
    7482  FileAttr := [ffaAnyFile];
    7583  s := TStringList.Create;
    … …  
    127135  If not InSubFolders then Exit;
    128136
    129   if SysUtils.FindFirst(UTF8Decode(inPath + '*.*'), faDirectory, Rec) = 0 then
     137  if SysUtils.FindFirst(UTF8Decode(inPath + FilterAll), faDirectory, Rec) = 0 then
    130138  try
    131139    repeat

  • trunk/Packages/Common/UJobProgressView.lfm

    r10 r15  
    1414  OnDestroy = FormDestroy
    1515  Position = poScreenCenter
    16   LCLVersion = '1.1'
     16  LCLVersion = '1.6.0.4'
    1717  object PanelOperationsTitle: TPanel
    1818    Left = 0

  • trunk/Packages/Common/UJobProgressView.lrt

    r10 r15  
    1 TJOBPROGRESSVIEW.LABELOPERATION.CAPTION=Operations:
    2 TJOBPROGRESSVIEW.LABELESTIMATEDTIMEPART.CAPTION=Estimated time:
    3 TJOBPROGRESSVIEW.LABELESTIMATEDTIMETOTAL.CAPTION=Total estimated time:
     1TFORMJOBPROGRESSVIEW.LABELOPERATION.CAPTION=Operations:
     2TFORMJOBPROGRESSVIEW.LABELESTIMATEDTIMEPART.CAPTION=Estimated time:
     3TFORMJOBPROGRESSVIEW.LABELESTIMATEDTIMETOTAL.CAPTION=Total estimated time:

  • trunk/Packages/Common/UJobProgressView.pas

    r10 r15  
    166166  STotalEstimatedTime = 'Total estimated time: %s';
    167167  SFinished = 'Finished';
     168  SOperations = 'Operations';
    168169
    169170procedure Register;

  • trunk/Packages/Common/UListViewSort.pas

    r10 r15  
    99uses
    1010  {$IFDEF Windows}Windows, CommCtrl, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils,
    11   Controls, DateUtils, Dialogs, SpecializedList, Forms, Grids, StdCtrls, ExtCtrls;
     11  Controls, DateUtils, Dialogs, SpecializedList, Forms, Grids, StdCtrls, ExtCtrls,
     12  LclIntf, LMessages, LclType, LResources;
    1213
    1314type
    … …  
    1819  TCompareEvent = function (Item1, Item2: TObject): Integer of object;
    1920  TListFilterEvent = procedure (ListViewSort: TListViewSort) of object;
     21
     22  { TListViewSort }
    2023
    2124  TListViewSort = class(TComponent)
    … …  
    2831    FColumn: Integer;
    2932    FOrder: TSortOrder;
     33    FOldListViewWindowProc: TWndMethod;
     34    FOnColumnWidthChanged: TNotifyEvent;
     35    procedure DoColumnBeginResize(const AColIndex: Integer);
     36    procedure DoColumnResized(const AColIndex: Integer);
     37    procedure DoColumnResizing(const AColIndex, AWidth: Integer);
    3038    procedure SetListView(const Value: TListView);
    3139    procedure ColumnClick(Sender: TObject; Column: TListColumn);
    … …  
    4048    procedure SetColumn(const Value: Integer);
    4149    procedure SetOrder(const Value: TSortOrder);
     50    {$IFDEF WINDOWS}
     51    procedure NewListViewWindowProc(var AMsg: TMessage);
     52    {$ENDIF}
    4253  public
    4354    List: TListObject;
    … …  
    5869    property OnCustomDraw: TLVCustomDrawItemEvent read FOnCustomDraw
    5970      write FOnCustomDraw;
     71    property OnColumnWidthChanged: TNotifyEvent read FOnColumnWidthChanged
     72      write FOnColumnWidthChanged;
    6073    property Column: Integer read FColumn write SetColumn;
    6174    property Order: TSortOrder read FOrder write SetOrder;
    … …  
    6881    FOnChange: TNotifyEvent;
    6982    FStringGrid1: TStringGrid;
    70     procedure DoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
     83    procedure GridDoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
     84    procedure GridDoOnResize(Sender: TObject);
    7185  public
    7286    constructor Create(AOwner: TComponent); override;
    7387    procedure UpdateFromListView(ListView: TListView);
    7488    function TextEntered: Boolean;
     89    function TextEnteredCount: Integer;
     90    function TextEnteredColumn(Index: Integer): Boolean;
    7591    function GetColValue(Index: Integer): string;
    7692    property StringGrid: TStringGrid read FStringGrid1 write FStringGrid1;
    … …  
    7995    property Align;
    8096    property Anchors;
     97    property BorderSpacing;
    8198  end;
    8299
    … …  
    93110{ TListViewFilter }
    94111
    95 procedure TListViewFilter.DoOnKeyUp(Sender: TObject; var Key: Word;
     112procedure TListViewFilter.GridDoOnKeyUp(Sender: TObject; var Key: Word;
    96113  Shift: TShiftState);
    97114begin
    98115  if Assigned(FOnChange) then
    99116    FOnChange(Self);
     117end;
     118
     119procedure TListViewFilter.GridDoOnResize(Sender: TObject);
     120begin
     121  FStringGrid1.DefaultRowHeight := FStringGrid1.Height;
    100122end;
    101123
    … …  
    113135  FStringGrid1.Options := [goFixedHorzLine, goFixedVertLine, goVertLine,
    114136    goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll];
    115   FStringGrid1.OnKeyUp := DoOnKeyUp;
     137  FStringGrid1.OnKeyUp := GridDoOnKeyUp;
     138  FStringGrid1.OnResize := GridDoOnResize;
    116139end;
    117140
    … …  
    119142var
    120143  I: Integer;
    121   NewColumn: TGridColumn;
    122144begin
    123145  with FStringGrid1 do begin
    124     Columns.Clear;
     146    Options := Options - [goEditing, goAlwaysShowEditor];
     147    //Columns.Clear;
    125148    while Columns.Count > ListView.Columns.Count do Columns.Delete(Columns.Count - 1);
    126     while Columns.Count < ListView.Columns.Count do NewColumn := Columns.Add;
     149    while Columns.Count < ListView.Columns.Count do Columns.Add;
    127150    for I := 0 to ListView.Columns.Count - 1 do begin
    128151      Columns[I].Width := ListView.Columns[I].Width;
    129152    end;
     153    Options := Options + [goEditing, goAlwaysShowEditor];
    130154  end;
    131155end;
    132156
    133157function TListViewFilter.TextEntered: Boolean;
     158begin
     159  Result := TextEnteredCount > 0;
     160end;
     161
     162function TListViewFilter.TextEnteredCount: Integer;
    134163var
    135164  I: Integer;
    136165begin
    137   Result := False;
     166  Result := 0;
    138167  for I := 0 to FStringGrid1.ColCount - 1 do begin
    139168    if FStringGrid1.Cells[I, 0] <> '' then begin
    140       Result := True;
    141       Break;
     169      Inc(Result);
    142170    end;
    143171  end;
     172end;
     173
     174function TListViewFilter.TextEnteredColumn(Index: Integer): Boolean;
     175begin
     176  Result := FStringGrid1.Cells[Index, 0] <> '';
    144177end;
    145178
    … …  
    153186{ TListViewSort }
    154187
     188{$IFDEF WINDOWS}
     189procedure TListViewSort.NewListViewWindowProc(var AMsg: TMessage);
     190var
     191  vColWidth: Integer;
     192  vMsgNotify: TLMNotify absolute AMsg;
     193  Code: Integer;
     194begin
     195  // call the old WindowProc of ListView
     196  FOldListViewWindowProc(AMsg);
     197
     198  // Currently we care only with WM_NOTIFY message
     199  if AMsg.Msg = WM_NOTIFY then
     200  begin
     201    Code := NMHDR(PHDNotify(vMsgNotify.NMHdr)^.Hdr).Code;
     202    case Code of
     203      HDN_ENDTRACKA, HDN_ENDTRACKW:
     204        DoColumnResized(PHDNotify(vMsgNotify.NMHdr)^.Item);
     205
     206      HDN_BEGINTRACKA, HDN_BEGINTRACKW:
     207        DoColumnBeginResize(PHDNotify(vMsgNotify.NMHdr)^.Item);
     208
     209      HDN_TRACKA, HDN_TRACKW:
     210        begin
     211          vColWidth := -1;
     212          if (PHDNotify(vMsgNotify.NMHdr)^.PItem<>nil)
     213             and (PHDNotify(vMsgNotify.NMHdr)^.PItem^.Mask and HDI_WIDTH <> 0)
     214          then
     215            vColWidth := PHDNotify(vMsgNotify.NMHdr)^.PItem^.cxy;
     216
     217          DoColumnResizing(PHDNotify(vMsgNotify.NMHdr)^.Item, vColWidth);
     218        end;
     219    end;
     220  end;
     221end;
     222{$ENDIF}
     223
     224procedure TListViewSort.DoColumnBeginResize(const AColIndex: Integer);
     225begin
     226end;
     227
     228procedure TListViewSort.DoColumnResizing(const AColIndex, AWidth: Integer);
     229begin
     230end;
     231
     232procedure TListViewSort.DoColumnResized(const AColIndex: Integer);
     233begin
     234  if Assigned(FOnColumnWidthChanged) then
     235    FOnColumnWidthChanged(Self);
     236end;
    155237
    156238procedure TListViewSort.ColumnClick(Sender: TObject; Column: TListColumn);
    … …  
    179261procedure TListViewSort.SetListView(const Value: TListView);
    180262begin
     263  if FListView = Value then Exit;
     264  if Assigned(FListView) then
     265    ListView.WindowProc := FOldListViewWindowProc;
    181266  FListView := Value;
    182267  FListView.OnColumnClick := ColumnClick;
    183268  FListView.OnCustomDrawItem := ListViewCustomDrawItem;
    184269  FListView.OnClick := ListViewClick;
     270  FOldListViewWindowProc := FListView.WindowProc;
     271  {$IFDEF WINDOWS}
     272  FListView.WindowProc := NewListViewWindowProc;
     273  {$ENDIF}
    185274end;
    186275
    … …  
    199288  if ListView.Items.Count <> List.Count then
    200289    ListView.Items.Count := List.Count;
    201   if Assigned(FOnCompareItem) then Sort(FOnCompareItem);
     290  if Assigned(FOnCompareItem) and (Order <> soNone) then Sort(FOnCompareItem);
    202291  //ListView.Items[-1]; // Workaround for not show first row if selected
    203292  ListView.Refresh;
    … …  
    266355  TP1: TPoint;
    267356  XBias, YBias: Integer;
    268   OldColor: TColor;
     357  PenColor: TColor;
     358  BrushColor: TColor;
    269359  BiasTop, BiasLeft: Integer;
    270360  Rect1: TRect;
    … …  
    278368  Item.Left := 0;
    279369  GetCheckBias(XBias, YBias, BiasTop, BiasLeft, ListView);
    280   OldColor := ListView.Canvas.Pen.Color;
     370  PenColor := ListView.Canvas.Pen.Color;
     371  BrushColor := ListView.Canvas.Brush.Color;
    281372  //TP1 := Item.GetPosition;
    282373  lRect := Item.DisplayRect(drBounds); // Windows 7 workaround
    … …  
    321412  end;
    322413  //ListView.Canvas.Brush.Color := ListView.Color;
    323   ListView.Canvas.Brush.Color := clWindow;
    324   ListView.Canvas.Pen.Color := OldColor;
     414  ListView.Canvas.Brush.Color := BrushColor;
     415  ListView.Canvas.Pen.Color := PenColor;
    325416end;
    326417

  • trunk/Packages/Common/UMemory.pas

    r10 r15  
    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

    r10 r15  
    33{$mode delphi}
    44
    5 // Date: 2010-06-01
     5// Date: 2015-04-18
    66
    77interface
    88
    99uses
    10   Classes, SysUtils, Forms, URegistry, LCLIntf, Registry;
     10  Classes, SysUtils, Forms, URegistry, LCLIntf, Registry, Controls, ComCtrls;
    1111
    1212type
    … …  
    1919    FMinVisiblePart: Integer;
    2020    FRegistryContext: TRegistryContext;
     21    procedure LoadControl(Control: TControl);
     22    procedure SaveControl(Control: TControl);
    2123  public
     24    FormNormalSize: TRect;
     25    FormRestoredSize: TRect;
     26    FormWindowState: TWindowState;
     27    Form: TForm;
     28    procedure LoadFromRegistry(RegistryContext: TRegistryContext);
     29    procedure SaveToRegistry(RegistryContext: TRegistryContext);
    2230    function CheckEntireVisible(Rect: TRect): TRect;
    2331    function CheckPartVisible(Rect: TRect; Part: Integer): TRect;
    … …  
    4452{ TPersistentForm }
    4553
     54procedure TPersistentForm.LoadControl(Control: TControl);
     55var
     56  I: Integer;
     57  WinControl: TWinControl;
     58  Count: Integer;
     59begin
     60  if Control is TListView then begin
     61    with Form, TRegistryEx.Create do
     62    try
     63      RootKey := RegistryContext.RootKey;
     64      OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True);
     65      for I := 0 to TListView(Control).Columns.Count - 1 do begin
     66        if ValueExists('ColWidth' + IntToStr(I)) then
     67          TListView(Control).Columns[I].Width := ReadInteger('ColWidth' + IntToStr(I));
     68      end;
     69    finally
     70      Free;
     71    end;
     72  end;
     73
     74  if Control is TWinControl then begin
     75    WinControl := TWinControl(Control);
     76    if WinControl.ControlCount > 0 then begin
     77      for I := 0 to WinControl.ControlCount - 1 do begin
     78        if WinControl.Controls[I] is TControl then begin
     79          LoadControl(WinControl.Controls[I]);
     80        end;
     81      end;
     82    end;
     83  end;
     84end;
     85
     86procedure TPersistentForm.SaveControl(Control: TControl);
     87var
     88  I: Integer;
     89  WinControl: TWinControl;
     90begin
     91  if Control is TListView then begin
     92    with Form, TRegistryEx.Create do
     93    try
     94      RootKey := RegistryContext.RootKey;
     95      OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True);
     96      for I := 0 to TListView(Control).Columns.Count - 1 do begin
     97        WriteInteger('ColWidth' + IntToStr(I), TListView(Control).Columns[I].Width);
     98      end;
     99    finally
     100      Free;
     101    end;
     102  end;
     103
     104  if Control is TWinControl then begin
     105      WinControl := TWinControl(Control);
     106      if WinControl.ControlCount > 0 then begin
     107        for I := 0 to WinControl.ControlCount - 1 do begin
     108          if WinControl.Controls[I] is TControl then begin
     109            SaveControl(WinControl.Controls[I]);
     110          end;
     111        end;
     112      end;
     113    end;
     114end;
     115
     116procedure TPersistentForm.LoadFromRegistry(RegistryContext: TRegistryContext);
     117begin
     118  with TRegistryEx.Create do
     119  try
     120    RootKey := RegistryContext.RootKey;
     121    OpenKey(RegistryContext.Key + '\Forms\' + Form.Name, True);
     122    // Normal size
     123    FormNormalSize.Left := ReadIntegerWithDefault('NormalLeft', FormNormalSize.Left);
     124    FormNormalSize.Top := ReadIntegerWithDefault('NormalTop', FormNormalSize.Top);
     125    FormNormalSize.Right := ReadIntegerWithDefault('NormalWidth', FormNormalSize.Right - FormNormalSize.Left)
     126      + FormNormalSize.Left;
     127    FormNormalSize.Bottom := ReadIntegerWithDefault('NormalHeight', FormNormalSize.Bottom - FormNormalSize.Top)
     128      + FormNormalSize.Top;
     129    // Restored size
     130    FormRestoredSize.Left := ReadIntegerWithDefault('RestoredLeft', FormRestoredSize.Left);
     131    FormRestoredSize.Top := ReadIntegerWithDefault('RestoredTop', FormRestoredSize.Top);
     132    FormRestoredSize.Right := ReadIntegerWithDefault('RestoredWidth', FormRestoredSize.Right - FormRestoredSize.Left)
     133      + FormRestoredSize.Left;
     134    FormRestoredSize.Bottom := ReadIntegerWithDefault('RestoredHeight', FormRestoredSize.Bottom - FormRestoredSize.Top)
     135      + FormRestoredSize.Top;
     136    // Other state
     137    FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(wsNormal)));
     138  finally
     139    Free;
     140  end;
     141end;
     142
     143procedure TPersistentForm.SaveToRegistry(RegistryContext: TRegistryContext);
     144begin
     145  with Form, TRegistryEx.Create do
     146  try
     147    RootKey := RegistryContext.RootKey;
     148    OpenKey(RegistryContext.Key + '\Forms\' + Form.Name, True);
     149    // Normal state
     150    WriteInteger('NormalWidth', FormNormalSize.Right - FormNormalSize.Left);
     151    WriteInteger('NormalHeight', FormNormalSize.Bottom - FormNormalSize.Top);
     152    WriteInteger('NormalTop', FormNormalSize.Top);
     153    WriteInteger('NormalLeft', FormNormalSize.Left);
     154    // Restored state
     155    WriteInteger('RestoredWidth', FormRestoredSize.Right - FormRestoredSize.Left);
     156    WriteInteger('RestoredHeight', FormRestoredSize.Bottom - FormRestoredSize.Top);
     157    WriteInteger('RestoredTop', FormRestoredSize.Top);
     158    WriteInteger('RestoredLeft', FormRestoredSize.Left);
     159    // Other state
     160    WriteInteger('WindowState', Integer(FormWindowState));
     161  finally
     162    Free;
     163  end;
     164end;
     165
    46166function TPersistentForm.CheckEntireVisible(Rect: TRect): TRect;
    47167var
    … …  
    98218procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False);
    99219var
    100   Normal: TRect;
    101   Restored: TRect;
    102220  LoadDefaults: Boolean;
    103221begin
    104   with TRegistryEx.Create do
    105     try
    106       RootKey := RegistryContext.RootKey;
    107       OpenKey(RegistryContext.Key + '\Forms\' + Form.Name, True);
    108 
    109       //RestoredWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(Form.WindowState)));
    110       //if RestoredWindowState = wsMinimized then
    111       //  RestoredWindowState := wsNormal;
    112       //Form.WindowState := RestoredWindowState;
    113       LoadDefaults := not ValueExists('NormalLeft');
    114       Normal := Bounds(ReadIntegerWithDefault('NormalLeft', (Screen.Width - Form.Width) div 2),
    115         ReadIntegerWithDefault('NormalTop', (Screen.Height - Form.Height) div 2),
    116         ReadIntegerWithDefault('NormalWidth', Form.Width),
    117         ReadIntegerWithDefault('NormalHeight', Form.Height));
    118       Restored := Bounds(ReadIntegerWithDefault('RestoredLeft', (Screen.Width - Form.Width) div 2),
    119         ReadIntegerWithDefault('RestoredTop', (Screen.Height - Form.Height) div 2),
    120         ReadIntegerWithDefault('RestoredWidth', Form.Width),
    121         ReadIntegerWithDefault('RestoredHeight', Form.Height));
    122 
    123       if not EqualRect(Normal, Restored) or
    124         (LoadDefaults and DefaultMaximized) then begin
    125         // Restore to maximized state
    126         Form.WindowState := wsNormal;
    127         if not EqualRect(Restored, Form.BoundsRect) then
    128           Form.BoundsRect := Restored;
    129         Form.WindowState := wsMaximized;
    130       end else begin
    131         // Restore to normal state
    132         Form.WindowState := wsNormal;
    133         if FEntireVisible then Normal := CheckEntireVisible(Normal)
    134           else if FMinVisiblePart > 0 then
    135         Normal := CheckPartVisible(Normal, FMinVisiblePart);
    136         if not EqualRect(Normal, Form.BoundsRect) then
    137           Form.BoundsRect := Normal;
    138       end;
    139 
    140       //if ReadBoolWithDefault('Visible', False) then Form.Show;
    141     finally
    142       Free;
    143     end;
     222  Self.Form := Form;
     223  // Set default
     224  FormNormalSize := Bounds((Screen.Width - Form.Width) div 2,
     225    (Screen.Height - Form.Height) div 2, Form.Width, Form.Height);
     226  FormRestoredSize := Bounds((Screen.Width - Form.Width) div 2,
     227    (Screen.Height - Form.Height) div 2, Form.Width, Form.Height);
     228
     229  LoadFromRegistry(RegistryContext);
     230
     231  if not EqualRect(FormNormalSize, FormRestoredSize) or
     232    (LoadDefaults and DefaultMaximized) then begin
     233    // Restore to maximized state
     234    Form.WindowState := wsNormal;
     235    if not EqualRect(FormRestoredSize, Form.BoundsRect) then
     236      Form.BoundsRect := FormRestoredSize;
     237    Form.WindowState := wsMaximized;
     238  end else begin
     239    // Restore to normal state
     240    Form.WindowState := wsNormal;
     241    if FEntireVisible then FormNormalSize := CheckEntireVisible(FormNormalSize)
     242      else if FMinVisiblePart > 0 then
     243    FormNormalSize := CheckPartVisible(FormNormalSize, FMinVisiblePart);
     244    if not EqualRect(FormNormalSize, Form.BoundsRect) then
     245      Form.BoundsRect := FormNormalSize;
     246  end;
     247  LoadControl(Form);
    144248end;
    145249
    146250procedure TPersistentForm.Save(Form: TForm);
    147251begin
    148   with Form, TRegistryEx.Create do
    149     try
    150       RootKey := RegistryContext.RootKey;
    151       OpenKey(RegistryContext.Key + '\Forms\' + Form.Name, True);
    152       WriteInteger('NormalWidth', Form.Width);
    153       WriteInteger('NormalHeight', Form.Height);
    154       WriteInteger('NormalTop', Form.Top);
    155       WriteInteger('NormalLeft', Form.Left);
    156       WriteInteger('RestoredWidth', Form.RestoredWidth);
    157       WriteInteger('RestoredHeight', Form.RestoredHeight);
    158       WriteInteger('RestoredTop', Form.RestoredTop);
    159       WriteInteger('RestoredLeft', Form.RestoredLeft);
    160       //WriteInteger('WindowState', Integer(Form.WindowState));
    161       //WriteBool('Visible', Form.Visible);
    162     finally
    163       Free;
    164     end;
     252  Self.Form := Form;
     253  FormNormalSize := Bounds(Form.Left, Form.Top, Form.Width, Form.Height);
     254  FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth,
     255    Form.RestoredHeight);
     256  FormWindowState := Form.WindowState;
     257  SaveToRegistry(RegistryContext);
     258  SaveControl(Form);
    165259end;
    166260
    … …  
    168262begin
    169263  inherited;
     264  if AOwner is TForm then Form := TForm(AOwner)
     265    else Form := nil;
    170266  FMinVisiblePart := 50;
    171267  FRegistryContext.RootKey := HKEY_CURRENT_USER;

  • trunk/Packages/Common/URegistry.pas

    r10 r15  
    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/UScaleDPI.pas

    r10 r15  
    1717  TControlDimension = class
    1818    BoundsRect: TRect;
    19     AuxSize: TPoint;
    2019    FontHeight: Integer;
    2120    Controls: TObjectList; // TList<TControlDimension>
     21    // Class specifics
     22    ButtonSize: TPoint; // TToolBar
     23    CoolBandWidth: Integer;
     24    ConstraintsMin: TPoint; // TForm
     25    ConstraintsMax: TPoint; // TForm
    2226    constructor Create;
    2327    destructor Destroy; override;
    … …  
    7478destructor TControlDimension.Destroy;
    7579begin
    76   Controls.Free;
     80  FreeAndNil(Controls);
    7781  inherited Destroy;
    7882end;
    … …  
    113117  Dimensions.Controls.Clear;
    114118  if Control is TToolBar then
    115     Dimensions.AuxSize := Point(TToolBar(Control).ButtonWidth, TToolBar(Control).ButtonHeight);
    116 
     119    Dimensions.ButtonSize := Point(TToolBar(Control).ButtonWidth, TToolBar(Control).ButtonHeight);
     120  if Control is TForm then begin
     121    Dimensions.ConstraintsMin := Point(TForm(Control).Constraints.MinWidth,
     122      TForm(Control).Constraints.MinHeight);
     123    Dimensions.ConstraintsMax := Point(TForm(Control).Constraints.MaxWidth,
     124      TForm(Control).Constraints.MaxHeight);
     125  end;
    117126  if Control is TWinControl then
    118127  for I := 0 to TWinControl(Control).ControlCount - 1 do begin
    119     if TWinControl(Control).Controls[I] is TControl then begin
     128    if TWinControl(Control).Controls[I] is TControl then
     129    // Do not scale docked forms twice
     130    if not (TWinControl(Control).Controls[I] is TForm) then begin
    120131      NewControl := TControlDimension.Create;
    121132      Dimensions.Controls.Add(NewControl);
    … …  
    133144  Control.Font.Height := Dimensions.FontHeight;
    134145  if Control is TToolBar then begin
    135     TToolBar(Control).ButtonWidth := Dimensions.AuxSize.X;
    136     TToolBar(Control).ButtonHeight := Dimensions.AuxSize.Y;
     146    TToolBar(Control).ButtonWidth := Dimensions.ButtonSize.X;
     147    TToolBar(Control).ButtonHeight := Dimensions.ButtonSize.Y;
     148  end;
     149  if Control is TForm then begin
     150    TForm(Control).Constraints.MinWidth := Dimensions.ConstraintsMin.X;
     151    TForm(Control).Constraints.MinHeight := Dimensions.ConstraintsMin.Y;
     152    TForm(Control).Constraints.MaxWidth := Dimensions.ConstraintsMax.X;
     153    TForm(Control).Constraints.MaxHeight := Dimensions.ConstraintsMax.Y;
    137154  end;
    138155  if Control is TWinControl then
    139156  for I := 0 to TWinControl(Control).ControlCount - 1 do begin
    140     if TWinControl(Control).Controls[I] is TControl then begin
     157    if TWinControl(Control).Controls[I] is TControl then
     158    // Do not scale docked forms twice
     159    if not (TWinControl(Control).Controls[I] is TForm) then begin
    141160      RestoreDimensions(TWinControl(Control).Controls[I], TControlDimension(Dimensions.Controls[I]));
    142161    end;
    … …  
    152171  Control.Font.Height := ScaleY(Dimensions.FontHeight, DesignDPI.Y);
    153172  if Control is TToolBar then begin
    154     TToolBar(Control).ButtonWidth := ScaleX(Dimensions.AuxSize.X, DesignDPI.X);
    155     TToolBar(Control).ButtonHeight := ScaleY(Dimensions.AuxSize.Y, DesignDPI.Y);
     173    TToolBar(Control).ButtonWidth := ScaleX(Dimensions.ButtonSize.X, DesignDPI.X);
     174    TToolBar(Control).ButtonHeight := ScaleY(Dimensions.ButtonSize.Y, DesignDPI.Y);
     175  end;
     176  if Control is TCoolBar then begin
     177    with TCoolBar(Control) do
     178    for I := 0 to Bands.Count - 1 do
     179    with TCoolBand(Bands[I]) do begin
     180      MinWidth := ScaleX(Dimensions.ButtonSize.X, DesignDPI.X);
     181      MinHeight := ScaleY(Dimensions.ButtonSize.Y, DesignDPI.Y);
     182      //Width := ScaleX(Dimensions.BoundsRect.Left -
     183    end;
     184  end;
     185  if Control is TForm then begin
     186    TForm(Control).Constraints.MinWidth := ScaleX(Dimensions.ConstraintsMin.X, DesignDPI.X);
     187    TForm(Control).Constraints.MaxWidth := ScaleX(Dimensions.ConstraintsMax.X, DesignDPI.X);
     188    TForm(Control).Constraints.MinHeight := ScaleY(Dimensions.ConstraintsMin.Y, DesignDPI.Y);
     189    TForm(Control).Constraints.MaxHeight := ScaleY(Dimensions.ConstraintsMax.Y, DesignDPI.Y);
    156190  end;
    157191  if Control is TWinControl then
    158192  for I := 0 to TWinControl(Control).ControlCount - 1 do begin
    159     if TWinControl(Control).Controls[I] is TControl then begin
     193    if TWinControl(Control).Controls[I] is TControl then
     194    // Do not scale docked forms twice
     195    if not (TWinControl(Control).Controls[I] is TForm) then begin
    160196      ScaleDimensions(TWinControl(Control).Controls[I], TControlDimension(Dimensions.Controls[I]));
    161197    end;
    … …  
    183219
    184220  SetLength(Temp, ImgList.Count);
    185   TempBmp := TBitmap.Create;
    186221  for I := 0 to ImgList.Count - 1 do
    187222  begin
     223    TempBmp := TBitmap.Create;
     224    TempBmp.PixelFormat := pf32bit;
    188225    ImgList.GetBitmap(I, TempBmp);
    189     //TempBmp.PixelFormat := pfDevice;
    190226    Temp[I] := TBitmap.Create;
    191227    Temp[I].SetSize(NewWidth, NewHeight);
     228    Temp[I].PixelFormat := pf32bit;
    192229    Temp[I].TransparentColor := TempBmp.TransparentColor;
    193230    //Temp[I].TransparentMode := TempBmp.TransparentMode;
    … …  
    199236    if (Temp[I].Width = 0) or (Temp[I].Height = 0) then Continue;
    200237    Temp[I].Canvas.StretchDraw(Rect(0, 0, Temp[I].Width, Temp[I].Height), TempBmp);
    201   end;
    202   TempBmp.Free;
     238    TempBmp.Free;
     239  end;
    203240
    204241  ImgList.Clear;
    … …  
    272309  end;
    273310
    274 
     311  if Control is TCoolBar then
     312  with TCoolBar(Control) do begin
     313    BeginUpdate;
     314    for I := 0 to Bands.Count - 1 do
     315      with Bands[I] do begin
     316        MinWidth := ScaleX(MinWidth, FromDPI.X);
     317        MinHeight := ScaleY(MinHeight, FromDPI.Y);
     318        Width := ScaleX(Width, FromDPI.X);
     319        //Control.Invalidate;
     320      end;
     321    EndUpdate;
     322  end;
    275323
    276324  if Control is TToolBar then begin

  • trunk/Packages/Common/UXMLUtils.pas

    r10 r15  
    1212function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString;
    1313procedure WriteInteger(Node: TDOMNode; Name: string; Value: Integer);
     14procedure WriteInt64(Node: TDOMNode; Name: string; Value: Int64);
    1415procedure WriteBoolean(Node: TDOMNode; Name: string; Value: Boolean);
    1516procedure WriteString(Node: TDOMNode; Name: string; Value: string);
     17procedure WriteDateTime(Node: TDOMNode; Name: string; Value: TDateTime);
    1618function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer;
     19function ReadInt64(Node: TDOMNode; Name: string; DefaultValue: Int64): Int64;
    1720function ReadBoolean(Node: TDOMNode; Name: string; DefaultValue: Boolean): Boolean;
    1821function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string;
     22function ReadDateTime(Node: TDOMNode; Name: string; DefaultValue: TDateTime): TDateTime;
    1923
    2024
    … …  
    7276  Minute: Integer;
    7377  Second: Integer;
     78  SecondFraction: Double;
    7479  Millisecond: Integer;
    7580begin
    … …  
    9499      if Pos('Z', XMLDateTime) > 0 then
    95100        LeftCutString(XMLDateTime, Part, 'Z');
    96       Millisecond := StrToInt(Part);
     101      SecondFraction := StrToFloat('0' + DecimalSeparator + Part);
     102      Millisecond := Trunc(SecondFraction * 1000);
    97103    end else begin
    98104      if Pos('+', XMLDateTime) > 0 then
    … …  
    138144end;
    139145
     146procedure WriteInt64(Node: TDOMNode; Name: string; Value: Int64);
     147var
     148  NewNode: TDOMNode;
     149begin
     150  NewNode := Node.OwnerDocument.CreateElement(Name);
     151  NewNode.TextContent := IntToStr(Value);
     152  Node.AppendChild(NewNode);
     153end;
     154
    140155procedure WriteBoolean(Node: TDOMNode; Name: string; Value: Boolean);
    141156var
    … …  
    156171end;
    157172
     173procedure WriteDateTime(Node: TDOMNode; Name: string; Value: TDateTime);
     174var
     175  NewNode: TDOMNode;
     176begin
     177  NewNode := Node.OwnerDocument.CreateElement(Name);
     178  NewNode.TextContent := DateTimeToXMLTime(Value);
     179  Node.AppendChild(NewNode);
     180end;
     181
    158182function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer;
    159183var
    … …  
    166190end;
    167191
     192function ReadInt64(Node: TDOMNode; Name: string; DefaultValue: Int64): Int64;
     193var
     194  NewNode: TDOMNode;
     195begin
     196  Result := DefaultValue;
     197  NewNode := Node.FindNode(Name);
     198  if Assigned(NewNode) then
     199    Result := StrToInt64(NewNode.TextContent);
     200end;
     201
    168202function ReadBoolean(Node: TDOMNode; Name: string; DefaultValue: Boolean): Boolean;
    169203var
    … …  
    186220end;
    187221
     222function ReadDateTime(Node: TDOMNode; Name: string; DefaultValue: TDateTime
     223  ): TDateTime;
     224var
     225  NewNode: TDOMNode;
     226begin
     227  Result := DefaultValue;
     228  NewNode := Node.FindNode(Name);
     229  if Assigned(NewNode) then
     230    Result := XMLTimeToDateTime(NewNode.TextContent);
     231end;
     232
    188233end.
    189234

  • trunk/Packages/CoolTranslator/UCoolTranslator.pas

    r10 r15  
    66
    77uses
    8   Classes, SysUtils, Forms, ExtCtrls, Controls, Contnrs,
     8  Classes, SysUtils, Forms, ExtCtrls, Controls, Contnrs, LazFileUtils, LazUTF8,
    99  Translations, TypInfo, Dialogs, FileUtil, LCLProc, ULanguages, LCLType;
    1010
    … …  
    4646    procedure TranslateProperty(Component: TPersistent; PropInfo: PPropInfo);
    4747    function IsExcluded(Component: TPersistent; PropertyName: string): Boolean;
     48    function GetLangFileDir: string;
    4849  public
    4950    ComponentExcludes: TComponentExcludesList;
    … …  
    150151  I: Integer;
    151152  LocaleShort: string;
     153  SearchMask: string;
    152154begin
    153155  FPOFiles.Clear;
    … …  
    157159    //ShowMessage(ExtractFileDir(Application.ExeName) +
    158160    //  DirectorySeparator + 'Languages' + ' ' + '*.' + LocaleShort + '.po');
    159     FileList := FindAllFiles(ExtractFileDir(UTF8Encode(Application.ExeName)) +
    160       DirectorySeparator + FPOFilesFolder, '*.' + LocaleShort + '.po');
     161    SearchMask := '*';
     162    if LocaleShort <> '' then SearchMask := SearchMask + '.' + LocaleShort;
     163    SearchMask := SearchMask + '.po';
     164    FileList := FindAllFiles(GetLangFileDir, SearchMask);
    161165    for I := 0 to FileList.Count - 1 do begin
    162166      FileName := FileList[I];
    163167      //FileName := FindLocaleFileName('.po');
    164       if FileExistsUTF8(FileName) then FPOFiles.Add(TPOFile.Create(FileName));
     168      if FileExists(FileName) and (
     169      ((LocaleShort = '') and (Pos('.', FileName) = Pos('.po', FileName))) or
     170      (LocaleShort <> '')) then FPOFiles.Add(TPOFile.Create(FileName));
    165171    end;
    166172  finally
    … …  
    174180  FPoFilesFolder := AValue;
    175181  ReloadFiles;
     182  CheckLanguageFiles;
    176183end;
    177184
    … …  
    284291end;
    285292
     293function TCoolTranslator.GetLangFileDir: string;
     294begin
     295  Result := FPOFilesFolder;
     296  if Copy(Result, 1, 1) <> DirectorySeparator then
     297    Result := ExtractFileDir(UTF8Encode(Application.ExeName)) +
     298      DirectorySeparator + Result;
     299end;
     300
    286301procedure TCoolTranslator.LanguageListToStrings(Strings: TStrings);
    287302var
    … …  
    316331  I: Integer;
    317332begin
     333  Result := '';
    318334  if Text <> '' then begin
    319335    for I := 0 to FPoFiles.Count - 1 do begin
    … …  
    342358var
    343359  I: Integer;
    344 begin
     360  LangDir: string;
     361begin
     362  LangDir := GetLangFileDir;
    345363  TLanguage(Languages[0]).Available := True; // Automatic
    346364
    347365  for I := 1 to Languages.Count - 1 do
    348366  with TLanguage(Languages[I]) do begin
    349     Available := FileExistsUTF8(POFilesFolder + DirectorySeparator + ExtractFileNameOnly(Application.ExeName) +
     367    Available := FileExists(LangDir + DirectorySeparator + ExtractFileNameOnly(Application.ExeName) +
    350368      '.' + Code + ExtensionSeparator + 'po') or (Code = 'en');
    351369  end;
    … …  
    382400begin
    383401  // Win32 user may decide to override locale with LANG variable.
    384   Lang := GetEnvironmentVariableUTF8('LANG');
     402  Lang := GetEnvironmentVariable('LANG');
    385403
    386404  // Use user selected language
    … …  
    390408  if Lang = '' then begin
    391409    for i := 1 to Paramcount - 1 do
    392       if (ParamStrUTF8(i) = '--LANG') or (ParamStrUTF8(i) = '-l') or
    393         (ParamStrUTF8(i) = '--lang') then
    394         Lang := ParamStrUTF8(i + 1);
     410      if (ParamStr(i) = '--LANG') or (ParamStr(i) = '-l') or
     411        (ParamStr(i) = '--lang') then
     412        Lang := ParamStr(i + 1);
    395413  end;
    396414  if Lang = '' then
    397     LCLGetLanguageIDs(Lang, T);
     415    LazGetLanguageIDs(Lang, T);
    398416
    399417  if Assigned(Language) and (Language.Code = '') and Assigned(FOnAutomaticLanguage) then begin
    400418    Lang := FOnAutomaticLanguage(Lang);
    401419  end;
    402 
    403   if Lang = 'en' then Lang := ''; // English files are without en code
    404420
    405421  Result := Lang;
    … …  
    423439    Exit;
    424440
    425   Result := ChangeFileExt(ParamStrUTF8(0), LCExt);
     441  Result := ChangeFileExt(ParamStr(0), LCExt);
    426442  if FileExistsUTF8(Result) then
    427443    Exit;

  • trunk/Packages/CoolWeb/WebServer/UHTTPSessionFile.pas

    r12 r15  
    5151begin
    5252  Result := BinToHexString(SHA1(FloatToStr(Now)));
    53   while FileExistsUTF8(Directory + DirectorySeparator + Result) do
     53  while FileExists(Directory + DirectorySeparator + Result) do
    5454    Result := BinToHexString(SHA1(FloatToStr(Now)));
    5555end;
    … …  
    7575    Lock.Acquire;
    7676    SessionFile := Directory + DirectorySeparator + HandlerData.SessionId;
    77     if FileExistsUTF8(SessionFile) then
     77    if FileExists(SessionFile) then
    7878      HandlerData.Session.LoadFromFile(SessionFile)
    7979      else HandlerData.SessionId := GetNewSessionId;
    … …  
    9292    SessionFile := Directory + DirectorySeparator + HandlerData.SessionId;
    9393    ForceDirectories(Directory);
    94     if DirectoryExistsUTF8(Directory) then begin
     94    if DirectoryExists(Directory) then begin
    9595      DeleteFile(SessionFile);
    9696      HandlerData.Session.SaveToFile(SessionFile)
Note: See TracChangeset for help on using the changeset viewer.