Changeset 520
- Timestamp:
- Mar 7, 2019, 4:34:53 PM (6 years ago)
- Location:
- Common
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
Common/Common.lpk
r510 r520 60 60 <Item5> 61 61 <Filename Value="UPrefixMultiplier.pas"/> 62 <HasRegisterProc Value="True"/> 62 63 <UnitName Value="UPrefixMultiplier"/> 63 64 </Item5> … … 144 145 <EnableI18NForLFM Value="True"/> 145 146 </i18n> 146 <RequiredPkgs Count=" 3">147 <RequiredPkgs Count="2"> 147 148 <Item1> 148 149 <PackageName Value="LCL"/> 149 150 </Item1> 150 151 <Item2> 151 <PackageName Value="TemplateGenerics"/>152 </Item2>153 <Item3>154 152 <PackageName Value="FCL"/> 155 153 <MinVersion Major="1" Valid="True"/> 156 </Item 3>154 </Item2> 157 155 </RequiredPkgs> 158 156 <UsageOptions> -
Common/Common.pas
r510 r520 20 20 begin 21 21 RegisterUnit('UDebugLog', @UDebugLog.Register); 22 RegisterUnit('UPrefixMultiplier', @UPrefixMultiplier.Register); 22 23 RegisterUnit('ULastOpenedList', @ULastOpenedList.Register); 23 24 RegisterUnit('UJobProgressView', @UJobProgressView.Register); -
Common/UCommon.pas
r518 r520 28 28 unfDNSDomainName = 11); 29 29 30 TFilterMethodMethod = function (FileName: string): Boolean of object; 30 TFilterMethod = function (FileName: string): Boolean of object; 31 TFileNameMethod = procedure (FileName: string) of object; 32 31 33 var 32 34 ExceptionHandler: TExceptionEvent; … … 74 76 procedure SaveStringToFile(S, FileName: string); 75 77 procedure SearchFiles(AList: TStrings; Dir: string; 76 FilterMethod: TFilterMethod Method = nil);78 FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil); 77 79 function GetStringPart(var Text: string; Separator: string): string; 78 80 function StripTags(const S: string): string; … … 81 83 function PosFromIndexReverse(SubStr: string; Text: string; 82 84 StartIndex: Integer): Integer; 85 procedure CopyStringArray(Dest: TStringArray; Source: array of string); 83 86 84 87 … … 108 111 I: Integer; 109 112 begin 113 Result := ''; 110 114 for I := 1 to Length(Source) do begin 111 115 Result := Result + LowerCase(IntToHex(Ord(Source[I]), 2)); … … 543 547 544 548 procedure SearchFiles(AList: TStrings; Dir: string; 545 FilterMethod: TFilterMethod Method = nil);549 FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil); 546 550 var 547 551 SR: TSearchRec; … … 553 557 if (SR.Name = '.') or (SR.Name = '..') or (Assigned(FilterMethod) and (not FilterMethod(SR.Name) or 554 558 not FilterMethod(Copy(Dir, 3, Length(Dir)) + SR.Name))) then Continue; 559 if Assigned(FileNameMethod) then 560 FileNameMethod(Dir + SR.Name); 555 561 AList.Add(Dir + SR.Name); 556 562 if (SR.Attr and faDirectory) <> 0 then … … 654 660 end; 655 661 662 procedure CopyStringArray(Dest: TStringArray; Source: array of string); 663 var 664 I: Integer; 665 begin 666 SetLength(Dest, Length(Source)); 667 for I := 0 to Length(Dest) - 1 do 668 Dest[I] := Source[I]; 669 end; 670 656 671 657 672 initialization -
Common/UDebugLog.pas
r510 r520 6 6 7 7 uses 8 Classes, SysUtils, FileUtil, SpecializedList, SyncObjs;8 Classes, SysUtils, FileUtil, fgl, SyncObjs; 9 9 10 10 type … … 29 29 procedure SetMaxCount(const AValue: Integer); 30 30 public 31 Items: T ListObject;31 Items: TFPGObjectList<TDebugLogItem>; 32 32 Lock: TCriticalSection; 33 33 procedure Add(Text: string; Group: string = ''); … … 117 117 begin 118 118 inherited; 119 Items := T ListObject.Create;119 Items := TFPGObjectList<TDebugLogItem>.Create; 120 120 Lock := TCriticalSection.Create; 121 121 MaxCount := 100; -
Common/UListViewSort.pas
r511 r520 9 9 uses 10 10 {$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, 12 12 LclIntf, LMessages, LclType, LResources; 13 13 … … 52 52 {$ENDIF} 53 53 public 54 List: T ListObject;55 Source: T ListObject;54 List: TFPGObjectList<TObject>; 55 Source: TFPGObjectList<TObject>; 56 56 constructor Create(AOwner: TComponent); override; 57 57 destructor Destroy; override; … … 98 98 end; 99 99 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 100 118 procedure Register; 101 119 … … 105 123 procedure Register; 106 124 begin 107 RegisterComponents('Common', [TListViewSort, TListViewFilter]); 125 RegisterComponents('Common', [TListViewSort, TListViewFilter, TListViewEx]); 126 end; 127 128 { TListViewEx } 129 130 procedure TListViewEx.ResizeHanlder; 131 begin 132 end; 133 134 constructor TListViewEx.Create(TheOwner: TComponent); 135 begin 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; 145 end; 146 147 destructor TListViewEx.Destroy; 148 begin 149 inherited Destroy; 108 150 end; 109 151 … … 277 319 end; 278 320 321 var 322 ListViewSortCompare: TCompareEvent; 323 324 function ListViewCompare(const Item1, Item2: TObject): Integer; 325 begin 326 Result := ListViewSortCompare(Item1, Item2); 327 end; 328 279 329 procedure TListViewSort.Sort(Compare: TCompareEvent); 280 330 begin 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; 281 334 if (List.Count > 0) then 282 List.Sort( Compare);335 List.Sort(ListViewCompare); 283 336 end; 284 337 … … 343 396 begin 344 397 inherited; 345 List := T ListObject.Create;346 List. OwnsObjects := False;398 List := TFPGObjectList<TObject>.Create; 399 List.FreeObjects := False; 347 400 end; 348 401 -
Common/UPool.pas
r295 r520 6 6 7 7 uses 8 Classes, SysUtils, syncobjs, SpecializedList, UThreading;8 Classes, SysUtils, syncobjs, fgl, UThreading; 9 9 10 10 type … … 22 22 function NewItemObject: TObject; virtual; 23 23 public 24 Items: T ListObject;25 FreeItems: T ListObject;24 Items: TFPGObjectList<TObject>; 25 FreeItems: TFPGObjectList<TObject>; 26 26 function Acquire: TObject; virtual; 27 27 procedure Release(Item: TObject); virtual; … … 185 185 begin 186 186 inherited; 187 Items := T ListObject.Create;188 FreeItems := T ListObject.Create;189 FreeItems. OwnsObjects := False;187 Items := TFPGObjectList<TObject>.Create; 188 FreeItems := TFPGObjectList<TObject>.Create; 189 FreeItems.FreeObjects := False; 190 190 FReleaseEvent := TEvent.Create(nil, False, False, ''); 191 191 end; -
Common/UPrefixMultiplier.pas
r118 r520 21 21 { TPrefixMultiplier } 22 22 23 TPrefixMultiplier = class 23 TPrefixMultiplier = class(TComponent) 24 24 private 25 function TruncateDigits(Value: Double;Digits:Integer=3):Double;25 function TruncateDigits(Value: Double; Digits: Integer = 3): Double; 26 26 public 27 27 function Add(Value: Double; PrefixMultipliers: TPrefixMultiplierDef; … … 72 72 ); 73 73 74 procedure Register; 75 76 74 77 implementation 78 79 procedure Register; 80 begin 81 RegisterComponents('Common', [TPrefixMultiplier]); 82 end; 75 83 76 84 { TPrefixMultiplier } … … 92 100 end; 93 101 94 function TPrefixMultiplier.Add(Value: Double;PrefixMultipliers:TPrefixMultiplierDef95 ; UnitText:string;Digits:Integer):string;102 function TPrefixMultiplier.Add(Value: Double; PrefixMultipliers: TPrefixMultiplierDef 103 ; UnitText:string; Digits: Integer): string; 96 104 var 97 105 I: Integer; -
Common/URegistry.pas
r501 r520 29 29 procedure SetCurrentContext(AValue: TRegistryContext); 30 30 public 31 function ReadChar(const Name: string): Char; 32 procedure WriteChar(const Name: string; Value: Char); 31 33 function ReadBoolWithDefault(const Name: string; 32 34 DefaultValue: Boolean): Boolean; 33 35 function ReadIntegerWithDefault(const Name: string; DefaultValue: Integer): Integer; 34 36 function ReadStringWithDefault(const Name: string; DefaultValue: string): string; 37 function ReadCharWithDefault(const Name: string; DefaultValue: Char): Char; 35 38 function ReadFloatWithDefault(const Name: string; 36 39 DefaultValue: Double): Double; … … 89 92 end; 90 93 94 function TRegistryEx.ReadCharWithDefault(const Name: string; DefaultValue: Char 95 ): Char; 96 begin 97 if ValueExists(Name) then Result := ReadChar(Name) 98 else begin 99 WriteChar(Name, DefaultValue); 100 Result := DefaultValue; 101 end; 102 end; 103 91 104 function TRegistryEx.ReadFloatWithDefault(const Name: string; 92 105 DefaultValue: Double): Double; … … 137 150 end; 138 151 152 function TRegistryEx.ReadChar(const Name: string): Char; 153 var 154 S: string; 155 begin 156 S := ReadString(Name); 157 if Length(S) > 0 then Result := S[1] 158 else Result := #0; 159 end; 160 161 procedure TRegistryEx.WriteChar(const Name: string; Value: Char); 162 begin 163 WriteString(Name, Value); 164 end; 165 139 166 function TRegistryEx.ReadBoolWithDefault(const Name: string; 140 167 DefaultValue: Boolean): Boolean;
Note:
See TracChangeset
for help on using the changeset viewer.