Changeset 204 for trunk/Packages/Common

Timestamp:

May 6, 2019, 2:49:33 PM (6 years ago)

Author:

chronos

Message:

• Modified: Use fgl unit instead of TemplateGenerics.
• Modified: Update czech translation.
• Modified: Updated packages.

Location:

trunk/Packages/Common

Files:

• Common.lpk (modified) (2 diffs)
• Common.pas (modified) (1 diff)
• Languages/UFindFile.cs.po (added)
• Languages/UJobProgressView.cs.po (modified) (2 diffs)
• Languages/UJobProgressView.po (modified) (1 diff)
• Languages/UScaleDPI.cs.po (added)
• UCommon.pas (modified) (7 diffs)
• UDebugLog.pas (modified) (3 diffs)
• UJobProgressView.lfm (modified) (2 diffs)
• UJobProgressView.lrj (added)
• UJobProgressView.lrt (deleted)
• UJobProgressView.pas (modified) (1 diff)
• UListViewSort.pas (modified) (6 diffs)
• UMemory.pas (modified) (1 diff)
• UPool.pas (modified) (3 diffs)
• UPrefixMultiplier.pas (modified) (3 diffs)
• URegistry.pas (modified) (3 diffs)

trunk/Packages/Common/Common.lpk

@@ -60 +60 @@
       <Item5>
         <Filename Value="UPrefixMultiplier.pas"/>
+        <HasRegisterProc Value="True"/>
         <UnitName Value="UPrefixMultiplier"/>
       </Item5>
@@ -144 +145 @@
       <EnableI18NForLFM Value="True"/>
     </i18n>
-    <RequiredPkgs Count="3">
+    <RequiredPkgs Count="2">
       <Item1>
         <PackageName Value="LCL"/>
       </Item1>
       <Item2>
-        <PackageName Value="TemplateGenerics"/>
-      </Item2>
-      <Item3>
         <PackageName Value="FCL"/>
         <MinVersion Major="1" Valid="True"/>
-      </Item3>
+      </Item2>
     </RequiredPkgs>
     <UsageOptions>

trunk/Packages/Common/Common.pas

@@ -20 +20 @@
 begin
   RegisterUnit('UDebugLog', @UDebugLog.Register);
+  RegisterUnit('UPrefixMultiplier', @UPrefixMultiplier.Register);
   RegisterUnit('ULastOpenedList', @ULastOpenedList.Register);
   RegisterUnit('UJobProgressView', @UJobProgressView.Register);

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

@@ -10 +10 @@
 "Content-Type: text/plain; charset=UTF-8\n"
 "Content-Transfer-Encoding: 8bit\n"
-"X-Generator: Poedit 1.8.8\n"
+"X-Generator: Poedit 2.2\n"
 
 #: ujobprogressview.sestimatedtime
@@ -24 +24 @@
 msgstr "Dokončené"
 
-#: ujobprogressview.soperations
-msgid "Operations:"
-msgstr ""
-
 #: ujobprogressview.spleasewait
 msgid "Please wait..."

trunk/Packages/Common/Languages/UJobProgressView.po

@@ -14 +14 @@
 msgstr ""
 
-#: ujobprogressview.soperations
-msgid "Operations:"
-msgstr ""
-
 #: ujobprogressview.spleasewait
 msgid "Please wait..."

trunk/Packages/Common/UCommon.pas

@@ -28 +28 @@
     unfDNSDomainName = 11);
 
-  TFilterMethodMethod = function (FileName: string): Boolean of object;
+  TFilterMethod = function (FileName: string): Boolean of object;
+  TFileNameMethod = procedure (FileName: string) of object;
+
 var
   ExceptionHandler: TExceptionEvent;
@@ -74 +76 @@
 procedure SaveStringToFile(S, FileName: string);
 procedure SearchFiles(AList: TStrings; Dir: string;
-  FilterMethod: TFilterMethodMethod = nil);
+  FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil);
 function GetStringPart(var Text: string; Separator: string): string;
 function StripTags(const S: string): string;
@@ -81 +83 @@
 function PosFromIndexReverse(SubStr: string; Text: string;
   StartIndex: Integer): Integer;
+procedure CopyStringArray(Dest: TStringArray; Source: array of string);
 
 
@@ -108 +111 @@
   I: Integer;
 begin
+  Result := '';
   for I := 1 to Length(Source) do begin
     Result := Result + LowerCase(IntToHex(Ord(Source[I]), 2));
@@ -543 +547 @@
 
 procedure SearchFiles(AList: TStrings; Dir: string;
-  FilterMethod: TFilterMethodMethod = nil);
+  FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil);
 var
   SR: TSearchRec;
