Changeset 520 for Common


Ignore:
Timestamp:
Mar 7, 2019, 4:34:53 PM (6 years ago)
Author:
chronos
Message:
  • Modified: Removed dependency on TemplateGenerics and used fgl unit as replacement.
Location:
Common
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • Common/Common.lpk

    r510 r520  
    6060      <Item5>
    6161        <Filename Value="UPrefixMultiplier.pas"/>
     62        <HasRegisterProc Value="True"/>
    6263        <UnitName Value="UPrefixMultiplier"/>
    6364      </Item5>
     
    144145      <EnableI18NForLFM Value="True"/>
    145146    </i18n>
    146     <RequiredPkgs Count="3">
     147    <RequiredPkgs Count="2">
    147148      <Item1>
    148149        <PackageName Value="LCL"/>
    149150      </Item1>
    150151      <Item2>
    151         <PackageName Value="TemplateGenerics"/>
    152       </Item2>
    153       <Item3>
    154152        <PackageName Value="FCL"/>
    155153        <MinVersion Major="1" Valid="True"/>
    156       </Item3>
     154      </Item2>
    157155    </RequiredPkgs>
    158156    <UsageOptions>
  • Common/Common.pas

    r510 r520  
    2020begin
    2121  RegisterUnit('UDebugLog', @UDebugLog.Register);
     22  RegisterUnit('UPrefixMultiplier', @UPrefixMultiplier.Register);
    2223  RegisterUnit('ULastOpenedList', @ULastOpenedList.Register);
    2324  RegisterUnit('UJobProgressView', @UJobProgressView.Register);
  • Common/UCommon.pas

    r518 r520  
    2828    unfDNSDomainName = 11);
    2929
    30   TFilterMethodMethod = function (FileName: string): Boolean of object;
     30  TFilterMethod = function (FileName: string): Boolean of object;
     31  TFileNameMethod = procedure (FileName: string) of object;
     32
    3133var
    3234  ExceptionHandler: TExceptionEvent;
     
    7476procedure SaveStringToFile(S, FileName: string);
    7577procedure SearchFiles(AList: TStrings; Dir: string;
    76   FilterMethod: TFilterMethodMethod = nil);
     78  FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil);
    7779function GetStringPart(var Text: string; Separator: string): string;
    7880function StripTags(const S: string): string;
     
    8183function PosFromIndexReverse(SubStr: string; Text: string;
    8284  StartIndex: Integer): Integer;
     85procedure CopyStringArray(Dest: TStringArray; Source: array of string);
    8386
    8487
     
    108111  I: Integer;
    109112begin
     113  Result := '';
    110114  for I := 1 to Length(Source) do begin
    111115    Result := Result + LowerCase(IntToHex(Ord(Source[I]), 2));
     
    543547
    544548procedure SearchFiles(AList: TStrings; Dir: string;
    545   FilterMethod: TFilterMethodMethod = nil);
     549  FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil);
    546550var
    547551  SR: TSearchRec;
     
    553557        if (SR.Name = '.') or (SR.Name = '..') or (Assigned(FilterMethod) and (not FilterMethod(SR.Name) or
    554558          not FilterMethod(Copy(Dir, 3, Length(Dir)) + SR.Name))) then Continue;
     559        if Assigned(FileNameMethod) then
     560          FileNameMethod(Dir + SR.Name);
    555561        AList.Add(Dir + SR.Name);
    556562        if (SR.Attr and faDirectory) <> 0 then
     
    654660end;
    655661
     662procedure CopyStringArray(Dest: TStringArray; Source: array of string);
     663var
     664  I: Integer;
     665begin
     666  SetLength(Dest, Length(Source));
     667  for I := 0 to Length(Dest) - 1 do
     668    Dest[I] := Source[I];
     669end;
     670
    656671
    657672initialization
  • Common/UDebugLog.pas

    r510 r520  
    66
    77uses
    8   Classes, SysUtils, FileUtil, SpecializedList, SyncObjs;
     8  Classes, SysUtils, FileUtil, fgl, SyncObjs;
    99
    1010type
     
    2929    procedure SetMaxCount(const AValue: Integer);
    3030  public
    31     Items: TListObject;
     31    Items: TFPGObjectList<TDebugLogItem>;
    3232    Lock: TCriticalSection;
    3333    procedure Add(Text: string; Group: string = '');
     
    117117begin
    118118  inherited;
    119   Items := TListObject.Create;
     119  Items := TFPGObjectList<TDebugLogItem>.Create;
    120120  Lock := TCriticalSection.Create;
    121121  MaxCount := 100;
  • Common/UListViewSort.pas

    r511 r520  
    99uses
    1010  {$IFDEF Windows}Windows, CommCtrl, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils,
    11   Controls, DateUtils, Dialogs, SpecializedList, Forms, Grids, StdCtrls, ExtCtrls,
     11  Controls, DateUtils, Dialogs, fgl, Forms, Grids, StdCtrls, ExtCtrls,
    1212  LclIntf, LMessages, LclType, LResources;
    1313
     
    5252    {$ENDIF}
    5353  public
    54     List: TListObject;
    55     Source: TListObject;
     54    List: TFPGObjectList<TObject>;
     55    Source: TFPGObjectList<TObject>;
    5656    constructor Create(AOwner: TComponent); override;
    5757    destructor Destroy; override;
     
    9898  end;
    9999
     100  { TListViewEx }
     101
     102  TListViewEx = class(TWinControl)
     103  private
     104    FFilter: TListViewFilter;
     105    FListView: TListView;
     106    FListViewSort: TListViewSort;
     107    procedure ResizeHanlder;
     108  public
     109    constructor Create(TheOwner: TComponent); override;
     110    destructor Destroy; override;
     111  published
     112    property ListView: TListView read FListView write FListView;
     113    property ListViewSort: TListViewSort read FListViewSort write FListViewSort;
     114    property Filter: TListViewFilter read FFilter write FFilter;
     115    property Visible;
     116  end;
     117
    100118procedure Register;
    101119
     
    105123procedure Register;
    106124begin
    107   RegisterComponents('Common', [TListViewSort, TListViewFilter]);
     125  RegisterComponents('Common', [TListViewSort, TListViewFilter, TListViewEx]);
     126end;
     127
     128{ TListViewEx }
     129
     130procedure TListViewEx.ResizeHanlder;
     131begin
     132end;
     133
     134constructor TListViewEx.Create(TheOwner: TComponent);
     135begin
     136  inherited Create(TheOwner);
     137  Filter := TListViewFilter.Create(Self);
     138  Filter.Parent := Self;
     139  Filter.Align := alBottom;
     140  ListView := TListView.Create(Self);
     141  ListView.Parent := Self;
     142  ListView.Align := alClient;
     143  ListViewSort := TListViewSort.Create(Self);
     144  ListViewSort.ListView := ListView;
     145end;
     146
     147destructor TListViewEx.Destroy;
     148begin
     149  inherited Destroy;
    108150end;
    109151
     
    277319end;
    278320
     321var
     322  ListViewSortCompare: TCompareEvent;
     323
     324function ListViewCompare(const Item1, Item2: TObject): Integer;
     325begin
     326  Result := ListViewSortCompare(Item1, Item2);
     327end;
     328
    279329procedure TListViewSort.Sort(Compare: TCompareEvent);
    280330begin
     331  // TODO: Because TFLGObjectList compare handler is not class method,
     332  // it is necessary to use simple function compare handler with local variable
     333  ListViewSortCompare := Compare;
    281334  if (List.Count > 0) then
    282     List.Sort(Compare);
     335    List.Sort(ListViewCompare);
    283336end;
    284337
     
    343396begin
    344397  inherited;
    345   List := TListObject.Create;
    346   List.OwnsObjects := False;
     398  List := TFPGObjectList<TObject>.Create;
     399  List.FreeObjects := False;
    347400end;
    348401
  • Common/UPool.pas

    r295 r520  
    66
    77uses
    8   Classes, SysUtils, syncobjs, SpecializedList, UThreading;
     8  Classes, SysUtils, syncobjs, fgl, UThreading;
    99
    1010type
     
    2222    function NewItemObject: TObject; virtual;
    2323  public
    24     Items: TListObject;
    25     FreeItems: TListObject;
     24    Items: TFPGObjectList<TObject>;
     25    FreeItems: TFPGObjectList<TObject>;
    2626    function Acquire: TObject; virtual;
    2727    procedure Release(Item: TObject); virtual;
     
    185185begin
    186186  inherited;
    187   Items := TListObject.Create;
    188   FreeItems := TListObject.Create;
    189   FreeItems.OwnsObjects := False;
     187  Items := TFPGObjectList<TObject>.Create;
     188  FreeItems := TFPGObjectList<TObject>.Create;
     189  FreeItems.FreeObjects := False;
    190190  FReleaseEvent := TEvent.Create(nil, False, False, '');
    191191end;
  • Common/UPrefixMultiplier.pas

    r118 r520  
    2121  { TPrefixMultiplier }
    2222
    23   TPrefixMultiplier = class
     23  TPrefixMultiplier = class(TComponent)
    2424  private
    25     function TruncateDigits(Value:Double;Digits:Integer=3):Double;
     25    function TruncateDigits(Value: Double; Digits: Integer = 3): Double;
    2626  public
    2727    function Add(Value: Double; PrefixMultipliers: TPrefixMultiplierDef;
     
    7272  );
    7373
     74procedure Register;
     75
     76
    7477implementation
     78
     79procedure Register;
     80begin
     81  RegisterComponents('Common', [TPrefixMultiplier]);
     82end;
    7583
    7684{ TPrefixMultiplier }
     
    92100end;
    93101
    94 function TPrefixMultiplier.Add(Value:Double;PrefixMultipliers:TPrefixMultiplierDef
    95   ;UnitText:string;Digits:Integer):string;
     102function TPrefixMultiplier.Add(Value: Double; PrefixMultipliers: TPrefixMultiplierDef
     103  ; UnitText:string; Digits: Integer): string;
    96104var
    97105  I: Integer;
  • Common/URegistry.pas

    r501 r520  
    2929    procedure SetCurrentContext(AValue: TRegistryContext);
    3030  public
     31    function ReadChar(const Name: string): Char;
     32    procedure WriteChar(const Name: string; Value: Char);
    3133    function ReadBoolWithDefault(const Name: string;
    3234      DefaultValue: Boolean): Boolean;
    3335    function ReadIntegerWithDefault(const Name: string; DefaultValue: Integer): Integer;
    3436    function ReadStringWithDefault(const Name: string; DefaultValue: string): string;
     37    function ReadCharWithDefault(const Name: string; DefaultValue: Char): Char;
    3538    function ReadFloatWithDefault(const Name: string;
    3639      DefaultValue: Double): Double;
     
    8992end;
    9093
     94function TRegistryEx.ReadCharWithDefault(const Name: string; DefaultValue: Char
     95  ): Char;
     96begin
     97  if ValueExists(Name) then Result := ReadChar(Name)
     98    else begin
     99      WriteChar(Name, DefaultValue);
     100      Result := DefaultValue;
     101    end;
     102end;
     103
    91104function TRegistryEx.ReadFloatWithDefault(const Name: string;
    92105  DefaultValue: Double): Double;
     
    137150end;
    138151
     152function TRegistryEx.ReadChar(const Name: string): Char;
     153var
     154  S: string;
     155begin
     156  S := ReadString(Name);
     157  if Length(S) > 0 then Result := S[1]
     158    else Result := #0;
     159end;
     160
     161procedure TRegistryEx.WriteChar(const Name: string; Value: Char);
     162begin
     163  WriteString(Name, Value);
     164end;
     165
    139166function TRegistryEx.ReadBoolWithDefault(const Name: string;
    140167  DefaultValue: Boolean): Boolean;
Note: See TracChangeset for help on using the changeset viewer.