Changeset 192 for trunk/Packages/Common


Ignore:
Timestamp:
May 1, 2018, 10:18:03 AM (7 years ago)
Author:
chronos
Message:
  • Modified: Updated newer Common package files.
Location:
trunk/Packages/Common
Files:
2 added
2 deleted
18 edited

Legend:

Unmodified
Added
Removed

  • trunk/Packages/Common/Common.lpk

    r177 r192  
    1515      <Parsing>
    1616        <SyntaxOptions>
     17          <SyntaxMode Value="Delphi"/>
    1718          <CStyleOperator Value="False"/>
    1819          <AllowLabel Value="False"/>
    … …  
    129130      </Item20>
    130131      <Item21>
    131         <Filename Value="UGeometry.pas"/>
    132         <UnitName Value="UGeometry"/>
     132        <Filename Value="UTheme.pas"/>
     133        <HasRegisterProc Value="True"/>
     134        <UnitName Value="UTheme"/>
    133135      </Item21>
    134136      <Item22>
    135         <Filename Value="UGeometryClasses.pas"/>
    136         <UnitName Value="UGeometryClasses"/>
     137        <Filename Value="UStringTable.pas"/>
     138        <UnitName Value="UStringTable"/>
    137139      </Item22>
    138140    </Files>
    … …  
    140142      <EnableI18N Value="True"/>
    141143      <OutDir Value="Languages"/>
     144      <EnableI18NForLFM Value="True"/>
    142145    </i18n>
    143     <RequiredPkgs Count="2">
     146    <RequiredPkgs Count="3">
    144147      <Item1>
    145         <PackageName Value="TemplateGenerics"/>
     148        <PackageName Value="LCL"/>
    146149      </Item1>
    147150      <Item2>
     151        <PackageName Value="TemplateGenerics"/>
     152      </Item2>
     153      <Item3>
    148154        <PackageName Value="FCL"/>
    149155        <MinVersion Major="1" Valid="True"/>
    150       </Item2>
     156      </Item3>
    151157    </RequiredPkgs>
    152158    <UsageOptions>

  • trunk/Packages/Common/Common.pas

    r170 r192  
    55unit Common;
    66
     7{$warn 5023 off : no warning about unused units}
    78interface
    89
    … …  
    1112  UMemory, UResetableThread, UPool, ULastOpenedList, URegistry,
    1213  UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort,
    13   UPersistentForm, UFindFile, UScaleDPI, UGeometry, UGeometryClasses,
     14  UPersistentForm, UFindFile, UScaleDPI, UTheme, UStringTable,
    1415  LazarusPackageIntf;
    1516
    … …  
    2627  RegisterUnit('UFindFile', @UFindFile.Register);
    2728  RegisterUnit('UScaleDPI', @UScaleDPI.Register);
     29  RegisterUnit('UTheme', @UTheme.Register);
    2830end;
    2931

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

    r116 r192  
    1515
    1616#: ujobprogressview.soperations
    17 msgid "Operations"
     17msgid "Operations:"
    1818msgstr ""
    1919

  • trunk/Packages/Common/UApplicationInfo.pas

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

  • trunk/Packages/Common/UCommon.pas

    r116 r192  
    2828    unfDNSDomainName = 11);
    2929
     30  TFilterMethodMethod = function (FileName: string): Boolean of object;
    3031var
    3132  ExceptionHandler: TExceptionEvent;
    … …  
    6364procedure OpenWebPage(URL: string);
    6465procedure OpenFileInShell(FileName: string);
    65 procedure ExecuteProgram(CommandLine: string);
     66procedure ExecuteProgram(Executable: string; Parameters: array of string);
    6667procedure FreeThenNil(var Obj);
    6768function RemoveQuotes(Text: string): string;
    … …  
    7071function GetDirCount(Dir: string): Integer;
    7172function MergeArray(A, B: array of string): TArrayOfString;
     73function LoadFileToStr(const FileName: TFileName): AnsiString;
     74procedure SearchFiles(AList: TStrings; Dir: string;
     75  FilterMethod: TFilterMethodMethod);
     76function GetStringPart(var Text: string; Separator: string): string;
    7277
    7378
    … …  
    111116  Path := IncludeTrailingPathDelimiter(APath);
    112117
    113   Find := FindFirst(UTF8Decode(Path + AFileSpec), faAnyFile xor faDirectory, SearchRec);
     118  Find := FindFirst(Path + AFileSpec, faAnyFile xor faDirectory, SearchRec);
    114119  while Find = 0 do begin
    115     DeleteFile(Path + UTF8Encode(SearchRec.Name));
     120    DeleteFile(Path + SearchRec.Name);
    116121
    117122    Find := SysUtils.FindNext(SearchRec);
    … …  
    428433end;
    429434
    430 procedure ExecuteProgram(CommandLine: string);
     435procedure ExecuteProgram(Executable: string; Parameters: array of string);
    431436var
    432437  Process: TProcess;
     438  I: Integer;
    433439begin
    434440  try
    435441    Process := TProcess.Create(nil);
    436     Process.CommandLine := CommandLine;
     442    Process.Executable := Executable;
     443    for I := 0 to Length(Parameters) - 1 do
     444      Process.Parameters.Add(Parameters[I]);
    437445    Process.Options := [poNoConsole];
    438446    Process.Execute;
    … …  
    455463procedure OpenFileInShell(FileName: string);
    456464begin
    457   ExecuteProgram('cmd.exe /c start "' + FileName + '"');
     465  ExecuteProgram('cmd.exe', ['/c', 'start', FileName]);
    458466end;
    459467
    … …  
    492500end;
    493501
     502function LoadFileToStr(const FileName: TFileName): AnsiString;
     503var
     504  FileStream: TFileStream;
     505  Read: Integer;
     506begin
     507  Result := '';
     508  FileStream := TFileStream.Create(FileName, fmOpenRead);
     509  try
     510    if FileStream.Size > 0 then begin
     511      SetLength(Result, FileStream.Size);
     512      Read := FileStream.Read(Pointer(Result)^, FileStream.Size);
     513      SetLength(Result, Read);
     514    end;
     515  finally
     516    FileStream.Free;
     517  end;
     518end;
     519
     520function DefaultSearchFilter(const FileName: string): Boolean;
     521begin
     522  Result := True;
     523end;
     524
     525procedure SearchFiles(AList: TStrings; Dir: string;
     526  FilterMethod: TFilterMethodMethod);
     527var
     528  SR: TSearchRec;
     529begin
     530  Dir := IncludeTrailingPathDelimiter(Dir);
     531  if FindFirst(Dir + '*', faAnyFile, SR) = 0 then
     532    try
     533      repeat
     534        if (SR.Name = '.') or (SR.Name = '..') or not FilterMethod(SR.Name) or
     535          not FilterMethod(Copy(Dir, 3, Length(Dir)) + SR.Name) then Continue;
     536        AList.Add(Dir + SR.Name);
     537        if (SR.Attr and faDirectory) <> 0 then
     538          SearchFiles(AList, Dir + SR.Name, FilterMethod);
     539      until FindNext(SR) <> 0;
     540    finally
     541      FindClose(SR);
     542    end;
     543end;
     544
     545function GetStringPart(var Text: string; Separator: string): string;
     546var
     547  P: Integer;
     548begin
     549  P := Pos(Separator, Text);
     550  if P > 0 then begin
     551    Result := Copy(Text, 1, P - 1);
     552    Delete(Text, 1, P - 1 + Length(Separator));
     553  end else begin
     554    Result := Text;
     555    Text := '';
     556  end;
     557  Result := Trim(Result);
     558  Text := Trim(Text);
     559end;
     560
    494561
    495562

  • trunk/Packages/Common/UDebugLog.pas

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

  • trunk/Packages/Common/UFindFile.pas

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

  • trunk/Packages/Common/UJobProgressView.lfm

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

  • trunk/Packages/Common/UJobProgressView.pas

    r116 r192  
    66
    77uses
    8   SysUtils, Variants, Classes, Graphics, Controls, Forms, Syncobjs,
    9   Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading,
     8  LCLType, SysUtils, Variants, Classes, Graphics, Controls, Forms, Syncobjs,
     9  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading, Math,
    1010  DateUtils;
    1111
    … …  
    1313  EstimatedTimeShowTreshold = 4;
    1414  EstimatedTimeShowTresholdTotal = 1;
    15   MemoLogHeight = 200;
    1615  UpdateInterval = 100; // ms
    1716
    … …  
    2423    FLock: TCriticalSection;
    2524    FOnChange: TNotifyEvent;
     25    FText: string;
    2626    FValue: Integer;
    2727    FMax: Integer;
    2828    procedure SetMax(const AValue: Integer);
     29    procedure SetText(AValue: string);
    2930    procedure SetValue(const AValue: Integer);
    3031  public
    … …  
    3536    property Value: Integer read FValue write SetValue;
    3637    property Max: Integer read FMax write SetMax;
     38    property Text: string read FText write SetText;
    3739    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    3840  end;
    … …  
    6971  end;
    7072
     73  TJobs = class(TObjectList)
     74  end;
     75
    7176  TJobThread = class(TListedThread)
    7277    procedure Execute; override;
    … …  
    8085  TFormJobProgressView = class(TForm)
    8186    ImageList1: TImageList;
     87    LabelText: TLabel;
    8288    Label2: TLabel;
    8389    LabelOperation: TLabel;
    … …  
    8692    ListViewJobs: TListView;
    8793    MemoLog: TMemo;
     94    PanelText: TPanel;
    8895    PanelProgressTotal: TPanel;
    8996    PanelOperationsTitle: TPanel;
    … …  
    94101    ProgressBarTotal: TProgressBar;
    95102    TimerUpdate: TTimer;
     103    procedure FormHide(Sender: TObject);
     104    procedure FormShow(Sender: TObject);
     105    procedure ReloadJobList;
    96106    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    97107    procedure FormDestroy(Sender: TObject);
    … …  
    100110    procedure FormCreate(Sender: TObject);
    101111    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     112    procedure UpdateHeight;
    102113  public
    103114    JobProgressView: TJobProgressView;
    … …  
    118129    TotalStartTime: TDateTime;
    119130    Log: TStringList;
     131    FForm: TFormJobProgressView;
    120132    procedure SetTerminate(const AValue: Boolean);
    121133    procedure UpdateProgress;
    122     procedure ReloadJobList;
    123     procedure StartJobs;
    124     procedure UpdateHeight;
    125134    procedure JobProgressChange(Sender: TObject);
    126135  public
    127     Form: TFormJobProgressView;
    128     Jobs: TObjectList; // TListObject<TJob>
     136    Jobs: TJobs;
    129137    CurrentJob: TJob;
    130138    CurrentJobIndex: Integer;
    … …  
    132140    destructor Destroy; override;
    133141    procedure Clear;
    134     procedure AddJob(Title: string; Method: TJobProgressViewMethod;
    135       NoThreaded: Boolean = False; WaitFor: Boolean = False);
    136     procedure Start(AAutoClose: Boolean = True);
     142    function AddJob(Title: string; Method: TJobProgressViewMethod;
     143      NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob;
     144    procedure Start;
    137145    procedure Stop;
    138146    procedure TermSleep(Delay: Integer);
     147    property Form: TFormJobProgressView read FForm;
    139148    property Terminate: Boolean read FTerminate write SetTerminate;
    140149  published
    … …  
    166175  STotalEstimatedTime = 'Total estimated time: %s';
    167176  SFinished = 'Finished';
    168   SOperations = 'Operations';
     177  SOperations = 'Operations:';
    169178
    170179procedure Register;
    … …  
    172181  RegisterComponents('Common', [TJobProgressView]);
    173182end;
     183
     184{ TJobThread }
    174185
    175186procedure TJobThread.Execute;
    … …  
    190201end;
    191202
    192 procedure TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod;
    193   NoThreaded: Boolean = False; WaitFor: Boolean = False);
     203function Scale96ToScreen(const ASize: Integer): Integer;
     204begin
     205  Result := MulDiv(ASize, Screen.PixelsPerInch, 96);
     206end;
     207
     208{ TFormJobProgressView }
     209
     210procedure TFormJobProgressView.UpdateHeight;
    194211var
    195   NewJob: TJob;
    196 begin
    197   NewJob := TJob.Create;
    198   NewJob.ProgressView := Self;
    199   NewJob.Title := Title;
    200   NewJob.Method := Method;
    201   NewJob.NoThreaded := NoThreaded;
    202   NewJob.WaitFor := WaitFor;
    203   NewJob.Progress.Max := 100;
    204   NewJob.Progress.Reset;
    205   NewJob.Progress.OnChange := JobProgressChange;
    206   Jobs.Add(NewJob);
     212  H: Integer;
     213  PanelOperationsVisible: Boolean;
     214  PanelOperationsHeight: Integer;
     215  PanelProgressVisible: Boolean;
     216  PanelProgressTotalVisible: Boolean;
     217  PanelLogVisible: Boolean;
     218  MemoLogHeight: Integer = 200;
     219  I: Integer;
     220  ItemRect: TRect;
     221  MaxH: Integer;
     222begin
     223    H := PanelOperationsTitle.Height;
     224    PanelOperationsVisible := JobProgressView.Jobs.Count > 0;
     225    if PanelOperationsVisible <> PanelOperations.Visible then
     226      PanelOperations.Visible := PanelOperationsVisible;
     227    if ListViewJobs.Items.Count > 0 then begin
     228      Maxh := 0;
     229      for I := 0 to ListViewJobs.Items.Count - 1 do
     230      begin
     231        ItemRect := ListViewJobs.Items[i].DisplayRect(drBounds);
     232        Maxh := Max(Maxh, ItemRect.Top + (ItemRect.Bottom - ItemRect.Top));
     233      end;
     234      PanelOperationsHeight := Scale96ToScreen(12) + Maxh;
     235    end else PanelOperationsHeight := Scale96ToScreen(8);
     236    if PanelOperationsHeight <> PanelOperations.Height then
     237      PanelOperations.Height := PanelOperationsHeight;
     238    if PanelOperationsVisible then
     239      H := H + PanelOperations.Height;
     240
     241    PanelProgressVisible := (JobProgressView.Jobs.Count > 0) and not JobProgressView.Finished;
     242    if PanelProgressVisible <> PanelProgress.Visible then
     243      PanelProgress.Visible := PanelProgressVisible;
     244    if PanelProgressVisible then
     245      H := H + PanelProgress.Height;
     246    PanelProgressTotalVisible := (JobProgressView.Jobs.Count > 1) and not JobProgressView.Finished;
     247    if PanelProgressTotalVisible <> PanelProgressTotal.Visible then
     248      PanelProgressTotal.Visible := PanelProgressTotalVisible;
     249    if PanelProgressTotalVisible then
     250      H := H + PanelProgressTotal.Height;
     251    Constraints.MinHeight := H;
     252    PanelLogVisible := MemoLog.Lines.Count > 0;
     253    if PanelLogVisible <> PanelLog.Visible then
     254      PanelLog.Visible := PanelLogVisible;
     255    if PanelLogVisible then
     256      H := H + Scale96ToScreen(MemoLogHeight);
     257    if PanelText.Visible then
     258      H := H + PanelText.Height;
     259    if Height <> H then begin
     260      Height := H;
     261      Top := (Screen.Height - H) div 2;
     262    end;
     263end;
     264
     265procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);
     266var
     267  ProgressBarPartVisible: Boolean;
     268  ProgressBarTotalVisible: Boolean;
     269begin
     270  JobProgressView.UpdateProgress;
     271  if Visible and (not ProgressBarPart.Visible) and
     272  Assigned(JobProgressView.CurrentJob) and
     273  (JobProgressView.CurrentJob.Progress.Value > 0) then begin
     274    ProgressBarPartVisible := True;
     275    if ProgressBarPartVisible <> ProgressBarPart.Visible then
     276      ProgressBarPart.Visible := ProgressBarPartVisible;
     277    ProgressBarTotalVisible := True;
     278    if ProgressBarTotalVisible <> ProgressBarTotal.Visible then
     279      ProgressBarTotal.Visible := ProgressBarTotalVisible;
     280  end;
     281  if not Visible then begin
     282    TimerUpdate.Interval := UpdateInterval;
     283    if not JobProgressView.OwnerDraw then Show;
     284  end;
     285  if Assigned(JobProgressView.CurrentJob) then begin
     286    LabelText.Caption := JobProgressView.CurrentJob.Progress.Text;
     287    if LabelText.Caption <> '' then begin
     288      PanelText.Visible := True;
     289      UpdateHeight;
     290    end;
     291  end;
     292end;
     293
     294procedure TFormJobProgressView.FormDestroy(Sender:TObject);
     295begin
     296end;
     297
     298procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);
     299begin
     300  if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then
     301  with TJob(JobProgressView.Jobs[Item.Index]) do begin
     302    Item.Caption := Title;
     303    if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1
     304      else if Finished then Item.ImageIndex := 0
     305      else Item.ImageIndex := 2;
     306    Item.Data := JobProgressView.Jobs[Item.Index];
     307  end;
     308end;
     309
     310procedure TFormJobProgressView.FormClose(Sender: TObject;
     311  var CloseAction: TCloseAction);
     312begin
     313end;
     314
     315procedure TFormJobProgressView.FormCreate(Sender: TObject);
     316begin
     317  Caption := SPleaseWait;
     318  try
     319    //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) +
     320    //  DirectorySeparator + 'horse.avi';
     321    //Animate1.Active := True;
     322  except
     323
     324  end;
     325end;
     326
     327procedure TFormJobProgressView.ReloadJobList;
     328begin
     329  // Workaround for not showing first line
     330  //Form.ListViewJobs.Items.Count := Jobs.Count + 1;
     331  //Form.ListViewJobs.Refresh;
     332
     333  if ListViewJobs.Items.Count <> JobProgressView.Jobs.Count then
     334    ListViewJobs.Items.Count := JobProgressView.Jobs.Count;
     335  ListViewJobs.Refresh;
     336  Application.ProcessMessages;
     337  UpdateHeight;
     338end;
     339
     340procedure TFormJobProgressView.FormShow(Sender: TObject);
     341begin
     342  ReloadJobList;
     343end;
     344
     345procedure TFormJobProgressView.FormHide(Sender: TObject);
     346begin
     347  JobProgressView.Jobs.Clear;
     348  ReloadJobList;
     349end;
     350
     351procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     352begin
     353  CanClose := JobProgressView.Finished;
     354  JobProgressView.Terminate := True;
     355  Caption := SPleaseWait + STerminate;
     356end;
     357
     358
     359{ TJobProgressView }
     360
     361function TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod;
     362  NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob;
     363begin
     364  Result := TJob.Create;
     365  Result.ProgressView := Self;
     366  Result.Title := Title;
     367  Result.Method := Method;
     368  Result.NoThreaded := NoThreaded;
     369  Result.WaitFor := WaitFor;
     370  Result.Progress.Max := 100;
     371  Result.Progress.Reset;
     372  Result.Progress.OnChange := JobProgressChange;
     373  Jobs.Add(Result);
    207374  //ReloadJobList;
    208375end;
    209376
    210 procedure TJobProgressView.Start(AAutoClose: Boolean = True);
    211 begin
    212   AutoClose := AAutoClose;
    213   StartJobs;
    214 end;
    215 
    216 procedure TJobProgressView.StartJobs;
     377procedure TJobProgressView.Start;
    217378var
    218379  I: Integer;
    … …  
    229390    Form.MemoLog.Clear;
    230391
     392    Form.PanelText.Visible := False;
    231393    Form.LabelEstimatedTimePart.Visible := False;
    232394    Form.LabelEstimatedTimeTotal.Visible := False;
    … …  
    258420      Form.ProgressBarPart.Visible := False;
    259421      //Show;
    260       ReloadJobList;
     422      Form.ReloadJobList;
    261423      Application.ProcessMessages;
    262424      if NoThreaded then begin
    … …  
    296458    //if Visible then Hide;
    297459    Form.MemoLog.Lines.Assign(Log);
    298     if (Form.MemoLog.Lines.Count = 0) and AutoClose then begin
     460    if (Form.MemoLog.Lines.Count = 0) and FAutoClose then begin
    299461      Form.Hide;
    300462    end;
    301     Clear;
     463    if not Form.Visible then Clear;
    302464    Form.Caption := SFinished;
    303465    //LabelEstimatedTimePart.Visible := False;
    304466    Finished := True;
    305467    CurrentJobIndex := -1;
    306     ReloadJobList;
    307   end;
    308 end;
    309 
    310 procedure TJobProgressView.UpdateHeight;
    311 var
    312   H: Integer;
    313   PanelOperationsVisible: Boolean;
    314   PanelOperationsHeight: Integer;
    315   PanelProgressVisible: Boolean;
    316   PanelProgressTotalVisible: Boolean;
    317   PanelLogVisible: Boolean;
    318 begin
    319   with Form do begin
    320   H := PanelOperationsTitle.Height;
    321   PanelOperationsVisible := Jobs.Count > 0;
    322   if PanelOperationsVisible <> PanelOperations.Visible then
    323     PanelOperations.Visible := PanelOperationsVisible;
    324   PanelOperationsHeight := 8 + 18 * Jobs.Count;
    325   if PanelOperationsHeight <> PanelOperations.Height then
    326     PanelOperations.Height := PanelOperationsHeight;
    327   if PanelOperationsVisible then
    328     H := H + PanelOperations.Height;
    329 
    330   PanelProgressVisible := (Jobs.Count > 0) and not Finished;
    331   if PanelProgressVisible <> PanelProgress.Visible then
    332     PanelProgress.Visible := PanelProgressVisible;
    333   if PanelProgressVisible then
    334     H := H + PanelProgress.Height;
    335   PanelProgressTotalVisible := (Jobs.Count > 1) and not Finished;
    336   if PanelProgressTotalVisible <> PanelProgressTotal.Visible then
    337     PanelProgressTotal.Visible := PanelProgressTotalVisible;
    338   if PanelProgressTotalVisible then
    339     H := H + PanelProgressTotal.Height;
    340   Constraints.MinHeight := H;
    341   PanelLogVisible := MemoLog.Lines.Count > 0;
    342   if PanelLogVisible <> PanelLog.Visible then
    343     PanelLog.Visible := PanelLogVisible;
    344   if PanelLogVisible then
    345     H := H + MemoLogHeight;
    346   if Height <> H then Height := H;
     468    Form.ReloadJobList;
    347469  end;
    348470end;
    … …  
    352474  if Assigned(FOnOwnerDraw) then
    353475    FOnOwnerDraw(Self);
    354 end;
    355 
    356 procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);
    357 var
    358   ProgressBarPartVisible: Boolean;
    359   ProgressBarTotalVisible: Boolean;
    360 begin
    361   JobProgressView.UpdateProgress;
    362   if Visible and (not ProgressBarPart.Visible) and
    363   Assigned(JobProgressView.CurrentJob) and
    364   (JobProgressView.CurrentJob.Progress.Value > 0) then begin
    365     ProgressBarPartVisible := True;
    366     if ProgressBarPartVisible <> ProgressBarPart.Visible then
    367       ProgressBarPart.Visible := ProgressBarPartVisible;
    368     ProgressBarTotalVisible := True;
    369     if ProgressBarTotalVisible <> ProgressBarTotal.Visible then
    370       ProgressBarTotal.Visible := ProgressBarTotalVisible;
    371   end;
    372   if not Visible then begin
    373     TimerUpdate.Interval := UpdateInterval;
    374     if not JobProgressView.OwnerDraw then Show;
    375   end;
    376 end;
    377 
    378 procedure TFormJobProgressView.FormDestroy(Sender:TObject);
    379 begin
    380 end;
    381 
    382 procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);
    383 begin
    384   if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then
    385   with TJob(JobProgressView.Jobs[Item.Index]) do begin
    386     Item.Caption := Title;
    387     if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1
    388       else if Finished then Item.ImageIndex := 0
    389       else Item.ImageIndex := 2;
    390     Item.Data := JobProgressView.Jobs[Item.Index];
    391   end;
    392 end;
    393 
    394 procedure TFormJobProgressView.FormClose(Sender: TObject;
    395   var CloseAction: TCloseAction);
    396 begin
    397   ListViewJobs.Clear;
    398 end;
    399 
    400 procedure TFormJobProgressView.FormCreate(Sender: TObject);
    401 begin
    402   Caption := SPleaseWait;
    403   try
    404     //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) +
    405     //  DirectorySeparator + 'horse.avi';
    406     //Animate1.Active := True;
    407   except
    408 
    409   end;
    410476end;
    411477
    … …  
    426492    Sleep(Quantum);
    427493  end;
    428 end;
    429 
    430 procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    431 begin
    432   CanClose := JobProgressView.Finished;
    433   JobProgressView.Terminate := True;
    434   Caption := SPleaseWait + STerminate;
    435494end;
    436495
    … …  
    490549end;
    491550
    492 procedure TJobProgressView.ReloadJobList;
    493 begin
    494   UpdateHeight;
    495   // Workaround for not showing first line
    496   Form.ListViewJobs.Items.Count := Jobs.Count + 1;
    497   Form.ListViewJobs.Refresh;
    498 
    499   if Form.ListViewJobs.Items.Count <> Jobs.Count then
    500     Form.ListViewJobs.Items.Count := Jobs.Count;
    501   Form.ListViewJobs.Refresh;
    502   //Application.ProcessMessages;
    503 end;
    504 
    505551constructor TJobProgressView.Create(TheOwner: TComponent);
    506552begin
    507553  inherited;
    508554  if not (csDesigning in ComponentState) then begin
    509     Form := TFormJobProgressView.Create(Self);
    510     Form.JobProgressView := Self;
    511   end;
    512   Jobs := TObjectList.Create;
     555    FForm := TFormJobProgressView.Create(Self);
     556    FForm.JobProgressView := Self;
     557  end;
     558  Jobs := TJobs.Create;
    513559  Log := TStringList.Create;
    514560  //PanelOperationsTitle.Height := 80;
    515   ShowDelay := 0; //1000; // ms
     561  AutoClose := True;
     562  ShowDelay := 0;
    516563end;
    517564
    … …  
    519566begin
    520567  Jobs.Clear;
     568  Log.Clear;
    521569  //ReloadJobList;
    522570end;
    … …  
    528576  inherited;
    529577end;
     578
     579{ TProgress }
    530580
    531581procedure TProgress.SetMax(const AValue: Integer);
    … …  
    536586    if FMax < 1 then FMax := 1;
    537587    if FValue >= FMax then FValue := FMax;
     588  finally
     589    FLock.Release;
     590  end;
     591end;
     592
     593procedure TProgress.SetText(AValue: string);
     594begin
     595  try
     596    FLock.Acquire;
     597    if FText = AValue then Exit;
     598    FText := AValue;
    538599  finally
    539600    FLock.Release;
    … …  
    563624end;
    564625
    565 { TProgress }
    566 
    567626procedure TProgress.Increment;
    568627begin

  • trunk/Packages/Common/ULastOpenedList.pas

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

  • trunk/Packages/Common/UListViewSort.pas

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

  • trunk/Packages/Common/UMemory.pas

    r43 r192  
    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

    r132 r192  
    2626    FormWindowState: TWindowState;
    2727    Form: TForm;
    28     DefaultFormWindowState: TWindowState;
    2928    procedure LoadFromRegistry(RegistryContext: TRegistryContext);
    3029    procedure SaveToRegistry(RegistryContext: TRegistryContext);
    3130    function CheckEntireVisible(Rect: TRect): TRect;
    3231    function CheckPartVisible(Rect: TRect; Part: Integer): TRect;
    33     procedure Load(Form: TForm; DefaultFormWindowState: TWindowState = wsNormal);
     32    procedure Load(Form: TForm; DefaultMaximized: Boolean = False);
    3433    procedure Save(Form: TForm);
    3534    constructor Create(AOwner: TComponent); override;
    … …  
    135134      + FormRestoredSize.Top;
    136135    // Other state
    137     FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(DefaultFormWindowState)));
     136    FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(wsNormal)));
    138137  finally
    139138    Free;
    … …  
    216215end;
    217216
    218 procedure TPersistentForm.Load(Form: TForm; DefaultFormWindowState: TWindowState = wsNormal);
     217procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False);
    219218begin
    220219  Self.Form := Form;
    221   Self.DefaultFormWindowState := DefaultFormWindowState;
    222 
    223220  // Set default
    224221  FormNormalSize := Bounds((Screen.Width - Form.Width) div 2,
    … …  
    230227
    231228  if not EqualRect(FormNormalSize, FormRestoredSize) or
    232     (FormWindowState = wsMaximized) then begin
     229    DefaultMaximized then begin
    233230    // Restore to maximized state
    234231    Form.WindowState := wsNormal;

  • trunk/Packages/Common/URegistry.pas

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

  • trunk/Packages/Common/UResetableThread.pas

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

  • trunk/Packages/Common/UThreading.pas

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

  • trunk/Packages/Common/UURI.pas

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

  • trunk/Packages/Common/UXMLUtils.pas

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