Changeset 51 for trunk/Packages/Common
- Timestamp:
- Dec 20, 2021, 6:45:12 PM (3 years ago)
- Location:
- trunk/Packages/Common
- Files:
-
- 14 added
- 1 deleted
- 14 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/Common/Common.lpk
r38 r51 37 37 </Other> 38 38 </CompilerOptions> 39 <Description Value="Various libraries"/> 40 <License Value="GNU/GPL"/> 41 <Version Minor="7"/> 42 <Files Count="22"> 39 <Description Value="Common package with various useful units. 40 41 Source: https://svn.zdechov.net/PascalClassLibrary/Common/"/> 42 <License Value="Copy left."/> 43 <Version Minor="8"/> 44 <Files Count="29"> 43 45 <Item1> 44 46 <Filename Value="StopWatch.pas"/> … … 139 141 <UnitName Value="UStringTable"/> 140 142 </Item22> 143 <Item23> 144 <Filename Value="UMetaCanvas.pas"/> 145 <UnitName Value="UMetaCanvas"/> 146 </Item23> 147 <Item24> 148 <Filename Value="UGeometric.pas"/> 149 <UnitName Value="UGeometric"/> 150 </Item24> 151 <Item25> 152 <Filename Value="UTranslator.pas"/> 153 <HasRegisterProc Value="True"/> 154 <UnitName Value="UTranslator"/> 155 </Item25> 156 <Item26> 157 <Filename Value="ULanguages.pas"/> 158 <UnitName Value="ULanguages"/> 159 </Item26> 160 <Item27> 161 <Filename Value="UFormAbout.pas"/> 162 <UnitName Value="UFormAbout"/> 163 </Item27> 164 <Item28> 165 <Filename Value="UAboutDialog.pas"/> 166 <HasRegisterProc Value="True"/> 167 <UnitName Value="UAboutDialog"/> 168 </Item28> 169 <Item29> 170 <Filename Value="UPixelPointer.pas"/> 171 <UnitName Value="UPixelPointer"/> 172 </Item29> 141 173 </Files> 142 174 <i18n> -
trunk/Packages/Common/Common.pas
r38 r51 12 12 UMemory, UResetableThread, UPool, ULastOpenedList, URegistry, 13 13 UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort, 14 UPersistentForm, UFindFile, UScaleDPI, UTheme, UStringTable, 15 LazarusPackageIntf; 14 UPersistentForm, UFindFile, UScaleDPI, UTheme, UStringTable, UMetaCanvas, 15 UGeometric, UTranslator, ULanguages, UFormAbout, UAboutDialog, 16 UPixelPointer, LazarusPackageIntf; 16 17 17 18 implementation … … 29 30 RegisterUnit('UScaleDPI', @UScaleDPI.Register); 30 31 RegisterUnit('UTheme', @UTheme.Register); 32 RegisterUnit('UTranslator', @UTranslator.Register); 33 RegisterUnit('UAboutDialog', @UAboutDialog.Register); 31 34 end; 32 35 -
trunk/Packages/Common/Languages/UJobProgressView.cs.po
r38 r51 24 24 msgstr "DokonÄené" 25 25 26 #: ujobprogressview.soperations27 #, fuzzy28 #| msgid "Operations"29 msgid "Operations:"30 msgstr "Operace"31 32 26 #: ujobprogressview.spleasewait 33 27 msgid "Please wait..." -
trunk/Packages/Common/Languages/UJobProgressView.po
r38 r51 14 14 msgstr "" 15 15 16 #: ujobprogressview.soperations17 msgid "Operations:"18 msgstr ""19 20 16 #: ujobprogressview.spleasewait 21 17 msgid "Please wait..." -
trunk/Packages/Common/UApplicationInfo.pas
r38 r51 6 6 7 7 uses 8 SysUtils, Classes, Forms, URegistry, Controls ;8 SysUtils, Classes, Forms, URegistry, Controls, Graphics, LCLType; 9 9 10 10 type … … 14 14 TApplicationInfo = class(TComponent) 15 15 private 16 FDescription: TCaption; 16 FDescription: TTranslateString; 17 FIcon: TBitmap; 17 18 FIdentification: Byte; 18 19 FLicense: string; … … 33 34 public 34 35 constructor Create(AOwner: TComponent); override; 36 destructor Destroy; override; 35 37 property Version: string read GetVersion; 36 38 function GetRegistryContext: TRegistryContext; … … 47 49 property EmailContact: string read FEmailContact write FEmailContact; 48 50 property AppName: string read FAppName write FAppName; 49 property Description: string read FDescription write FDescription;51 property Description: TTranslateString read FDescription write FDescription; 50 52 property ReleaseDate: TDateTime read FReleaseDate write FReleaseDate; 51 53 property RegistryKey: string read FRegistryKey write FRegistryKey; 52 54 property RegistryRoot: TRegistryRoot read FRegistryRoot write FRegistryRoot; 53 55 property License: string read FLicense write FLicense; 56 property Icon: TBitmap read FIcon write FIcon; 54 57 end; 55 58 … … 74 77 constructor TApplicationInfo.Create(AOwner: TComponent); 75 78 begin 76 inherited Create(AOwner);79 inherited; 77 80 FVersionMajor := 1; 78 81 FIdentification := 1; … … 80 83 FRegistryKey := '\Software\' + FAppName; 81 84 FRegistryRoot := rrKeyCurrentUser; 85 FIcon := TBitmap.Create; 86 end; 87 88 destructor TApplicationInfo.Destroy; 89 begin 90 FreeAndNil(FIcon); 91 inherited; 82 92 end; 83 93 -
trunk/Packages/Common/UCommon.pas
r38 r51 40 40 {$ENDIF} 41 41 42 function IntToBin(Data: Int64; Count: Byte): string;42 function AddLeadingZeroes(const aNumber, Length : integer) : string; 43 43 function BinToInt(BinStr: string): Int64; 44 function TryHexToInt(Data: string; var Value: Integer): Boolean;45 function TryBinToInt(Data: string; var Value: Integer): Boolean;46 44 function BinToHexString(Source: AnsiString): string; 47 45 //function DelTree(DirName : string): Boolean; … … 49 47 function BCDToInt(Value: Byte): Byte; 50 48 function CompareByteArray(Data1, Data2: TArrayOfByte): Boolean; 49 procedure CopyStringArray(Dest: TStringArray; Source: array of string); 50 function CombinePaths(Path1, Path2: string): string; 51 function ComputerName: string; 52 procedure DeleteFiles(APath, AFileSpec: string); 53 procedure ExecuteProgram(Executable: string; Parameters: array of string); 54 procedure FileDialogUpdateFilterFileType(FileDialog: TOpenDialog); 55 procedure FreeThenNil(var Obj); 56 function GetDirCount(Dir: string): Integer; 51 57 function GetUserName: string; 52 function LoggedOnUserNameEx(Format: TUserNameFormat): string;53 function SplitString(var Text: string; Count: Word): string;54 58 function GetBitCount(Variable: QWord; MaxIndex: Integer): Integer; 55 59 function GetBit(Variable: QWord; Index: Byte): Boolean; 60 function GetStringPart(var Text: string; Separator: string): string; 61 function GenerateNewName(OldName: string): string; 62 function GetFileFilterItemExt(Filter: string; Index: Integer): string; 63 function IntToBin(Data: Int64; Count: Byte): string; 64 function LastPos(const SubStr: String; const S: String): Integer; 65 function LoadFileToStr(const FileName: TFileName): AnsiString; 66 function LoggedOnUserNameEx(Format: TUserNameFormat): string; 67 function MergeArray(A, B: array of string): TArrayOfString; 68 function OccurenceOfChar(What: Char; Where: string): Integer; 69 procedure OpenWebPage(URL: string); 70 procedure OpenFileInShell(FileName: string); 71 function PosFromIndex(SubStr: string; Text: string; 72 StartIndex: Integer): Integer; 73 function PosFromIndexReverse(SubStr: string; Text: string; 74 StartIndex: Integer): Integer; 75 function RemoveQuotes(Text: string): string; 76 procedure SaveStringToFile(S, FileName: string); 56 77 procedure SetBit(var Variable: Int64; Index: Byte; State: Boolean); overload; 57 78 procedure SetBit(var Variable: QWord; Index: Byte; State: Boolean); overload; 58 79 procedure SetBit(var Variable: Cardinal; Index: Byte; State: Boolean); overload; 59 80 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 81 procedure SearchFiles(AList: TStrings; Dir: string; 78 82 FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil); 79 function GetStringPart(var Text: string; Separator: string): string;83 function SplitString(var Text: string; Count: Word): string; 80 84 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); 85 function TryHexToInt(Data: string; var Value: Integer): Boolean; 86 function TryBinToInt(Data: string; var Value: Integer): Boolean; 87 procedure SortStrings(Strings: TStrings); 86 88 87 89 … … 669 671 end; 670 672 673 function CombinePaths(Path1, Path2: string): string; 674 begin 675 Result := Path1; 676 if Result <> '' then Result := Result + DirectorySeparator + Path2 677 else Result := Path2; 678 end; 679 680 procedure SortStrings(Strings: TStrings); 681 var 682 Tmp: TStringList; 683 begin 684 Strings.BeginUpdate; 685 try 686 if Strings is TStringList then begin 687 TStringList(Strings).Sort; 688 end else begin 689 Tmp := TStringList.Create; 690 try 691 Tmp.Assign(Strings); 692 Tmp.Sort; 693 Strings.Assign(Tmp); 694 finally 695 Tmp.Free; 696 end; 697 end; 698 finally 699 Strings.EndUpdate; 700 end; 701 end; 702 671 703 672 704 initialization -
trunk/Packages/Common/UJobProgressView.lfm
r38 r51 15 15 OnShow = FormShow 16 16 Position = poScreenCenter 17 LCLVersion = ' 1.8.2.0'17 LCLVersion = '2.0.2.0' 18 18 object PanelOperationsTitle: TPanel 19 19 Left = 0 … … 241 241 Interval = 100 242 242 OnTimer = TimerUpdateTimer 243 left = 264243 left = 320 244 244 top = 8 245 245 end -
trunk/Packages/Common/UJobProgressView.pas
r38 r51 175 175 STotalEstimatedTime = 'Total estimated time: %s'; 176 176 SFinished = 'Finished'; 177 SOperations = 'Operations:';178 177 179 178 procedure Register; -
trunk/Packages/Common/UListViewSort.pas
r38 r51 1 1 unit UListViewSort; 2 2 3 // Date: 201 0-11-033 // Date: 2019-05-17 4 4 5 5 {$mode delphi} … … 8 8 9 9 uses 10 {$IFDEF Windows}Windows, CommCtrl, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils,10 {$IFDEF Windows}Windows, CommCtrl, LMessages, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils, 11 11 Controls, DateUtils, Dialogs, fgl, Forms, Grids, StdCtrls, ExtCtrls, 12 LclIntf, L Messages, LclType, LResources;12 LclIntf, LclType, LResources; 13 13 14 14 type … … 81 81 FOnChange: TNotifyEvent; 82 82 FStringGrid1: TStringGrid; 83 procedure DoOnChange; 83 84 procedure GridDoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 84 85 procedure GridDoOnResize(Sender: TObject); … … 90 91 function TextEnteredColumn(Index: Integer): Boolean; 91 92 function GetColValue(Index: Integer): string; 93 procedure Reset; 92 94 property StringGrid: TStringGrid read FStringGrid1 write FStringGrid1; 93 95 published … … 152 154 { TListViewFilter } 153 155 156 procedure TListViewFilter.DoOnChange; 157 begin 158 if Assigned(FOnChange) then FOnChange(Self); 159 end; 160 154 161 procedure TListViewFilter.GridDoOnKeyUp(Sender: TObject; var Key: Word; 155 162 Shift: TShiftState); 156 163 begin 157 if Assigned(FOnChange) then 158 FOnChange(Self); 164 DoOnChange; 159 165 end; 160 166 … … 227 233 Result := StringGrid.Cells[Index, 0] 228 234 else Result := ''; 235 end; 236 237 procedure TListViewFilter.Reset; 238 var 239 I: Integer; 240 begin 241 with StringGrid do 242 for I := 0 to ColCount - 1 do 243 Cells[I, 0] := ''; 244 DoOnChange; 229 245 end; 230 246 -
trunk/Packages/Common/UMemory.pas
r31 r51 112 112 procedure TMemory.WriteMemory(Position: Integer; Memory: TMemory); 113 113 begin 114 Move(Memory.FData, PByte( @FData+ Position)^, Memory.Size);114 Move(Memory.FData, PByte(PByte(@FData) + Position)^, Memory.Size); 115 115 end; 116 116 117 117 procedure TMemory.ReadMemory(Position: Integer; Memory: TMemory); 118 118 begin 119 Move(PByte( @FData+ Position)^, Memory.FData, Memory.Size);119 Move(PByte(PByte(@FData) + Position)^, Memory.FData, Memory.Size); 120 120 end; 121 121 -
trunk/Packages/Common/UPersistentForm.pas
r38 r51 3 3 {$mode delphi} 4 4 5 // Date: 20 15-04-185 // Date: 2020-11-26 6 6 7 7 interface … … 9 9 uses 10 10 Classes, SysUtils, Forms, URegistry, LCLIntf, Registry, Controls, ComCtrls, 11 ExtCtrls ;11 ExtCtrls, LCLType; 12 12 13 13 type … … 26 26 FormRestoredSize: TRect; 27 27 FormWindowState: TWindowState; 28 FormFullScreen: Boolean; 28 29 Form: TForm; 29 30 procedure LoadFromRegistry(RegistryContext: TRegistryContext); … … 31 32 function CheckEntireVisible(Rect: TRect): TRect; 32 33 function CheckPartVisible(Rect: TRect; Part: Integer): TRect; 33 procedure Load(Form: TForm; DefaultMaximized: Boolean = False); 34 procedure Load(Form: TForm; DefaultMaximized: Boolean = False; 35 DefaultFullScreen: Boolean = False); 34 36 procedure Save(Form: TForm); 35 37 constructor Create(AOwner: TComponent); override; 38 procedure SetFullScreen(State: Boolean); 36 39 property RegistryContext: TRegistryContext read FRegistryContext 37 40 write FRegistryContext; … … 43 46 procedure Register; 44 47 48 45 49 implementation 46 47 50 48 51 procedure Register; … … 169 172 + FormRestoredSize.Top; 170 173 // Other state 171 FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(wsNormal))); 174 FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(FormWindowState))); 175 FormFullScreen := ReadBoolWithDefault('FullScreen', FormFullScreen); 172 176 finally 173 177 Free; … … 193 197 // Other state 194 198 WriteInteger('WindowState', Integer(FormWindowState)); 199 WriteBool('FullScreen', FormFullScreen); 195 200 finally 196 201 Free; … … 250 255 end; 251 256 252 procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False); 257 procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False; 258 DefaultFullScreen: Boolean = False); 253 259 begin 254 260 Self.Form := Form; … … 258 264 FormRestoredSize := Bounds((Screen.Width - Form.Width) div 2, 259 265 (Screen.Height - Form.Height) div 2, Form.Width, Form.Height); 266 FormWindowState := Form.WindowState; 267 FormFullScreen := DefaultFullScreen; 260 268 261 269 LoadFromRegistry(RegistryContext); … … 277 285 Form.BoundsRect := FormNormalSize; 278 286 end; 287 if FormFullScreen then SetFullScreen(True); 279 288 LoadControl(Form); 280 289 end; … … 284 293 Self.Form := Form; 285 294 FormNormalSize := Bounds(Form.Left, Form.Top, Form.Width, Form.Height); 286 FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth, 287 Form.RestoredHeight); 295 if not FormFullScreen then 296 FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth, 297 Form.RestoredHeight); 288 298 FormWindowState := Form.WindowState; 289 299 SaveToRegistry(RegistryContext); … … 300 310 end; 301 311 312 procedure TPersistentForm.SetFullScreen(State: Boolean); 313 begin 314 if State then begin 315 FormFullScreen := True; 316 FormNormalSize := Form.BoundsRect; 317 FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth, 318 Form.RestoredHeight); 319 FormWindowState := Form.WindowState; 320 ShowWindow(Form.Handle, SW_SHOWFULLSCREEN); 321 {$IFDEF WINDOWS} 322 Form.BorderStyle := bsNone; 323 {$ENDIF} 324 end else begin 325 FormFullScreen := False; 326 {$IFDEF WINDOWS} 327 Form.BorderStyle := bsSizeable; 328 {$ENDIF} 329 ShowWindow(Form.Handle, SW_SHOWNORMAL); 330 if FormWindowState = wsNormal then begin 331 Form.BoundsRect := FormNormalSize; 332 end else 333 if FormWindowState = wsMaximized then begin 334 Form.BoundsRect := FormRestoredSize; 335 Form.WindowState := wsMaximized; 336 end; 337 end; 338 end; 339 302 340 end. 303 341 -
trunk/Packages/Common/UScaleDPI.pas
r38 r51 227 227 Temp[I] := TBitmap.Create; 228 228 Temp[I].SetSize(NewWidth, NewHeight); 229 {$IFDEF Linux} 230 Temp[I].PixelFormat := pf24bit; 231 {$ELSE} 229 232 Temp[I].PixelFormat := pf32bit; 233 {$ENDIF} 230 234 Temp[I].TransparentColor := TempBmp.TransparentColor; 231 235 //Temp[I].TransparentMode := TempBmp.TransparentMode; -
trunk/Packages/Common/UTheme.pas
r38 r51 5 5 uses 6 6 Classes, SysUtils, Graphics, ComCtrls, Controls, ExtCtrls, Menus, StdCtrls, 7 Spin, Forms, Contnrs, Grids;7 Spin, Forms, fgl, Grids; 8 8 9 9 type … … 19 19 { TThemes } 20 20 21 TThemes = class(T ObjectList)21 TThemes = class(TFPGObjectList<TTheme>) 22 22 function AddNew(Name: string): TTheme; 23 23 function FindByName(Name: string): TTheme; … … 74 74 procedure TThemes.LoadToStrings(Strings: TStrings); 75 75 var 76 Theme: TTheme;76 I: Integer; 77 77 begin 78 Strings.Clear; 79 for Theme in Self do 80 Strings.AddObject(Theme.Name, Theme); 78 Strings.BeginUpdate; 79 try 80 while Strings.Count < Count do Strings.Add(''); 81 while Strings.Count > Count do Strings.Delete(Strings.Count - 1); 82 for I := 0 to Count - 1 do begin 83 Strings[I] := Items[I].Name; 84 Strings.Objects[I] := Items[I]; 85 end; 86 finally 87 Strings.EndUpdate; 88 end; 81 89 end; 82 90 … … 123 131 destructor TThemeManager.Destroy; 124 132 begin 125 Themes.Free;126 inherited Destroy;133 FreeAndNil(Themes); 134 inherited; 127 135 end; 128 136 -
trunk/Packages/Common/UThreading.pas
r38 r51 6 6 7 7 uses 8 Classes, SysUtils, Forms, Contnrs, SyncObjs;8 Classes, SysUtils, Forms, fgl, SyncObjs; 9 9 10 10 type … … 22 22 function GetSuspended: Boolean; virtual; abstract; 23 23 function GetTerminated: Boolean; virtual; abstract; 24 function GetThreadId: Integer; virtual; abstract;24 function GetThreadId: TThreadID; virtual; abstract; 25 25 procedure SetFreeOnTerminate(const AValue: Boolean); virtual; abstract; 26 26 procedure SetPriority(const AValue: TThreadPriority); virtual; abstract; … … 42 42 property Terminated: Boolean read GetTerminated write SetTerminated; 43 43 property Finished: Boolean read GetFinished; 44 property ThreadId: Integerread GetThreadId;44 property ThreadId: TThreadID read GetThreadId; 45 45 end; 46 46 … … 68 68 function GetSuspended: Boolean; override; 69 69 function GetTerminated: Boolean; override; 70 function GetThreadId: Integer; override;70 function GetThreadId: TThreadID; override; 71 71 procedure SetFreeOnTerminate(const AValue: Boolean); override; 72 72 procedure SetPriority(const AValue: TThreadPriority); override; … … 102 102 { TThreadList } 103 103 104 TThreadList = class(T ObjectList)105 function FindById(Id: Integer): TVirtualThread;104 TThreadList = class(TFPGObjectList<TVirtualThread>) 105 function FindById(Id: TThreadID): TVirtualThread; 106 106 constructor Create; virtual; 107 107 end; … … 164 164 if MainThreadID = ThreadID then Method 165 165 else begin 166 Thread := ThreadList.FindById(ThreadID); 166 try 167 ThreadListLock.Acquire; 168 Thread := ThreadList.FindById(ThreadID); 169 finally 170 ThreadListLock.Release; 171 end; 167 172 if Assigned(Thread) then begin 168 173 Thread.Synchronize(Method); … … 173 178 { TThreadList } 174 179 175 function TThreadList.FindById(Id: Integer): TVirtualThread;180 function TThreadList.FindById(Id: TThreadID): TVirtualThread; 176 181 var 177 182 I: Integer; 178 183 begin 179 184 I := 0; 180 while (I < ThreadList.Count) and (T VirtualThread(ThreadList[I]).ThreadID <> Id) do185 while (I < ThreadList.Count) and (ThreadList[I].ThreadID <> Id) do 181 186 Inc(I); 182 if I < ThreadList.Count then Result := T VirtualThread(ThreadList[I])187 if I < ThreadList.Count then Result := ThreadList[I] 183 188 else Result := nil; 184 189 end; … … 233 238 end; 234 239 235 function TListedThread.GetThreadId: Integer;240 function TListedThread.GetThreadId: TThreadID; 236 241 begin 237 242 Result := FThread.ThreadID; … … 356 361 ThreadListLock := TCriticalSection.Create; 357 362 ThreadList := TThreadList.Create; 358 ThreadList. OwnsObjects := False;363 ThreadList.FreeObjects := False; 359 364 360 365 finalization
Note:
See TracChangeset
for help on using the changeset viewer.