@@ -553 +557 @@
         if (SR.Name = '.') or (SR.Name = '..') or (Assigned(FilterMethod) and (not FilterMethod(SR.Name) or
           not FilterMethod(Copy(Dir, 3, Length(Dir)) + SR.Name))) then Continue;
+        if Assigned(FileNameMethod) then
+          FileNameMethod(Dir + SR.Name);
         AList.Add(Dir + SR.Name);
         if (SR.Attr and faDirectory) <> 0 then
@@ -654 +660 @@
 end;
 
+procedure CopyStringArray(Dest: TStringArray; Source: array of string);
+var
+  I: Integer;
+begin
+  SetLength(Dest, Length(Source));
+  for I := 0 to Length(Dest) - 1 do
+    Dest[I] := Source[I];
+end;
+
 
 initialization

trunk/Packages/Common/UDebugLog.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, FileUtil, SpecializedList, SyncObjs;
+  Classes, SysUtils, FileUtil, fgl, SyncObjs;
 
 type
@@ -29 +29 @@
     procedure SetMaxCount(const AValue: Integer);
   public
-    Items: TListObject;
+    Items: TFPGObjectList<TDebugLogItem>;
     Lock: TCriticalSection;
     procedure Add(Text: string; Group: string = '');
@@ -117 +117 @@
 begin
   inherited;
-  Items := TListObject.Create;
+  Items := TFPGObjectList<TDebugLogItem>.Create;
   Lock := TCriticalSection.Create;
   MaxCount := 100;

trunk/Packages/Common/UJobProgressView.lfm

@@ -15 +15 @@
   OnShow = FormShow
   Position = poScreenCenter
-  LCLVersion = '1.8.2.0'
+  LCLVersion = '2.0.2.0'
   object PanelOperationsTitle: TPanel
     Left = 0
@@ -241 +241 @@
     Interval = 100
     OnTimer = TimerUpdateTimer
-    left = 264
+    left = 320
     top = 8
   end

trunk/Packages/Common/UJobProgressView.pas

@@ -175 +175 @@
   STotalEstimatedTime = 'Total estimated time: %s';
   SFinished = 'Finished';
-  SOperations = 'Operations:';
 
 procedure Register;

trunk/Packages/Common/UListViewSort.pas

@@ -9 +9 @@
 uses
   {$IFDEF Windows}Windows, CommCtrl, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils,
-  Controls, DateUtils, Dialogs, SpecializedList, Forms, Grids, StdCtrls, ExtCtrls,
+  Controls, DateUtils, Dialogs, fgl, Forms, Grids, StdCtrls, ExtCtrls,
   LclIntf, LMessages, LclType, LResources;
 
@@ -52 +52 @@
     {$ENDIF}
   public
-    List: TListObject;
-    Source: TListObject;
+    List: TFPGObjectList<TObject>;
+    Source: TFPGObjectList<TObject>;
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -98 +98 @@
   end;
 
+  { TListViewEx }
+
+  TListViewEx = class(TWinControl)
+  private
+    FFilter: TListViewFilter;
+    FListView: TListView;
+    FListViewSort: TListViewSort;
+    procedure ResizeHanlder;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+  published
+    property ListView: TListView read FListView write FListView;
+    property ListViewSort: TListViewSort read FListViewSort write FListViewSort;
+    property Filter: TListViewFilter read FFilter write FFilter;
+    property Visible;
+  end;
+
 procedure Register;
 
@@ -105 +123 @@
 procedure Register;
 begin
-  RegisterComponents('Common', [TListViewSort, TListViewFilter]);
+  RegisterComponents('Common', [TListViewSort, TListViewFilter, TListViewEx]);
+end;
+
+{ TListViewEx }
+
+procedure TListViewEx.ResizeHanlder;
+begin
+end;
+
+constructor TListViewEx.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  Filter := TListViewFilter.Create(Self);
+  Filter.Parent := Self;
+  Filter.Align := alBottom;
+  ListView := TListView.Create(Self);
+  ListView.Parent := Self;
+  ListView.Align := alClient;
+  ListViewSort := TListViewSort.Create(Self);
+  ListViewSort.ListView := ListView;
+end;
+
+destructor TListViewEx.Destroy;
+begin
+  inherited Destroy;
 end;
 
@@ -277 +319 @@
 end;
 
+var
+  ListViewSortCompare: TCompareEvent;
+
+function ListViewCompare(const Item1, Item2: TObject): Integer;
+begin
+  Result := ListViewSortCompare(Item1, Item2);
+end;
+
 procedure TListViewSort.Sort(Compare: TCompareEvent);
 begin
+  // TODO: Because TFLGObjectList compare handler is not class method,
+  // it is necessary to use simple function compare handler with local variable
+  ListViewSortCompare := Compare;
   if (List.Count > 0) then
