Changeset 313 for trunk/Packages/Common
- Timestamp:
- Jan 18, 2022, 10:45:33 PM (3 years ago)
- Location:
- trunk/Packages/Common
- Files:
-
- 11 added
- 10 deleted
- 18 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/Common/Common.lpk
r308 r313 1 1 <?xml version="1.0" encoding="UTF-8"?> 2 2 <CONFIG> 3 <Package Version=" 4">3 <Package Version="5"> 4 4 <PathDelim Value="\"/> 5 5 <Name Value="Common"/> … … 33 33 <Other> 34 34 <CompilerMessages> 35 <IgnoredMessages idx 5024="True"/>35 <IgnoredMessages idx6058="True" idx5024="True" idx3124="True" idx3123="True"/> 36 36 </CompilerMessages> 37 37 </Other> … … 41 41 Source: https://svn.zdechov.net/PascalClassLibrary/Common/"/> 42 42 <License Value="Copy left."/> 43 <Version Minor=" 8"/>43 <Version Minor="9"/> 44 44 <Files Count="29"> 45 45 <Item1> … … 172 172 </Item29> 173 173 </Files> 174 <CompatibilityMode Value="True"/> 174 175 <i18n> 175 176 <EnableI18N Value="True"/> -
trunk/Packages/Common/Languages/UJobProgressView.cs.po
r308 r313 13 13 14 14 #: ujobprogressview.sestimatedtime 15 #, object-pascal-format 15 16 msgid "Estimated time: %s" 16 17 msgstr "Odhadovaný čas: %s" … … 33 34 34 35 #: ujobprogressview.stotalestimatedtime 36 #, object-pascal-format 35 37 msgid "Total estimated time: %s" 36 38 msgstr "Celkový odhadovaný čas: %s" -
trunk/Packages/Common/Languages/UScaleDPI.cs.po
r308 r313 13 13 14 14 #: uscaledpi.swrongdpi 15 #, object-pascal-format 15 16 msgid "Wrong DPI [%d,%d]" 16 17 msgstr "Chybné DPI [%d,%d]" -
trunk/Packages/Common/Languages/UThreading.cs.po
r43 r313 11 11 12 12 #: uthreading.scurrentthreadnotfound 13 #, object-pascal-format 13 14 msgid "Current thread ID %d not found in virtual thread list." 14 15 msgstr "Aktuální vlákno ID %d nenalezeno v seznamu virtuálních vláken." -
trunk/Packages/Common/UAboutDialog.pas
r308 r313 7 7 uses 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus, 9 StdCtrls,ExtCtrls, UApplicationInfo, UCommon, UTranslator, UTheme, UFormAbout;9 ExtCtrls, UApplicationInfo, UCommon, UTranslator, UTheme, UFormAbout; 10 10 11 11 type … … 16 16 private 17 17 FApplicationInfo: TApplicationInfo; 18 F CoolTranslator: TTranslator;18 FTranslator: TTranslator; 19 19 FThemeManager: TThemeManager; 20 20 public … … 22 22 procedure Show; 23 23 published 24 property CoolTranslator: TTranslator read FCoolTranslator write FCoolTranslator;24 property Translator: TTranslator read FTranslator write FTranslator; 25 25 property ThemeManager: TThemeManager read FThemeManager write FThemeManager; 26 26 property ApplicationInfo: TApplicationInfo read FApplicationInfo write -
trunk/Packages/Common/UCommon.pas
r310 r313 6 6 7 7 uses 8 {$ ifdef Windows}Windows,{$endif}9 {$ ifdef Linux}baseunix,{$endif}8 {$IFDEF WINDOWS}Windows,{$ENDIF} 9 {$IFDEF UNIX}baseunix,{$ENDIF} 10 10 Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf, 11 11 FileUtil; //, ShFolder, ShellAPI; … … 35 35 DLLHandle1: HModule; 36 36 37 {$IFDEF W indows}37 {$IFDEF WINDOWS} 38 38 GetUserNameEx: procedure (NameFormat: DWORD; 39 39 lpNameBuffer: LPSTR; nSize: PULONG); stdcall; … … 85 85 function TryHexToInt(Data: string; var Value: Integer): Boolean; 86 86 function TryBinToInt(Data: string; var Value: Integer): Boolean; 87 procedure SortStrings(Strings: TStrings); 87 88 88 89 … … 291 292 function Explode(Separator: char; Data: string): TArrayOfString; 292 293 begin 294 Result := nil; 293 295 SetLength(Result, 0); 294 296 while Pos(Separator, Data) > 0 do begin … … 345 347 Name: UtsName; 346 348 begin 349 Name := Default(UtsName); 347 350 fpuname(Name); 348 351 Result := Name.Nodename; … … 504 507 I: Integer; 505 508 begin 509 Result := Default(TArrayOfString); 506 510 SetLength(Result, Length(A) + Length(B)); 507 511 for I := 0 to Length(A) - 1 do … … 677 681 end; 678 682 683 procedure SortStrings(Strings: TStrings); 684 var 685 Tmp: TStringList; 686 begin 687 Strings.BeginUpdate; 688 try 689 if Strings is TStringList then begin 690 TStringList(Strings).Sort; 691 end else begin 692 Tmp := TStringList.Create; 693 try 694 Tmp.Assign(Strings); 695 Tmp.Sort; 696 Strings.Assign(Tmp); 697 finally 698 Tmp.Free; 699 end; 700 end; 701 finally 702 Strings.EndUpdate; 703 end; 704 end; 705 679 706 680 707 initialization -
trunk/Packages/Common/UFindFile.pas
r192 r313 59 59 FilterAll = '*.*'; 60 60 {$ENDIF} 61 {$IFDEF LINUX}61 {$IFDEF UNIX} 62 62 FilterAll = '*'; 63 63 {$ENDIF} -
trunk/Packages/Common/UFormAbout.pas
r308 r313 50 50 if Assigned(AboutDialog) then 51 51 with TAboutDialog(AboutDialog) do begin 52 if Assigned( CoolTranslator) then53 CoolTranslator.TranslateComponentRecursive(Self);52 if Assigned(Translator) then 53 Translator.TranslateComponentRecursive(Self); 54 54 if Assigned(ThemeManager) then 55 55 ThemeManager.UseTheme(Self); -
trunk/Packages/Common/UGeometric.pas
r308 r313 96 96 I: Integer; 97 97 begin 98 Result := Default(TPointArray); 98 99 SetLength(Result, Length(P)); 99 100 for I := 0 to High(P) do -
trunk/Packages/Common/UJobProgressView.lfm
r308 r313 1 1 object FormJobProgressView: TFormJobProgressView 2 2 Left = 467 3 Height = 3453 Height = 414 4 4 Top = 252 5 Width = 5395 Width = 647 6 6 BorderIcons = [biSystemMenu] 7 ClientHeight = 3458 ClientWidth = 5399 DesignTimePPI = 1 207 ClientHeight = 414 8 ClientWidth = 647 9 DesignTimePPI = 144 10 10 OnClose = FormClose 11 11 OnCloseQuery = FormCloseQuery 12 12 OnCreate = FormCreate 13 OnDestroy = FormDestroy14 13 OnHide = FormHide 15 14 OnShow = FormShow 16 15 Position = poScreenCenter 17 LCLVersion = '2. 0.2.0'16 LCLVersion = '2.2.0.4' 18 17 object PanelOperationsTitle: TPanel 19 18 Left = 0 20 Height = 3 219 Height = 38 21 20 Top = 0 22 Width = 53921 Width = 647 23 22 Align = alTop 24 23 BevelOuter = bvNone 25 ClientHeight = 3 226 ClientWidth = 53924 ClientHeight = 38 25 ClientWidth = 647 27 26 FullRepaint = False 28 27 TabOrder = 0 29 28 object LabelOperation: TLabel 30 Left = 831 Height = 2 032 Top = 833 Width = 7629 Left = 10 30 Height = 26 31 Top = 10 32 Width = 99 34 33 Caption = 'Operations:' 35 ParentColor = False36 34 ParentFont = False 37 35 end … … 39 37 object PanelLog: TPanel 40 38 Left = 0 41 Height = 1 3342 Top = 2 1243 Width = 53939 Height = 161 40 Top = 253 41 Width = 647 44 42 Align = alClient 45 43 BevelOuter = bvSpace 46 ClientHeight = 1 3347 ClientWidth = 53944 ClientHeight = 161 45 ClientWidth = 647 48 46 TabOrder = 1 49 47 object MemoLog: TMemo 50 Left = 851 Height = 1 1752 Top = 853 Width = 52348 Left = 10 49 Height = 141 50 Top = 10 51 Width = 627 54 52 Anchors = [akTop, akLeft, akRight, akBottom] 55 53 ReadOnly = True … … 60 58 object PanelProgress: TPanel 61 59 Left = 0 62 Height = 5463 Top = 1 0664 Width = 53960 Height = 65 61 Top = 126 62 Width = 647 65 63 Align = alTop 66 64 BevelOuter = bvNone 67 ClientHeight = 5468 ClientWidth = 53965 ClientHeight = 65 66 ClientWidth = 647 69 67 TabOrder = 2 70 68 object ProgressBarPart: TProgressBar 71 Left = 1 072 Height = 2 473 Top = 2 474 Width = 52369 Left = 12 70 Height = 29 71 Top = 29 72 Width = 628 75 73 Anchors = [akTop, akLeft, akRight] 76 74 TabOrder = 0 77 75 end 78 76 object LabelEstimatedTimePart: TLabel 79 Left = 880 Height = 2 077 Left = 10 78 Height = 26 81 79 Top = -2 82 Width = 1 0380 Width = 132 83 81 Caption = 'Estimated time:' 84 ParentColor = False85 82 end 86 83 end 87 84 object PanelOperations: TPanel 88 85 Left = 0 89 Height = 4290 Top = 6491 Width = 53986 Height = 50 87 Top = 76 88 Width = 647 92 89 Align = alTop 93 90 BevelOuter = bvNone 94 ClientHeight = 4295 ClientWidth = 53991 ClientHeight = 50 92 ClientWidth = 647 96 93 FullRepaint = False 97 94 TabOrder = 3 98 95 object ListViewJobs: TListView 99 Left = 8100 Height = 3 2101 Top = 5102 Width = 52396 Left = 10 97 Height = 38 98 Top = 6 99 Width = 627 103 100 Anchors = [akTop, akLeft, akRight, akBottom] 104 101 AutoWidthLastColumn = True … … 107 104 Columns = < 108 105 item 109 Width = 523106 Width = 614 110 107 end> 111 108 OwnerData = True … … 120 117 object PanelProgressTotal: TPanel 121 118 Left = 0 122 Height = 52123 Top = 1 60124 Width = 539119 Height = 62 120 Top = 191 121 Width = 647 125 122 Align = alTop 126 123 BevelOuter = bvNone 127 ClientHeight = 52128 ClientWidth = 539124 ClientHeight = 62 125 ClientWidth = 647 129 126 TabOrder = 4 130 127 object LabelEstimatedTimeTotal: TLabel 131 Left = 8132 Height = 2 0128 Left = 10 129 Height = 26 133 130 Top = 0 134 Width = 1 41131 Width = 178 135 132 Caption = 'Total estimated time:' 136 ParentColor = False137 133 end 138 134 object ProgressBarTotal: TProgressBar 139 Left = 8140 Height = 2 4141 Top = 2 4142 Width = 523135 Left = 10 136 Height = 29 137 Top = 29 138 Width = 627 143 139 Anchors = [akTop, akLeft, akRight] 144 140 TabOrder = 0 … … 147 143 object PanelText: TPanel 148 144 Left = 0 149 Height = 3 2150 Top = 3 2151 Width = 539145 Height = 38 146 Top = 38 147 Width = 647 152 148 Align = alTop 153 149 BevelOuter = bvNone 154 ClientHeight = 3 2155 ClientWidth = 539150 ClientHeight = 38 151 ClientWidth = 647 156 152 TabOrder = 5 157 153 object LabelText: TLabel 158 Left = 8159 Height = 2 4160 Top = 8161 Width = 525154 Left = 10 155 Height = 29 156 Top = 10 157 Width = 630 162 158 Anchors = [akTop, akLeft, akRight] 163 159 AutoSize = False 164 ParentColor = False165 160 end 166 161 end 167 162 object ImageList1: TImageList 168 BkColor = clForeground 169 left = 200 170 top = 8 163 Left = 240 164 Top = 10 171 165 Bitmap = { 172 4C69020000001000000010000000FF00FF00FF00FF00FF00FF00FF00FF00FF00 173 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 174 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 175 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 176 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 177 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 178 FF00000000FF000000FFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 179 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000 180 00FF000000FF000000FFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 181 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FF0000 182 00FF000000FF000000FFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 183 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FF000000FF0000 184 00FF000000FFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 185 FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FF000000FF000000FF0000 186 00FFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FFFF00FF00FF00 187 FF00FF00FF00FF00FF00FF00FF00000000FF000000FF000000FF000000FFFF00 188 FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FF000000FF000000FFFF00 189 FF00FF00FF00FF00FF00000000FF000000FF000000FF000000FFFF00FF00FF00 190 FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FF000000FF000000FF0000 191 00FFFF00FF00000000FF000000FF000000FF000000FFFF00FF00FF00FF00FF00 192 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FF000000FF0000 193 00FF000000FF000000FF000000FF000000FFFF00FF00FF00FF00FF00FF00FF00 194 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FF0000 195 00FF000000FF000000FF000000FFFF00FF00FF00FF00FF00FF00FF00FF00FF00 196 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000 197 00FF000000FF000000FFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 198 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 199 FF00000000FFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 200 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 201 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 202 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 203 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 204 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 205 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 206 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 207 FF00FF00FF00FF00FF00FF00FF00000000FFFF00FF00FF00FF00FF00FF00FF00 208 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 209 FF00FF00FF00FF00FF00FF00FF00000000FF000000FFFF00FF00FF00FF00FF00 210 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 211 FF00FF00FF00FF00FF00FF00FF00000000FF000084FF000000FFFF00FF00FF00 212 FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FF000000FF000000FF0000 213 00FF000000FF000000FF000000FF000000FF0000FFFF000084FF000000FFFF00 214 FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FF0000FFFF0000FFFF0000 215 FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF000084FF0000 216 00FFFF00FF00FF00FF00FF00FF00FF00FF00000000FF0000FFFF0000FFFF0000 217 FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000 218 84FF000000FFFF00FF00FF00FF00FF00FF00000000FF0000FFFF0000FFFF0000 219 FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000 220 FFFF000084FF000000FFFF00FF00FF00FF00000000FF0000FFFF0000FFFF0000 221 FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000 222 84FF000000FFFF00FF00FF00FF00FF00FF00000000FF0000FFFF0000FFFF0000 223 FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF000084FF0000 224 00FFFF00FF00FF00FF00FF00FF00FF00FF00000000FF000000FF000000FF0000 225 00FF000000FF000000FF000000FF000000FF0000FFFF000084FF000000FFFF00 226 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 227 FF00FF00FF00FF00FF00FF00FF00000000FF000084FF000000FFFF00FF00FF00 228 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 229 FF00FF00FF00FF00FF00FF00FF00000000FF000000FFFF00FF00FF00FF00FF00 230 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 231 FF00FF00FF00FF00FF00FF00FF00000000FFFF00FF00FF00FF00FF00FF00FF00 232 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 233 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 234 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 235 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 236 FF00FF00FF00FF00FF00FF00FF00 166 4C7A0200000010000000100000006A0000000000000078DAE593490E00100C45 167 7B78F72E5684A63A1142C382BE4F0708F89C955117F4B016BE67B5FC6E96DB97 168 B0D4B9F4CD949F36DED1DF922B0F1BD11FAB5AFC68DE5C44D40220A9FA779EC8 169 6A349FD5A435E43CADA1E3678D73F773F1DBF3EFADFFEEFEBBF97F6696BE9D36 237 170 } 238 171 end … … 241 174 Interval = 100 242 175 OnTimer = TimerUpdateTimer 243 left = 320244 top = 8176 Left = 384 177 Top = 10 245 178 end 246 179 end -
trunk/Packages/Common/UJobProgressView.pas
r308 r313 7 7 uses 8 8 SysUtils, Variants, Classes, Graphics, Controls, Forms, Syncobjs, 9 Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading, Math,9 Dialogs, ComCtrls, StdCtrls, ExtCtrls, fgl, UThreading, Math, 10 10 DateUtils; 11 11 … … 71 71 end; 72 72 73 TJobs = class(T ObjectList)73 TJobs = class(TFPGObjectList<TJob>) 74 74 end; 75 75 … … 105 105 procedure ReloadJobList; 106 106 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); 107 procedure FormDestroy(Sender: TObject);108 107 procedure ListViewJobsData(Sender: TObject; Item: TListItem); 109 108 procedure TimerUpdateTimer(Sender: TObject); … … 286 285 end; 287 286 288 procedure TFormJobProgressView.FormDestroy(Sender:TObject);289 begin290 end;291 292 287 procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem); 293 288 begin 294 289 if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then 295 with TJob(JobProgressView.Jobs[Item.Index])do begin290 with JobProgressView.Jobs[Item.Index] do begin 296 291 Item.Caption := Title; 297 292 if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1 … … 405 400 I := 0; 406 401 while I < Jobs.Count do 407 with TJob(Jobs[I])do begin402 with Jobs[I] do begin 408 403 CurrentJobIndex := I; 409 CurrentJob := TJob(Jobs[I]);404 CurrentJob := Jobs[I]; 410 405 JobProgressChange(Self); 411 406 StartTime := Now; … … 420 415 Method(CurrentJob); 421 416 end else begin 417 Thread := TJobThread.Create(True); 422 418 try 423 Thread := TJobThread.Create(True);424 419 with Thread do begin 425 420 FreeOnTerminate := False; … … 494 489 if AValue = FTerminate then Exit; 495 490 for I := 0 to Jobs.Count - 1 do 496 TJob(Jobs[I]).Terminate := AValue;491 Jobs[I].Terminate := AValue; 497 492 FTerminate := AValue; 498 493 end; … … 620 615 procedure TProgress.Increment; 621 616 begin 622 try623 FLock.Acquire;617 FLock.Acquire; 618 try 624 619 Value := Value + 1; 625 620 finally … … 630 625 procedure TProgress.Reset; 631 626 begin 632 try633 FLock.Acquire;627 FLock.Acquire; 628 try 634 629 FValue := 0; 635 630 finally … … 678 673 destructor TJob.Destroy; 679 674 begin 680 Progress.Free;675 FreeAndNil(Progress); 681 676 inherited; 682 677 end; -
trunk/Packages/Common/ULanguages.pas
r308 r313 1 1 unit ULanguages; 2 2 3 {$mode objfpc}{$H+}3 {$mode delphi}{$H+} 4 4 5 5 interface 6 6 7 7 uses 8 Classes, SysUtils, Contnrs;8 Classes, SysUtils, fgl; 9 9 10 10 type … … 15 15 end; 16 16 17 { TLanguage List}18 19 TLanguage List = class(TObjectList)17 { TLanguages } 18 19 TLanguages = class(TFPGObjectList<TLanguage>) 20 20 function SearchByCode(ACode: string): TLanguage; 21 21 procedure AddNew(Code: string; Name: string); 22 constructor Create ;22 constructor Create(FreeObjects: Boolean = True); 23 23 end; 24 24 … … 223 223 224 224 225 { TLanguage List}226 227 function TLanguage List.SearchByCode(ACode: string): TLanguage;225 { TLanguages } 226 227 function TLanguages.SearchByCode(ACode: string): TLanguage; 228 228 var 229 229 I: Integer; … … 235 235 end; 236 236 237 procedure TLanguage List.AddNew(Code: string; Name: string);237 procedure TLanguages.AddNew(Code: string; Name: string); 238 238 var 239 239 NewItem: TLanguage; … … 245 245 end; 246 246 247 constructor TLanguage List.Create;247 constructor TLanguages.Create(FreeObjects: Boolean); 248 248 begin 249 inherited Create;249 inherited; 250 250 AddNew('', SLangAuto); 251 251 AddNew('aa', SLang_aa); -
trunk/Packages/Common/UListViewSort.pas
r308 r313 81 81 FOnChange: TNotifyEvent; 82 82 FStringGrid1: TStringGrid; 83 procedure DoOnChange; 83 84 procedure GridDoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 84 85 procedure GridDoOnResize(Sender: TObject); … … 90 91 function TextEnteredColumn(Index: Integer): Boolean; 91 92 function GetColValue(Index: Integer): string; 93 procedure Reset; 92 94 property StringGrid: TStringGrid read FStringGrid1 write FStringGrid1; 93 95 published … … 152 154 { TListViewFilter } 153 155 156 procedure TListViewFilter.DoOnChange; 157 begin 158 if Assigned(FOnChange) then FOnChange(Self); 159 end; 160 154 161 procedure TListViewFilter.GridDoOnKeyUp(Sender: TObject; var Key: Word; 155 162 Shift: TShiftState); 156 163 begin 157 if Assigned(FOnChange) then 158 FOnChange(Self); 164 DoOnChange; 159 165 end; 160 166 … … 227 233 Result := StringGrid.Cells[Index, 0] 228 234 else Result := ''; 235 end; 236 237 procedure TListViewFilter.Reset; 238 var 239 I: Integer; 240 begin 241 with StringGrid do 242 for I := 0 to ColCount - 1 do 243 Cells[I, 0] := ''; 244 DoOnChange; 229 245 end; 230 246 -
trunk/Packages/Common/UMetaCanvas.pas
r308 r313 142 142 procedure RoundRect(const Rect: TRect; RX,RY: Integer); overload; 143 143 procedure TextOut(X,Y: Integer; const Text: String); override; 144 procedure Polygon(Points: PPoint; NumPts: Integer; Winding: boolean = False); override;144 procedure Polygon(Points: PPoint; NumPts: Integer; Winding: Boolean = False); override; 145 145 procedure Ellipse(x1, y1, x2, y2: Integer); override; 146 146 procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); override; … … 502 502 end; 503 503 504 procedure TMetaCanvas.Polygon(Points: PPoint; NumPts: Integer; Winding: boolean504 procedure TMetaCanvas.Polygon(Points: PPoint; NumPts: Integer; Winding: Boolean 505 505 ); 506 506 var … … 508 508 I: Integer; 509 509 begin 510 APoints := nil; 510 511 SetLength(APoints, NumPts); 511 512 for I := 0 to High(APoints) do -
trunk/Packages/Common/URegistry.pas
r306 r313 132 132 function TRegistryEx.OpenKey(const Key: string; CanCreate: Boolean): Boolean; 133 133 begin 134 {$IFDEF Linux}134 {$IFDEF UNIX} 135 135 //CloseKey; 136 136 {$ENDIF} … … 140 140 function TRegistryEx.GetCurrentContext: TRegistryContext; 141 141 begin 142 Result.Key := CurrentPath;142 Result.Key := String(CurrentPath); 143 143 Result.RootKey := RootKey; 144 144 end; -
trunk/Packages/Common/UScaleDPI.pas
r310 r313 8 8 9 9 uses 10 Classes, Forms, Graphics, Controls, ComCtrls, LCLType, SysUtils, StdCtrls, 11 Contnrs; 10 Classes, Forms, Graphics, Controls, ComCtrls, LCLType, SysUtils, fgl; 12 11 13 12 type 13 TControlDimensions = class; 14 14 15 15 { TControlDimension } … … 18 18 BoundsRect: TRect; 19 19 FontHeight: Integer; 20 Controls: T ObjectList; // TList<TControlDimension>20 Controls: TControlDimensions; 21 21 // Class specifics 22 22 ButtonSize: TPoint; // TToolBar … … 26 26 constructor Create; 27 27 destructor Destroy; override; 28 end; 29 30 TControlDimensions = class(TFPGObjectList<TControlDimension>) 28 31 end; 29 32 … … 73 76 constructor TControlDimension.Create; 74 77 begin 75 Controls := T ObjectList.Create;78 Controls := TControlDimensions.Create; 76 79 end; 77 80 … … 79 82 begin 80 83 FreeAndNil(Controls); 81 inherited Destroy;84 inherited; 82 85 end; 83 86 … … 212 215 TempBmp: TBitmap; 213 216 Temp: array of TBitmap; 214 NewWidth, NewHeight: integer; 217 NewWidth: Integer; 218 NewHeight: Integer; 215 219 I: Integer; 216 220 begin 217 221 ImgList.BeginUpdate; 218 NewWidth := ScaleX(ImgList.Width, FromDPI.X); 219 NewHeight := ScaleY(ImgList.Height, FromDPI.Y); 220 221 SetLength(Temp, ImgList.Count); 222 for I := 0 to ImgList.Count - 1 do 223 begin 224 TempBmp := TBitmap.Create; 225 TempBmp.PixelFormat := pf32bit; 226 ImgList.GetBitmap(I, TempBmp); 227 Temp[I] := TBitmap.Create; 228 Temp[I].SetSize(NewWidth, NewHeight); 229 {$IFDEF Linux} 230 Temp[I].PixelFormat := pf24bit; 231 {$ELSE} 232 Temp[I].PixelFormat := pf32bit; 233 {$ENDIF} 234 Temp[I].TransparentColor := TempBmp.TransparentColor; 235 //Temp[I].TransparentMode := TempBmp.TransparentMode; 236 Temp[I].Transparent := True; 237 Temp[I].Canvas.Brush.Style := bsSolid; 238 Temp[I].Canvas.Brush.Color := Temp[I].TransparentColor; 239 Temp[I].Canvas.FillRect(0, 0, Temp[I].Width, Temp[I].Height); 240 241 if (Temp[I].Width = 0) or (Temp[I].Height = 0) then Continue; 242 Temp[I].Canvas.StretchDraw(Rect(0, 0, Temp[I].Width, Temp[I].Height), TempBmp); 243 TempBmp.Free; 244 end; 245 246 ImgList.Clear; 247 ImgList.Width := NewWidth; 248 ImgList.Height := NewHeight; 249 250 for I := 0 to High(Temp) do 251 begin 252 ImgList.Add(Temp[I], nil); 253 Temp[i].Free; 254 end; 255 ImgList.EndUpdate; 222 try 223 NewWidth := ScaleX(ImgList.Width, FromDPI.X); 224 NewHeight := ScaleY(ImgList.Height, FromDPI.Y); 225 226 Temp := nil; 227 SetLength(Temp, ImgList.Count); 228 for I := 0 to ImgList.Count - 1 do 229 begin 230 TempBmp := TBitmap.Create; 231 try 232 TempBmp.PixelFormat := pf32bit; 233 ImgList.GetBitmap(I, TempBmp); 234 Temp[I] := TBitmap.Create; 235 Temp[I].SetSize(NewWidth, NewHeight); 236 {$IFDEF UNIX} 237 Temp[I].PixelFormat := pf24bit; 238 {$ELSE} 239 Temp[I].PixelFormat := pf32bit; 240 {$ENDIF} 241 Temp[I].TransparentColor := TempBmp.TransparentColor; 242 //Temp[I].TransparentMode := TempBmp.TransparentMode; 243 Temp[I].Transparent := True; 244 Temp[I].Canvas.Brush.Style := bsSolid; 245 Temp[I].Canvas.Brush.Color := Temp[I].TransparentColor; 246 Temp[I].Canvas.FillRect(0, 0, Temp[I].Width, Temp[I].Height); 247 248 if (Temp[I].Width = 0) or (Temp[I].Height = 0) then Continue; 249 Temp[I].Canvas.StretchDraw(Rect(0, 0, Temp[I].Width, Temp[I].Height), TempBmp); 250 finally 251 TempBmp.Free; 252 end; 253 end; 254 255 ImgList.Clear; 256 ImgList.Width := NewWidth; 257 ImgList.Height := NewHeight; 258 259 for I := 0 to High(Temp) do 260 begin 261 ImgList.Add(Temp[I], nil); 262 Temp[i].Free; 263 end; 264 finally 265 ImgList.EndUpdate; 266 end; 256 267 end; 257 268 … … 331 342 with TCoolBar(Control) do begin 332 343 BeginUpdate; 333 for I := 0 to Bands.Count - 1 do 334 with Bands[I] do begin 335 MinWidth := ScaleX(MinWidth, FromDPI.X); 336 MinHeight := ScaleY(MinHeight, FromDPI.Y); 337 // Workaround to bad band width auto sizing 338 //Width := ScaleX(Width, FromDPI.X); 339 Width := ScaleX(Control.Width + 28, FromDPI.X); 340 //Control.Invalidate; 344 try 345 for I := 0 to Bands.Count - 1 do 346 with Bands[I] do begin 347 MinWidth := ScaleX(MinWidth, FromDPI.X); 348 MinHeight := ScaleY(MinHeight, FromDPI.Y); 349 // Workaround to bad band width auto sizing 350 //Width := ScaleX(Width, FromDPI.X); 351 Width := ScaleX(Control.Width + 28, FromDPI.X); 352 //Control.Invalidate; 353 end; 354 // Workaround for bad autosizing of coolbar 355 if AutoSize then begin 356 AutoSize := False; 357 Height := ScaleY(Height, FromDPI.Y); 358 AutoSize := True; 341 359 end; 342 // Workaround for bad autosizing of coolbar 343 if AutoSize then begin 344 AutoSize := False; 345 Height := ScaleY(Height, FromDPI.Y); 346 AutoSize := True; 347 end; 348 EndUpdate; 360 finally 361 EndUpdate; 362 end; 349 363 end; 350 364 -
trunk/Packages/Common/UTheme.pas
r308 r313 5 5 uses 6 6 Classes, SysUtils, Graphics, ComCtrls, Controls, ExtCtrls, Menus, StdCtrls, 7 Spin, Forms, Contnrs, Grids;7 Spin, Forms, fgl, Grids; 8 8 9 9 type … … 19 19 { TThemes } 20 20 21 TThemes = class(T ObjectList)21 TThemes = class(TFPGObjectList<TTheme>) 22 22 function AddNew(Name: string): TTheme; 23 23 function FindByName(Name: string): TTheme; … … 74 74 procedure TThemes.LoadToStrings(Strings: TStrings); 75 75 var 76 Theme: TTheme;76 I: Integer; 77 77 begin 78 Strings.Clear; 79 for Theme in Self do 80 Strings.AddObject(Theme.Name, Theme); 78 Strings.BeginUpdate; 79 try 80 while Strings.Count < Count do Strings.Add(''); 81 while Strings.Count > Count do Strings.Delete(Strings.Count - 1); 82 for I := 0 to Count - 1 do begin 83 Strings[I] := Items[I].Name; 84 Strings.Objects[I] := Items[I]; 85 end; 86 finally 87 Strings.EndUpdate; 88 end; 81 89 end; 82 90 … … 123 131 destructor TThemeManager.Destroy; 124 132 begin 125 Themes.Free;126 inherited Destroy;133 FreeAndNil(Themes); 134 inherited; 127 135 end; 128 136 -
trunk/Packages/Common/UTranslator.pas
r308 r313 1 1 unit UTranslator; 2 2 3 {$mode Delphi}{$H+}3 {$mode delphi}{$H+} 4 4 5 5 interface 6 6 7 7 uses 8 Classes, SysUtils, Forms, ExtCtrls, Controls, Contnrs, LazFileUtils, LazUTF8,8 Classes, SysUtils, Forms, ExtCtrls, Controls, fgl, LazFileUtils, LazUTF8, 9 9 Translations, TypInfo, Dialogs, FileUtil, LCLProc, ULanguages, LCLType, 10 10 LCLVersion; … … 12 12 type 13 13 THandleStringEvent = function (AValue: string): string of object; 14 15 TPoFiles = class(TFPGObjectList<TPOFile>) 16 end; 14 17 15 18 { TComponentExcludes } … … 24 27 { TComponentExcludesList } 25 28 26 TComponentExcludesList = class(T ObjectList)29 TComponentExcludesList = class(TFPGObjectList<TComponentExcludes>) 27 30 function FindByClassType(AClassType: TClass): TComponentExcludes; 28 31 procedure DumpToStrings(Strings: TStrings); … … 36 39 FOnAutomaticLanguage: THandleStringEvent; 37 40 FOnTranslate: TNotifyEvent; 38 FP OFilesFolder: string;39 FP OFiles: TObjectList; // TObjectList<TPOFile>;41 FPoFilesFolder: string; 42 FPoFiles: TPoFiles; 40 43 function GetLocale: string; 41 44 function GetLocaleShort: string; … … 50 53 public 51 54 ComponentExcludes: TComponentExcludesList; 52 Languages: TLanguage List;55 Languages: TLanguages; 53 56 procedure Translate; 54 procedure LanguageListToStrings(Strings: TStrings );57 procedure LanguageListToStrings(Strings: TStrings; WithCode: Boolean = True); 55 58 procedure TranslateResourceStrings(PoFileName: string); 56 59 procedure TranslateUnitResourceStrings(UnitName: string; PoFileName: string); … … 63 66 destructor Destroy; override; 64 67 published 65 property POFilesFolder: string read FP OFilesFolder write SetPOFilesFolder;68 property POFilesFolder: string read FPoFilesFolder write SetPOFilesFolder; 66 69 property Language: TLanguage read FLanguage write SetLanguage; 67 70 property OnTranslate: TNotifyEvent read FOnTranslate write FOnTranslate; … … 71 74 72 75 procedure Register; 76 73 77 74 78 implementation … … 117 121 destructor TComponentExcludes.Destroy; 118 122 begin 119 PropertyExcludes.Free;120 inherited Destroy;123 FreeAndNil(PropertyExcludes); 124 inherited; 121 125 end; 122 126 … … 128 132 I, J: Integer; 129 133 Po: TPoFile; 130 Item: TP OFileItem;134 Item: TPoFileItem; 131 135 begin 132 136 TranslateComponentRecursive(Application); … … 134 138 // Merge files to single translation file 135 139 try 136 Po := TP OFile.Create;137 for I := 0 to FP OFiles.Count - 1 do140 Po := TPoFile.Create; 141 for I := 0 to FPoFiles.Count - 1 do 138 142 with TPoFile(FPoFiles[I]) do 139 143 for J := 0 to Items.Count - 1 do … … 162 166 SearchMask: string; 163 167 begin 164 FP OFiles.Clear;168 FPoFiles.Clear; 165 169 if Assigned(FLanguage) then 166 170 try … … 177 181 if FileExists(FileName) and ( 178 182 ((LocaleShort = '') and (Pos('.', FileName) = Pos('.po', FileName))) or 179 (LocaleShort <> '')) then FP OFiles.Add(TPOFile.Create(FileName));183 (LocaleShort <> '')) then FPoFiles.Add(TPOFile.Create(FileName)); 180 184 end; 181 185 finally … … 281 285 var 282 286 Item: TClass; 283 284 287 Excludes: TComponentExcludes; 285 288 begin … … 301 304 function TTranslator.GetLangFileDir: string; 302 305 begin 303 Result := FP OFilesFolder;306 Result := FPoFilesFolder; 304 307 if Copy(Result, 1, 1) <> DirectorySeparator then 305 308 Result := ExtractFileDir(Application.ExeName) + … … 307 310 end; 308 311 309 procedure TTranslator.LanguageListToStrings(Strings: TStrings );312 procedure TTranslator.LanguageListToStrings(Strings: TStrings; WithCode: Boolean = True); 310 313 var 311 314 I: Integer; … … 313 316 begin 314 317 with Strings do begin 315 Clear; 316 for I := 0 to Languages.Count - 1 do 317 with TLanguage(Languages[I]) do 318 if Available then begin 319 ItemName := Name; 320 if Code <> '' then ItemName := ItemName + ' (' + Code + ')'; 321 AddObject(ItemName, Languages[I]); 322 end; 318 BeginUpdate; 319 try 320 Clear; 321 for I := 0 to Languages.Count - 1 do 322 with Languages[I] do 323 if Available then begin 324 ItemName := Name; 325 if WithCode and (Code <> '') then ItemName := ItemName + ' (' + Code + ')'; 326 AddObject(ItemName, Languages[I]); 327 end; 328 finally 329 EndUpdate; 330 end; 323 331 end; 324 332 end; … … 342 350 if Text <> '' then begin 343 351 for I := 0 to FPoFiles.Count - 1 do begin 344 Result := TPoFile(FP OFiles[I]).Translate(Identifier, Text);352 Result := TPoFile(FPoFiles[I]).Translate(Identifier, Text); 345 353 if Result <> Text then Break; 346 354 end; … … 369 377 begin 370 378 LangDir := GetLangFileDir; 371 TLanguage(Languages[0]).Available := True; // Automatic379 Languages.SearchByCode('').Available := True; // Automatic 372 380 373 381 for I := 1 to Languages.Count - 1 do 374 with TLanguage(Languages[I])do begin382 with Languages[I] do begin 375 383 Available := FileExists(LangDir + DirectorySeparator + ExtractFileNameOnly(Application.ExeName) + 376 384 '.' + Code + ExtensionSeparator + 'po') or (Code = 'en'); … … 381 389 begin 382 390 inherited; 383 FP OFiles := TObjectList.Create;391 FPoFiles := TPoFiles.Create; 384 392 ComponentExcludes := TComponentExcludesList.Create; 385 Languages := TLanguage List.Create;393 Languages := TLanguages.Create; 386 394 POFilesFolder := 'Languages'; 387 395 CheckLanguageFiles; … … 395 403 destructor TTranslator.Destroy; 396 404 begin 397 F POFiles.Free;398 Languages.Free;399 ComponentExcludes.Free;400 inherited Destroy;405 FreeAndNil(FPoFiles); 406 FreeAndNil(Languages); 407 FreeAndNil(ComponentExcludes); 408 inherited; 401 409 end; 402 410
Note:
See TracChangeset
for help on using the changeset viewer.