Changeset 133 for trunk/Packages
- Timestamp:
- Mar 4, 2022, 10:57:08 PM (3 years ago)
- Location:
- trunk/Packages/Common
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/Common/UCommon.pas
r129 r133 8 8 {$IFDEF WINDOWS}Windows,{$ENDIF} 9 9 {$IFDEF UNIX}baseunix,{$ENDIF} 10 Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf, 10 Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf, Graphics, 11 11 FileUtil; //, ShFolder, ShellAPI; 12 12 13 13 type 14 14 TArrayOfByte = array of Byte; 15 TArrayOfString = array of string;16 15 TExceptionEvent = procedure(Sender: TObject; E: Exception) of object; 17 16 … … 35 34 DLLHandle1: HModule; 36 35 36 const 37 clLightBlue = TColor($FF8080); 38 clLightGreen = TColor($80FF80); 39 clLightRed = TColor($8080FF); 40 37 41 {$IFDEF WINDOWS} 38 42 GetUserNameEx: procedure (NameFormat: DWORD; … … 51 55 function ComputerName: string; 52 56 procedure DeleteFiles(APath, AFileSpec: string); 57 function Explode(Separator: Char; Data: string): TStringArray; 53 58 procedure ExecuteProgram(Executable: string; Parameters: array of string); 54 59 procedure FileDialogUpdateFilterFileType(FileDialog: TOpenDialog); … … 65 70 function LoadFileToStr(const FileName: TFileName): AnsiString; 66 71 function LoggedOnUserNameEx(Format: TUserNameFormat): string; 67 function MergeArray(A, B: array of string): T ArrayOfString;72 function MergeArray(A, B: array of string): TStringArray; 68 73 function OccurenceOfChar(What: Char; Where: string): Integer; 69 74 procedure OpenWebPage(URL: string); 75 procedure OpenEmail(Email: string); 70 76 procedure OpenFileInShell(FileName: string); 71 77 function PosFromIndex(SubStr: string; Text: string; … … 83 89 function SplitString(var Text: string; Count: Word): string; 84 90 function StripTags(const S: string): string; 85 function TryHexToInt(Data: string; varValue: Integer): Boolean;86 function TryBinToInt(Data: string; varValue: Integer): Boolean;91 function TryHexToInt(Data: string; out Value: Integer): Boolean; 92 function TryBinToInt(Data: string; out Value: Integer): Boolean; 87 93 procedure SortStrings(Strings: TStrings); 88 94 … … 246 252 end; 247 253 248 function TryHexToInt(Data: string; varValue: Integer): Boolean;254 function TryHexToInt(Data: string; out Value: Integer): Boolean; 249 255 var 250 256 I: Integer; … … 262 268 end; 263 269 264 function TryBinToInt(Data: string; varValue: Integer): Boolean;270 function TryBinToInt(Data: string; out Value: Integer): Boolean; 265 271 var 266 272 I: Integer; … … 290 296 end; 291 297 292 function Explode(Separator: char; Data: string): TArrayOfString; 293 begin 294 Result := nil; 295 SetLength(Result, 0); 296 while Pos(Separator, Data) > 0 do begin 298 function Explode(Separator: Char; Data: string): TStringArray; 299 var 300 Index: Integer; 301 begin 302 Result := Default(TStringArray); 303 repeat 304 Index := Pos(Separator, Data); 305 if Index > 0 then begin 306 SetLength(Result, Length(Result) + 1); 307 Result[High(Result)] := Copy(Data, 1, Index - 1); 308 Delete(Data, 1, Index); 309 end else Break; 310 until False; 311 if Data <> '' then begin 297 312 SetLength(Result, Length(Result) + 1); 298 Result[High(Result)] := Copy(Data, 1, Pos(Separator, Data) - 1); 299 Delete(Data, 1, Pos(Separator, Data)); 300 end; 301 SetLength(Result, Length(Result) + 1); 302 Result[High(Result)] := Data; 303 end; 304 305 {$IFDEF Windows} 313 Result[High(Result)] := Data; 314 end; 315 end; 316 317 {$IFDEF WINDOWS} 306 318 function GetUserName: string; 307 319 const … … 311 323 begin 312 324 L := MAX_USERNAME_LENGTH + 2; 325 Result := Default(string); 313 326 SetLength(Result, L); 314 327 if Windows.GetUserName(PChar(Result), L) and (L > 0) then begin … … 324 337 end; 325 338 end; 326 {$ endif}339 {$ENDIF} 327 340 328 341 function ComputerName: string; 329 {$ ifdef mswindows}342 {$IFDEF WINDOWS} 330 343 const 331 344 INFO_BUFFER_SIZE = 32767; … … 342 355 end; 343 356 end; 344 {$ endif}345 {$ ifdef unix}357 {$ENDIF} 358 {$IFDEF UNIX} 346 359 var 347 360 Name: UtsName; … … 351 364 Result := Name.Nodename; 352 365 end; 353 {$ endif}354 355 {$ ifdef windows}366 {$ENDIF} 367 368 {$IFDEF WINDOWS} 356 369 function LoggedOnUserNameEx(Format: TUserNameFormat): string; 357 370 const … … 431 444 procedure LoadLibraries; 432 445 begin 433 {$IFDEF W indows}446 {$IFDEF WINDOWS} 434 447 DLLHandle1 := LoadLibrary('secur32.dll'); 435 448 if DLLHandle1 <> 0 then … … 442 455 procedure FreeLibraries; 443 456 begin 444 {$IFDEF W indows}457 {$IFDEF WINDOWS} 445 458 if DLLHandle1 <> 0 then FreeLibrary(DLLHandle1); 446 459 {$ENDIF} … … 475 488 end; 476 489 490 procedure OpenEmail(Email: string); 491 begin 492 OpenURL('mailto:' + Email); 493 end; 494 477 495 procedure OpenFileInShell(FileName: string); 478 496 begin … … 503 521 end; 504 522 505 function MergeArray(A, B: array of string): T ArrayOfString;506 var 507 I: Integer; 508 begin 509 Result := Default(T ArrayOfString);523 function MergeArray(A, B: array of string): TStringArray; 524 var 525 I: Integer; 526 begin 527 Result := Default(TStringArray); 510 528 SetLength(Result, Length(A) + Length(B)); 511 529 for I := 0 to Length(A) - 1 do -
trunk/Packages/Common/ULastOpenedList.pas
r102 r133 84 84 destructor TLastOpenedList.Destroy; 85 85 begin 86 Items.Free;86 FreeAndNil(Items); 87 87 inherited; 88 88 end; … … 94 94 begin 95 95 if Assigned(MenuItem) then begin 96 MenuItem.Clear; 96 while MenuItem.Count > Items.Count do 97 MenuItem.Delete(MenuItem.Count - 1); 98 while MenuItem.Count < Items.Count do begin 99 NewMenuItem := TMenuItem.Create(MenuItem); 100 MenuItem.Add(NewMenuItem); 101 end; 97 102 for I := 0 to Items.Count - 1 do begin 98 NewMenuItem := TMenuItem.Create(MenuItem); 99 NewMenuItem.Caption := Items[I]; 100 NewMenuItem.OnClick := ClickAction; 101 MenuItem.Add(NewMenuItem); 103 MenuItem.Items[I].Caption := Items[I]; 104 MenuItem.Items[I].OnClick := ClickAction; 102 105 end; 103 106 end; -
trunk/Packages/Common/UTheme.pas
r122 r133 41 41 property Theme: TTheme read FTheme write SetTheme; 42 42 end; 43 44 const 45 ThemeNameSystem = 'System'; 46 ThemeNameLight = 'Light'; 47 ThemeNameDark = 'Dark'; 43 48 44 49 procedure Register; … … 105 110 inherited; 106 111 Themes := TThemes.Create; 107 with Themes.AddNew( 'System') do begin112 with Themes.AddNew(ThemeNameSystem) do begin 108 113 ColorWindow := clWindow; 109 114 ColorWindowText := clWindowText; … … 113 118 end; 114 119 Theme := TTheme(Themes.First); 115 with Themes.AddNew( 'Dark') do begin120 with Themes.AddNew(ThemeNameDark) do begin 116 121 ColorWindow := RGBToColor($20, $20, $20); 117 122 ColorWindowText := clWhite; … … 120 125 ColorControlSelected := RGBToColor(96, 125, 155); 121 126 end; 122 with Themes.AddNew( 'Light') do begin127 with Themes.AddNew(ThemeNameLight) do begin 123 128 ColorWindow := clWhite; 124 129 ColorWindowText := clBlack; … … 175 180 procedure TThemeManager.UseTheme(Form: TForm); 176 181 begin 177 if not Used and (FTheme.Name = 'System') then Exit;182 if not Used and (FTheme.Name = ThemeNameSystem) then Exit; 178 183 ApplyTheme(Form); 179 184 Used := True;
Note:
See TracChangeset
for help on using the changeset viewer.