Changeset 463 for branches/highdpi/Packages/Common
- Timestamp:
- Nov 29, 2023, 2:35:44 PM (12 months ago)
- Location:
- branches/highdpi/Packages/Common
- Files:
-
- 9 added
- 2 edited
- 1 copied
- 48 moved
Legend:
- Unmodified
- Added
- Removed
-
branches/highdpi/Packages/Common/AboutDialog.pas
r462 r463 1 unit UAboutDialog; 2 3 {$mode delphi} 1 unit AboutDialog; 4 2 5 3 interface … … 7 5 uses 8 6 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus, 9 StdCtrls, ExtCtrls, UApplicationInfo, UCommon, UTranslator, UTheme, UFormAbout;7 ExtCtrls, ApplicationInfo, Common, Translator, Theme, FormAbout; 10 8 11 9 type … … 16 14 private 17 15 FApplicationInfo: TApplicationInfo; 18 F CoolTranslator: TTranslator;16 FTranslator: TTranslator; 19 17 FThemeManager: TThemeManager; 20 18 public … … 22 20 procedure Show; 23 21 published 24 property CoolTranslator: TTranslator read FCoolTranslator write FCoolTranslator;22 property Translator: TTranslator read FTranslator write FTranslator; 25 23 property ThemeManager: TThemeManager read FThemeManager write FThemeManager; 26 24 property ApplicationInfo: TApplicationInfo read FApplicationInfo write … … 52 50 53 51 end. 54 -
branches/highdpi/Packages/Common/ApplicationInfo.pas
r462 r463 1 unit UApplicationInfo; 2 3 {$mode delphi} 1 unit ApplicationInfo; 4 2 5 3 interface 6 4 7 5 uses 8 UDpiControls, SysUtils, Classes, Forms, URegistry, Controls, Graphics, LCLType;6 UDpiControls, SysUtils, Classes, Forms, RegistryEx, Controls, Graphics, LCLType; 9 7 10 8 type … … 59 57 procedure Register; 60 58 59 61 60 implementation 62 61 -
branches/highdpi/Packages/Common/Common.Delay.pas
r462 r463 1 unit UDelay; 2 3 {$mode delphi} 1 unit Common.Delay; 4 2 5 3 interface … … 73 71 74 72 end. 75 -
branches/highdpi/Packages/Common/Common.lpk
r405 r463 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" idx5071="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"/>44 <Files Count=" 27">43 <Version Minor="11"/> 44 <Files Count="33"> 45 45 <Item1> 46 46 <Filename Value="StopWatch.pas"/> … … 48 48 </Item1> 49 49 <Item2> 50 <Filename Value=" UCommon.pas"/>51 <UnitName Value=" UCommon"/>50 <Filename Value="Common.pas"/> 51 <UnitName Value="Common"/> 52 52 </Item2> 53 53 <Item3> 54 <Filename Value=" UDebugLog.pas"/>55 <HasRegisterProc Value="True"/> 56 <UnitName Value=" UDebugLog"/>54 <Filename Value="DebugLog.pas"/> 55 <HasRegisterProc Value="True"/> 56 <UnitName Value="DebugLog"/> 57 57 </Item3> 58 58 <Item4> 59 <Filename Value=" UDelay.pas"/>60 <UnitName Value=" UDelay"/>59 <Filename Value="Common.Delay.pas"/> 60 <UnitName Value="Common.Delay"/> 61 61 </Item4> 62 62 <Item5> 63 <Filename Value=" UPrefixMultiplier.pas"/>64 <HasRegisterProc Value="True"/> 65 <UnitName Value=" UPrefixMultiplier"/>63 <Filename Value="PrefixMultiplier.pas"/> 64 <HasRegisterProc Value="True"/> 65 <UnitName Value="PrefixMultiplier"/> 66 66 </Item5> 67 67 <Item6> 68 <Filename Value="U URI.pas"/>69 <UnitName Value="U URI"/>68 <Filename Value="URI.pas"/> 69 <UnitName Value="URI"/> 70 70 </Item6> 71 71 <Item7> 72 <Filename Value=" UThreading.pas"/>73 <UnitName Value=" UThreading"/>72 <Filename Value="Threading.pas"/> 73 <UnitName Value="Threading"/> 74 74 </Item7> 75 75 <Item8> 76 <Filename Value=" UMemory.pas"/>77 <UnitName Value=" UMemory"/>76 <Filename Value="Memory.pas"/> 77 <UnitName Value="Memory"/> 78 78 </Item8> 79 79 <Item9> 80 <Filename Value=" UResetableThread.pas"/>81 <UnitName Value=" UResetableThread"/>80 <Filename Value="ResetableThread.pas"/> 81 <UnitName Value="ResetableThread"/> 82 82 </Item9> 83 83 <Item10> 84 <Filename Value=" UPool.pas"/>85 <UnitName Value=" UPool"/>84 <Filename Value="Pool.pas"/> 85 <UnitName Value="Pool"/> 86 86 </Item10> 87 87 <Item11> 88 <Filename Value=" ULastOpenedList.pas"/>89 <HasRegisterProc Value="True"/> 90 <UnitName Value=" ULastOpenedList"/>88 <Filename Value="LastOpenedList.pas"/> 89 <HasRegisterProc Value="True"/> 90 <UnitName Value="LastOpenedList"/> 91 91 </Item11> 92 92 <Item12> 93 <Filename Value=" URegistry.pas"/>94 <UnitName Value=" URegistry"/>93 <Filename Value="RegistryEx.pas"/> 94 <UnitName Value="RegistryEx"/> 95 95 </Item12> 96 96 <Item13> 97 <Filename Value=" UJobProgressView.pas"/>98 <HasRegisterProc Value="True"/> 99 <UnitName Value=" UJobProgressView"/>97 <Filename Value="JobProgressView.pas"/> 98 <HasRegisterProc Value="True"/> 99 <UnitName Value="JobProgressView"/> 100 100 </Item13> 101 101 <Item14> 102 <Filename Value=" UXMLUtils.pas"/>103 <UnitName Value=" UXMLUtils"/>102 <Filename Value="XML.pas"/> 103 <UnitName Value="XML"/> 104 104 </Item14> 105 105 <Item15> 106 <Filename Value=" UApplicationInfo.pas"/>107 <HasRegisterProc Value="True"/> 108 <UnitName Value=" UApplicationInfo"/>106 <Filename Value="ApplicationInfo.pas"/> 107 <HasRegisterProc Value="True"/> 108 <UnitName Value="ApplicationInfo"/> 109 109 </Item15> 110 110 <Item16> 111 <Filename Value=" USyncCounter.pas"/>112 <UnitName Value=" USyncCounter"/>111 <Filename Value="SyncCounter.pas"/> 112 <UnitName Value="SyncCounter"/> 113 113 </Item16> 114 114 <Item17> 115 <Filename Value=" UPersistentForm.pas"/>116 <HasRegisterProc Value="True"/> 117 <UnitName Value=" UPersistentForm"/>115 <Filename Value="ListViewSort.pas"/> 116 <HasRegisterProc Value="True"/> 117 <UnitName Value="ListViewSort"/> 118 118 </Item17> 119 119 <Item18> 120 <Filename Value=" UFindFile.pas"/>121 <HasRegisterProc Value="True"/> 122 <UnitName Value=" UFindFile"/>120 <Filename Value="PersistentForm.pas"/> 121 <HasRegisterProc Value="True"/> 122 <UnitName Value="PersistentForm"/> 123 123 </Item18> 124 124 <Item19> 125 <Filename Value=" UScaleDPI.pas"/>126 <HasRegisterProc Value="True"/> 127 <UnitName Value=" UScaleDPI"/>125 <Filename Value="FindFile.pas"/> 126 <HasRegisterProc Value="True"/> 127 <UnitName Value="FindFile"/> 128 128 </Item19> 129 129 <Item20> 130 <Filename Value=" UTheme.pas"/>131 <HasRegisterProc Value="True"/> 132 <UnitName Value=" UTheme"/>130 <Filename Value="ScaleDPI.pas"/> 131 <HasRegisterProc Value="True"/> 132 <UnitName Value="ScaleDPI"/> 133 133 </Item20> 134 134 <Item21> 135 <Filename Value="UStringTable.pas"/> 136 <UnitName Value="UStringTable"/> 135 <Filename Value="Theme.pas"/> 136 <HasRegisterProc Value="True"/> 137 <UnitName Value="Theme"/> 137 138 </Item21> 138 139 <Item22> 139 <Filename Value=" UGeometric.pas"/>140 <UnitName Value=" UGeometric"/>140 <Filename Value="StringTable.pas"/> 141 <UnitName Value="StringTable"/> 141 142 </Item22> 142 143 <Item23> 143 <Filename Value="UTranslator.pas"/> 144 <HasRegisterProc Value="True"/> 145 <UnitName Value="UTranslator"/> 144 <Filename Value="MetaCanvas.pas"/> 145 <UnitName Value="MetaCanvas"/> 146 146 </Item23> 147 147 <Item24> 148 <Filename Value=" ULanguages.pas"/>149 <UnitName Value=" ULanguages"/>148 <Filename Value="Geometric.pas"/> 149 <UnitName Value="Geometric"/> 150 150 </Item24> 151 151 <Item25> 152 <Filename Value="UFormAbout.pas"/> 153 <UnitName Value="UFormAbout"/> 152 <Filename Value="Translator.pas"/> 153 <HasRegisterProc Value="True"/> 154 <UnitName Value="Translator"/> 154 155 </Item25> 155 156 <Item26> 156 <Filename Value="UAboutDialog.pas"/> 157 <HasRegisterProc Value="True"/> 158 <UnitName Value="UAboutDialog"/> 157 <Filename Value="Languages.pas"/> 158 <UnitName Value="Languages"/> 159 159 </Item26> 160 160 <Item27> 161 <Filename Value=" UPixelPointer.pas"/>162 <UnitName Value=" UPixelPointer"/>161 <Filename Value="FormAbout.pas"/> 162 <UnitName Value="FormAbout"/> 163 163 </Item27> 164 <Item28> 165 <Filename Value="AboutDialog.pas"/> 166 <HasRegisterProc Value="True"/> 167 <UnitName Value="AboutDialog"/> 168 </Item28> 169 <Item29> 170 <Filename Value="PixelPointer.pas"/> 171 <UnitName Value="PixelPointer"/> 172 </Item29> 173 <Item30> 174 <Filename Value="DataFile.pas"/> 175 <UnitName Value="DataFile"/> 176 </Item30> 177 <Item31> 178 <Filename Value="TestCase.pas"/> 179 <UnitName Value="TestCase"/> 180 </Item31> 181 <Item32> 182 <Filename Value="Generics.pas"/> 183 <UnitName Value="Generics"/> 184 </Item32> 185 <Item33> 186 <Filename Value="CommonPackage.pas"/> 187 <Type Value="Main Unit"/> 188 <UnitName Value="CommonPackage"/> 189 </Item33> 164 190 </Files> 191 <CompatibilityMode Value="True"/> 165 192 <i18n> 166 193 <EnableI18N Value="True"/> -
branches/highdpi/Packages/Common/Common.pas
r462 r463 1 unit UCommon; 2 3 {$mode delphi} 1 unit Common; 4 2 5 3 interface 6 4 7 5 uses 8 {$ ifdef Windows}Windows,{$endif}9 {$ ifdef Linux}baseunix,{$endif}10 Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf, 11 FileUtil ; //, ShFolder, ShellAPI;6 {$IFDEF WINDOWS}Windows,{$ENDIF} 7 {$IFDEF UNIX}baseunix,{$ENDIF} 8 Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf, Graphics, 9 FileUtil, Generics.Collections; //, ShFolder, ShellAPI; 12 10 13 11 type 14 12 TArrayOfByte = array of Byte; 15 TArrayOfString = array of string;16 13 TExceptionEvent = procedure(Sender: TObject; E: Exception) of object; 17 14 … … 35 32 DLLHandle1: HModule; 36 33 37 {$IFDEF Windows} 38 GetUserNameEx: procedure (NameFormat: DWORD; 39 lpNameBuffer: LPSTR; nSize: PULONG); stdcall; 40 {$ENDIF} 41 42 function IntToBin(Data: Int64; Count: Byte): string; 34 {$IFDEF WINDOWS} 35 GetUserNameEx: procedure (NameFormat: DWORD; 36 lpNameBuffer: LPSTR; nSize: PULONG); stdcall; 37 {$ENDIF} 38 39 const 40 clLightBlue = TColor($FF8080); 41 clLightGreen = TColor($80FF80); 42 clLightRed = TColor($8080FF); 43 44 function AddLeadingZeroes(const aNumber, Length : integer) : string; 43 45 function BinToInt(BinStr: string): Int64; 44 function TryHexToInt(Data: string; var Value: Integer): Boolean;45 function TryBinToInt(Data: string; var Value: Integer): Boolean;46 46 function BinToHexString(Source: AnsiString): string; 47 47 //function DelTree(DirName : string): Boolean; … … 49 49 function BCDToInt(Value: Byte): Byte; 50 50 function CompareByteArray(Data1, Data2: TArrayOfByte): Boolean; 51 procedure CopyStringArray(Dest: TStringArray; Source: array of string); 52 function CombinePaths(Path1, Path2: string): string; 53 function ComputerName: string; 54 procedure DeleteFiles(APath, AFileSpec: string); 55 function Explode(Separator: Char; Data: string): TStringArray; 56 procedure ExecuteProgram(Executable: string; Parameters: array of string); 57 procedure FileDialogUpdateFilterFileType(FileDialog: TOpenDialog); 58 procedure FreeThenNil(var Obj); 59 function GetDirCount(Dir: string): Integer; 51 60 function GetUserName: string; 52 function LoggedOnUserNameEx(Format: TUserNameFormat): string;53 function SplitString(var Text: string; Count: Word): string;54 61 function GetBitCount(Variable: QWord; MaxIndex: Integer): Integer; 55 62 function GetBit(Variable: QWord; Index: Byte): Boolean; 63 function GetStringPart(var Text: string; Separator: string): string; 64 function GenerateNewName(OldName: string): string; 65 function GetFileFilterItemExt(Filter: string; Index: Integer): string; 66 function IntToBin(Data: Int64; Count: Byte): string; 67 function Implode(Separator: Char; List: TList<string>): string; 68 function LastPos(const SubStr: String; const S: String): Integer; 69 function LoadFileToStr(const FileName: TFileName): AnsiString; 70 function LoggedOnUserNameEx(Format: TUserNameFormat): string; 71 function MergeArray(A, B: array of string): TStringArray; 72 function OccurenceOfChar(What: Char; Where: string): Integer; 73 procedure OpenWebPage(URL: string); 74 procedure OpenEmail(Email: string); 75 procedure OpenFileInShell(FileName: string); 76 function PosFromIndex(SubStr: string; Text: string; 77 StartIndex: Integer): Integer; 78 function PosFromIndexReverse(SubStr: string; Text: string; 79 StartIndex: Integer): Integer; 80 function RemoveQuotes(Text: string): string; 81 procedure SaveStringToFile(S, FileName: string); 56 82 procedure SetBit(var Variable: Int64; Index: Byte; State: Boolean); overload; 57 83 procedure SetBit(var Variable: QWord; Index: Byte; State: Boolean); overload; 58 84 procedure SetBit(var Variable: Cardinal; Index: Byte; State: Boolean); overload; 59 85 procedure SetBit(var Variable: Word; Index: Byte; State: Boolean); overload; 60 function AddLeadingZeroes(const aNumber, Length : integer) : string;61 function LastPos(const SubStr: String; const S: String): Integer;62 function GenerateNewName(OldName: string): string;63 function GetFileFilterItemExt(Filter: string; Index: Integer): string;64 procedure FileDialogUpdateFilterFileType(FileDialog: TOpenDialog);65 procedure DeleteFiles(APath, AFileSpec: string);66 procedure OpenWebPage(URL: string);67 procedure OpenFileInShell(FileName: string);68 procedure ExecuteProgram(Executable: string; Parameters: array of string);69 procedure FreeThenNil(var Obj);70 function RemoveQuotes(Text: string): string;71 function ComputerName: string;72 function OccurenceOfChar(What: Char; Where: string): Integer;73 function GetDirCount(Dir: string): Integer;74 function MergeArray(A, B: array of string): TArrayOfString;75 function LoadFileToStr(const FileName: TFileName): AnsiString;76 procedure SaveStringToFile(S, FileName: string);77 86 procedure SearchFiles(AList: TStrings; Dir: string; 78 87 FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil); 79 function GetStringPart(var Text: string; Separator: string): string;88 function SplitString(var Text: string; Count: Word): string; 80 89 function StripTags(const S: string): string; 81 function PosFromIndex(SubStr: string; Text: string; 82 StartIndex: Integer): Integer; 83 function PosFromIndexReverse(SubStr: string; Text: string; 84 StartIndex: Integer): Integer; 85 procedure CopyStringArray(Dest: TStringArray; Source: array of string); 90 function TryHexToInt(Data: string; out Value: Integer): Boolean; 91 function TryBinToInt(Data: string; out Value: Integer): Boolean; 92 procedure SortStrings(Strings: TStrings); 86 93 87 94 … … 244 251 end; 245 252 246 function TryHexToInt(Data: string; varValue: Integer): Boolean;253 function TryHexToInt(Data: string; out Value: Integer): Boolean; 247 254 var 248 255 I: Integer; … … 260 267 end; 261 268 262 function TryBinToInt(Data: string; varValue: Integer): Boolean;269 function TryBinToInt(Data: string; out Value: Integer): Boolean; 263 270 var 264 271 I: Integer; … … 288 295 end; 289 296 290 function Explode(Separator: char; Data: string): TArrayOfString; 291 begin 292 SetLength(Result, 0); 293 while Pos(Separator, Data) > 0 do begin 297 function Explode(Separator: Char; Data: string): TStringArray; 298 var 299 Index: Integer; 300 begin 301 Result := Default(TStringArray); 302 repeat 303 Index := Pos(Separator, Data); 304 if Index > 0 then begin 305 SetLength(Result, Length(Result) + 1); 306 Result[High(Result)] := Copy(Data, 1, Index - 1); 307 Delete(Data, 1, Index); 308 end else Break; 309 until False; 310 if Data <> '' then begin 294 311 SetLength(Result, Length(Result) + 1); 295 Result[High(Result)] := Copy(Data, 1, Pos(Separator, Data) - 1); 296 Delete(Data, 1, Pos(Separator, Data)); 297 end; 298 SetLength(Result, Length(Result) + 1); 299 Result[High(Result)] := Data; 300 end; 301 302 {$IFDEF Windows} 312 Result[High(Result)] := Data; 313 end; 314 end; 315 316 function Implode(Separator: Char; List: TList<string>): string; 317 var 318 I: Integer; 319 begin 320 Result := ''; 321 for I := 0 to List.Count - 1 do begin 322 Result := Result + List[I]; 323 if I < List.Count - 1 then Result := Result + Separator; 324 end; 325 end; 326 327 {$IFDEF WINDOWS} 303 328 function GetUserName: string; 304 329 const … … 308 333 begin 309 334 L := MAX_USERNAME_LENGTH + 2; 335 Result := Default(string); 310 336 SetLength(Result, L); 311 337 if Windows.GetUserName(PChar(Result), L) and (L > 0) then begin … … 321 347 end; 322 348 end; 323 {$ endif}349 {$ENDIF} 324 350 325 351 function ComputerName: string; 326 {$ ifdef mswindows}352 {$IFDEF WINDOWS} 327 353 const 328 354 INFO_BUFFER_SIZE = 32767; … … 339 365 end; 340 366 end; 341 {$ endif}342 {$ ifdef unix}367 {$ENDIF} 368 {$IFDEF UNIX} 343 369 var 344 370 Name: UtsName; 345 371 begin 372 Name := Default(UtsName); 346 373 fpuname(Name); 347 374 Result := Name.Nodename; 348 375 end; 349 {$ endif}350 351 {$ ifdef windows}376 {$ENDIF} 377 378 {$IFDEF WINDOWS} 352 379 function LoggedOnUserNameEx(Format: TUserNameFormat): string; 353 380 const … … 427 454 procedure LoadLibraries; 428 455 begin 429 {$IFDEF W indows}456 {$IFDEF WINDOWS} 430 457 DLLHandle1 := LoadLibrary('secur32.dll'); 431 458 if DLLHandle1 <> 0 then … … 438 465 procedure FreeLibraries; 439 466 begin 440 {$IFDEF W indows}467 {$IFDEF WINDOWS} 441 468 if DLLHandle1 <> 0 then FreeLibrary(DLLHandle1); 442 469 {$ENDIF} … … 471 498 end; 472 499 500 procedure OpenEmail(Email: string); 501 begin 502 OpenURL('mailto:' + Email); 503 end; 504 473 505 procedure OpenFileInShell(FileName: string); 474 506 begin … … 499 531 end; 500 532 501 function MergeArray(A, B: array of string): TArrayOfString; 502 var 503 I: Integer; 504 begin 533 function MergeArray(A, B: array of string): TStringArray; 534 var 535 I: Integer; 536 begin 537 Result := Default(TStringArray); 505 538 SetLength(Result, Length(A) + Length(B)); 506 539 for I := 0 to Length(A) - 1 do … … 669 702 end; 670 703 704 function CombinePaths(Path1, Path2: string): string; 705 begin 706 Result := Path1; 707 if Result <> '' then Result := Result + DirectorySeparator + Path2 708 else Result := Path2; 709 end; 710 711 procedure SortStrings(Strings: TStrings); 712 var 713 Tmp: TStringList; 714 begin 715 Strings.BeginUpdate; 716 try 717 if Strings is TStringList then begin 718 TStringList(Strings).Sort; 719 end else begin 720 Tmp := TStringList.Create; 721 try 722 Tmp.Assign(Strings); 723 Tmp.Sort; 724 Strings.Assign(Tmp); 725 finally 726 Tmp.Free; 727 end; 728 end; 729 finally 730 Strings.EndUpdate; 731 end; 732 end; 733 671 734 672 735 initialization … … 680 743 681 744 end. 745 -
branches/highdpi/Packages/Common/CommonPackage.pas
r462 r463 3 3 } 4 4 5 unit Common ;5 unit CommonPackage; 6 6 7 7 {$warn 5023 off : no warning about unused units} … … 9 9 10 10 uses 11 StopWatch, UCommon, UDebugLog, UDelay, UPrefixMultiplier, UURI, UThreading,12 UMemory, UResetableThread, UPool, ULastOpenedList, URegistry,13 UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter,14 UPersistentForm, UFindFile, UScaleDPI, UTheme, UStringTable, UGeometric,15 UTranslator, ULanguages, UFormAbout, UAboutDialog, UPixelPointer,11 StopWatch, Common, DebugLog, Common.Delay, PrefixMultiplier, URI, Threading, 12 Memory, ResetableThread, Pool, LastOpenedList, RegistryEx, JobProgressView, 13 XML, ApplicationInfo, SyncCounter, ListViewSort, PersistentForm, FindFile, 14 ScaleDPI, Theme, StringTable, MetaCanvas, Geometric, Translator, Languages, 15 FormAbout, AboutDialog, PixelPointer, DataFile, TestCase, Generics, 16 16 LazarusPackageIntf; 17 17 … … 20 20 procedure Register; 21 21 begin 22 RegisterUnit('UDebugLog', @UDebugLog.Register); 23 RegisterUnit('UPrefixMultiplier', @UPrefixMultiplier.Register); 24 RegisterUnit('ULastOpenedList', @ULastOpenedList.Register); 25 RegisterUnit('UJobProgressView', @UJobProgressView.Register); 26 RegisterUnit('UApplicationInfo', @UApplicationInfo.Register); 27 RegisterUnit('UPersistentForm', @UPersistentForm.Register); 28 RegisterUnit('UFindFile', @UFindFile.Register); 29 RegisterUnit('UScaleDPI', @UScaleDPI.Register); 30 RegisterUnit('UTheme', @UTheme.Register); 31 RegisterUnit('UTranslator', @UTranslator.Register); 32 RegisterUnit('UAboutDialog', @UAboutDialog.Register); 22 RegisterUnit('DebugLog', @DebugLog.Register); 23 RegisterUnit('PrefixMultiplier', @PrefixMultiplier.Register); 24 RegisterUnit('LastOpenedList', @LastOpenedList.Register); 25 RegisterUnit('JobProgressView', @JobProgressView.Register); 26 RegisterUnit('ApplicationInfo', @ApplicationInfo.Register); 27 RegisterUnit('ListViewSort', @ListViewSort.Register); 28 RegisterUnit('PersistentForm', @PersistentForm.Register); 29 RegisterUnit('FindFile', @FindFile.Register); 30 RegisterUnit('ScaleDPI', @ScaleDPI.Register); 31 RegisterUnit('Theme', @Theme.Register); 32 RegisterUnit('Translator', @Translator.Register); 33 RegisterUnit('AboutDialog', @AboutDialog.Register); 33 34 end; 34 35 -
branches/highdpi/Packages/Common/DebugLog.pas
r462 r463 1 unit UDebugLog; 2 3 {$mode delphi} 1 unit DebugLog; 4 2 5 3 interface 6 4 7 5 uses 8 Classes, SysUtils, FileUtil, fgl, SyncObjs;6 Classes, SysUtils, FileUtil, Generics.Collections, SyncObjs; 9 7 10 8 type … … 15 13 Group: string; 16 14 Text: string; 15 end; 16 17 TDebugLogItems = class(TObjectList<TDebugLogItem>) 17 18 end; 18 19 … … 29 30 procedure SetMaxCount(const AValue: Integer); 30 31 public 31 Items: T FPGObjectList<TDebugLogItem>;32 Items: TDebugLogItems; 32 33 Lock: TCriticalSection; 33 34 procedure Add(Text: string; Group: string = ''); … … 44 45 45 46 procedure Register; 47 46 48 47 49 implementation … … 117 119 begin 118 120 inherited; 119 Items := T FPGObjectList<TDebugLogItem>.Create;121 Items := TDebugLogItems.Create; 120 122 Lock := TCriticalSection.Create; 121 123 MaxCount := 100; … … 126 128 destructor TDebugLog.Destroy; 127 129 begin 128 Items.Free;129 Lock.Free;130 FreeAndNil(Items); 131 FreeAndNil(Lock); 130 132 inherited; 131 133 end; 132 134 133 135 end. 134 -
branches/highdpi/Packages/Common/FindFile.pas
r462 r463 19 19 } 20 20 21 unit UFindFile;21 unit FindFile; 22 22 23 23 interface … … 35 35 private 36 36 s : TStringList; 37 38 37 fSubFolder : boolean; 39 38 fAttr: TFileAttrib; 40 39 fPath : string; 41 40 fFileMask : string; 42 43 41 procedure SetPath(Value: string); 44 42 procedure FileSearch(const inPath : string); … … 46 44 constructor Create(AOwner: TComponent); override; 47 45 destructor Destroy; override; 48 49 46 function SearchForFiles: TStringList; 50 47 published … … 59 56 FilterAll = '*.*'; 60 57 {$ENDIF} 61 {$IFDEF LINUX}58 {$IFDEF UNIX} 62 59 FilterAll = '*'; 63 60 {$ENDIF} 64 61 65 62 procedure Register; 63 66 64 67 65 implementation … … 87 85 begin 88 86 s.Free; 89 inherited Destroy;87 inherited; 90 88 end; 91 89 … … 145 143 SysUtils.FindClose(Rec); 146 144 end; 147 end; 145 end; 148 146 149 147 end. 150 -
branches/highdpi/Packages/Common/FormAbout.lfm
r462 r463 1 1 object FormAbout: TDpiFormAbout 2 2 Left = 1014 3 Height = 4023 Height = 349 4 4 Top = 577 5 Width = 7025 Width = 609 6 6 Caption = 'About' 7 ClientHeight = 402 8 ClientWidth = 702 9 DesignTimePPI = 144 10 OnCreate = FormCreate 7 ClientHeight = 349 8 ClientWidth = 609 9 DesignTimePPI = 125 11 10 OnShow = FormShow 12 11 Position = poScreenCenter 13 LCLVersion = '2. 0.10.0'12 LCLVersion = '2.2.4.0' 14 13 object LabelDescription: TLabel 15 Left = 3016 Height = 2 417 Top = 1 3518 Width = 64214 Left = 26 15 Height = 22 16 Top = 117 17 Width = 557 19 18 Align = alTop 20 BorderSpacing.Left = 3021 BorderSpacing.Right = 3022 BorderSpacing.Bottom = 3019 BorderSpacing.Left = 26 20 BorderSpacing.Right = 26 21 BorderSpacing.Bottom = 26 23 22 Caption = 'Description' 24 23 ParentColor = False … … 27 26 end 28 27 object LabelContent: TLabel 29 Left = 3030 Height = 2 431 Top = 1 8932 Width = 64228 Left = 26 29 Height = 22 30 Top = 165 31 Width = 557 33 32 Align = alTop 34 BorderSpacing.Around = 3033 BorderSpacing.Around = 26 35 34 Caption = ' ' 36 35 ParentColor = False … … 39 38 object PanelTop: TDpiPanel 40 39 Left = 0 41 Height = 1 3540 Height = 117 42 41 Top = 0 43 Width = 70242 Width = 609 44 43 Align = alTop 45 44 BevelOuter = bvNone 46 ClientHeight = 1 3547 ClientWidth = 70245 ClientHeight = 117 46 ClientWidth = 609 48 47 FullRepaint = False 49 48 ParentFont = False 50 49 TabOrder = 0 51 50 object LabelAppName: TLabel 52 Left = 10853 Height = 8454 Top = 2055 Width = 56451 Left = 94 52 Height = 73 53 Top = 17 54 Width = 489 56 55 Anchors = [akTop, akLeft, akRight] 57 56 AutoSize = False 58 BorderSpacing.Around = 3057 BorderSpacing.Around = 26 59 58 Caption = 'Title' 60 Font.Height = - 6059 Font.Height = -52 61 60 ParentColor = False 62 61 ParentFont = False … … 64 63 end 65 64 object ImageLogo: TImage 66 Left = 2 467 Height = 7468 Top = 3069 Width = 7265 Left = 21 66 Height = 64 67 Top = 26 68 Width = 62 70 69 Proportional = True 71 70 Stretch = True … … 74 73 object PanelButtons: TDpiPanel 75 74 Left = 0 76 Height = 7577 Top = 32778 Width = 70275 Height = 65 76 Top = 284 77 Width = 609 79 78 Align = alBottom 80 79 BevelOuter = bvNone 81 ClientHeight = 7582 ClientWidth = 70280 ClientHeight = 65 81 ClientWidth = 609 83 82 TabOrder = 1 84 83 object ButtonHomePage: TButton 85 Left = 2 486 Height = 3 887 Top = 2 488 Width = 2 6484 Left = 21 85 Height = 33 86 Top = 21 87 Width = 229 89 88 Anchors = [akLeft, akBottom] 90 89 Caption = 'Home page' … … 94 93 end 95 94 object ButtonClose: TButton 96 Left = 53297 Height = 3 898 Top = 2 499 Width = 1 4095 Left = 461 96 Height = 33 97 Top = 21 98 Width = 122 100 99 Anchors = [akRight, akBottom] 101 100 Caption = 'Close' -
branches/highdpi/Packages/Common/FormAbout.pas
r462 r463 1 unit UFormAbout; 2 3 {$mode delphi} 1 unit FormAbout; 4 2 5 3 interface … … 7 5 uses 8 6 UDpiControls, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus, 9 StdCtrls, ExtCtrls, UApplicationInfo, UCommon, UTranslator, UTheme;7 StdCtrls, ExtCtrls, ApplicationInfo, Common, Translator, Theme; 10 8 11 9 type … … 22 20 PanelButtons: TDpiPanel; 23 21 procedure ButtonHomePageClick(Sender: TObject); 24 procedure FormCreate(Sender: TObject);25 22 procedure FormShow(Sender: TObject); 26 private27 { private declarations }28 23 public 29 24 AboutDialog: TObject; //TAboutDialog … … 37 32 38 33 uses 39 UAboutDialog;34 AboutDialog; 40 35 41 36 resourcestring … … 50 45 if Assigned(AboutDialog) then 51 46 with TAboutDialog(AboutDialog) do begin 52 if Assigned( CoolTranslator) then53 CoolTranslator.TranslateComponentRecursive(Self);47 if Assigned(Translator) then 48 Translator.TranslateComponentRecursive(Self); 54 49 if Assigned(ThemeManager) then 55 50 ThemeManager.UseTheme(Self); … … 79 74 end; 80 75 81 procedure TFormAbout.FormCreate(Sender: TObject);82 begin83 end;84 85 76 end. 86 -
branches/highdpi/Packages/Common/Geometric.pas
r462 r463 1 unit UGeometric; 2 3 {$mode delphi} 1 unit Geometric; 4 2 5 3 interface … … 10 8 type 11 9 TPointArray = array of TPoint; 10 11 { TVector } 12 13 TVector = record 14 Position: TPoint; 15 Direction: TPoint; 16 function GetLength: Double; 17 function GetAngle: Double; 18 procedure SetLength(Value: Double); 19 class function Create(P1, P2: TPoint): TVector; static; 20 end; 12 21 13 22 function Distance(P1, P2: TPoint): Integer; … … 15 24 function AddPoint(const P1, P2: TPoint): TPoint; 16 25 function SubPoint(const P1, P2: TPoint): TPoint; 17 function PointToLineDistance(const P, V, W: TPoint ): Integer;26 function PointToLineDistance(const P, V, W: TPoint; out Intersect: TPoint): Integer; 18 27 function ComparePoint(P1, P2: TPoint): Boolean; 19 28 function RotatePoint(Center, P: TPoint; Angle: Double): TPoint; … … 27 36 function ShiftRect(ARect: TRect; Delta: TPoint): TRect; 28 37 38 29 39 implementation 30 40 … … 51 61 end; 52 62 53 function PointToLineDistance(const P, V, W: TPoint ): Integer;63 function PointToLineDistance(const P, V, W: TPoint; out Intersect: TPoint): Integer; 54 64 var 55 65 l2, t: Double; … … 69 79 if T < 0 then begin 70 80 Result := Distance(P, V); // Beyond the 'v' end of the segment 71 exit; 81 Intersect := V; 82 Exit; 72 83 end 73 84 else if T > 1 then begin 74 85 Result := Distance(P, W); // Beyond the 'w' end of the segment 86 Intersect := W; 75 87 Exit; 76 88 end; … … 78 90 TT.Y := Trunc(V.Y + T * (W.Y - V.Y)); 79 91 Result := Distance(P, TT); 92 Intersect := TT; 80 93 end; 81 94 … … 96 109 I: Integer; 97 110 begin 111 Result := Default(TPointArray); 98 112 SetLength(Result, Length(P)); 99 113 for I := 0 to High(P) do … … 162 176 end; 163 177 178 { TVector } 179 180 function TVector.GetLength: Double; 181 begin 182 Result := Sqrt(Sqr(Direction.X) + Sqr(Direction.Y)); 183 end; 184 185 function TVector.GetAngle: Double; 186 begin 187 Result := ArcTan2(Direction.Y, Direction.X); 188 end; 189 190 procedure TVector.SetLength(Value: Double); 191 var 192 Angle: Double; 193 begin 194 Angle := GetAngle; 195 Direction := Point(Round(Cos(Angle) * Value), 196 Round(Sin(Angle) * Value)); 197 end; 198 199 class function TVector.Create(P1, P2: TPoint): TVector; 200 begin 201 Result.Position := P1; 202 Result.Direction := Point(P2.X - P1.X, P2.Y - P1.Y); 203 end; 164 204 165 205 end. -
branches/highdpi/Packages/Common/JobProgressView.lfm
r462 r463 1 1 object FormJobProgressView: TDpiFormJobProgressView 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: TDpiPanel 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: TDpiPanel 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: TDpiMemo 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: TDpiPanel 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: TDpiPanel 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: TDpiListView 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: TDpiPanel 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: TDpiPanel 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: TDpiImageList 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 -
branches/highdpi/Packages/Common/JobProgressView.pas
r462 r463 1 unit UJobProgressView; 2 3 {$MODE Delphi} 1 unit JobProgressView; 4 2 5 3 interface … … 7 5 uses 8 6 UDpiControls, SysUtils, Variants, Classes, Graphics, Controls, Forms, Syncobjs, 9 Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading, Math,7 Dialogs, ComCtrls, StdCtrls, ExtCtrls, Generics.Collections, Threading, Math, 10 8 DateUtils; 11 9 … … 71 69 end; 72 70 73 TJobs = class(TObjectList )71 TJobs = class(TObjectList<TJob>) 74 72 end; 75 73 … … 105 103 procedure ReloadJobList; 106 104 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); 107 procedure FormDestroy(Sender: TObject);108 105 procedure ListViewJobsData(Sender: TObject; Item: TListItem); 109 106 procedure TimerUpdateTimer(Sender: TObject); … … 157 154 end; 158 155 159 //var160 // FormJobProgressView: TFormJobProgressView;161 162 156 procedure Register; 163 157 164 158 resourcestring 165 159 SExecuted = 'Executed'; 160 166 161 167 162 implementation … … 187 182 try 188 183 try 189 //raise Exception.Create('Exception in job');190 184 ProgressView.CurrentJob.Method(Job); 191 185 except … … 286 280 end; 287 281 288 procedure TFormJobProgressView.FormDestroy(Sender:TObject);289 begin290 end;291 292 282 procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem); 293 283 begin 294 284 if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then 295 with TJob(JobProgressView.Jobs[Item.Index])do begin285 with JobProgressView.Jobs[Item.Index] do begin 296 286 Item.Caption := Title; 297 287 if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1 … … 311 301 Caption := SPleaseWait; 312 302 try 313 //Animate1.FileName := ExtractFileDir(UTF8Encode( DpiApplication.ExeName)) +303 //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) + 314 304 // DirectorySeparator + 'horse.avi'; 315 305 //Animate1.Active := True; … … 405 395 I := 0; 406 396 while I < Jobs.Count do 407 with TJob(Jobs[I])do begin397 with Jobs[I] do begin 408 398 CurrentJobIndex := I; 409 CurrentJob := TJob(Jobs[I]);399 CurrentJob := Jobs[I]; 410 400 JobProgressChange(Self); 411 401 StartTime := Now; … … 420 410 Method(CurrentJob); 421 411 end else begin 412 Thread := TJobThread.Create(True); 422 413 try 423 Thread := TJobThread.Create(True);424 414 with Thread do begin 425 415 FreeOnTerminate := False; … … 494 484 if AValue = FTerminate then Exit; 495 485 for I := 0 to Jobs.Count - 1 do 496 TJob(Jobs[I]).Terminate := AValue;486 Jobs[I].Terminate := AValue; 497 487 FTerminate := AValue; 498 488 end; … … 620 610 procedure TProgress.Increment; 621 611 begin 622 try623 FLock.Acquire;612 FLock.Acquire; 613 try 624 614 Value := Value + 1; 625 615 finally … … 630 620 procedure TProgress.Reset; 631 621 begin 632 try633 FLock.Acquire;622 FLock.Acquire; 623 try 634 624 FValue := 0; 635 625 finally … … 647 637 begin 648 638 FLock.Free; 649 inherited Destroy;639 inherited; 650 640 end; 651 641 … … 678 668 destructor TJob.Destroy; 679 669 begin 680 Progress.Free;670 FreeAndNil(Progress); 681 671 inherited; 682 672 end; -
branches/highdpi/Packages/Common/Languages.pas
r462 r463 1 unit ULanguages; 2 3 {$mode objfpc}{$H+} 1 unit Languages; 4 2 5 3 interface 6 4 7 5 uses 8 Classes, SysUtils, Contnrs;6 Classes, SysUtils, Generics.Collections; 9 7 10 8 type … … 15 13 end; 16 14 17 { TLanguage List}18 19 TLanguage List = class(TObjectList)15 { TLanguages } 16 17 TLanguages = class(TObjectList<TLanguage>) 20 18 function SearchByCode(ACode: string): TLanguage; 21 19 procedure AddNew(Code: string; Name: string); 22 constructor Create ;20 constructor Create(FreeObjects: Boolean = True); 23 21 end; 24 22 … … 218 216 SLang_za = 'Zhuang'; 219 217 SLang_zh = 'Chinese'; 218 SLang_zh_Hans = 'Simplified Chinese'; 219 SLang_zh_Hant = 'Traditional Chinese'; 220 220 SLang_zu = 'Zulu'; 221 221 222 222 223 implementation 223 224 224 225 225 { TLanguage List}226 227 function TLanguage List.SearchByCode(ACode: string): TLanguage;226 { TLanguages } 227 228 function TLanguages.SearchByCode(ACode: string): TLanguage; 228 229 var 229 230 I: Integer; 230 231 begin 231 232 I := 0; 232 while (I < Count) and ( TLanguage(Items[I]).Code <ACode) do Inc(I);233 if I < Count then Result := TLanguage(Items[I])233 while (I < Count) and (Items[I].Code <> ACode) do Inc(I); 234 if I < Count then Result := Items[I] 234 235 else Result := nil; 235 236 end; 236 237 237 procedure TLanguage List.AddNew(Code: string; Name: string);238 procedure TLanguages.AddNew(Code: string; Name: string); 238 239 var 239 240 NewItem: TLanguage; … … 245 246 end; 246 247 247 constructor TLanguage List.Create;248 constructor TLanguages.Create(FreeObjects: Boolean); 248 249 begin 249 inherited Create;250 inherited; 250 251 AddNew('', SLangAuto); 251 252 AddNew('aa', SLang_aa); … … 441 442 AddNew('za', SLang_za); 442 443 AddNew('zh', SLang_zh); 444 AddNew('zh-Hant', SLang_zh_Hant); 445 AddNew('zh-Hans', SLang_zh_Hans); 443 446 AddNew('zu', SLang_zu); 444 447 end; 445 448 446 449 end. 447 -
branches/highdpi/Packages/Common/Languages/DebugLog.cs.po
r462 r463 10 10 "Content-Transfer-Encoding: 8bit\n" 11 11 12 #: udebuglog.sfilenamenotdefined 12 #: debuglog.sfilenamenotdefined 13 #, fuzzy 14 msgctxt "debuglog.sfilenamenotdefined" 13 15 msgid "Filename not defined" 14 16 msgstr "Neurčen soubor" -
branches/highdpi/Packages/Common/Languages/DebugLog.pot
r462 r463 2 2 msgstr "Content-Type: text/plain; charset=UTF-8" 3 3 4 #: udebuglog.sfilenamenotdefined4 #: debuglog.sfilenamenotdefined 5 5 msgid "Filename not defined" 6 msgstr " Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8"6 msgstr "" 7 7 -
branches/highdpi/Packages/Common/Languages/FindFile.cs.po
r462 r463 12 12 "X-Generator: Poedit 1.8.9\n" 13 13 14 #: ufindfile.sdirnotfound 14 #: findfile.sdirnotfound 15 #, fuzzy 16 msgctxt "findfile.sdirnotfound" 15 17 msgid "Directory not found" 16 18 msgstr "Adresář nenalezen" -
branches/highdpi/Packages/Common/Languages/FindFile.pot
r462 r463 2 2 msgstr "Content-Type: text/plain; charset=UTF-8" 3 3 4 #: ufindfile.sdirnotfound4 #: findfile.sdirnotfound 5 5 msgid "Directory not found" 6 6 msgstr "" -
branches/highdpi/Packages/Common/Languages/FormAbout.cs.po
r462 r463 12 12 "X-Generator: Poedit 2.4.1\n" 13 13 14 #: uformabout.slicense 14 #: formabout.slicense 15 #, fuzzy 16 msgctxt "formabout.slicense" 15 17 msgid "License" 16 18 msgstr "Licence" 17 19 18 #: uformabout.sreleasedate 20 #: formabout.sreleasedate 21 #, fuzzy 22 msgctxt "formabout.sreleasedate" 19 23 msgid "Release date" 20 24 msgstr "Datum uvolnění" 21 25 22 #: uformabout.sversion 26 #: formabout.sversion 27 #, fuzzy 28 msgctxt "formabout.sversion" 23 29 msgid "Version" 24 30 msgstr "Verze" -
branches/highdpi/Packages/Common/Languages/FormAbout.pot
r462 r463 2 2 msgstr "Content-Type: text/plain; charset=UTF-8" 3 3 4 #: uformabout.slicense4 #: formabout.slicense 5 5 msgid "License" 6 6 msgstr "" 7 7 8 #: uformabout.sreleasedate8 #: formabout.sreleasedate 9 9 msgid "Release date" 10 10 msgstr "" 11 11 12 #: uformabout.sversion12 #: formabout.sversion 13 13 msgid "Version" 14 14 msgstr "" -
branches/highdpi/Packages/Common/Languages/JobProgressView.cs.po
r462 r463 12 12 "X-Generator: Poedit 2.2\n" 13 13 14 #: ujobprogressview.sestimatedtime 14 #: jobprogressview.sestimatedtime 15 #, object-pascal-format, fuzzy 16 msgctxt "jobprogressview.sestimatedtime" 15 17 msgid "Estimated time: %s" 16 18 msgstr "Odhadovaný čas: %s" 17 19 18 #: ujobprogressview.sexecuted 20 #: jobprogressview.sexecuted 21 #, fuzzy 22 msgctxt "jobprogressview.sexecuted" 19 23 msgid "Executed" 20 24 msgstr "Vykonané" 21 25 22 #: ujobprogressview.sfinished 26 #: jobprogressview.sfinished 27 #, fuzzy 28 msgctxt "jobprogressview.sfinished" 23 29 msgid "Finished" 24 30 msgstr "Dokončené" 25 31 26 #: ujobprogressview.spleasewait 32 #: jobprogressview.spleasewait 33 #, fuzzy 34 msgctxt "jobprogressview.spleasewait" 27 35 msgid "Please wait..." 28 36 msgstr "Prosím čekejte..." 29 37 30 #: ujobprogressview.sterminate 38 #: jobprogressview.sterminate 39 #, fuzzy 40 msgctxt "jobprogressview.sterminate" 31 41 msgid "Termination" 32 42 msgstr "Přerušení" 33 43 34 #: ujobprogressview.stotalestimatedtime 44 #: jobprogressview.stotalestimatedtime 45 #, object-pascal-format, fuzzy 46 msgctxt "jobprogressview.stotalestimatedtime" 35 47 msgid "Total estimated time: %s" 36 48 msgstr "Celkový odhadovaný čas: %s" -
branches/highdpi/Packages/Common/Languages/JobProgressView.pot
r462 r463 2 2 msgstr "Content-Type: text/plain; charset=UTF-8" 3 3 4 #: ujobprogressview.sestimatedtime 4 #: jobprogressview.sestimatedtime 5 #, object-pascal-format 5 6 msgid "Estimated time: %s" 6 7 msgstr "" 7 8 8 #: ujobprogressview.sexecuted9 #: jobprogressview.sexecuted 9 10 msgid "Executed" 10 11 msgstr "" 11 12 12 #: ujobprogressview.sfinished13 #: jobprogressview.sfinished 13 14 msgid "Finished" 14 15 msgstr "" 15 16 16 #: ujobprogressview.spleasewait17 #: jobprogressview.spleasewait 17 18 msgid "Please wait..." 18 19 msgstr "" 19 20 20 #: ujobprogressview.sterminate21 #: jobprogressview.sterminate 21 22 msgid "Termination" 22 23 msgstr "" 23 24 24 #: ujobprogressview.stotalestimatedtime 25 #: jobprogressview.stotalestimatedtime 26 #, object-pascal-format 25 27 msgid "Total estimated time: %s" 26 28 msgstr "" -
branches/highdpi/Packages/Common/Languages/Languages.pot
r462 r463 2 2 msgstr "Content-Type: text/plain; charset=UTF-8" 3 3 4 #: ulanguages.slangauto4 #: languages.slangauto 5 5 msgid "Automatic" 6 6 msgstr "" 7 7 8 #: ulanguages.slang_aa8 #: languages.slang_aa 9 9 msgid "Afar" 10 10 msgstr "" 11 11 12 #: ulanguages.slang_ab12 #: languages.slang_ab 13 13 msgid "Abkhazian" 14 14 msgstr "" 15 15 16 #: ulanguages.slang_ae16 #: languages.slang_ae 17 17 msgid "Avestan" 18 18 msgstr "" 19 19 20 #: ulanguages.slang_af20 #: languages.slang_af 21 21 msgid "Afrikaans" 22 22 msgstr "" 23 23 24 #: ulanguages.slang_ak24 #: languages.slang_ak 25 25 msgid "Akan" 26 26 msgstr "" 27 27 28 #: ulanguages.slang_am28 #: languages.slang_am 29 29 msgid "Amharic" 30 30 msgstr "" 31 31 32 #: ulanguages.slang_an32 #: languages.slang_an 33 33 msgid "Aragonese" 34 34 msgstr "" 35 35 36 #: ulanguages.slang_ar36 #: languages.slang_ar 37 37 msgid "Arabic" 38 38 msgstr "" 39 39 40 #: ulanguages.slang_as40 #: languages.slang_as 41 41 msgid "Assamese" 42 42 msgstr "" 43 43 44 #: ulanguages.slang_av44 #: languages.slang_av 45 45 msgid "Avaric" 46 46 msgstr "" 47 47 48 #: ulanguages.slang_ay48 #: languages.slang_ay 49 49 msgid "Aymara" 50 50 msgstr "" 51 51 52 #: ulanguages.slang_az52 #: languages.slang_az 53 53 msgid "Azerbaijani" 54 54 msgstr "" 55 55 56 #: ulanguages.slang_ba56 #: languages.slang_ba 57 57 msgid "Bashkir" 58 58 msgstr "" 59 59 60 #: ulanguages.slang_be60 #: languages.slang_be 61 61 msgid "Belarusian" 62 62 msgstr "" 63 63 64 #: ulanguages.slang_bg64 #: languages.slang_bg 65 65 msgid "Bulgarian" 66 66 msgstr "" 67 67 68 #: ulanguages.slang_bh68 #: languages.slang_bh 69 69 msgid "Bihari" 70 70 msgstr "" 71 71 72 #: ulanguages.slang_bi72 #: languages.slang_bi 73 73 msgid "Bislama" 74 74 msgstr "" 75 75 76 #: ulanguages.slang_bm76 #: languages.slang_bm 77 77 msgid "Bambara" 78 78 msgstr "" 79 79 80 #: ulanguages.slang_bn80 #: languages.slang_bn 81 81 msgid "Bengali" 82 82 msgstr "" 83 83 84 #: ulanguages.slang_bo84 #: languages.slang_bo 85 85 msgid "Tibetan" 86 86 msgstr "" 87 87 88 #: ulanguages.slang_br88 #: languages.slang_br 89 89 msgid "Breton" 90 90 msgstr "" 91 91 92 #: ulanguages.slang_bs92 #: languages.slang_bs 93 93 msgid "Bosnian" 94 94 msgstr "" 95 95 96 #: ulanguages.slang_ca96 #: languages.slang_ca 97 97 msgid "Catalan" 98 98 msgstr "" 99 99 100 #: ulanguages.slang_ce100 #: languages.slang_ce 101 101 msgid "Chechen" 102 102 msgstr "" 103 103 104 #: ulanguages.slang_ch104 #: languages.slang_ch 105 105 msgid "Chamorro" 106 106 msgstr "" 107 107 108 #: ulanguages.slang_co108 #: languages.slang_co 109 109 msgid "Corsican" 110 110 msgstr "" 111 111 112 #: ulanguages.slang_cr112 #: languages.slang_cr 113 113 msgid "Cree" 114 114 msgstr "" 115 115 116 #: ulanguages.slang_cs116 #: languages.slang_cs 117 117 msgid "Czech" 118 118 msgstr "" 119 119 120 #: ulanguages.slang_cv120 #: languages.slang_cv 121 121 msgid "Chuvash" 122 122 msgstr "" 123 123 124 #: ulanguages.slang_cy124 #: languages.slang_cy 125 125 msgid "Welsh" 126 126 msgstr "" 127 127 128 #: ulanguages.slang_da128 #: languages.slang_da 129 129 msgid "Danish" 130 130 msgstr "" 131 131 132 #: ulanguages.slang_de132 #: languages.slang_de 133 133 msgid "German" 134 134 msgstr "" 135 135 136 #: ulanguages.slang_de_at136 #: languages.slang_de_at 137 137 msgid "Austrian German" 138 138 msgstr "" 139 139 140 #: ulanguages.slang_de_ch140 #: languages.slang_de_ch 141 141 msgid "Swiss German" 142 142 msgstr "" 143 143 144 #: ulanguages.slang_dv144 #: languages.slang_dv 145 145 msgid "Divehi" 146 146 msgstr "" 147 147 148 #: ulanguages.slang_dz148 #: languages.slang_dz 149 149 msgid "Dzongkha" 150 150 msgstr "" 151 151 152 #: ulanguages.slang_ee152 #: languages.slang_ee 153 153 msgid "Ewe" 154 154 msgstr "" 155 155 156 #: ulanguages.slang_el156 #: languages.slang_el 157 157 msgid "Greek" 158 158 msgstr "" 159 159 160 #: ulanguages.slang_en160 #: languages.slang_en 161 161 msgid "English" 162 162 msgstr "" 163 163 164 #: ulanguages.slang_en_au164 #: languages.slang_en_au 165 165 msgid "Australian English" 166 166 msgstr "" 167 167 168 #: ulanguages.slang_en_ca168 #: languages.slang_en_ca 169 169 msgid "Canadian English" 170 170 msgstr "" 171 171 172 #: ulanguages.slang_en_gb172 #: languages.slang_en_gb 173 173 msgid "British English" 174 174 msgstr "" 175 175 176 #: ulanguages.slang_en_us176 #: languages.slang_en_us 177 177 msgid "American English" 178 178 msgstr "" 179 179 180 #: ulanguages.slang_eo180 #: languages.slang_eo 181 181 msgid "Esperanto" 182 182 msgstr "" 183 183 184 #: ulanguages.slang_es184 #: languages.slang_es 185 185 msgid "Spanish" 186 186 msgstr "" 187 187 188 #: ulanguages.slang_et188 #: languages.slang_et 189 189 msgid "Estonian" 190 190 msgstr "" 191 191 192 #: ulanguages.slang_eu192 #: languages.slang_eu 193 193 msgid "Basque" 194 194 msgstr "" 195 195 196 #: ulanguages.slang_fa196 #: languages.slang_fa 197 197 msgid "Persian" 198 198 msgstr "" 199 199 200 #: ulanguages.slang_ff200 #: languages.slang_ff 201 201 msgid "Fulah" 202 202 msgstr "" 203 203 204 #: ulanguages.slang_fi204 #: languages.slang_fi 205 205 msgid "Finnish" 206 206 msgstr "" 207 207 208 #: ulanguages.slang_fj208 #: languages.slang_fj 209 209 msgid "Fijian" 210 210 msgstr "" 211 211 212 #: ulanguages.slang_fo212 #: languages.slang_fo 213 213 msgid "Faroese" 214 214 msgstr "" 215 215 216 #: ulanguages.slang_fr216 #: languages.slang_fr 217 217 msgid "French" 218 218 msgstr "" 219 219 220 #: ulanguages.slang_fr_be221 msgctxt " ulanguages.slang_fr_be"220 #: languages.slang_fr_be 221 msgctxt "languages.slang_fr_be" 222 222 msgid "Walloon" 223 223 msgstr "" 224 224 225 #: ulanguages.slang_fy225 #: languages.slang_fy 226 226 msgid "Frisian" 227 227 msgstr "" 228 228 229 #: ulanguages.slang_ga229 #: languages.slang_ga 230 230 msgid "Irish" 231 231 msgstr "" 232 232 233 #: ulanguages.slang_gd233 #: languages.slang_gd 234 234 msgid "Gaelic" 235 235 msgstr "" 236 236 237 #: ulanguages.slang_gl237 #: languages.slang_gl 238 238 msgid "Gallegan" 239 239 msgstr "" 240 240 241 #: ulanguages.slang_gn241 #: languages.slang_gn 242 242 msgid "Guarani" 243 243 msgstr "" 244 244 245 #: ulanguages.slang_gu245 #: languages.slang_gu 246 246 msgid "Gujarati" 247 247 msgstr "" 248 248 249 #: ulanguages.slang_gv249 #: languages.slang_gv 250 250 msgid "Manx" 251 251 msgstr "" 252 252 253 #: ulanguages.slang_ha253 #: languages.slang_ha 254 254 msgid "Hausa" 255 255 msgstr "" 256 256 257 #: ulanguages.slang_he257 #: languages.slang_he 258 258 msgid "Hebrew" 259 259 msgstr "" 260 260 261 #: ulanguages.slang_hi261 #: languages.slang_hi 262 262 msgid "Hindi" 263 263 msgstr "" 264 264 265 #: ulanguages.slang_ho265 #: languages.slang_ho 266 266 msgid "Hiri Motu" 267 267 msgstr "" 268 268 269 #: ulanguages.slang_hr269 #: languages.slang_hr 270 270 msgid "Croatian" 271 271 msgstr "" 272 272 273 #: ulanguages.slang_ht273 #: languages.slang_ht 274 274 msgid "Haitian" 275 275 msgstr "" 276 276 277 #: ulanguages.slang_hu277 #: languages.slang_hu 278 278 msgid "Hungarian" 279 279 msgstr "" 280 280 281 #: ulanguages.slang_hy281 #: languages.slang_hy 282 282 msgid "Armenian" 283 283 msgstr "" 284 284 285 #: ulanguages.slang_hz285 #: languages.slang_hz 286 286 msgid "Herero" 287 287 msgstr "" 288 288 289 #: ulanguages.slang_ia289 #: languages.slang_ia 290 290 msgid "Interlingua" 291 291 msgstr "" 292 292 293 #: ulanguages.slang_id293 #: languages.slang_id 294 294 msgid "Indonesian" 295 295 msgstr "" 296 296 297 #: ulanguages.slang_ie297 #: languages.slang_ie 298 298 msgid "Interlingue" 299 299 msgstr "" 300 300 301 #: ulanguages.slang_ig301 #: languages.slang_ig 302 302 msgid "Igbo" 303 303 msgstr "" 304 304 305 #: ulanguages.slang_ii305 #: languages.slang_ii 306 306 msgid "Sichuan Yi" 307 307 msgstr "" 308 308 309 #: ulanguages.slang_ik309 #: languages.slang_ik 310 310 msgid "Inupiaq" 311 311 msgstr "" 312 312 313 #: ulanguages.slang_io313 #: languages.slang_io 314 314 msgid "Ido" 315 315 msgstr "" 316 316 317 #: ulanguages.slang_is317 #: languages.slang_is 318 318 msgid "Icelandic" 319 319 msgstr "" 320 320 321 #: ulanguages.slang_it321 #: languages.slang_it 322 322 msgid "Italian" 323 323 msgstr "" 324 324 325 #: ulanguages.slang_iu325 #: languages.slang_iu 326 326 msgid "Inuktitut" 327 327 msgstr "" 328 328 329 #: ulanguages.slang_ja329 #: languages.slang_ja 330 330 msgid "Japanese" 331 331 msgstr "" 332 332 333 #: ulanguages.slang_jv333 #: languages.slang_jv 334 334 msgid "Javanese" 335 335 msgstr "" 336 336 337 #: ulanguages.slang_ka337 #: languages.slang_ka 338 338 msgid "Georgian" 339 339 msgstr "" 340 340 341 #: ulanguages.slang_kg341 #: languages.slang_kg 342 342 msgid "Kongo" 343 343 msgstr "" 344 344 345 #: ulanguages.slang_ki345 #: languages.slang_ki 346 346 msgid "Kikuyu" 347 347 msgstr "" 348 348 349 #: ulanguages.slang_kj349 #: languages.slang_kj 350 350 msgid "Kuanyama" 351 351 msgstr "" 352 352 353 #: ulanguages.slang_kk353 #: languages.slang_kk 354 354 msgid "Kazakh" 355 355 msgstr "" 356 356 357 #: ulanguages.slang_kl357 #: languages.slang_kl 358 358 msgid "Greenlandic" 359 359 msgstr "" 360 360 361 #: ulanguages.slang_km361 #: languages.slang_km 362 362 msgid "Khmer" 363 363 msgstr "" 364 364 365 #: ulanguages.slang_kn365 #: languages.slang_kn 366 366 msgid "Kannada" 367 367 msgstr "" 368 368 369 #: ulanguages.slang_ko369 #: languages.slang_ko 370 370 msgid "Korean" 371 371 msgstr "" 372 372 373 #: ulanguages.slang_kr373 #: languages.slang_kr 374 374 msgid "Kanuri" 375 375 msgstr "" 376 376 377 #: ulanguages.slang_ks377 #: languages.slang_ks 378 378 msgid "Kashmiri" 379 379 msgstr "" 380 380 381 #: ulanguages.slang_ku381 #: languages.slang_ku 382 382 msgid "Kurdish" 383 383 msgstr "" 384 384 385 #: ulanguages.slang_kv385 #: languages.slang_kv 386 386 msgid "Komi" 387 387 msgstr "" 388 388 389 #: ulanguages.slang_kw389 #: languages.slang_kw 390 390 msgid "Cornish" 391 391 msgstr "" 392 392 393 #: ulanguages.slang_ky393 #: languages.slang_ky 394 394 msgid "Kirghiz" 395 395 msgstr "" 396 396 397 #: ulanguages.slang_la397 #: languages.slang_la 398 398 msgid "Latin" 399 399 msgstr "" 400 400 401 #: ulanguages.slang_lb401 #: languages.slang_lb 402 402 msgid "Luxembourgish" 403 403 msgstr "" 404 404 405 #: ulanguages.slang_lg405 #: languages.slang_lg 406 406 msgid "Ganda" 407 407 msgstr "" 408 408 409 #: ulanguages.slang_li409 #: languages.slang_li 410 410 msgid "Limburgan" 411 411 msgstr "" 412 412 413 #: ulanguages.slang_ln413 #: languages.slang_ln 414 414 msgid "Lingala" 415 415 msgstr "" 416 416 417 #: ulanguages.slang_lo417 #: languages.slang_lo 418 418 msgid "Lao" 419 419 msgstr "" 420 420 421 #: ulanguages.slang_lt421 #: languages.slang_lt 422 422 msgid "Lithuanian" 423 423 msgstr "" 424 424 425 #: ulanguages.slang_lu425 #: languages.slang_lu 426 426 msgid "Luba-Katanga" 427 427 msgstr "" 428 428 429 #: ulanguages.slang_lv429 #: languages.slang_lv 430 430 msgid "Latvian" 431 431 msgstr "" 432 432 433 #: ulanguages.slang_mg433 #: languages.slang_mg 434 434 msgid "Malagasy" 435 435 msgstr "" 436 436 437 #: ulanguages.slang_mh437 #: languages.slang_mh 438 438 msgid "Marshallese" 439 439 msgstr "" 440 440 441 #: ulanguages.slang_mi441 #: languages.slang_mi 442 442 msgid "Maori" 443 443 msgstr "" 444 444 445 #: ulanguages.slang_mk445 #: languages.slang_mk 446 446 msgid "Macedonian" 447 447 msgstr "" 448 448 449 #: ulanguages.slang_ml449 #: languages.slang_ml 450 450 msgid "Malayalam" 451 451 msgstr "" 452 452 453 #: ulanguages.slang_mn453 #: languages.slang_mn 454 454 msgid "Mongolian" 455 455 msgstr "" 456 456 457 #: ulanguages.slang_mo457 #: languages.slang_mo 458 458 msgid "Moldavian" 459 459 msgstr "" 460 460 461 #: ulanguages.slang_mr461 #: languages.slang_mr 462 462 msgid "Marathi" 463 463 msgstr "" 464 464 465 #: ulanguages.slang_ms465 #: languages.slang_ms 466 466 msgid "Malay" 467 467 msgstr "" 468 468 469 #: ulanguages.slang_mt469 #: languages.slang_mt 470 470 msgid "Maltese" 471 471 msgstr "" 472 472 473 #: ulanguages.slang_my473 #: languages.slang_my 474 474 msgid "Burmese" 475 475 msgstr "" 476 476 477 #: ulanguages.slang_na477 #: languages.slang_na 478 478 msgid "Nauru" 479 479 msgstr "" 480 480 481 #: ulanguages.slang_nb481 #: languages.slang_nb 482 482 msgid "Norwegian Bokmaal" 483 483 msgstr "" 484 484 485 #: ulanguages.slang_nd485 #: languages.slang_nd 486 486 msgid "Ndebele, North" 487 487 msgstr "" 488 488 489 #: ulanguages.slang_ne489 #: languages.slang_ne 490 490 msgid "Nepali" 491 491 msgstr "" 492 492 493 #: ulanguages.slang_ng493 #: languages.slang_ng 494 494 msgid "Ndonga" 495 495 msgstr "" 496 496 497 #: ulanguages.slang_nl497 #: languages.slang_nl 498 498 msgid "Dutch" 499 499 msgstr "" 500 500 501 #: ulanguages.slang_nl_be501 #: languages.slang_nl_be 502 502 msgid "Flemish" 503 503 msgstr "" 504 504 505 #: ulanguages.slang_nn505 #: languages.slang_nn 506 506 msgid "Norwegian Nynorsk" 507 507 msgstr "" 508 508 509 #: ulanguages.slang_no509 #: languages.slang_no 510 510 msgid "Norwegian" 511 511 msgstr "" 512 512 513 #: ulanguages.slang_nr513 #: languages.slang_nr 514 514 msgid "Ndebele, South" 515 515 msgstr "" 516 516 517 #: ulanguages.slang_nv517 #: languages.slang_nv 518 518 msgid "Navajo" 519 519 msgstr "" 520 520 521 #: ulanguages.slang_ny521 #: languages.slang_ny 522 522 msgid "Chichewa" 523 523 msgstr "" 524 524 525 #: ulanguages.slang_oc525 #: languages.slang_oc 526 526 msgid "Occitan" 527 527 msgstr "" 528 528 529 #: ulanguages.slang_oj529 #: languages.slang_oj 530 530 msgid "Ojibwa" 531 531 msgstr "" 532 532 533 #: ulanguages.slang_om533 #: languages.slang_om 534 534 msgid "Oromo" 535 535 msgstr "" 536 536 537 #: ulanguages.slang_or537 #: languages.slang_or 538 538 msgid "Oriya" 539 539 msgstr "" 540 540 541 #: ulanguages.slang_os541 #: languages.slang_os 542 542 msgid "Ossetian" 543 543 msgstr "" 544 544 545 #: ulanguages.slang_pa545 #: languages.slang_pa 546 546 msgid "Panjabi" 547 547 msgstr "" 548 548 549 #: ulanguages.slang_pi549 #: languages.slang_pi 550 550 msgid "Pali" 551 551 msgstr "" 552 552 553 #: ulanguages.slang_pl553 #: languages.slang_pl 554 554 msgid "Polish" 555 555 msgstr "" 556 556 557 #: ulanguages.slang_ps557 #: languages.slang_ps 558 558 msgid "Pushto" 559 559 msgstr "" 560 560 561 #: ulanguages.slang_pt561 #: languages.slang_pt 562 562 msgid "Portuguese" 563 563 msgstr "" 564 564 565 #: ulanguages.slang_pt_br565 #: languages.slang_pt_br 566 566 msgid "Brazilian Portuguese" 567 567 msgstr "" 568 568 569 #: ulanguages.slang_qu569 #: languages.slang_qu 570 570 msgid "Quechua" 571 571 msgstr "" 572 572 573 #: ulanguages.slang_rm573 #: languages.slang_rm 574 574 msgid "Raeto-Romance" 575 575 msgstr "" 576 576 577 #: ulanguages.slang_rn577 #: languages.slang_rn 578 578 msgid "Rundi" 579 579 msgstr "" 580 580 581 #: ulanguages.slang_ro581 #: languages.slang_ro 582 582 msgid "Romanian" 583 583 msgstr "" 584 584 585 #: ulanguages.slang_ru585 #: languages.slang_ru 586 586 msgid "Russian" 587 587 msgstr "" 588 588 589 #: ulanguages.slang_rw589 #: languages.slang_rw 590 590 msgid "Kinyarwanda" 591 591 msgstr "" 592 592 593 #: ulanguages.slang_sa593 #: languages.slang_sa 594 594 msgid "Sanskrit" 595 595 msgstr "" 596 596 597 #: ulanguages.slang_sc597 #: languages.slang_sc 598 598 msgid "Sardinian" 599 599 msgstr "" 600 600 601 #: ulanguages.slang_sd601 #: languages.slang_sd 602 602 msgid "Sindhi" 603 603 msgstr "" 604 604 605 #: ulanguages.slang_se605 #: languages.slang_se 606 606 msgid "Northern Sami" 607 607 msgstr "" 608 608 609 #: ulanguages.slang_sg609 #: languages.slang_sg 610 610 msgid "Sango" 611 611 msgstr "" 612 612 613 #: ulanguages.slang_si613 #: languages.slang_si 614 614 msgid "Sinhalese" 615 615 msgstr "" 616 616 617 #: ulanguages.slang_sk617 #: languages.slang_sk 618 618 msgid "Slovak" 619 619 msgstr "" 620 620 621 #: ulanguages.slang_sl621 #: languages.slang_sl 622 622 msgid "Slovenian" 623 623 msgstr "" 624 624 625 #: ulanguages.slang_sm625 #: languages.slang_sm 626 626 msgid "Samoan" 627 627 msgstr "" 628 628 629 #: ulanguages.slang_sn629 #: languages.slang_sn 630 630 msgid "Shona" 631 631 msgstr "" 632 632 633 #: ulanguages.slang_so633 #: languages.slang_so 634 634 msgid "Somali" 635 635 msgstr "" 636 636 637 #: ulanguages.slang_sq637 #: languages.slang_sq 638 638 msgid "Albanian" 639 639 msgstr "" 640 640 641 #: ulanguages.slang_sr641 #: languages.slang_sr 642 642 msgid "Serbian" 643 643 msgstr "" 644 644 645 #: ulanguages.slang_ss645 #: languages.slang_ss 646 646 msgid "Swati" 647 647 msgstr "" 648 648 649 #: ulanguages.slang_st649 #: languages.slang_st 650 650 msgid "Sotho, Southern" 651 651 msgstr "" 652 652 653 #: ulanguages.slang_su653 #: languages.slang_su 654 654 msgid "Sundanese" 655 655 msgstr "" 656 656 657 #: ulanguages.slang_sv657 #: languages.slang_sv 658 658 msgid "Swedish" 659 659 msgstr "" 660 660 661 #: ulanguages.slang_sw661 #: languages.slang_sw 662 662 msgid "Swahili" 663 663 msgstr "" 664 664 665 #: ulanguages.slang_ta665 #: languages.slang_ta 666 666 msgid "Tamil" 667 667 msgstr "" 668 668 669 #: ulanguages.slang_te669 #: languages.slang_te 670 670 msgid "Telugu" 671 671 msgstr "" 672 672 673 #: ulanguages.slang_tg673 #: languages.slang_tg 674 674 msgid "Tajik" 675 675 msgstr "" 676 676 677 #: ulanguages.slang_th677 #: languages.slang_th 678 678 msgid "Thai" 679 679 msgstr "" 680 680 681 #: ulanguages.slang_ti681 #: languages.slang_ti 682 682 msgid "Tigrinya" 683 683 msgstr "" 684 684 685 #: ulanguages.slang_tk685 #: languages.slang_tk 686 686 msgid "Turkmen" 687 687 msgstr "" 688 688 689 #: ulanguages.slang_tl689 #: languages.slang_tl 690 690 msgid "Tagalog" 691 691 msgstr "" 692 692 693 #: ulanguages.slang_tn693 #: languages.slang_tn 694 694 msgid "Tswana" 695 695 msgstr "" 696 696 697 #: ulanguages.slang_to697 #: languages.slang_to 698 698 msgid "Tonga" 699 699 msgstr "" 700 700 701 #: ulanguages.slang_tr701 #: languages.slang_tr 702 702 msgid "Turkish" 703 703 msgstr "" 704 704 705 #: ulanguages.slang_ts705 #: languages.slang_ts 706 706 msgid "Tsonga" 707 707 msgstr "" 708 708 709 #: ulanguages.slang_tt709 #: languages.slang_tt 710 710 msgid "Tatar" 711 711 msgstr "" 712 712 713 #: ulanguages.slang_tw713 #: languages.slang_tw 714 714 msgid "Twi" 715 715 msgstr "" 716 716 717 #: ulanguages.slang_ty717 #: languages.slang_ty 718 718 msgid "Tahitian" 719 719 msgstr "" 720 720 721 #: ulanguages.slang_ug721 #: languages.slang_ug 722 722 msgid "Uighur" 723 723 msgstr "" 724 724 725 #: ulanguages.slang_uk725 #: languages.slang_uk 726 726 msgid "Ukrainian" 727 727 msgstr "" 728 728 729 #: ulanguages.slang_ur729 #: languages.slang_ur 730 730 msgid "Urdu" 731 731 msgstr "" 732 732 733 #: ulanguages.slang_uz733 #: languages.slang_uz 734 734 msgid "Uzbek" 735 735 msgstr "" 736 736 737 #: ulanguages.slang_ve737 #: languages.slang_ve 738 738 msgid "Venda" 739 739 msgstr "" 740 740 741 #: ulanguages.slang_vi741 #: languages.slang_vi 742 742 msgid "Vietnamese" 743 743 msgstr "" 744 744 745 #: ulanguages.slang_vo745 #: languages.slang_vo 746 746 msgid "Volapuk" 747 747 msgstr "" 748 748 749 #: ulanguages.slang_wa750 msgctxt " ulanguages.slang_wa"749 #: languages.slang_wa 750 msgctxt "languages.slang_wa" 751 751 msgid "Walloon" 752 752 msgstr "" 753 753 754 #: ulanguages.slang_wo754 #: languages.slang_wo 755 755 msgid "Wolof" 756 756 msgstr "" 757 757 758 #: ulanguages.slang_xh758 #: languages.slang_xh 759 759 msgid "Xhosa" 760 760 msgstr "" 761 761 762 #: ulanguages.slang_yi762 #: languages.slang_yi 763 763 msgid "Yiddish" 764 764 msgstr "" 765 765 766 #: ulanguages.slang_yo766 #: languages.slang_yo 767 767 msgid "Yoruba" 768 768 msgstr "" 769 769 770 #: ulanguages.slang_za770 #: languages.slang_za 771 771 msgid "Zhuang" 772 772 msgstr "" 773 773 774 #: ulanguages.slang_zh774 #: languages.slang_zh 775 775 msgid "Chinese" 776 776 msgstr "" 777 777 778 #: ulanguages.slang_zu 778 #: languages.slang_zh_hans 779 msgid "Simplified Chinese" 780 msgstr "" 781 782 #: languages.slang_zh_hant 783 msgid "Traditional Chinese" 784 msgstr "" 785 786 #: languages.slang_zu 779 787 msgid "Zulu" 780 788 msgstr "" -
branches/highdpi/Packages/Common/Languages/Pool.cs.po
r462 r463 10 10 "Content-Transfer-Encoding: 8bit\n" 11 11 12 #: upool.sobjectpoolempty 12 #: pool.sobjectpoolempty 13 #, fuzzy 14 msgctxt "pool.sobjectpoolempty" 13 15 msgid "Object pool is empty" 14 16 msgstr "Zásobník objektů je prázdný" 15 17 16 #: upool.sreleaseerror 18 #: pool.sreleaseerror 19 #, fuzzy 20 msgctxt "pool.sreleaseerror" 17 21 msgid "Unknown object for release from pool" 18 22 msgstr "Neznýmý objekt pro uvolnění ze zásobníku" -
branches/highdpi/Packages/Common/Languages/Pool.pot
r462 r463 2 2 msgstr "Content-Type: text/plain; charset=UTF-8" 3 3 4 #: upool.sobjectpoolempty4 #: pool.sobjectpoolempty 5 5 msgid "Object pool is empty" 6 msgstr " Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8"6 msgstr "" 7 7 8 #: upool.sreleaseerror8 #: pool.sreleaseerror 9 9 msgid "Unknown object for release from pool" 10 10 msgstr "" -
branches/highdpi/Packages/Common/Languages/ResetableThread.cs.po
r462 r463 10 10 "Content-Transfer-Encoding: 8bit\n" 11 11 12 #: uresetablethread.swaiterror 12 #: resetablethread.swaiterror 13 #, fuzzy 14 msgctxt "resetablethread.swaiterror" 13 15 msgid "WaitFor error" 14 16 msgstr "Chyba WaitFor" -
branches/highdpi/Packages/Common/Languages/ResetableThread.pot
r462 r463 2 2 msgstr "Content-Type: text/plain; charset=UTF-8" 3 3 4 #: uresetablethread.swaiterror4 #: resetablethread.swaiterror 5 5 msgid "WaitFor error" 6 msgstr " Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8"6 msgstr "" 7 7 -
branches/highdpi/Packages/Common/Languages/ScaleDPI.cs.po
r462 r463 12 12 "X-Generator: Poedit 1.8.9\n" 13 13 14 #: uscaledpi.swrongdpi 14 #: scaledpi.swrongdpi 15 #, object-pascal-format, fuzzy 16 msgctxt "scaledpi.swrongdpi" 15 17 msgid "Wrong DPI [%d,%d]" 16 18 msgstr "Chybné DPI [%d,%d]" -
branches/highdpi/Packages/Common/Languages/ScaleDPI.pot
r462 r463 2 2 msgstr "Content-Type: text/plain; charset=UTF-8" 3 3 4 #: uscaledpi.swrongdpi 4 #: scaledpi.swrongdpi 5 #, object-pascal-format 5 6 msgid "Wrong DPI [%d,%d]" 6 7 msgstr "" -
branches/highdpi/Packages/Common/Languages/Threading.cs.po
r462 r463 10 10 "Content-Transfer-Encoding: 8bit\n" 11 11 12 #: uthreading.scurrentthreadnotfound 12 #: threading.scurrentthreadnotfound 13 #, object-pascal-format, fuzzy 14 msgctxt "threading.scurrentthreadnotfound" 13 15 msgid "Current thread ID %d not found in virtual thread list." 14 16 msgstr "Aktuální vlákno ID %d nenalezeno v seznamu virtuálních vláken." -
branches/highdpi/Packages/Common/Languages/Threading.pot
r462 r463 2 2 msgstr "Content-Type: text/plain; charset=UTF-8" 3 3 4 #: uthreading.scurrentthreadnotfound5 #, fuzzy,badformat4 #: threading.scurrentthreadnotfound 5 #, object-pascal-format 6 6 msgid "Current thread ID %d not found in virtual thread list." 7 msgstr " Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8"7 msgstr "" 8 8 -
branches/highdpi/Packages/Common/LastOpenedList.pas
r462 r463 1 unit ULastOpenedList; 2 3 {$mode delphi} 1 unit LastOpenedList; 4 2 5 3 interface 6 4 7 5 uses 8 UDpiControls, Classes, SysUtils, Registry, URegistry, Menus, XMLConf, DOM;6 UDpiControls, Classes, SysUtils, Registry, RegistryEx, Menus, XMLConf, DOM; 9 7 10 8 type … … 84 82 destructor TLastOpenedList.Destroy; 85 83 begin 86 Items.Free;84 FreeAndNil(Items); 87 85 inherited; 88 86 end; … … 94 92 begin 95 93 if Assigned(MenuItem) then begin 96 MenuItem.Clear; 94 while MenuItem.Count > Items.Count do 95 MenuItem.Delete(MenuItem.Count - 1); 96 while MenuItem.Count < Items.Count do begin 97 NewMenuItem := TDpiMenuItem.Create(MenuItem); 98 MenuItem.Add(NewMenuItem); 99 end; 97 100 for I := 0 to Items.Count - 1 do begin 98 NewMenuItem := TDpiMenuItem.Create(MenuItem); 99 NewMenuItem.Caption := Items[I]; 100 NewMenuItem.OnClick := ClickAction; 101 MenuItem.Add(NewMenuItem); 101 MenuItem.Items[I].Caption := Items[I]; 102 MenuItem.Items[I].OnClick := ClickAction; 102 103 end; 103 104 end; … … 193 194 194 195 end. 195 -
branches/highdpi/Packages/Common/ListViewSort.pas
r462 r463 1 unit UListViewSort;1 unit ListViewSort; 2 2 3 3 // Date: 2019-05-17 4 5 {$mode delphi}6 4 7 5 interface … … 9 7 uses 10 8 UDpiControls, {$IFDEF Windows}Windows, CommCtrl, LMessages, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils, 11 Controls, DateUtils, Dialogs, fgl,Forms, Grids, StdCtrls, ExtCtrls,12 LclIntf, LclType, LResources ;9 Controls, DateUtils, Dialogs, Forms, Grids, StdCtrls, ExtCtrls, 10 LclIntf, LclType, LResources, Generics.Collections, Generics.Defaults; 13 11 14 12 type … … 19 17 TCompareEvent = function (Item1, Item2: TObject): Integer of object; 20 18 TListFilterEvent = procedure (ListViewSort: TListViewSort) of object; 19 20 TObjects = TObjectList<TObject>; 21 21 22 22 { TListViewSort } … … 27 27 FOnCompareItem: TCompareEvent; 28 28 FOnFilter: TListFilterEvent; 29 FOnCustomDraw: T LVCustomDrawItemEvent;29 FOnCustomDraw: TDpiLVCustomDrawItemEvent; 30 30 {$IFDEF Windows}FHeaderHandle: HWND;{$ENDIF} 31 31 FColumn: Integer; … … 42 42 procedure GetCheckBias(var XBias, YBias, BiasTop, BiasLeft: Integer; 43 43 const ListView: TDpiListView); 44 procedure ListViewCustomDrawItem(Sender: T CustomListView;44 procedure ListViewCustomDrawItem(Sender: TDpiCustomListView; 45 45 Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); 46 46 procedure ListViewClick(Sender: TObject); … … 52 52 {$ENDIF} 53 53 public 54 List: TFPGObjectList<TObject>;55 Source: TFPGObjectList<TObject>;54 Source: TObjects; 55 List: TObjects; 56 56 constructor Create(AOwner: TComponent); override; 57 57 destructor Destroy; override; … … 67 67 property OnFilter: TListFilterEvent read FOnFilter 68 68 write FOnFilter; 69 property OnCustomDraw: T LVCustomDrawItemEvent read FOnCustomDraw69 property OnCustomDraw: TDpiLVCustomDrawItemEvent read FOnCustomDraw 70 70 write FOnCustomDraw; 71 71 property OnColumnWidthChanged: TNotifyEvent read FOnColumnWidthChanged … … 81 81 FOnChange: TNotifyEvent; 82 82 FStringGrid1: TDpiStringGrid; 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: TDpiStringGrid read FStringGrid1 write FStringGrid1; 93 95 published … … 147 149 destructor TListViewEx.Destroy; 148 150 begin 149 inherited Destroy;151 inherited; 150 152 end; 151 153 152 154 { TListViewFilter } 155 156 procedure TListViewFilter.DoOnChange; 157 begin 158 if Assigned(FOnChange) then FOnChange(Self); 159 end; 153 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 … … 229 235 end; 230 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; 245 end; 246 231 247 { TListViewSort } 232 248 … … 322 338 ListViewSortCompare: TCompareEvent; 323 339 324 function ListViewCompare(const Item1, Item2: TObject): Integer;340 function ListViewCompare(constref Item1, Item2: TObject): Integer; 325 341 begin 326 342 Result := ListViewSortCompare(Item1, Item2); … … 333 349 ListViewSortCompare := Compare; 334 350 if (List.Count > 0) then 335 List.Sort( ListViewCompare);351 List.Sort(TComparer<TObject>.Construct(ListViewCompare)); 336 352 end; 337 353 … … 339 355 begin 340 356 if Assigned(FOnFilter) then FOnFilter(Self) 341 else if Assigned(Source) then 342 List.Assign(Source) else 357 else if Assigned(Source) then begin 343 358 List.Clear; 359 List.AddRange(Source); 360 end else List.Clear; 344 361 if ListView.Items.Count <> List.Count then 345 362 ListView.Items.Count := List.Count; … … 396 413 begin 397 414 inherited; 398 List := T FPGObjectList<TObject>.Create;399 List. FreeObjects := False;415 List := TObjects.Create; 416 List.OwnsObjects := False; 400 417 end; 401 418 402 419 destructor TListViewSort.Destroy; 403 420 begin 404 List.Free;421 FreeAndNil(List); 405 422 inherited; 406 423 end; … … 491 508 end; 492 509 493 procedure TListViewSort.ListViewCustomDrawItem(Sender: T CustomListView;510 procedure TListViewSort.ListViewCustomDrawItem(Sender: TDpiCustomListView; 494 511 Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); 495 512 begin -
branches/highdpi/Packages/Common/Memory.pas
r462 r463 1 unit UMemory; 2 3 {$mode Delphi}{$H+} 1 unit Memory; 4 2 5 3 interface … … 44 42 end; 45 43 44 46 45 implementation 47 46 … … 50 49 procedure TPositionMemory.SetSize(AValue: Integer); 51 50 begin 52 inherited SetSize(AValue);51 inherited; 53 52 if FPosition > FSize then FPosition := FSize; 54 53 end; … … 107 106 begin 108 107 Size := 0; 109 inherited Destroy;108 inherited; 110 109 end; 111 110 … … 121 120 122 121 end. 123 -
branches/highdpi/Packages/Common/PersistentForm.pas
r462 r463 1 unit UPersistentForm; 2 3 {$mode delphi} 4 5 // Date: 2020-11-26 1 unit PersistentForm; 6 2 7 3 interface 8 4 9 5 uses 10 UDpiControls, Classes, SysUtils, Forms, URegistry, LCLIntf, Registry, Controls, ComCtrls,6 UDpiControls, Classes, SysUtils, Forms, RegistryEx, LCLIntf, Registry, Controls, ComCtrls, 11 7 ExtCtrls, LCLType; 12 8 … … 23 19 procedure SaveControl(Control: TDpiControl); 24 20 public 25 FormNormalSize: TRect;26 21 FormRestoredSize: TRect; 27 22 FormWindowState: TWindowState; … … 157 152 RootKey := RegistryContext.RootKey; 158 153 OpenKey(RegistryContext.Key + '\Forms\' + Form.Name, True); 159 // Normal size 160 FormNormalSize.Left := ReadIntegerWithDefault('NormalLeft', FormNormalSize.Left); 161 FormNormalSize.Top := ReadIntegerWithDefault('NormalTop', FormNormalSize.Top); 162 FormNormalSize.Right := ReadIntegerWithDefault('NormalWidth', FormNormalSize.Right - FormNormalSize.Left) 163 + FormNormalSize.Left; 164 FormNormalSize.Bottom := ReadIntegerWithDefault('NormalHeight', FormNormalSize.Bottom - FormNormalSize.Top) 165 + FormNormalSize.Top; 154 166 155 // Restored size 167 156 FormRestoredSize.Left := ReadIntegerWithDefault('RestoredLeft', FormRestoredSize.Left); … … 171 160 FormRestoredSize.Bottom := ReadIntegerWithDefault('RestoredHeight', FormRestoredSize.Bottom - FormRestoredSize.Top) 172 161 + FormRestoredSize.Top; 162 173 163 // Other state 174 164 FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(FormWindowState))); … … 185 175 RootKey := RegistryContext.RootKey; 186 176 OpenKey(RegistryContext.Key + '\Forms\' + Form.Name, True); 187 // Normal state 188 WriteInteger('NormalWidth', FormNormalSize.Right - FormNormalSize.Left); 189 WriteInteger('NormalHeight', FormNormalSize.Bottom - FormNormalSize.Top); 190 WriteInteger('NormalTop', FormNormalSize.Top); 191 WriteInteger('NormalLeft', FormNormalSize.Left); 192 // Restored state 177 178 // Restored size 193 179 WriteInteger('RestoredWidth', FormRestoredSize.Right - FormRestoredSize.Left); 194 180 WriteInteger('RestoredHeight', FormRestoredSize.Bottom - FormRestoredSize.Top); 195 181 WriteInteger('RestoredTop', FormRestoredSize.Top); 196 182 WriteInteger('RestoredLeft', FormRestoredSize.Left); 183 197 184 // Other state 198 185 WriteInteger('WindowState', Integer(FormWindowState)); … … 259 246 begin 260 247 Self.Form := Form; 248 261 249 // Set default 262 FormNormalSize := Bounds((DpiScreen.Width - Form.Width) div 2,263 (DpiScreen.Height - Form.Height) div 2, Form.Width, Form.Height);264 250 FormRestoredSize := Bounds((DpiScreen.Width - Form.Width) div 2, 265 251 (DpiScreen.Height - Form.Height) div 2, Form.Width, Form.Height); … … 269 255 LoadFromRegistry(RegistryContext); 270 256 271 if not EqualRect(FormNormalSize, FormRestoredSize) or 272 DefaultMaximized then begin 257 if (FormWindowState = wsMaximized) or DefaultMaximized then begin 273 258 // Restore to maximized state 274 259 Form.WindowState := wsNormal; … … 279 264 // Restore to normal state 280 265 Form.WindowState := wsNormal; 281 if FEntireVisible then Form NormalSize := CheckEntireVisible(FormNormalSize)266 if FEntireVisible then FormRestoredSize := CheckEntireVisible(FormRestoredSize) 282 267 else if FMinVisiblePart > 0 then 283 FormNormalSize := CheckPartVisible(FormNormalSize, FMinVisiblePart);284 if not EqualRect(Form NormalSize, Form.BoundsRect) then285 Form.BoundsRect := Form NormalSize;268 FormRestoredSize := CheckPartVisible(FormRestoredSize, FMinVisiblePart); 269 if not EqualRect(FormRestoredSize, Form.BoundsRect) then 270 Form.BoundsRect := FormRestoredSize; 286 271 end; 287 272 if FormFullScreen then SetFullScreen(True); … … 292 277 begin 293 278 Self.Form := Form; 294 FormNormalSize := Bounds(Form.Left, Form.Top, Form.Width, Form.Height); 295 if not FormFullScreen then 296 FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth, 297 Form.RestoredHeight); 298 FormWindowState := Form.WindowState; 279 if not FormFullScreen then begin 280 FormWindowState := Form.WindowState; 281 if FormWindowState = wsMaximized then begin 282 FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth, 283 Form.RestoredHeight); 284 end else 285 if FormWindowState = wsNormal then begin 286 FormRestoredSize := Bounds(Form.Left, Form.Top, Form.Width, Form.Height); 287 end; 288 end; 299 289 SaveToRegistry(RegistryContext); 300 290 SaveControl(Form); … … 314 304 if State then begin 315 305 FormFullScreen := True; 316 FormNormalSize := Form.BoundsRect; 317 FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth, 318 Form.RestoredHeight); 306 if Form.WindowState = wsMaximized then begin 307 FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth, 308 Form.RestoredHeight); 309 end else 310 if Form.WindowState = wsNormal then begin 311 FormRestoredSize := Bounds(Form.Left, Form.Top, Form.Width, Form.Height); 312 end; 319 313 FormWindowState := Form.WindowState; 314 Form.WindowState := wsMaximized; 315 Form.WindowState := wsNormal; 320 316 ShowWindow(Form.Handle, SW_SHOWFULLSCREEN); 321 317 {$IFDEF WINDOWS} … … 329 325 ShowWindow(Form.Handle, SW_SHOWNORMAL); 330 326 if FormWindowState = wsNormal then begin 331 Form.BoundsRect := FormNormalSize; 327 Form.WindowState := wsNormal; 328 Form.BoundsRect := FormRestoredSize; 332 329 end else 333 330 if FormWindowState = wsMaximized then begin … … 339 336 340 337 end. 341 -
branches/highdpi/Packages/Common/PixelPointer.pas
r462 r463 1 unit UPixelPointer;1 unit PixelPointer; 2 2 3 3 interface … … 15 15 private 16 16 procedure SetRGB(AValue: Cardinal); 17 function GetRGB: Cardinal; 17 function GetRGB: Cardinal; 18 18 public 19 19 property RGB: Cardinal read GetRGB write SetRGB; … … 41 41 procedure SetXY(X, Y: Integer); inline; // Set pixel position relative to base 42 42 procedure SetX(X: Integer); inline; // Set horizontal pixel position relative to base 43 class function Create(Bitmap: TDpiRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; inline; static; 43 44 end; 44 45 PPixelPointer = ^TPixelPointer; 45 46 46 function PixelPointer(Bitmap: TDpiRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; inline;47 47 function SwapRedBlue(Color: TColor32): TColor32; 48 48 procedure BitmapCopyRect(DstBitmap: TDpiRasterImage; DstRect: TRect; SrcBitmap: TDpiRasterImage; SrcPos: TPoint); … … 60 60 function ColorToColor32(Color: TColor): TColor32; 61 61 62 62 63 implementation 63 64 … … 119 120 SrcBitmap.BeginUpdate(True); 120 121 DstBitmap.BeginUpdate(True); 121 SrcPtr := PixelPointer(SrcBitmap, SrcPos.X, SrcPos.Y);122 DstPtr := PixelPointer(DstBitmap, DstRect.Left, DstRect.Top);122 SrcPtr := TPixelPointer.Create(SrcBitmap, SrcPos.X, SrcPos.Y); 123 DstPtr := TPixelPointer.Create(DstBitmap, DstRect.Left, DstRect.Top); 123 124 for Y := 0 to DstRect.Height - 1 do begin 124 125 for X := 0 to DstRect.Width - 1 do begin … … 138 139 var 139 140 SrcPtr, DstPtr: TPixelPointer; 140 SubPtr: TPixelPointer;141 141 X, Y: Integer; 142 142 XX, YY: Integer; … … 150 150 SrcBitmap.BeginUpdate(True); 151 151 DstBitmap.BeginUpdate(True); 152 SrcPtr := PixelPointer(SrcBitmap, SrcRect.Left, SrcRect.Top);153 DstPtr := PixelPointer(DstBitmap, DstRect.Left, DstRect.Top);152 SrcPtr := TPixelPointer.Create(SrcBitmap, SrcRect.Left, SrcRect.Top); 153 DstPtr := TPixelPointer.Create(DstBitmap, DstRect.Left, DstRect.Top); 154 154 for Y := 0 to DstRect.Height - 1 do begin 155 155 for X := 0 to DstRect.Width - 1 do begin … … 181 181 begin 182 182 Bitmap.BeginUpdate(True); 183 Ptr := PixelPointer(Bitmap);183 Ptr := TPixelPointer.Create(Bitmap); 184 184 for Y := 0 to Bitmap.Height - 1 do begin 185 185 for X := 0 to Bitmap.Width - 1 do begin … … 198 198 begin 199 199 Bitmap.BeginUpdate(True); 200 Ptr := PixelPointer(Bitmap, Rect.Left, Rect.Top);200 Ptr := TPixelPointer.Create(Bitmap, Rect.Left, Rect.Top); 201 201 for Y := 0 to Rect.Height - 1 do begin 202 202 for X := 0 to Rect.Width - 1 do begin … … 215 215 begin 216 216 Bitmap.BeginUpdate(True); 217 Ptr := PixelPointer(Bitmap);217 Ptr := TPixelPointer.Create(Bitmap); 218 218 for Y := 0 to Bitmap.Height - 1 do begin 219 219 for X := 0 to Bitmap.Width - 1 do begin … … 232 232 begin 233 233 Bitmap.BeginUpdate(True); 234 Ptr := PixelPointer(Bitmap);234 Ptr := TPixelPointer.Create(Bitmap); 235 235 for Y := 0 to Bitmap.Height - 1 do begin 236 236 for X := 0 to Bitmap.Width - 1 do begin … … 252 252 Pixel := Color32ToPixel32(Color); 253 253 Bitmap.BeginUpdate(True); 254 Ptr := PixelPointer(Bitmap);254 Ptr := TPixelPointer.Create(Bitmap); 255 255 for Y := 0 to Bitmap.Height - 1 do begin 256 256 for X := 0 to Bitmap.Width - 1 do begin … … 295 295 end; 296 296 297 function PixelPointer(Bitmap: TDpiRasterImage; BaseX: Integer;297 class function TPixelPointer.Create(Bitmap: TDpiRasterImage; BaseX: Integer; 298 298 BaseY: Integer): TPixelPointer; 299 299 begin … … 310 310 end; 311 311 312 313 312 end. 314 -
branches/highdpi/Packages/Common/Pool.pas
r462 r463 1 unit UPool; 2 3 {$mode Delphi}{$H+} 1 unit Pool; 4 2 5 3 interface 6 4 7 5 uses 8 Classes, SysUtils, syncobjs, fgl, UThreading;6 Classes, SysUtils, syncobjs, Generics.Collections, Threading; 9 7 10 8 type … … 22 20 function NewItemObject: TObject; virtual; 23 21 public 24 Items: T FPGObjectList<TObject>;25 FreeItems: T FPGObjectList<TObject>;22 Items: TObjectList<TObject>; 23 FreeItems: TObjectList<TObject>; 26 24 function Acquire: TObject; virtual; 27 25 procedure Release(Item: TObject); virtual; … … 108 106 constructor TThreadedPool.Create; 109 107 begin 110 inherited Create;108 inherited; 111 109 Lock := TCriticalSection.Create; 112 110 end; … … 116 114 TotalCount := 0; 117 115 Lock.Free; 118 inherited Destroy;116 inherited; 119 117 end; 120 118 … … 185 183 begin 186 184 inherited; 187 Items := T FPGObjectList<TObject>.Create;188 FreeItems := T FPGObjectList<TObject>.Create;189 FreeItems. FreeObjects := False;185 Items := TObjectList<TObject>.Create; 186 FreeItems := TObjectList<TObject>.Create; 187 FreeItems.OwnsObjects := False; 190 188 FReleaseEvent := TEvent.Create(nil, False, False, ''); 191 189 end; … … 201 199 202 200 end. 203 -
branches/highdpi/Packages/Common/PrefixMultiplier.pas
r462 r463 1 unit UPrefixMultiplier;1 unit PrefixMultiplier; 2 2 3 3 // Date: 2010-06-01 4 5 {$mode delphi}6 4 7 5 interface … … 33 31 ( 34 32 (ShortText: 'y'; FullText: 'yocto'; Value: 1e-24), 35 33 (ShortText: 'z'; FullText: 'zepto'; Value: 1e-21), 36 34 (ShortText: 'a'; FullText: 'atto'; Value: 1e-18), 37 35 (ShortText: 'f'; FullText: 'femto'; Value: 1e-15), … … 54 52 ( 55 53 (ShortText: 'ys'; FullText: 'yocto'; Value: 1e-24), 56 54 (ShortText: 'zs'; FullText: 'zepto'; Value: 1e-21), 57 55 (ShortText: 'as'; FullText: 'atto'; Value: 1e-18), 58 56 (ShortText: 'fs'; FullText: 'femto'; Value: 1e-15), … … 126 124 127 125 end. 128 -
branches/highdpi/Packages/Common/RegistryEx.pas
r462 r463 1 unit URegistry; 2 3 {$MODE delphi} 1 unit RegistryEx; 4 2 5 3 interface … … 48 46 HKEY_CURRENT_CONFIG, HKEY_DYN_DATA); 49 47 48 50 49 implementation 51 52 50 53 51 { TRegistryContext } … … 132 130 function TRegistryEx.OpenKey(const Key: string; CanCreate: Boolean): Boolean; 133 131 begin 134 {$IFDEF Linux}132 {$IFDEF UNIX} 135 133 //CloseKey; 136 134 {$ENDIF} … … 140 138 function TRegistryEx.GetCurrentContext: TRegistryContext; 141 139 begin 142 Result.Key := CurrentPath;140 Result.Key := String(CurrentPath); 143 141 Result.RootKey := RootKey; 144 142 end; -
branches/highdpi/Packages/Common/ResetableThread.pas
r462 r463 1 unit UResetableThread; 2 3 {$mode Delphi}{$H+} 1 unit ResetableThread; 4 2 5 3 interface 6 4 7 5 uses 8 Classes, SysUtils, syncobjs, UThreading, UPool;6 Classes, SysUtils, syncobjs, Threading, Pool; 9 7 10 8 type … … 167 165 FreeAndNil(FStopEvent); 168 166 FreeAndNil(FLock); 169 inherited Destroy;167 inherited; 170 168 end; 171 169 … … 286 284 constructor TThreadPool.Create; 287 285 begin 288 inherited Create;286 inherited; 289 287 end; 290 288 … … 293 291 TotalCount := 0; 294 292 WaitForEmpty; 295 inherited Destroy;293 inherited; 296 294 end; 297 295 -
branches/highdpi/Packages/Common/ScaleDPI.pas
r462 r463 1 unit UScaleDPI;1 unit ScaleDPI; 2 2 3 3 { See: http://wiki.lazarus.freepascal.org/High_DPI } 4 4 5 {$mode delphi}{$H+}6 7 5 interface 8 6 9 7 uses 10 UDpiControls, Classes, Forms, Graphics, Controls, ComCtrls, LCLType, SysUtils, StdCtrls,11 Contnrs;8 UDpiControls, Classes, Forms, Graphics, Controls, ComCtrls, LCLType, SysUtils, 9 Generics.Collections; 12 10 13 11 type 12 TControlDimensions = class; 14 13 15 14 { TControlDimension } … … 18 17 BoundsRect: TRect; 19 18 FontHeight: Integer; 20 Controls: T ObjectList; // TList<TControlDimension>19 Controls: TControlDimensions; 21 20 // Class specifics 22 21 ButtonSize: TPoint; // TToolBar … … 26 25 constructor Create; 27 26 destructor Destroy; override; 27 end; 28 29 TControlDimensions = class(TObjectList<TControlDimension>) 28 30 end; 29 31 … … 73 75 constructor TControlDimension.Create; 74 76 begin 75 Controls := T ObjectList.Create;77 Controls := TControlDimensions.Create; 76 78 end; 77 79 … … 79 81 begin 80 82 FreeAndNil(Controls); 81 inherited Destroy;83 inherited; 82 84 end; 83 85 … … 212 214 TempBmp: TDpiBitmap; 213 215 Temp: array of TDpiBitmap; 214 NewWidth, NewHeight: integer; 216 NewWidth: Integer; 217 NewHeight: Integer; 215 218 I: Integer; 216 219 begin 217 220 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 := TDpiBitmap.Create; 225 TempBmp.PixelFormat := pf32bit; 226 ImgList.GetBitmap(I, TempBmp); 227 Temp[I] := TDpiBitmap.Create; 228 Temp[I].SetSize(NewWidth, NewHeight); 229 Temp[I].PixelFormat := pf32bit; 230 Temp[I].TransparentColor := TempBmp.TransparentColor; 231 //Temp[I].TransparentMode := TempBmp.TransparentMode; 232 Temp[I].Transparent := True; 233 Temp[I].Canvas.Brush.Style := bsSolid; 234 Temp[I].Canvas.Brush.Color := Temp[I].TransparentColor; 235 Temp[I].Canvas.FillRect(0, 0, Temp[I].Width, Temp[I].Height); 236 237 if (Temp[I].Width = 0) or (Temp[I].Height = 0) then Continue; 238 Temp[I].Canvas.StretchDraw(Rect(0, 0, Temp[I].Width, Temp[I].Height), TempBmp); 239 TempBmp.Free; 240 end; 241 242 ImgList.Clear; 243 ImgList.Width := NewWidth; 244 ImgList.Height := NewHeight; 245 246 for I := 0 to High(Temp) do 247 begin 248 ImgList.Add(Temp[I], nil); 249 Temp[i].Free; 250 end; 251 ImgList.EndUpdate; 221 try 222 NewWidth := ScaleX(ImgList.Width, FromDPI.X); 223 NewHeight := ScaleY(ImgList.Height, FromDPI.Y); 224 225 Temp := nil; 226 SetLength(Temp, ImgList.Count); 227 for I := 0 to ImgList.Count - 1 do 228 begin 229 TempBmp := TDpiBitmap.Create; 230 try 231 TempBmp.PixelFormat := pf32bit; 232 ImgList.GetBitmap(I, TempBmp); 233 Temp[I] := TDpiBitmap.Create; 234 Temp[I].SetSize(NewWidth, NewHeight); 235 {$IFDEF UNIX} 236 Temp[I].PixelFormat := pf24bit; 237 {$ELSE} 238 Temp[I].PixelFormat := pf32bit; 239 {$ENDIF} 240 Temp[I].TransparentColor := TempBmp.TransparentColor; 241 //Temp[I].TransparentMode := TempBmp.TransparentMode; 242 Temp[I].Transparent := True; 243 Temp[I].Canvas.Brush.Style := bsSolid; 244 Temp[I].Canvas.Brush.Color := Temp[I].TransparentColor; 245 Temp[I].Canvas.FillRect(0, 0, Temp[I].Width, Temp[I].Height); 246 247 if (Temp[I].Width = 0) or (Temp[I].Height = 0) then Continue; 248 Temp[I].Canvas.StretchDraw(Rect(0, 0, Temp[I].Width, Temp[I].Height), TempBmp); 249 finally 250 TempBmp.Free; 251 end; 252 end; 253 254 ImgList.Clear; 255 ImgList.Width := NewWidth; 256 ImgList.Height := NewHeight; 257 258 for I := 0 to High(Temp) do 259 begin 260 ImgList.Add(Temp[I], nil); 261 Temp[i].Free; 262 end; 263 finally 264 ImgList.EndUpdate; 265 end; 252 266 end; 253 267 … … 303 317 304 318 //if Control is TMemo then Exit; 305 //if Control is T DpiForm then319 //if Control is TForm then 306 320 // Control.DisableAutoSizing; 307 321 with Control do begin … … 327 341 with TDpiCoolBar(Control) do begin 328 342 BeginUpdate; 329 for I := 0 to Bands.Count - 1 do 330 with Bands[I] do begin 331 MinWidth := ScaleX(MinWidth, FromDPI.X); 332 MinHeight := ScaleY(MinHeight, FromDPI.Y); 333 // Workaround to bad band width auto sizing 334 //Width := ScaleX(Width, FromDPI.X); 335 Width := ScaleX(Control.Width + 28, FromDPI.X); 336 //Control.Invalidate; 343 try 344 for I := 0 to Bands.Count - 1 do 345 with Bands[I] do begin 346 MinWidth := ScaleX(MinWidth, FromDPI.X); 347 MinHeight := ScaleY(MinHeight, FromDPI.Y); 348 // Workaround to bad band width auto sizing 349 //Width := ScaleX(Width, FromDPI.X); 350 Width := ScaleX(Control.Width + 28, FromDPI.X); 351 //Control.Invalidate; 352 end; 353 // Workaround for bad autosizing of coolbar 354 if AutoSize then begin 355 AutoSize := False; 356 Height := ScaleY(Height, FromDPI.Y); 357 AutoSize := True; 337 358 end; 338 // Workaround for bad autosizing of coolbar 339 if AutoSize then begin 340 AutoSize := False; 341 Height := ScaleY(Height, FromDPI.Y); 342 AutoSize := True; 343 end; 344 EndUpdate; 359 finally 360 EndUpdate; 361 end; 345 362 end; 346 363 … … 353 370 end; 354 371 355 //if Control is T DpiForm then372 //if Control is TForm then 356 373 // Control.EnableAutoSizing; 357 374 end; -
branches/highdpi/Packages/Common/StopWatch.pas
r405 r463 5 5 6 6 uses 7 {$IFDEF W indows}Windows,{$ENDIF}7 {$IFDEF WINDOWS}Windows,{$ENDIF} 8 8 SysUtils, DateUtils; 9 9 … … 32 32 end; 33 33 34 34 35 implementation 35 36 … … 40 41 fIsRunning := False; 41 42 42 {$IFDEF W indows}43 {$IFDEF WINDOWS} 43 44 fIsHighResolution := QueryPerformanceFrequency(fFrequency) ; 44 45 {$ELSE} … … 92 93 93 94 end. 95 -
branches/highdpi/Packages/Common/StringTable.pas
r462 r463 1 unit UStringTable; 2 3 {$mode objfpc}{$H+} 1 unit StringTable; 4 2 5 3 interface … … 71 69 end; 72 70 73 74 71 end. 75 -
branches/highdpi/Packages/Common/SyncCounter.pas
r462 r463 1 unit USyncCounter; 2 3 {$mode delphi} 1 unit SyncCounter; 4 2 5 3 interface … … 25 23 procedure Assign(Source: TSyncCounter); 26 24 end; 25 27 26 28 27 implementation … … 69 68 begin 70 69 Lock.Free; 71 inherited Destroy;70 inherited; 72 71 end; 73 72 … … 79 78 80 79 end. 81 -
branches/highdpi/Packages/Common/Theme.pas
r462 r463 1 unit UTheme;1 unit Theme; 2 2 3 3 interface … … 5 5 uses 6 6 UDpiControls, Classes, SysUtils, Graphics, ComCtrls, Controls, ExtCtrls, Menus, StdCtrls, 7 Spin, Forms, Contnrs, Grids;7 Spin, Forms, Generics.Collections, Grids; 8 8 9 9 type … … 19 19 { TThemes } 20 20 21 TThemes = class(TObjectList )21 TThemes = class(TObjectList<TTheme>) 22 22 function AddNew(Name: string): TTheme; 23 23 function FindByName(Name: string): TTheme; … … 42 42 end; 43 43 44 const 45 ThemeNameSystem = 'System'; 46 ThemeNameLight = 'Light'; 47 ThemeNameDark = 'Dark'; 48 44 49 procedure Register; 50 45 51 46 52 implementation … … 74 80 procedure TThemes.LoadToStrings(Strings: TStrings); 75 81 var 76 Theme: TTheme;82 I: Integer; 77 83 begin 78 Strings.Clear; 79 for Theme in Self do 80 Strings.AddObject(Theme.Name, Theme); 84 Strings.BeginUpdate; 85 try 86 while Strings.Count < Count do Strings.Add(''); 87 while Strings.Count > Count do Strings.Delete(Strings.Count - 1); 88 for I := 0 to Count - 1 do begin 89 Strings[I] := Items[I].Name; 90 Strings.Objects[I] := Items[I]; 91 end; 92 finally 93 Strings.EndUpdate; 94 end; 81 95 end; 82 96 … … 97 111 inherited; 98 112 Themes := TThemes.Create; 99 with Themes.AddNew( 'System') do begin113 with Themes.AddNew(ThemeNameSystem) do begin 100 114 ColorWindow := clWindow; 101 115 ColorWindowText := clWindowText; … … 105 119 end; 106 120 Theme := TTheme(Themes.First); 107 with Themes.AddNew( 'Dark') do begin121 with Themes.AddNew(ThemeNameDark) do begin 108 122 ColorWindow := RGBToColor($20, $20, $20); 109 123 ColorWindowText := clWhite; … … 112 126 ColorControlSelected := RGBToColor(96, 125, 155); 113 127 end; 114 with Themes.AddNew( 'Light') do begin128 with Themes.AddNew(ThemeNameLight) do begin 115 129 ColorWindow := clWhite; 116 130 ColorWindowText := clBlack; … … 123 137 destructor TThemeManager.Destroy; 124 138 begin 125 Themes.Free;126 inherited Destroy;139 FreeAndNil(Themes); 140 inherited; 127 141 end; 128 142 … … 167 181 procedure TThemeManager.UseTheme(Form: TDpiForm); 168 182 begin 169 if not Used and (FTheme.Name = 'System') then Exit;183 if not Used and (FTheme.Name = ThemeNameSystem) then Exit; 170 184 ApplyTheme(Form); 171 185 Used := True; 172 186 end; 173 187 188 end. 174 189 175 end. -
branches/highdpi/Packages/Common/Threading.pas
r462 r463 1 unit UThreading; 2 3 {$mode delphi} 1 unit Threading; 4 2 5 3 interface 6 4 7 5 uses 8 UDpiControls, Classes, SysUtils, Forms, Contnrs, SyncObjs;6 UDpiControls, Classes, SysUtils, Forms, Generics.Collections, SyncObjs; 9 7 10 8 type 11 9 TExceptionEvent = procedure (Sender: TObject; E: Exception) of object; 12 10 TMethodCall = procedure of object; 13 14 11 15 12 { TVirtualThread } … … 22 19 function GetSuspended: Boolean; virtual; abstract; 23 20 function GetTerminated: Boolean; virtual; abstract; 24 function GetThreadId: Integer; virtual; abstract;21 function GetThreadId: TThreadID; virtual; abstract; 25 22 procedure SetFreeOnTerminate(const AValue: Boolean); virtual; abstract; 26 23 procedure SetPriority(const AValue: TThreadPriority); virtual; abstract; … … 42 39 property Terminated: Boolean read GetTerminated write SetTerminated; 43 40 property Finished: Boolean read GetFinished; 44 property ThreadId: Integerread GetThreadId;41 property ThreadId: TThreadID read GetThreadId; 45 42 end; 46 43 … … 68 65 function GetSuspended: Boolean; override; 69 66 function GetTerminated: Boolean; override; 70 function GetThreadId: Integer; override;67 function GetThreadId: TThreadID; override; 71 68 procedure SetFreeOnTerminate(const AValue: Boolean); override; 72 69 procedure SetPriority(const AValue: TThreadPriority); override; … … 102 99 { TThreadList } 103 100 104 TThreadList = class(TObjectList )105 function FindById(Id: Integer): TVirtualThread;101 TThreadList = class(TObjectList<TVirtualThread>) 102 function FindById(Id: TThreadID): TVirtualThread; 106 103 constructor Create; virtual; 107 104 end; … … 164 161 if MainThreadID = ThreadID then Method 165 162 else begin 166 Thread := ThreadList.FindById(ThreadID); 163 try 164 ThreadListLock.Acquire; 165 Thread := ThreadList.FindById(ThreadID); 166 finally 167 ThreadListLock.Release; 168 end; 167 169 if Assigned(Thread) then begin 168 170 Thread.Synchronize(Method); … … 173 175 { TThreadList } 174 176 175 function TThreadList.FindById(Id: Integer): TVirtualThread;177 function TThreadList.FindById(Id: TThreadID): TVirtualThread; 176 178 var 177 179 I: Integer; 178 180 begin 179 181 I := 0; 180 while (I < ThreadList.Count) and (T VirtualThread(ThreadList[I]).ThreadID <> Id) do182 while (I < ThreadList.Count) and (ThreadList[I].ThreadID <> Id) do 181 183 Inc(I); 182 if I < ThreadList.Count then Result := T VirtualThread(ThreadList[I])184 if I < ThreadList.Count then Result := ThreadList[I] 183 185 else Result := nil; 184 186 end; … … 233 235 end; 234 236 235 function TListedThread.GetThreadId: Integer;237 function TListedThread.GetThreadId: TThreadID; 236 238 begin 237 239 Result := FThread.ThreadID; … … 290 292 end; 291 293 FThread.Free; 292 inherited Destroy;294 inherited; 293 295 end; 294 296 … … 364 366 365 367 end. 366 -
branches/highdpi/Packages/Common/Translator.pas
r462 r463 1 unit UTranslator; 2 3 {$mode Delphi}{$H+} 1 unit Translator; 4 2 5 3 interface 6 4 7 5 uses 8 UDpiControls, Classes, SysUtils, Forms, ExtCtrls, Controls, Contnrs,LazFileUtils, LazUTF8,9 Translations, TypInfo, Dialogs, FileUtil, LCLProc, ULanguages, LCLType,10 LCLVersion ;6 UDpiControls, Classes, SysUtils, Forms, ExtCtrls, Controls, LazFileUtils, LazUTF8, 7 Translations, TypInfo, Dialogs, FileUtil, LCLProc, Languages, LCLType, 8 LCLVersion, Generics.Collections; 11 9 12 10 type 13 11 THandleStringEvent = function (AValue: string): string of object; 12 13 TPoFiles = class(TObjectList<TPOFile>) 14 end; 14 15 15 16 { TComponentExcludes } … … 24 25 { TComponentExcludesList } 25 26 26 TComponentExcludesList = class(TObjectList )27 TComponentExcludesList = class(TObjectList<TComponentExcludes>) 27 28 function FindByClassType(AClassType: TClass): TComponentExcludes; 28 29 procedure DumpToStrings(Strings: TStrings); … … 36 37 FOnAutomaticLanguage: THandleStringEvent; 37 38 FOnTranslate: TNotifyEvent; 38 FP OFilesFolder: string;39 FP OFiles: TObjectList; // TObjectList<TPOFile>;39 FPoFilesFolder: string; 40 FPoFiles: TPoFiles; 40 41 function GetLocale: string; 41 42 function GetLocaleShort: string; … … 50 51 public 51 52 ComponentExcludes: TComponentExcludesList; 52 Languages: TLanguage List;53 Languages: TLanguages; 53 54 procedure Translate; 54 procedure LanguageListToStrings(Strings: TStrings );55 procedure LanguageListToStrings(Strings: TStrings; WithCode: Boolean = True); 55 56 procedure TranslateResourceStrings(PoFileName: string); 56 57 procedure TranslateUnitResourceStrings(UnitName: string; PoFileName: string); … … 63 64 destructor Destroy; override; 64 65 published 65 property POFilesFolder: string read FP OFilesFolder write SetPOFilesFolder;66 property POFilesFolder: string read FPoFilesFolder write SetPOFilesFolder; 66 67 property Language: TLanguage read FLanguage write SetLanguage; 67 68 property OnTranslate: TNotifyEvent read FOnTranslate write FOnTranslate; … … 71 72 72 73 procedure Register; 74 73 75 74 76 implementation … … 117 119 destructor TComponentExcludes.Destroy; 118 120 begin 119 PropertyExcludes.Free;120 inherited Destroy;121 FreeAndNil(PropertyExcludes); 122 inherited; 121 123 end; 122 124 … … 128 130 I, J: Integer; 129 131 Po: TPoFile; 130 Item: TP OFileItem;132 Item: TPoFileItem; 131 133 begin 132 134 TranslateComponentRecursive(DpiApplication); … … 134 136 // Merge files to single translation file 135 137 try 136 Po := TP OFile.Create;137 for I := 0 to FP OFiles.Count - 1 do138 Po := TPoFile.Create; 139 for I := 0 to FPoFiles.Count - 1 do 138 140 with TPoFile(FPoFiles[I]) do 139 141 for J := 0 to Items.Count - 1 do … … 162 164 SearchMask: string; 163 165 begin 164 FP OFiles.Clear;166 FPoFiles.Clear; 165 167 if Assigned(FLanguage) then 166 168 try 167 169 LocaleShort := GetLocaleShort; 168 //ShowMessage(ExtractFileDir( DpiApplication.ExeName) +170 //ShowMessage(ExtractFileDir(Application.ExeName) + 169 171 // DirectorySeparator + 'Languages' + ' ' + '*.' + LocaleShort + '.po'); 170 172 SearchMask := '*'; … … 177 179 if FileExists(FileName) and ( 178 180 ((LocaleShort = '') and (Pos('.', FileName) = Pos('.po', FileName))) or 179 (LocaleShort <> '')) then FP OFiles.Add(TPOFile.Create(FileName));181 (LocaleShort <> '')) then FPoFiles.Add(TPOFile.Create(FileName)); 180 182 end; 181 183 finally … … 281 283 var 282 284 Item: TClass; 283 284 285 Excludes: TComponentExcludes; 285 286 begin … … 287 288 Item := Component.ClassType; 288 289 while Assigned(Item) do begin 289 //ShowMessage(Component.Name + ', ' + Component.ClassName + ', ' + Item.ClassName + ', ' + PropertyName);290 290 Excludes := ComponentExcludes.FindByClassType(Item.ClassType); 291 291 if Assigned(Excludes) then begin … … 301 301 function TTranslator.GetLangFileDir: string; 302 302 begin 303 Result := FP OFilesFolder;303 Result := FPoFilesFolder; 304 304 if Copy(Result, 1, 1) <> DirectorySeparator then 305 305 Result := ExtractFileDir(DpiApplication.ExeName) + … … 307 307 end; 308 308 309 procedure TTranslator.LanguageListToStrings(Strings: TStrings );309 procedure TTranslator.LanguageListToStrings(Strings: TStrings; WithCode: Boolean = True); 310 310 var 311 311 I: Integer; … … 313 313 begin 314 314 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; 315 BeginUpdate; 316 try 317 Clear; 318 for I := 0 to Languages.Count - 1 do 319 with Languages[I] do 320 if Available then begin 321 ItemName := Name; 322 if WithCode and (Code <> '') then ItemName := ItemName + ' (' + Code + ')'; 323 AddObject(ItemName, Languages[I]); 324 end; 325 finally 326 EndUpdate; 327 end; 323 328 end; 324 329 end; … … 342 347 if Text <> '' then begin 343 348 for I := 0 to FPoFiles.Count - 1 do begin 344 Result := TPoFile(FP OFiles[I]).Translate(Identifier, Text);349 Result := TPoFile(FPoFiles[I]).Translate(Identifier, Text); 345 350 if Result <> Text then Break; 346 351 end; … … 369 374 begin 370 375 LangDir := GetLangFileDir; 371 TLanguage(Languages[0]).Available := True; // Automatic376 Languages.SearchByCode('').Available := True; // Automatic 372 377 373 378 for I := 1 to Languages.Count - 1 do 374 with TLanguage(Languages[I])do begin379 with Languages[I] do begin 375 380 Available := FileExists(LangDir + DirectorySeparator + ExtractFileNameOnly(DpiApplication.ExeName) + 376 381 '.' + Code + ExtensionSeparator + 'po') or (Code = 'en'); … … 381 386 begin 382 387 inherited; 383 FP OFiles := TObjectList.Create;388 FPoFiles := TPoFiles.Create; 384 389 ComponentExcludes := TComponentExcludesList.Create; 385 Languages := TLanguage List.Create;390 Languages := TLanguages.Create; 386 391 POFilesFolder := 'Languages'; 387 392 CheckLanguageFiles; … … 395 400 destructor TTranslator.Destroy; 396 401 begin 397 F POFiles.Free;398 Languages.Free;399 ComponentExcludes.Free;400 inherited Destroy;402 FreeAndNil(FPoFiles); 403 FreeAndNil(Languages); 404 FreeAndNil(ComponentExcludes); 405 inherited; 401 406 end; 402 407 … … 564 569 end; 565 570 566 567 571 end. 568 -
branches/highdpi/Packages/Common/URI.pas
r462 r463 1 unit U URI;1 unit URI; 2 2 3 3 // Date: 2011-04-04 4 5 {$mode delphi}6 4 7 5 interface … … 85 83 end; 86 84 85 87 86 implementation 88 87 … … 183 182 begin 184 183 Items.Free; 185 inherited Destroy;184 inherited; 186 185 end; 187 186 … … 232 231 begin 233 232 Path.Free; 234 inherited Destroy;233 inherited; 235 234 end; 236 235 … … 243 242 Fragment := TURI(Source).Fragment; 244 243 Query := TURI(Source).Query; 245 end else inherited Assign(Source);244 end else inherited; 246 245 end; 247 246 … … 291 290 destructor TURL.Destroy; 292 291 begin 293 inherited Destroy;292 inherited; 294 293 end; 295 294 … … 344 343 begin 345 344 Directory.Free; 346 inherited Destroy; 347 end; 348 345 inherited; 346 end; 349 347 350 348 end. 351 -
branches/highdpi/Packages/Common/XML.pas
r462 r463 1 unit UXMLUtils; 2 3 {$mode delphi} 1 unit XML; 4 2 5 3 interface … … 16 14 procedure WriteString(Node: TDOMNode; Name: string; Value: string); 17 15 procedure WriteDateTime(Node: TDOMNode; Name: string; Value: TDateTime); 16 procedure WriteDouble(Node: TDOMNode; Name: string; Value: Double); 18 17 function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer; 19 18 function ReadInt64(Node: TDOMNode; Name: string; DefaultValue: Int64): Int64; … … 21 20 function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string; 22 21 function ReadDateTime(Node: TDOMNode; Name: string; DefaultValue: TDateTime): TDateTime; 22 function ReadDouble(Node: TDOMNode; Name: string; DefaultValue: Double): Double; 23 23 procedure ReadXMLFileParser(out Doc: TXMLDocument; FileName: string); 24 24 25 25 26 26 implementation 27 28 function ReadDouble(Node: TDOMNode; Name: string; DefaultValue: Double): Double; 29 var 30 NewNode: TDOMNode; 31 begin 32 Result := DefaultValue; 33 NewNode := Node.FindNode(DOMString(Name)); 34 if Assigned(NewNode) then 35 Result := StrToFloat(string(NewNode.TextContent)); 36 end; 27 37 28 38 procedure ReadXMLFileParser(out Doc: TXMLDocument; FileName: string); … … 202 212 end; 203 213 214 procedure WriteDouble(Node: TDOMNode; Name: string; Value: Double); 215 var 216 NewNode: TDOMNode; 217 begin 218 NewNode := Node.OwnerDocument.CreateElement(DOMString(Name)); 219 NewNode.TextContent := DOMString(FloatToStr(Value)); 220 Node.AppendChild(NewNode); 221 end; 222 204 223 function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer; 205 224 var … … 254 273 255 274 end. 256
Note:
See TracChangeset
for help on using the changeset viewer.