-    List.Sort(Compare);
+    List.Sort(ListViewCompare);
 end;
 
@@ -343 +396 @@
 begin
   inherited;
-  List := TListObject.Create;
-  List.OwnsObjects := False;
+  List := TFPGObjectList<TObject>.Create;
+  List.FreeObjects := False;
 end;
 

trunk/Packages/Common/UMemory.pas

@@ -112 +112 @@
 procedure TMemory.WriteMemory(Position: Integer; Memory: TMemory);
 begin
-  Move(Memory.FData, PByte(@FData + Position)^, Memory.Size);
+  Move(Memory.FData, PByte(PByte(@FData) + Position)^, Memory.Size);
 end;
 
 procedure TMemory.ReadMemory(Position: Integer; Memory: TMemory);
 begin
-  Move(PByte(@FData + Position)^, Memory.FData, Memory.Size);
+  Move(PByte(PByte(@FData) + Position)^, Memory.FData, Memory.Size);
 end;
 

trunk/Packages/Common/UPool.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, syncobjs, SpecializedList, UThreading;
+  Classes, SysUtils, syncobjs, fgl, UThreading;
 
 type
@@ -22 +22 @@
     function NewItemObject: TObject; virtual;
   public
-    Items: TListObject;
-    FreeItems: TListObject;
+    Items: TFPGObjectList<TObject>;
+    FreeItems: TFPGObjectList<TObject>;
     function Acquire: TObject; virtual;
     procedure Release(Item: TObject); virtual;
@@ -185 +185 @@
 begin
   inherited;
-  Items := TListObject.Create;
-  FreeItems := TListObject.Create;
-  FreeItems.OwnsObjects := False;
+  Items := TFPGObjectList<TObject>.Create;
+  FreeItems := TFPGObjectList<TObject>.Create;
+  FreeItems.FreeObjects := False;
   FReleaseEvent := TEvent.Create(nil, False, False, '');
 end;

trunk/Packages/Common/UPrefixMultiplier.pas

@@ -21 +21 @@
   { TPrefixMultiplier }
 
-  TPrefixMultiplier = class
+  TPrefixMultiplier = class(TComponent)
   private
-    function TruncateDigits(Value:Double;Digits:Integer=3):Double;
+    function TruncateDigits(Value: Double; Digits: Integer = 3): Double;
   public
     function Add(Value: Double; PrefixMultipliers: TPrefixMultiplierDef;
@@ -72 +72 @@
   );
 
+procedure Register;
+
+
 implementation
+
+procedure Register;
+begin
+  RegisterComponents('Common', [TPrefixMultiplier]);
+end;
 
 { TPrefixMultiplier }
@@ -92 +100 @@
 end;
 
-function TPrefixMultiplier.Add(Value:Double;PrefixMultipliers:TPrefixMultiplierDef
-  ;UnitText:string;Digits:Integer):string;
+function TPrefixMultiplier.Add(Value: Double; PrefixMultipliers: TPrefixMultiplierDef
+  ; UnitText:string; Digits: Integer): string;
 var
   I: Integer;

trunk/Packages/Common/URegistry.pas

@@ -29 +29 @@
     procedure SetCurrentContext(AValue: TRegistryContext);
   public
+    function ReadChar(const Name: string): Char;
+    procedure WriteChar(const Name: string; Value: Char);
     function ReadBoolWithDefault(const Name: string;
       DefaultValue: Boolean): Boolean;
     function ReadIntegerWithDefault(const Name: string; DefaultValue: Integer): Integer;
     function ReadStringWithDefault(const Name: string; DefaultValue: string): string;
+    function ReadCharWithDefault(const Name: string; DefaultValue: Char): Char;
     function ReadFloatWithDefault(const Name: string;
       DefaultValue: Double): Double;
@@ -89 +92 @@
 end;
 
+function TRegistryEx.ReadCharWithDefault(const Name: string; DefaultValue: Char
+  ): Char;
+begin
+  if ValueExists(Name) then Result := ReadChar(Name)
+    else begin
+      WriteChar(Name, DefaultValue);
+      Result := DefaultValue;
+    end;
+end;
+
 function TRegistryEx.ReadFloatWithDefault(const Name: string;
   DefaultValue: Double): Double;
@@ -137 +150 @@
 end;
 
+function TRegistryEx.ReadChar(const Name: string): Char;
+var
+  S: string;
+begin
+  S := ReadString(Name);
+  if Length(S) > 0 then Result := S[1]
+    else Result := #0;
+end;
+
+procedure TRegistryEx.WriteChar(const Name: string; Value: Char);
+begin
+  WriteString(Name, Value);
+end;
+
 function TRegistryEx.ReadBoolWithDefault(const Name: string;
   DefaultValue: Boolean): Boolean;