Changeset 133 for trunk/Packages/Common

Timestamp:

Mar 4, 2022, 10:57:08 PM (3 years ago)

Author:

chronos

Message:

• Added: Compile multiple action for compilation of code with mutliple compilers at once.

Location:

trunk/Packages/Common

Files:

• UCommon.pas (modified) (16 diffs)
• ULastOpenedList.pas (modified) (2 diffs)
• UTheme.pas (modified) (5 diffs)

trunk/Packages/Common/UCommon.pas

@@ -8 +8 @@
   {$IFDEF WINDOWS}Windows,{$ENDIF}
   {$IFDEF UNIX}baseunix,{$ENDIF}
-  Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf,
+  Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf, Graphics,
   FileUtil; //, ShFolder, ShellAPI;
 
 type
   TArrayOfByte = array of Byte;
-  TArrayOfString = array of string;
   TExceptionEvent = procedure(Sender: TObject; E: Exception) of object;
 
@@ -35 +34 @@
   DLLHandle1: HModule;
 
+const
+  clLightBlue = TColor($FF8080);
+  clLightGreen = TColor($80FF80);
+  clLightRed = TColor($8080FF);
+
 {$IFDEF WINDOWS}
   GetUserNameEx: procedure (NameFormat: DWORD;
@@ -51 +55 @@
 function ComputerName: string;
 procedure DeleteFiles(APath, AFileSpec: string);
+function Explode(Separator: Char; Data: string): TStringArray;
 procedure ExecuteProgram(Executable: string; Parameters: array of string);
 procedure FileDialogUpdateFilterFileType(FileDialog: TOpenDialog);
@@ -65 +70 @@
 function LoadFileToStr(const FileName: TFileName): AnsiString;
 function LoggedOnUserNameEx(Format: TUserNameFormat): string;
-function MergeArray(A, B: array of string): TArrayOfString;
+function MergeArray(A, B: array of string): TStringArray;
 function OccurenceOfChar(What: Char; Where: string): Integer;
 procedure OpenWebPage(URL: string);
+procedure OpenEmail(Email: string);
 procedure OpenFileInShell(FileName: string);
 function PosFromIndex(SubStr: string; Text: string;
@@ -83 +89 @@
 function SplitString(var Text: string; Count: Word): string;
 function StripTags(const S: string): string;
-function TryHexToInt(Data: string; var Value: Integer): Boolean;
-function TryBinToInt(Data: string; var Value: Integer): Boolean;
+function TryHexToInt(Data: string; out Value: Integer): Boolean;
+function TryBinToInt(Data: string; out Value: Integer): Boolean;
 procedure SortStrings(Strings: TStrings);
 
@@ -246 +252 @@
 end;
 
-function TryHexToInt(Data: string; var Value: Integer): Boolean;
+function TryHexToInt(Data: string; out Value: Integer): Boolean;
 var
   I: Integer;
@@ -262 +268 @@
 end;
 
-function TryBinToInt(Data: string; var Value: Integer): Boolean;
+function TryBinToInt(Data: string; out Value: Integer): Boolean;
 var
   I: Integer;
@@ -290 +296 @@
 end;
 
-function Explode(Separator: char; Data: string): TArrayOfString;
-begin
-  Result := nil;
-  SetLength(Result, 0);
-  while Pos(Separator, Data) > 0 do begin
+function Explode(Separator: Char; Data: string): TStringArray;
+var
+  Index: Integer;
+begin
+  Result := Default(TStringArray);
+  repeat
+    Index := Pos(Separator, Data);
+    if Index > 0 then begin
+      SetLength(Result, Length(Result) + 1);
+      Result[High(Result)] := Copy(Data, 1, Index - 1);
+      Delete(Data, 1, Index);
+    end else Break;
+  until False;
+  if Data <> '' then begin
     SetLength(Result, Length(Result) + 1);
-    Result[High(Result)] := Copy(Data, 1, Pos(Separator, Data) - 1);
-    Delete(Data, 1, Pos(Separator, Data));
-  end;
-  SetLength(Result, Length(Result) + 1);
-  Result[High(Result)] := Data;
-end;
-
-{$IFDEF Windows}
+    Result[High(Result)] := Data;
+  end;
+end;
+
+{$IFDEF WINDOWS}
 function GetUserName: string;
 const
@@ -311 +323 @@
 begin
   L := MAX_USERNAME_LENGTH + 2;
+  Result := Default(string);
   SetLength(Result, L);
   if Windows.GetUserName(PChar(Result), L) and (L > 0) then begin
@@ -324 +337 @@
   end;
 end;
-{$endif}
+{$ENDIF}
 
 function ComputerName: string;
-{$ifdef mswindows}
+{$IFDEF WINDOWS}
 const
  INFO_BUFFER_SIZE = 32767;
@@ -342 +355 @@
   end;
 end;
-{$endif}
-{$ifdef unix}
+{$ENDIF}
+{$IFDEF UNIX}
 var
   Name: UtsName;
@@ -351 +364 @@
   Result := Name.Nodename;
 end;
-{$endif}
-
-{$ifdef windows}
+{$ENDIF}
+
+{$IFDEF WINDOWS}
 function LoggedOnUserNameEx(Format: TUserNameFormat): string;
 const
@@ -431 +444 @@
 procedure LoadLibraries;
 begin
-  {$IFDEF Windows}
+  {$IFDEF WINDOWS}
   DLLHandle1 := LoadLibrary('secur32.dll');
   if DLLHandle1 <> 0 then
@@ -442 +455 @@
 procedure FreeLibraries;
 begin
-  {$IFDEF Windows}
+  {$IFDEF WINDOWS}
   if DLLHandle1 <> 0 then FreeLibrary(DLLHandle1);
   {$ENDIF}
@@ -475 +488 @@
 end;
 
+procedure OpenEmail(Email: string);
+begin
+  OpenURL('mailto:' + Email);
+end;
+
 procedure OpenFileInShell(FileName: string);
 begin
@@ -503 +521 @@
 end;
 
-function MergeArray(A, B: array of string): TArrayOfString;
-var
-  I: Integer;
-begin
-  Result := Default(TArrayOfString);
+function MergeArray(A, B: array of string): TStringArray;
+var
+  I: Integer;
+begin
+  Result := Default(TStringArray);
   SetLength(Result, Length(A) + Length(B));
   for I := 0 to Length(A) - 1 do

trunk/Packages/Common/ULastOpenedList.pas

@@ -84 +84 @@
 destructor TLastOpenedList.Destroy;
 begin
-  Items.Free;
+  FreeAndNil(Items);
   inherited;
 end;
@@ -94 +94 @@
 begin
   if Assigned(MenuItem) then begin
-    MenuItem.Clear;
+    while MenuItem.Count > Items.Count do
+      MenuItem.Delete(MenuItem.Count - 1);
+    while MenuItem.Count < Items.Count do begin
+      NewMenuItem := TMenuItem.Create(MenuItem);
+      MenuItem.Add(NewMenuItem);
+    end;
     for I := 0 to Items.Count - 1 do begin
-      NewMenuItem := TMenuItem.Create(MenuItem);
-      NewMenuItem.Caption := Items[I];
-      NewMenuItem.OnClick := ClickAction;
-      MenuItem.Add(NewMenuItem);
+      MenuItem.Items[I].Caption := Items[I];
+      MenuItem.Items[I].OnClick := ClickAction;
     end;
   end;

trunk/Packages/Common/UTheme.pas

@@ -41 +41 @@
     property Theme: TTheme read FTheme write SetTheme;
   end;
+
+const
+  ThemeNameSystem = 'System';
+  ThemeNameLight = 'Light';
+  ThemeNameDark = 'Dark';
 
 procedure Register;
@@ -105 +110 @@
   inherited;
   Themes := TThemes.Create;
-  with Themes.AddNew('System') do begin
+  with Themes.AddNew(ThemeNameSystem) do begin
     ColorWindow := clWindow;
     ColorWindowText := clWindowText;
@@ -113 +118 @@
   end;
   Theme := TTheme(Themes.First);
-  with Themes.AddNew('Dark') do begin
+  with Themes.AddNew(ThemeNameDark) do begin
     ColorWindow := RGBToColor($20, $20, $20);
     ColorWindowText := clWhite;
@@ -120 +125 @@
     ColorControlSelected := RGBToColor(96, 125, 155);
   end;
-  with Themes.AddNew('Light') do begin
+  with Themes.AddNew(ThemeNameLight) do begin
     ColorWindow := clWhite;
     ColorWindowText := clBlack;
@@ -175 +180 @@
 procedure TThemeManager.UseTheme(Form: TForm);
 begin
-  if not Used and (FTheme.Name = 'System') then Exit;
+  if not Used and (FTheme.Name = ThemeNameSystem) then Exit;
   ApplyTheme(Form);
   Used := True;