Changeset 153 for trunk/Packages/Common
- Timestamp:
- Aug 14, 2024, 1:05:13 PM (3 months ago)
- Location:
- trunk/Packages/Common
- Files:
-
- 2 added
- 10 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/Common/Common.pas
r148 r153 53 53 function ComputerName: string; 54 54 procedure DeleteFiles(APath, AFileSpec: string); 55 function EndsWith(Text, What: string): Boolean; 55 56 function Explode(Separator: Char; Data: string): TStringArray; 56 57 procedure ExecuteProgram(Executable: string; Parameters: array of string); … … 87 88 procedure SearchFiles(AList: TStrings; Dir: string; 88 89 FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil); 90 procedure SortStrings(Strings: TStrings); 89 91 function SplitString(var Text: string; Count: Word): string; 90 92 function StripTags(const S: string): string; 93 function StartsWith(Text, What: string): Boolean; 91 94 function TryHexToInt(Data: string; out Value: Integer): Boolean; 92 95 function TryBinToInt(Data: string; out Value: Integer): Boolean; 93 procedure SortStrings(Strings: TStrings);94 96 95 97 96 98 implementation 99 100 function StartsWith(Text, What: string): Boolean; 101 begin 102 Result := Copy(Text, 1, Length(Text)) = What; 103 end; 104 105 function EndsWith(Text, What: string): Boolean; 106 begin 107 Result := Copy(Text, Length(Text) - Length(What) + 1, MaxInt) = What; 108 end; 97 109 98 110 function BinToInt(BinStr : string) : Int64; -
trunk/Packages/Common/FindFile.pas
r145 r153 75 75 constructor TFindFile.Create(AOwner: TComponent); 76 76 begin 77 inherited Create(AOwner);77 inherited; 78 78 Path := IncludeTrailingBackslash(UTF8Encode(GetCurrentDir)); 79 79 FileMask := FilterAll; -
trunk/Packages/Common/FormEx.pas
r148 r153 13 13 private 14 14 FCounter: Integer; static; 15 FFirstShow: Boolean; 15 16 protected 16 17 procedure DoShow; override; … … 19 20 procedure DoDestroy; override; 20 21 public 22 FullScreen: Boolean; 21 23 PersistentForm: TPersistentForm; static; 22 24 ThemeManager: TThemeManager; static; … … 44 46 begin 45 47 inherited; 46 PersistentForm.Load(Self); 48 if not FFirstShow and (not (csDesigning in ComponentState)) then begin 49 FFirstShow := True; 50 PersistentForm.Load(Self); 51 FullScreen := PersistentForm.FormFullScreen; 52 end; 47 53 end; 48 54 … … 68 74 end; 69 75 70 PersistentForm.Load(Self);71 76 Translator.TranslateComponentRecursive(Self); 72 77 ThemeManager.UseTheme(Self); … … 77 82 procedure TFormEx.DoClose(var CloseAction: TCloseAction); 78 83 begin 79 PersistentForm.Save(Self); 84 if (not (csDesigning in ComponentState)) then begin 85 PersistentForm.FormFullScreen := FullScreen; 86 PersistentForm.Save(Self); 87 end; 80 88 inherited; 81 89 end; -
trunk/Packages/Common/ListViewSort.pas
r145 r153 136 136 constructor TListViewEx.Create(TheOwner: TComponent); 137 137 begin 138 inherited Create(TheOwner);138 inherited; 139 139 Filter := TListViewFilter.Create(Self); 140 140 Filter.Parent := Self; … … 172 172 constructor TListViewFilter.Create(AOwner: TComponent); 173 173 begin 174 inherited Create(AOwner);174 inherited; 175 175 FStringGrid1 := TStringGrid.Create(Self); 176 176 FStringGrid1.Align := alClient; -
trunk/Packages/Common/PersistentForm.pas
r145 r153 16 16 FMinVisiblePart: Integer; 17 17 FRegistryContext: TRegistryContext; 18 FResizeEventOccured: Boolean; 18 19 procedure LoadControl(Control: TControl); 19 20 procedure SaveControl(Control: TControl); 21 procedure WindowStateChange(Sender: TObject); 20 22 public 21 23 FormRestoredSize: TRect; … … 301 303 302 304 procedure TPersistentForm.SetFullScreen(State: Boolean); 305 {$IFDEF UNIX} 306 var 307 OldHandler: TNotifyEvent; 308 var 309 I: Integer; 310 {$ENDIF} 303 311 begin 304 312 if State then begin … … 312 320 end; 313 321 FormWindowState := Form.WindowState; 314 Form.WindowState := wsMaximized;315 Form.WindowState := wsNormal;316 ShowWindow(Form.Handle, SW_SHOWFULLSCREEN);317 322 {$IFDEF WINDOWS} 318 323 Form.BorderStyle := bsNone; 319 324 {$ENDIF} 325 Form.WindowState := wsFullscreen; 326 {$IFDEF UNIX} 327 // Workaround on Linux, WindowState is rewriten by WMSize event to wsNormal. 328 // We need for that even to occure 329 OldHandler := Form.OnWindowStateChange; 330 Form.OnWindowStateChange := WindowStateChange; 331 FResizeEventOccured := False; 332 for I := 0 to 10 do begin 333 if FResizeEventOccured then Break; 334 Application.ProcessMessages; 335 Sleep(1); 336 end; 337 Form.OnWindowStateChange := OldHandler; 338 FormFullScreen := True; 339 {$ENDIF} 320 340 end else begin 321 341 FormFullScreen := False; 342 Form.WindowState := wsNormal; 322 343 {$IFDEF WINDOWS} 323 344 Form.BorderStyle := bsSizeable; 324 345 {$ENDIF} 325 ShowWindow(Form.Handle, SW_SHOWNORMAL);326 346 if FormWindowState = wsNormal then begin 327 347 Form.WindowState := wsNormal; … … 335 355 end; 336 356 357 procedure TPersistentForm.WindowStateChange(Sender: TObject); 358 begin 359 Form.WindowState := wsFullscreen; 360 FResizeEventOccured := True; 361 end; 362 337 363 end. -
trunk/Packages/Common/PixelPointer.pas
r148 r153 18 18 function GetRGB: Cardinal; inline; 19 19 public 20 class function CreateRGB(R, G, B: Byte): TPixel32; static; 21 class function CreateRGBA(R, G, B, A: Byte): TPixel32; static; 20 22 property RGB: Cardinal read GetRGB write SetRGB; 21 23 case Integer of … … 104 106 end; 105 107 108 class function TPixel32.CreateRGB(R, G, B: Byte): TPixel32; 109 begin 110 Result.R := R; 111 Result.G := G; 112 Result.B := B; 113 Result.A := 0; 114 end; 115 116 class function TPixel32.CreateRGBA(R, G, B, A: Byte): TPixel32; 117 begin 118 Result.R := R; 119 Result.G := G; 120 Result.B := B; 121 Result.A := A; 122 end; 123 106 124 procedure TPixel32.SetRGB(AValue: Cardinal); 107 125 begin -
trunk/Packages/Common/Pool.pas
r145 r153 57 57 try 58 58 Lock.Acquire; 59 inherited SetTotalCount(AValue);59 inherited; 60 60 finally 61 61 Lock.Release; … … 67 67 try 68 68 Lock.Acquire; 69 Result := inherited GetUsedCount;69 Result := inherited; 70 70 finally 71 71 Lock.Release; … … 88 88 end; 89 89 end; 90 Result := inherited Acquire;90 Result := inherited; 91 91 finally 92 92 Lock.Release; … … 98 98 try 99 99 Lock.Acquire; 100 inherited Release(Item);100 inherited; 101 101 finally 102 102 Lock.Release; … … 113 113 begin 114 114 TotalCount := 0; 115 Lock.Free;115 FreeAndNil(Lock); 116 116 inherited; 117 117 end; -
trunk/Packages/Common/RegistryEx.pas
r145 r153 133 133 //CloseKey; 134 134 {$ENDIF} 135 Result := inherited OpenKey(Key, CanCreate);135 Result := inherited; 136 136 end; 137 137 -
trunk/Packages/Common/StopWatch.pas
r145 r153 13 13 TStopWatch = class 14 14 private 15 fFrequency: TLargeInteger;16 fIsRunning: Boolean;17 fIsHighResolution: Boolean;18 fStartCount, fStopCount: TLargeInteger;19 procedure SetTickStamp(var lInt : TLargeInteger);15 FFrequency: TLargeInteger; 16 FIsRunning: Boolean; 17 FIsHighResolution: Boolean; 18 FStartCount, fStopCount: TLargeInteger; 19 procedure SetTickStamp(var Value: TLargeInteger); 20 20 function GetElapsedTicks: TLargeInteger; 21 21 function GetElapsedMiliseconds: TLargeInteger; 22 22 function GetElapsed: string; 23 23 public 24 constructor Create(const startOnCreate: Boolean = False) ;24 constructor Create(const StartOnCreate: Boolean = False) ; 25 25 procedure Start; 26 26 procedure Stop; 27 property IsHighResolution : Boolean read fIsHighResolution;28 property ElapsedTicks 29 property ElapsedMiliseconds 30 property Elapsed 31 property IsRunning : Boolean read fIsRunning;27 property IsHighResolution: Boolean read FIsHighResolution; 28 property ElapsedTicks: TLargeInteger read GetElapsedTicks; 29 property ElapsedMiliseconds: TLargeInteger read GetElapsedMiliseconds; 30 property Elapsed: string read GetElapsed; 31 property IsRunning: Boolean read FIsRunning; 32 32 end; 33 33 … … 35 35 implementation 36 36 37 constructor TStopWatch.Create(const startOnCreate : boolean = false);37 constructor TStopWatch.Create(const StartOnCreate: Boolean = False); 38 38 begin 39 inherited Create; 40 41 fIsRunning := False; 39 FIsRunning := False; 42 40 43 41 {$IFDEF WINDOWS} 44 42 fIsHighResolution := QueryPerformanceFrequency(fFrequency) ; 45 43 {$ELSE} 46 fIsHighResolution := False;44 FIsHighResolution := False; 47 45 {$ENDIF} 48 if NOT fIsHighResolution then fFrequency := MSecsPerSec;46 if NOT FIsHighResolution then FFrequency := MSecsPerSec; 49 47 50 48 if StartOnCreate then Start; … … 53 51 function TStopWatch.GetElapsedTicks: TLargeInteger; 54 52 begin 55 Result := fStopCount - fStartCount;53 Result := FStopCount - FStartCount; 56 54 end; 57 55 58 procedure TStopWatch.SetTickStamp(var lInt : TLargeInteger);56 procedure TStopWatch.SetTickStamp(var Value: TLargeInteger); 59 57 begin 60 if fIsHighResolution then58 if FIsHighResolution then 61 59 {$IFDEF Windows} 62 QueryPerformanceCounter( lInt)60 QueryPerformanceCounter(Value) 63 61 {$ELSE} 64 62 {$ENDIF} 65 63 else 66 lInt := MilliSecondOf(Now);64 Value := MilliSecondOf(Now); 67 65 end; 68 66 69 67 function TStopWatch.GetElapsed: string; 70 68 var 71 dt: TDateTime;69 Elapsed: TDateTime; 72 70 begin 73 dt:= ElapsedMiliseconds / MSecsPerSec / SecsPerDay;74 result := Format('%d days, %s', [Trunc(dt), FormatDateTime('hh:nn:ss.z', Frac(dt))]) ;71 Elapsed := ElapsedMiliseconds / MSecsPerSec / SecsPerDay; 72 Result := Format('%d days, %s', [Trunc(Elapsed), FormatDateTime('hh:nn:ss.z', Frac(Elapsed))]) ; 75 73 end; 76 74 77 75 function TStopWatch.GetElapsedMiliseconds: TLargeInteger; 78 76 begin 79 Result := (MSecsPerSec * (fStopCount - fStartCount)) div fFrequency;77 Result := (MSecsPerSec * (fStopCount - FStartCount)) div FFrequency; 80 78 end; 81 79 82 80 procedure TStopWatch.Start; 83 81 begin 84 SetTickStamp( fStartCount);85 fIsRunning := True;82 SetTickStamp(FStartCount); 83 FIsRunning := True; 86 84 end; 87 85 88 86 procedure TStopWatch.Stop; 89 87 begin 90 SetTickStamp( fStopCount);91 fIsRunning := False;88 SetTickStamp(FStopCount); 89 FIsRunning := False; 92 90 end; 93 91 -
trunk/Packages/Common/Threading.pas
r145 r153 188 188 constructor TThreadList.Create; 189 189 begin 190 inherited Create;190 inherited; 191 191 end; 192 192
Note:
See TracChangeset
for help on using the changeset viewer.