Changeset 73 for trunk


Ignore:
Timestamp:
Oct 27, 2016, 3:00:47 PM (8 years ago)
Author:
chronos
Message:
  • Added: Remember position and size of main form after close of application.
  • Modified: Updated Common package to latest version.
Location:
trunk
Files:
23 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.lfm

    r72 r73  
    55  Width = 860
    66  Caption = 'LazFuck'
    7   ClientHeight = 558
     7  ClientHeight = 561
    88  ClientWidth = 860
    99  Menu = MainMenu1
     10  OnClose = FormClose
    1011  OnCloseQuery = FormCloseQuery
    1112  OnCreate = FormCreate
    1213  OnDestroy = FormDestroy
    1314  OnShow = FormShow
    14   LCLVersion = '1.7'
     15  LCLVersion = '1.6.0.4'
    1516  WindowState = wsMaximized
    1617  object StatusBarMain: TStatusBar
    1718    Left = 0
    18     Height = 24
    19     Top = 534
     19    Height = 28
     20    Top = 533
    2021    Width = 860
    2122    Panels = <   
    … …  
    130131  object PageControlRight: TPageControl
    131132    Left = 467
    132     Height = 508
     133    Height = 507
    133134    Top = 26
    134135    Width = 393
    … …  
    140141    object TabSheetDebug: TTabSheet
    141142      Caption = 'Debug'
    142       ClientHeight = 504
    143       ClientWidth = 313
     143      ClientHeight = 499
     144      ClientWidth = 359
    144145      object PanelInput: TPanel
    145146        Left = 0
    146147        Height = 64
    147148        Top = 0
    148         Width = 313
     149        Width = 359
    149150        Align = alTop
    150151        BevelOuter = bvNone
    … …  
    156157        Height = 5
    157158        Top = 64
    158         Width = 313
     159        Width = 359
    159160        Align = alTop
    160161        ResizeAnchor = akTop
    … …  
    164165        Height = 259
    165166        Top = 69
    166         Width = 313
     167        Width = 359
    167168        Align = alTop
    168169        BevelOuter = bvNone
    … …  
    174175        Height = 5
    175176        Top = 328
    176         Width = 313
     177        Width = 359
    177178        Align = alTop
    178179        ResizeAnchor = akTop
    … …  
    182183        Height = 86
    183184        Top = 333
    184         Width = 313
     185        Width = 359
    185186        Align = alTop
    186187        BevelOuter = bvNone
    … …  
    192193        Height = 5
    193194        Top = 419
    194         Width = 313
     195        Width = 359
    195196        Align = alTop
    196197        ResizeAnchor = akTop
    … …  
    198199      object PanelMemory: TPanel
    199200        Left = 0
    200         Height = 80
     201        Height = 75
    201202        Top = 424
    202         Width = 313
     203        Width = 359
    203204        Align = alClient
    204205        BevelOuter = bvNone
    … …  
    209210  object Splitter1: TSplitter
    210211    Left = 462
    211     Height = 508
     212    Height = 507
    212213    Top = 26
    213214    Width = 5
    … …  
    217218  object PanelLeft: TPanel
    218219    Left = 0
    219     Height = 508
     220    Height = 507
    220221    Top = 26
    221222    Width = 462
    222223    Align = alClient
    223224    BevelOuter = bvNone
    224     ClientHeight = 508
     225    ClientHeight = 507
    225226    ClientWidth = 462
    226227    TabOrder = 4
    227228    object PageControlMain: TPageControl
    228229      Left = 0
    229       Height = 385
     230      Height = 384
    230231      Top = 0
    231232      Width = 462
    … …  
    245246      Left = 0
    246247      Height = 118
    247       Top = 390
     248      Top = 389
    248249      Width = 462
    249250      ActivePage = TabSheetMessages
    … …  
    260261      Left = 0
    261262      Height = 5
    262       Top = 385
     263      Top = 384
    263264      Width = 462
    264265      Align = alBottom

  • trunk/Forms/UFormMain.pas

    r72 r73  
    135135    procedure AViewInterpretterExecute(Sender: TObject);
    136136    procedure AViewLogExecute(Sender: TObject);
     137    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    137138    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    138139    procedure FormCreate(Sender: TObject);
    … …  
    200201  UpdateTargetList;
    201202  DockInit;
     203  Core.PersistentForm1.Load(Self);
    202204end;
    203205
    … …  
    439441end;
    440442
     443procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
     444begin
     445  Core.PersistentForm1.Save(Self);
     446end;
     447
    441448procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: boolean);
    442449begin

  • trunk/Forms/UFormOptions.pas

    r72 r73  
    8686procedure TOptionsForm.Save;
    8787begin
    88   Core.ScaleDPI.DPI.X := SpinEditDPIX.Value;
    89   Core.ScaleDPI.DPI.Y := SpinEditDPIY.Value;
     88  Core.ScaleDPI.DPI := Point(SpinEditDPIX.Value, SpinEditDPIY.Value);
    9089  Core.ScaleDPI.AutoDetect := CheckBoxDPIAuto.Checked;
    9190  Core.OptimizationLevel := TCompilerOptimization(ComboBoxOptimizatipn.ItemIndex);

  • trunk/Packages/Common/Common.lpk

    r72 r73  
    1313        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
    1414      </SearchPaths>
    15       <Other>
    16         <CompilerMessages>
    17           <IgnoredMessages idx5024="True"/>
    18         </CompilerMessages>
    19       </Other>
    2015    </CompilerOptions>
    2116    <Description Value="Various libraries"/>
    … …  
    115110      <EnableI18N Value="True"/>
    116111      <OutDir Value="Languages"/>
     112      <EnableI18NForLFM Value="True"/>
    117113    </i18n>
    118     <RequiredPkgs Count="2">
     114    <RequiredPkgs Count="3">
    119115      <Item1>
    120         <PackageName Value="TemplateGenerics"/>
     116        <PackageName Value="LCL"/>
    121117      </Item1>
    122118      <Item2>
     119        <PackageName Value="TemplateGenerics"/>
     120      </Item2>
     121      <Item3>
    123122        <PackageName Value="FCL"/>
    124123        <MinVersion Major="1" Valid="True"/>
    125       </Item2>
     124      </Item3>
    126125    </RequiredPkgs>
    127126    <UsageOptions>

  • trunk/Packages/Common/Common.pas

    r72 r73  
    55unit Common;
    66
    7 {$warn 5023 off : no warning about unused units}
    87interface
    98

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

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

  • trunk/Packages/Common/UApplicationInfo.pas

    r72 r73  
    66
    77uses
    8   SysUtils, Classes, Forms, URegistry;
     8  SysUtils, Registry, Classes, Forms, URegistry;
    99
    1010type
    … …  
    1515  private
    1616    FIdentification: Byte;
     17    FLicense: string;
    1718    FVersionMajor: Byte;
    1819    FVersionMinor: Byte;
    … …  
    4748    property RegistryKey: string read FRegistryKey write FRegistryKey;
    4849    property RegistryRoot: TRegistryRoot read FRegistryRoot write FRegistryRoot;
     50    property License: string read FLicense write FLicense;
    4951  end;
    5052

  • trunk/Packages/Common/UCommon.pas

    r72 r73  
    88  {$IFDEF Windows}Windows,{$ENDIF}
    99  Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf,
    10   FileUtil, LazFileUtils; //, ShFolder, ShellAPI;
     10  FileUtil; //, ShFolder, ShellAPI;
    1111
    1212type
    … …  
    6464procedure ExecuteProgram(CommandLine: string);
    6565procedure FreeThenNil(var Obj);
     66function RemoveQuotes(Text: string): string;
     67function ComputerName: string;
     68function OccurenceOfChar(What: Char; Where: string): Integer;
     69function GetDirCount(Dir: string): Integer;
     70function MergeArray(A, B: array of string): TArrayOfString;
    6671
    6772
    … …  
    9196  I: Integer;
    9297begin
    93   Result := '';
    9498  for I := 1 to Length(Source) do begin
    9599    Result := Result + LowerCase(IntToHex(Ord(Source[I]), 2));
    … …  
    106110  Path := IncludeTrailingPathDelimiter(APath);
    107111
    108   Find := FindFirst(Path + AFileSpec, faAnyFile xor faDirectory, SearchRec);
     112  Find := FindFirst(UTF8Decode(Path + AFileSpec), faAnyFile xor faDirectory, SearchRec);
    109113  while Find = 0 do begin
    110     DeleteFileUTF8(Path + SearchRec.Name);
     114    DeleteFile(Path + UTF8Encode(SearchRec.Name));
    111115
    112116    Find := SysUtils.FindNext(SearchRec);
    … …  
    287291  L: LongWord;
    288292begin
    289 
    290293  L := MAX_USERNAME_LENGTH + 2;
    291294  SetLength(Result, L);
    … …  
    302305  end;
    303306end;
     307
     308function ComputerName: string;
     309{$ifdef mswindows}
     310const
     311 INFO_BUFFER_SIZE = 32767;
     312var
     313  Buffer : array[0..INFO_BUFFER_SIZE] of WideChar;
     314  Ret : DWORD;
     315begin
     316  Ret := INFO_BUFFER_SIZE;
     317  If (GetComputerNameW(@Buffer[0],Ret)) then begin
     318    Result := UTF8Encode(WideString(Buffer));
     319  end
     320  else begin
     321    Result := 'ERROR_NO_COMPUTERNAME_RETURNED';
     322  end;
     323end;
     324{$endif}
     325{$ifdef unix}
     326begin
     327  Result := GetHostName;
     328end;
     329{$endif}
    304330
    305331function LoggedOnUserNameEx(Format: TUserNameFormat): string;
    … …  
    417443
    418444procedure OpenWebPage(URL: string);
     445var
     446  Process: TProcess;
     447  Browser, Params: string;
    419448begin
    420449  OpenURL(URL);
     450  {try
     451    Process := TProcess.Create(nil);
     452    Browser := '';
     453    //FindDefaultBrowser(Browser, Params);
     454    //Process.Executable := Browser;
     455    //Process.Parameters.Add(Format(Params, [ApplicationInfo.HomePage]);
     456    Process.CommandLine := 'cmd.exe /c start ' + URL;
     457    Process.Options := [poNoConsole];
     458    Process.Execute;
     459  finally
     460    Process.Free;
     461  end;}
    421462end;
    422463
    … …  
    426467end;
    427468
     469function RemoveQuotes(Text: string): string;
     470begin
     471  Result := Text;
     472  if (Pos('"', Text) = 1) and (Text[Length(Text)] = '"') then
     473    Result := Copy(Text, 2, Length(Text) - 2);
     474end;
     475
     476function OccurenceOfChar(What: Char; Where: string): Integer;
     477var
     478  I: Integer;
     479begin
     480  Result := 0;
     481  for I := 1 to Length(Where) do
     482    if Where[I] = What then Inc(Result);
     483end;
     484
     485function GetDirCount(Dir: string): Integer;
     486begin
     487  Result := OccurenceOfChar(DirectorySeparator, Dir);
     488  if Copy(Dir, Length(Dir), 1) = DirectorySeparator then
     489    Dec(Result);
     490end;
     491
     492function MergeArray(A, B: array of string): TArrayOfString;
     493var
     494  I: Integer;
     495begin
     496  SetLength(Result, Length(A) + Length(B));
     497  for I := 0 to Length(A) - 1 do
     498    Result[I] := A[I];
     499  for I := 0 to Length(B) - 1 do
     500    Result[Length(A) + I] := B[I];
     501end;
     502
     503
     504
    428505initialization
    429506

  • trunk/Packages/Common/UDebugLog.pas

    r72 r73  
    66
    77uses
    8   Classes, SysUtils, FileUtil, SpecializedList, SyncObjs, LazFileUtils;
     8  Classes, SysUtils, FileUtil, SpecializedList, SyncObjs;
    99
    1010type
    … …  
    103103  try
    104104    if ExtractFileDir(FileName) <> '' then
    105       ForceDirectoriesUTF8(ExtractFileDir(FileName));
    106     if FileExistsUTF8(FileName) then LogFile := TFileStream.Create(FileName, fmOpenWrite)
    107       else LogFile := TFileStream.Create(FileName, fmCreate);
     105      ForceDirectories(ExtractFileDir(FileName));
     106    if FileExists(FileName) then LogFile := TFileStream.Create(UTF8Decode(FileName), fmOpenWrite)
     107      else LogFile := TFileStream.Create(UTF8Decode(FileName), fmCreate);
    108108    LogFile.Seek(0, soFromEnd);
    109109    Text := FormatDateTime('hh:nn:ss.zzz', Now) + ': ' + Text + LineEnding;

  • trunk/Packages/Common/UFindFile.pas

    r72 r73  
    2424
    2525uses
    26   SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
     26  SysUtils, Classes, Graphics, Controls, Forms, Dialogs, FileCtrl;
    2727
    2828type
    … …  
    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;
    … …  
    116124  if ffaAnyFile in FileAttr then Attr := Attr + faAnyFile;
    117125
    118   if SysUtils.FindFirst(inPath + FileMask, Attr, Rec) = 0 then
     126  if SysUtils.FindFirst(UTF8Decode(inPath + FileMask), Attr, Rec) = 0 then
    119127  try
    120128    repeat
    … …  
    127135  If not InSubFolders then Exit;
    128136
    129   if SysUtils.FindFirst(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

    r59 r73  
    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

    r54 r73  
    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

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

  • trunk/Packages/Common/ULastOpenedList.pas

    r72 r73  
    139139    OpenKey(Context.Key, True);
    140140    for I := 0 to Items.Count - 1 do
    141       WriteString('File' + IntToStr(I), Items[I]);
     141      WriteString('File' + IntToStr(I), UTF8Decode(Items[I]));
    142142  finally
    143143    Free;

  • trunk/Packages/Common/UListViewSort.pas

    r72 r73  
    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;
    … …  
    6982    FStringGrid1: TStringGrid;
    7083    procedure DoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
     84    procedure DoOnResize(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
    … …  
    98115  if Assigned(FOnChange) then
    99116    FOnChange(Self);
     117end;
     118
     119procedure TListViewFilter.DoOnResize(Sender: TObject);
     120begin
     121  FStringGrid1.DefaultRowHeight := FStringGrid1.Height;
    100122end;
    101123
    … …  
    114136    goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll];
    115137  FStringGrid1.OnKeyUp := DoOnKeyUp;
     138  FStringGrid1.OnResize := DoOnResize;
    116139end;
    117140
    … …  
    121144begin
    122145  with FStringGrid1 do begin
    123     Columns.Clear;
     146    //Columns.Clear;
    124147    while Columns.Count > ListView.Columns.Count do Columns.Delete(Columns.Count - 1);
    125148    while Columns.Count < ListView.Columns.Count do Columns.Add;
    … …  
    131154
    132155function TListViewFilter.TextEntered: Boolean;
     156begin
     157  Result := TextEnteredCount > 0;
     158end;
     159
     160function TListViewFilter.TextEnteredCount: Integer;
    133161var
    134162  I: Integer;
    135163begin
    136   Result := False;
     164  Result := 0;
    137165  for I := 0 to FStringGrid1.ColCount - 1 do begin
    138166    if FStringGrid1.Cells[I, 0] <> '' then begin
    139       Result := True;
    140       Break;
     167      Inc(Result);
    141168    end;
    142169  end;
     170end;
     171
     172function TListViewFilter.TextEnteredColumn(Index: Integer): Boolean;
     173begin
     174  Result := FStringGrid1.Cells[Index, 0] <> '';
    143175end;
    144176
    … …  
    152184{ TListViewSort }
    153185
     186{$IFDEF WINDOWS}
     187procedure TListViewSort.NewListViewWindowProc(var AMsg: TMessage);
     188var
     189  vColWidth: Integer;
     190  vMsgNotify: TLMNotify absolute AMsg;
     191  Code: Integer;
     192begin
     193  // call the old WindowProc of ListView
     194  FOldListViewWindowProc(AMsg);
     195
     196  // Currently we care only with WM_NOTIFY message
     197  if AMsg.Msg = WM_NOTIFY then
     198  begin
     199    Code := PHDNotify(vMsgNotify.NMHdr)^.Hdr.Code;
     200    case Code of
     201      HDN_ENDTRACKA, HDN_ENDTRACKW:
     202        DoColumnResized(PHDNotify(vMsgNotify.NMHdr)^.Item);
     203
     204      HDN_BEGINTRACKA, HDN_BEGINTRACKW:
     205        DoColumnBeginResize(PHDNotify(vMsgNotify.NMHdr)^.Item);
     206
     207      HDN_TRACKA, HDN_TRACKW:
     208        begin
     209          vColWidth := -1;
     210          if (PHDNotify(vMsgNotify.NMHdr)^.PItem<>nil)
     211             and (PHDNotify(vMsgNotify.NMHdr)^.PItem^.Mask and HDI_WIDTH <> 0)
     212          then
     213            vColWidth := PHDNotify(vMsgNotify.NMHdr)^.PItem^.cxy;
     214
     215          DoColumnResizing(PHDNotify(vMsgNotify.NMHdr)^.Item, vColWidth);
     216        end;
     217    end;
     218  end;
     219end;
     220{$ENDIF}
     221
     222procedure TListViewSort.DoColumnBeginResize(const AColIndex: Integer);
     223begin
     224end;
     225
     226procedure TListViewSort.DoColumnResizing(const AColIndex, AWidth: Integer);
     227begin
     228end;
     229
     230procedure TListViewSort.DoColumnResized(const AColIndex: Integer);
     231begin
     232  if Assigned(FOnColumnWidthChanged) then
     233    FOnColumnWidthChanged(Self);
     234end;
    154235
    155236procedure TListViewSort.ColumnClick(Sender: TObject; Column: TListColumn);
    … …  
    178259procedure TListViewSort.SetListView(const Value: TListView);
    179260begin
     261  if FListView = Value then Exit;
     262  if Assigned(FListView) then
     263    ListView.WindowProc := FOldListViewWindowProc;
    180264  FListView := Value;
    181265  FListView.OnColumnClick := ColumnClick;
    182266  FListView.OnCustomDrawItem := ListViewCustomDrawItem;
    183267  FListView.OnClick := ListViewClick;
     268  FOldListViewWindowProc := FListView.WindowProc;
     269  {$IFDEF WINDOWS}
     270  FListView.WindowProc := NewListViewWindowProc;
     271  {$ENDIF}
    184272end;
    185273
    … …  
    198286  if ListView.Items.Count <> List.Count then
    199287    ListView.Items.Count := List.Count;
    200   if Assigned(FOnCompareItem) then Sort(FOnCompareItem);
     288  if Assigned(FOnCompareItem) and (Order <> soNone) then Sort(FOnCompareItem);
    201289  //ListView.Items[-1]; // Workaround for not show first row if selected
    202290  ListView.Refresh;

  • trunk/Packages/Common/UPersistentForm.pas

    r59 r73  
    33{$mode delphi}
    44
    5 // Date: 2010-06-01
     5// Date: 2015-04-18
    66
    77interface
    … …  
    2020    FRegistryContext: TRegistryContext;
    2121  public
     22    FormNormalSize: TRect;
     23    FormRestoredSize: TRect;
     24    FormWindowState: TWindowState;
     25    Form: TForm;
     26    procedure LoadFromRegistry(RegistryContext: TRegistryContext);
     27    procedure SaveToRegistry(RegistryContext: TRegistryContext);
    2228    function CheckEntireVisible(Rect: TRect): TRect;
    2329    function CheckPartVisible(Rect: TRect; Part: Integer): TRect;
    … …  
    4450{ TPersistentForm }
    4551
     52procedure TPersistentForm.LoadFromRegistry(RegistryContext: TRegistryContext);
     53begin
     54  with TRegistryEx.Create do
     55  try
     56    RootKey := RegistryContext.RootKey;
     57    OpenKey(RegistryContext.Key + '\Forms\' + Form.Name, True);
     58    // Normal size
     59    FormNormalSize.Left := ReadIntegerWithDefault('NormalLeft', FormNormalSize.Left);
     60    FormNormalSize.Top := ReadIntegerWithDefault('NormalTop', FormNormalSize.Top);
     61    FormNormalSize.Right := ReadIntegerWithDefault('NormalWidth', FormNormalSize.Right - FormNormalSize.Left)
     62      + FormNormalSize.Left;
     63    FormNormalSize.Bottom := ReadIntegerWithDefault('NormalHeight', FormNormalSize.Bottom - FormNormalSize.Top)
     64      + FormNormalSize.Top;
     65    // Restored size
     66    FormRestoredSize.Left := ReadIntegerWithDefault('RestoredLeft', FormRestoredSize.Left);
     67    FormRestoredSize.Top := ReadIntegerWithDefault('RestoredTop', FormRestoredSize.Top);
     68    FormRestoredSize.Right := ReadIntegerWithDefault('RestoredWidth', FormRestoredSize.Right - FormRestoredSize.Left)
     69      + FormRestoredSize.Left;
     70    FormRestoredSize.Bottom := ReadIntegerWithDefault('RestoredHeight', FormRestoredSize.Bottom - FormRestoredSize.Top)
     71      + FormRestoredSize.Top;
     72    // Other state
     73    FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(wsNormal)));
     74  finally
     75    Free;
     76  end;
     77end;
     78
     79procedure TPersistentForm.SaveToRegistry(RegistryContext: TRegistryContext);
     80begin
     81  with Form, TRegistryEx.Create do
     82  try
     83    RootKey := RegistryContext.RootKey;
     84    OpenKey(RegistryContext.Key + '\Forms\' + Form.Name, True);
     85    // Normal state
     86    WriteInteger('NormalWidth', FormNormalSize.Right - FormNormalSize.Left);
     87    WriteInteger('NormalHeight', FormNormalSize.Bottom - FormNormalSize.Top);
     88    WriteInteger('NormalTop', FormNormalSize.Top);
     89    WriteInteger('NormalLeft', FormNormalSize.Left);
     90    // Restored state
     91    WriteInteger('RestoredWidth', FormRestoredSize.Right - FormRestoredSize.Left);
     92    WriteInteger('RestoredHeight', FormRestoredSize.Bottom - FormRestoredSize.Top);
     93    WriteInteger('RestoredTop', FormRestoredSize.Top);
     94    WriteInteger('RestoredLeft', FormRestoredSize.Left);
     95    // Other state
     96    WriteInteger('WindowState', Integer(FormWindowState));
     97  finally
     98    Free;
     99  end;
     100end;
     101
    46102function TPersistentForm.CheckEntireVisible(Rect: TRect): TRect;
    47103var
    … …  
    98154procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False);
    99155var
    100   Normal: TRect;
    101   Restored: TRect;
    102156  LoadDefaults: Boolean;
    103157begin
    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;
     158  Self.Form := Form;
     159  // Set default
     160  FormNormalSize := Bounds((Screen.Width - Form.Width) div 2,
     161    (Screen.Height - Form.Height) div 2, Form.Width, Form.Height);
     162  FormRestoredSize := Bounds((Screen.Width - Form.Width) div 2,
     163    (Screen.Height - Form.Height) div 2, Form.Width, Form.Height);
     164
     165  LoadFromRegistry(RegistryContext);
     166
     167  if not EqualRect(FormNormalSize, FormRestoredSize) or
     168    (LoadDefaults and DefaultMaximized) then begin
     169    // Restore to maximized state
     170    Form.WindowState := wsNormal;
     171    if not EqualRect(FormRestoredSize, Form.BoundsRect) then
     172      Form.BoundsRect := FormRestoredSize;
     173    Form.WindowState := wsMaximized;
     174  end else begin
     175    // Restore to normal state
     176    Form.WindowState := wsNormal;
     177    if FEntireVisible then FormNormalSize := CheckEntireVisible(FormNormalSize)
     178      else if FMinVisiblePart > 0 then
     179    FormNormalSize := CheckPartVisible(FormNormalSize, FMinVisiblePart);
     180    if not EqualRect(FormNormalSize, Form.BoundsRect) then
     181      Form.BoundsRect := FormNormalSize;
     182  end;
    144183end;
    145184
    146185procedure TPersistentForm.Save(Form: TForm);
    147186begin
    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;
     187  Self.Form := Form;
     188  FormNormalSize := Bounds(Form.Left, Form.Top, Form.Width, Form.Height);
     189  FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth,
     190    Form.RestoredHeight);
     191  FormWindowState := Form.WindowState;
     192  SaveToRegistry(RegistryContext);
    165193end;
    166194
    … …  
    168196begin
    169197  inherited;
     198  if AOwner is TForm then Form := TForm(AOwner)
     199    else Form := nil;
    170200  FMinVisiblePart := 50;
    171201  FRegistryContext.RootKey := HKEY_CURRENT_USER;

  • trunk/Packages/Common/UScaleDPI.pas

    r72 r73  
    88
    99uses
    10   Classes, Forms, Graphics, Controls, ComCtrls, LCLType;
     10  Classes, Forms, Graphics, Controls, ComCtrls, LCLType, SysUtils, StdCtrls,
     11  Contnrs;
    1112
    1213type
     14
     15  { TControlDimension }
     16
     17  TControlDimension = class
     18    BoundsRect: TRect;
     19    FontHeight: Integer;
     20    Controls: TObjectList; // TList<TControlDimension>
     21    // Class specifics
     22    ButtonSize: TPoint; // TToolBar
     23    CoolBandWidth: Integer;
     24    ConstraintsMin: TPoint; // TForm
     25    ConstraintsMax: TPoint; // TForm
     26    constructor Create;
     27    destructor Destroy; override;
     28  end;
    1329
    1430  { TScaleDPI }
    … …  
    1733  private
    1834    FAutoDetect: Boolean;
     35    FDesignDPI: TPoint;
     36    FDPI: TPoint;
    1937    procedure SetAutoDetect(AValue: Boolean);
     38    procedure SetDesignDPI(AValue: TPoint);
     39    procedure SetDPI(AValue: TPoint);
    2040  public
    21     DPI: TPoint;
    22     DesignDPI: TPoint;
     41    procedure StoreDimensions(Control: TControl; Dimensions: TControlDimension);
     42    procedure RestoreDimensions(Control: TControl; Dimensions: TControlDimension);
     43    procedure ScaleDimensions(Control: TControl; Dimensions: TControlDimension);
    2344    procedure ApplyToAll(FromDPI: TPoint);
    24     procedure ScaleDPI(Control: TControl; FromDPI: TPoint);
     45    procedure ScaleControl(Control: TControl; FromDPI: TPoint);
    2546    procedure ScaleImageList(ImgList: TImageList; FromDPI: TPoint);
    26     function ScaleXY(Size: TPoint; FromDPI: Integer): TPoint;
     47    function ScalePoint(APoint: TPoint; FromDPI: TPoint): TPoint;
     48    function ScaleRect(ARect: TRect; FromDPI: TPoint): TRect;
    2749    function ScaleX(Size: Integer; FromDPI: Integer): Integer;
    2850    function ScaleY(Size: Integer; FromDPI: Integer): Integer;
    2951    constructor Create(AOwner: TComponent); override;
     52    property DesignDPI: TPoint read FDesignDPI write SetDesignDPI;
     53    property DPI: TPoint read FDPI write SetDPI;
    3054  published
    3155    property AutoDetect: Boolean read FAutoDetect write SetAutoDetect;
    … …  
    3458procedure Register;
    3559
     60
    3661implementation
    3762
     63resourcestring
     64  SWrongDPI = 'Wrong DPI [%d,%d]';
     65
    3866procedure Register;
    3967begin
    4068  RegisterComponents('Common', [TScaleDPI]);
     69end;
     70
     71{ TControlDimension }
     72
     73constructor TControlDimension.Create;
     74begin
     75  Controls := TObjectList.Create;
     76end;
     77
     78destructor TControlDimension.Destroy;
     79begin
     80  FreeAndNil(Controls);
     81  inherited Destroy;
    4182end;
    4283
    … …  
    5091end;
    5192
     93procedure TScaleDPI.SetDesignDPI(AValue: TPoint);
     94begin
     95  if (FDesignDPI.X = AValue.X) and (FDesignDPI.Y = AValue.Y) then Exit;
     96  if (AValue.X <= 0) or (AValue.Y <= 0) then
     97    raise Exception.Create(Format(SWrongDPI, [AValue.X, AValue.Y]));
     98  FDesignDPI := AValue;
     99end;
     100
     101procedure TScaleDPI.SetDPI(AValue: TPoint);
     102begin
     103  if (FDPI.X = AValue.X) and (FDPI.Y = AValue.Y) then Exit;
     104  if (AValue.X <= 0) or (AValue.Y <= 0) then
     105    raise Exception.Create(Format(SWrongDPI, [AValue.X, AValue.Y]));
     106  FDPI := AValue;
     107end;
     108
     109procedure TScaleDPI.StoreDimensions(Control: TControl;
     110  Dimensions: TControlDimension);
     111var
     112  NewControl: TControlDimension;
     113  I: Integer;
     114begin
     115  Dimensions.BoundsRect := Control.BoundsRect;
     116  Dimensions.FontHeight := Control.Font.GetTextHeight('Hg');
     117  Dimensions.Controls.Clear;
     118  if Control is TToolBar then
     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;
     126  if Control is TWinControl then
     127  for I := 0 to TWinControl(Control).ControlCount - 1 do 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
     131      NewControl := TControlDimension.Create;
     132      Dimensions.Controls.Add(NewControl);
     133      StoreDimensions(TWinControl(Control).Controls[I], NewControl);
     134    end;
     135  end;
     136end;
     137
     138procedure TScaleDPI.RestoreDimensions(Control: TControl;
     139  Dimensions: TControlDimension);
     140var
     141  I: Integer;
     142begin
     143  Control.BoundsRect := Dimensions.BoundsRect;
     144  Control.Font.Height := Dimensions.FontHeight;
     145  if Control is TToolBar then begin
     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;
     154  end;
     155  if Control is TWinControl then
     156  for I := 0 to TWinControl(Control).ControlCount - 1 do 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
     160      RestoreDimensions(TWinControl(Control).Controls[I], TControlDimension(Dimensions.Controls[I]));
     161    end;
     162  end;
     163end;
     164
     165procedure TScaleDPI.ScaleDimensions(Control: TControl;
     166  Dimensions: TControlDimension);
     167var
     168  I: Integer;
     169begin
     170  Control.BoundsRect := ScaleRect(Dimensions.BoundsRect, DesignDPI);
     171  Control.Font.Height := ScaleY(Dimensions.FontHeight, DesignDPI.Y);
     172  if Control is TToolBar then begin
     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);
     190  end;
     191  if Control is TWinControl then
     192  for I := 0 to TWinControl(Control).ControlCount - 1 do 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
     196      ScaleDimensions(TWinControl(Control).Controls[I], TControlDimension(Dimensions.Controls[I]));
     197    end;
     198  end;
     199end;
     200
    52201procedure TScaleDPI.ApplyToAll(FromDPI: TPoint);
    53202var
    … …  
    55204begin
    56205  for I := 0 to Screen.FormCount - 1 do begin
    57     ScaleDPI(Screen.Forms[I], FromDPI);
     206    ScaleControl(Screen.Forms[I], FromDPI);
    58207  end;
    59208end;
    … …  
    70219
    71220  SetLength(Temp, ImgList.Count);
    72   TempBmp := TBitmap.Create;
    73221  for I := 0 to ImgList.Count - 1 do
    74222  begin
     223    TempBmp := TBitmap.Create;
     224    TempBmp.PixelFormat := pf32bit;
    75225    ImgList.GetBitmap(I, TempBmp);
    76     //TempBmp.PixelFormat := pfDevice;
    77226    Temp[I] := TBitmap.Create;
    78227    Temp[I].SetSize(NewWidth, NewHeight);
     228    Temp[I].PixelFormat := pf32bit;
    79229    Temp[I].TransparentColor := TempBmp.TransparentColor;
    80230    //Temp[I].TransparentMode := TempBmp.TransparentMode;
    … …  
    86236    if (Temp[I].Width = 0) or (Temp[I].Height = 0) then Continue;
    87237    Temp[I].Canvas.StretchDraw(Rect(0, 0, Temp[I].Width, Temp[I].Height), TempBmp);
    88   end;
    89   TempBmp.Free;
     238    TempBmp.Free;
     239  end;
    90240
    91241  ImgList.Clear;
    … …  
    110260end;
    111261
    112 function TScaleDPI.ScaleXY(Size: TPoint; FromDPI: Integer): TPoint;
    113 begin
    114   Result.X := ScaleX(Size.X, FromDPI);
    115   Result.Y := ScaleY(Size.Y, FromDPI);
     262function TScaleDPI.ScalePoint(APoint: TPoint; FromDPI: TPoint): TPoint;
     263begin
     264  Result.X := ScaleX(APoint.X, FromDPI.X);
     265  Result.Y := ScaleY(APoint.Y, FromDPI.Y);
     266end;
     267
     268function TScaleDPI.ScaleRect(ARect: TRect; FromDPI: TPoint): TRect;
     269begin
     270  Result.TopLeft := ScalePoint(ARect.TopLeft, FromDPI);
     271  Result.BottomRight := ScalePoint(ARect.BottomRight, FromDPI);
    116272end;
    117273
    … …  
    123279end;
    124280
    125 procedure TScaleDPI.ScaleDPI(Control: TControl; FromDPI: TPoint);
     281procedure TScaleDPI.ScaleControl(Control: TControl; FromDPI: TPoint);
    126282var
    127283  I: Integer;
    128284  WinControl: TWinControl;
    129285  ToolBarControl: TToolBar;
    130 begin
     286  OldAnchors: TAnchors;
     287  OldAutoSize: Boolean;
     288begin
     289  //if Control is TMemo then Exit;
     290  //if Control is TForm then
     291  //  Control.DisableAutoSizing;
    131292  with Control do begin
     293    //OldAutoSize := AutoSize;
     294    //AutoSize := False;
     295    //Anchors := [];
    132296    Left := ScaleX(Left, FromDPI.X);
    133297    Top := ScaleY(Top, FromDPI.Y);
     298    //if not (akRight in Anchors) then
    134299    Width := ScaleX(Width, FromDPI.X);
     300    //if not (akBottom in Anchors) then
    135301    Height := ScaleY(Height, FromDPI.Y);
    136302    {$IFDEF LCL Qt}
    … …  
    139305      Font.Height := ScaleY(Font.GetTextHeight('Hg'), FromDPI.Y);
    140306    {$ENDIF}
     307    //Anchors := OldAnchors;
     308    //AutoSize := OldAutoSize;
    141309  end;
    142310
    … …  
    149317  end;
    150318
     319  //if not (Control is TCustomPage) then
    151320  if Control is TWinControl then begin
    152321    WinControl := TWinControl(Control);
    … …  
    154323      for I := 0 to WinControl.ControlCount - 1 do begin
    155324        if WinControl.Controls[I] is TControl then begin
    156           ScaleDPI(WinControl.Controls[I], FromDPI);
     325          ScaleControl(WinControl.Controls[I], FromDPI);
    157326        end;
    158327      end;
    159328    end;
    160329  end;
     330  //if Control is TForm then
     331  //  Control.EnableAutoSizing;
    161332end;
    162333

  • trunk/Packages/Common/UURI.pas

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

  • trunk/Packages/Common/UXMLUtils.pas

    r72 r73  
    77uses
    88  {$IFDEF WINDOWS}Windows,{$ENDIF}
    9   Classes, SysUtils, DateUtils;
     9  Classes, SysUtils, DateUtils, XMLRead, XMLWrite, DOM;
    1010
    1111function XMLTimeToDateTime(XMLDateTime: string): TDateTime;
    12 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): string;
     12function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString;
     13procedure WriteInteger(Node: TDOMNode; Name: string; Value: Integer);
     14procedure WriteInt64(Node: TDOMNode; Name: string; Value: Int64);
     15procedure WriteBoolean(Node: TDOMNode; Name: string; Value: Boolean);
     16procedure WriteString(Node: TDOMNode; Name: string; Value: string);
     17procedure WriteDateTime(Node: TDOMNode; Name: string; Value: TDateTime);
     18function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer;
     19function ReadInt64(Node: TDOMNode; Name: string; DefaultValue: Int64): Int64;
     20function ReadBoolean(Node: TDOMNode; Name: string; DefaultValue: Boolean): Boolean;
     21function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string;
     22function ReadDateTime(Node: TDOMNode; Name: string; DefaultValue: TDateTime): TDateTime;
    1323
    1424
    … …  
    3545function LeftCutString(var Source: string; out Output: string; Delimiter: string; Allowed: string = ''): Boolean;
    3646var
    37   I: Integer;
     47  I, J: Integer;
    3848  Matched: Boolean;
    3949begin
    … …  
    6676  Minute: Integer;
    6777  Second: Integer;
     78  SecondFraction: Double;
    6879  Millisecond: Integer;
    6980begin
    … …  
    8899      if Pos('Z', XMLDateTime) > 0 then
    89100        LeftCutString(XMLDateTime, Part, 'Z');
    90       Millisecond := StrToInt(Part);
     101      SecondFraction := StrToFloat('0' + DecimalSeparator + Part);
     102      Millisecond := Trunc(SecondFraction * 1000);
    91103    end else begin
    92104      if Pos('+', XMLDateTime) > 0 then
    … …  
    106118end;
    107119
    108 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): string;
     120function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString;
    109121const
    110122  Neg: array[Boolean] of string =  ('+', '-');
    … …  
    123135end;
    124136
     137procedure WriteInteger(Node: TDOMNode; Name: string; Value: Integer);
     138var
     139  NewNode: TDOMNode;
     140begin
     141  NewNode := Node.OwnerDocument.CreateElement(Name);
     142  NewNode.TextContent := IntToStr(Value);
     143  Node.AppendChild(NewNode);
     144end;
     145
     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
     155procedure WriteBoolean(Node: TDOMNode; Name: string; Value: Boolean);
     156var
     157  NewNode: TDOMNode;
     158begin
     159  NewNode := Node.OwnerDocument.CreateElement(Name);
     160  NewNode.TextContent := BoolToStr(Value);
     161  Node.AppendChild(NewNode);
     162end;
     163
     164procedure WriteString(Node: TDOMNode; Name: string; Value: string);
     165var
     166  NewNode: TDOMNode;
     167begin
     168  NewNode := Node.OwnerDocument.CreateElement(Name);
     169  NewNode.TextContent := Value;
     170  Node.AppendChild(NewNode);
     171end;
     172
     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
     182function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer;
     183var
     184  NewNode: TDOMNode;
     185begin
     186  Result := DefaultValue;
     187  NewNode := Node.FindNode(Name);
     188  if Assigned(NewNode) then
     189    Result := StrToInt(NewNode.TextContent);
     190end;
     191
     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
     202function ReadBoolean(Node: TDOMNode; Name: string; DefaultValue: Boolean): Boolean;
     203var
     204  NewNode: TDOMNode;
     205begin
     206  Result := DefaultValue;
     207  NewNode := Node.FindNode(Name);
     208  if Assigned(NewNode) then
     209    Result := StrToBool(NewNode.TextContent);
     210end;
     211
     212function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string;
     213var
     214  NewNode: TDOMNode;
     215begin
     216  Result := DefaultValue;
     217  NewNode := Node.FindNode(Name);
     218  if Assigned(NewNode) then
     219    Result := NewNode.TextContent;
     220end;
     221
     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
    125233end.
    126234

  • trunk/Packages/CoolTranslator/CoolTranslator.pas

    r72 r73  
    55unit CoolTranslator;
    66
    7 {$warn 5023 off : no warning about unused units}
    87interface
    98

  • trunk/Packages/TemplateGenerics/TemplateGenerics.pas

    r72 r73  
    55unit TemplateGenerics;
    66
    7 {$warn 5023 off : no warning about unused units}
    87interface
    98

  • trunk/UCore.lfm

    r70 r73  
    3535    top = 128
    3636  end
     37  object PersistentForm1: TPersistentForm
     38    MinVisiblePart = 50
     39    EntireVisible = False
     40    left = 72
     41    top = 184
     42  end
    3743end

  • trunk/UCore.pas

    r72 r73  
    77uses
    88  Classes, SysUtils, FileUtil, UApplicationInfo, ULastOpenedList, UProject,
    9   UCoolTranslator, UTarget, URegistry, Registry, Graphics, UScaleDPI;
     9  UCoolTranslator, UTarget, URegistry, Registry, Graphics, UScaleDPI,
     10  UPersistentForm;
    1011
    1112type
    … …  
    1718    CoolTranslator1: TCoolTranslator;
    1819    LastOpenedList: TLastOpenedList;
     20    PersistentForm1: TPersistentForm;
    1921    procedure DataModuleCreate(Sender: TObject);
    2022    procedure DataModuleDestroy(Sender: TObject);
    … …  
    9395  LastOpenedList.LoadFromRegistry(RegContext(Root, Key));
    9496  Targets.LoadFromRegistry(Root, Key);
     97  PersistentForm1.RegistryContext := RegContext(Root, Key + '\Forms');
    9598end;
    9699
Note: See TracChangeset for help on using the changeset viewer.