Changeset 566


Ignore:
Timestamp:
Jun 29, 2023, 11:23:03 PM (17 months ago)
Author:
chronos
Message:
  • Modified: Updated Common package.
Location:
Common
Files:
13 added
1 deleted
5 edited
3 moved

Legend:

Unmodified
Added
Removed

  • Common/Common.lpk

    r563 r566  
    1111      <PathDelim Value="\"/>
    1212      <SearchPaths>
     13        <OtherUnitFiles Value="Forms"/>
    1314        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    1415      </SearchPaths>
    … …  
    4142Source: https://svn.zdechov.net/PascalClassLibrary/Common/"/>
    4243    <License Value="Copy left."/>
    43     <Version Minor="11"/>
    44     <Files Count="33">
     44    <Version Minor="12"/>
     45    <Files Count="36">
    4546      <Item1>
    4647        <Filename Value="StopWatch.pas"/>
    … …  
    159160      </Item26>
    160161      <Item27>
    161         <Filename Value="FormAbout.pas"/>
    162         <UnitName Value="FormAbout"/>
     162        <Filename Value="PixelPointer.pas"/>
     163        <UnitName Value="PixelPointer"/>
    163164      </Item27>
    164165      <Item28>
    165         <Filename Value="AboutDialog.pas"/>
    166         <HasRegisterProc Value="True"/>
    167         <UnitName Value="AboutDialog"/>
     166        <Filename Value="DataFile.pas"/>
     167        <UnitName Value="DataFile"/>
    168168      </Item28>
    169169      <Item29>
    170         <Filename Value="PixelPointer.pas"/>
    171         <UnitName Value="PixelPointer"/>
     170        <Filename Value="TestCase.pas"/>
     171        <UnitName Value="TestCase"/>
    172172      </Item29>
    173173      <Item30>
    174         <Filename Value="DataFile.pas"/>
    175         <UnitName Value="DataFile"/>
     174        <Filename Value="Generics.pas"/>
     175        <UnitName Value="Generics"/>
    176176      </Item30>
    177177      <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>
    186178        <Filename Value="CommonPackage.pas"/>
    187179        <Type Value="Main Unit"/>
    188180        <UnitName Value="CommonPackage"/>
     181      </Item31>
     182      <Item32>
     183        <Filename Value="Table.pas"/>
     184        <UnitName Value="Table"/>
     185      </Item32>
     186      <Item33>
     187        <Filename Value="FormEx.pas"/>
     188        <HasRegisterProc Value="True"/>
     189        <UnitName Value="FormEx"/>
    189190      </Item33>
     191      <Item34>
     192        <Filename Value="Forms\FormTests.pas"/>
     193        <UnitName Value="FormTests"/>
     194      </Item34>
     195      <Item35>
     196        <Filename Value="Forms\FormTest.pas"/>
     197        <UnitName Value="FormTest"/>
     198      </Item35>
     199      <Item36>
     200        <Filename Value="Forms\FormAbout.pas"/>
     201        <UnitName Value="FormAbout"/>
     202      </Item36>
    190203    </Files>
    191204    <CompatibilityMode Value="True"/>

  • Common/Common.pas

    r563 r566  
    6666function IntToBin(Data: Int64; Count: Byte): string;
    6767function Implode(Separator: Char; List: TList<string>): string;
     68function Implode(Separator: Char; List: TStringList; Around: string = ''): string;
    6869function LastPos(const SubStr: String; const S: String): Integer;
    6970function LoadFileToStr(const FileName: TFileName): AnsiString;
    … …  
    206207end;*)
    207208
     209function Implode(Separator: Char; List: TStringList; Around: string = ''): string;
     210var
     211  I: Integer;
     212begin
     213  Result := '';
     214  for I := 0 to List.Count - 1 do begin
     215    Result := Result + Around + List[I] + Around;
     216    if I < List.Count - 1 then Result := Result + Separator;
     217  end;
     218end;
     219
    208220function LastPos(const SubStr: String; const S: String): Integer;
    209221begin

  • Common/CommonPackage.pas

    r563 r566  
    99
    1010uses
    11   StopWatch, Common, DebugLog, Common.Delay, PrefixMultiplier, URI, Threading,
     11  StopWatch, Common, DebugLog, Common.Delay, PrefixMultiplier, URI, Threading, 
    1212  Memory, ResetableThread, Pool, LastOpenedList, RegistryEx, JobProgressView,
    1313  XML, ApplicationInfo, SyncCounter, ListViewSort, PersistentForm, FindFile,
    1414  ScaleDPI, Theme, StringTable, MetaCanvas, Geometric, Translator, Languages,
    15   FormAbout, AboutDialog, PixelPointer, DataFile, TestCase, Generics,
    16   LazarusPackageIntf;
     15  PixelPointer, DataFile, TestCase, Generics, Table, FormEx, FormTests,
     16  FormTest, FormAbout, LazarusPackageIntf;
    1717
    1818implementation
    … …  
    3131  RegisterUnit('Theme', @Theme.Register);
    3232  RegisterUnit('Translator', @Translator.Register);
    33   RegisterUnit('AboutDialog', @AboutDialog.Register);
     33  RegisterUnit('FormEx', @FormEx.Register);
    3434end;
    3535

  • Common/DataFile.pas

    r563 r566  
    7777procedure TDataFile.Assign(Source: TPersistent);
    7878begin
    79   inherited;
    8079  if Source is TDataFile then begin
    8180    FFileName := TDataFile(Source).FFileName;
    8281    FModified := TDataFile(Source).FModified;
    83   end;
     82  end else inherited;
    8483end;
    8584

  • Common/Forms/FormAbout.lfm

    r565 r566  
    11object FormAbout: TFormAbout
    2   Left = 1014
    3   Height = 349
    4   Top = 577
    5   Width = 609
     2  Left = 624
     3  Height = 402
     4  Top = 622
     5  Width = 702
    66  Caption = 'About'
    7   ClientHeight = 349
    8   ClientWidth = 609
    9   DesignTimePPI = 125
     7  ClientHeight = 402
     8  ClientWidth = 702
     9  DesignTimePPI = 144
    1010  OnShow = FormShow
    1111  Position = poScreenCenter
    12   LCLVersion = '2.2.4.0'
     12  LCLVersion = '2.2.6.0'
    1313  object LabelDescription: TLabel
    14     Left = 26
    15     Height = 22
    16     Top = 117
    17     Width = 557
     14    Left = 30
     15    Height = 26
     16    Top = 135
     17    Width = 642
    1818    Align = alTop
    19     BorderSpacing.Left = 26
    20     BorderSpacing.Right = 26
    21     BorderSpacing.Bottom = 26
     19    BorderSpacing.Left = 30
     20    BorderSpacing.Right = 30
     21    BorderSpacing.Bottom = 30
    2222    Caption = 'Description'
    2323    ParentColor = False
    … …  
    2626  end
    2727  object LabelContent: TLabel
    28     Left = 26
    29     Height = 22
    30     Top = 165
    31     Width = 557
     28    Left = 30
     29    Height = 26
     30    Top = 191
     31    Width = 642
    3232    Align = alTop
    33     BorderSpacing.Around = 26
     33    BorderSpacing.Around = 30
    3434    Caption = '   '
    3535    ParentColor = False
    … …  
    3838  object PanelTop: TPanel
    3939    Left = 0
    40     Height = 117
     40    Height = 135
    4141    Top = 0
    42     Width = 609
     42    Width = 702
    4343    Align = alTop
    4444    BevelOuter = bvNone
    45     ClientHeight = 117
    46     ClientWidth = 609
     45    ClientHeight = 135
     46    ClientWidth = 702
    4747    FullRepaint = False
    4848    ParentFont = False
    4949    TabOrder = 0
    5050    object LabelAppName: TLabel
    51       Left = 94
    52       Height = 73
    53       Top = 17
    54       Width = 489
     51      Left = 108
     52      Height = 84
     53      Top = 20
     54      Width = 564
    5555      Anchors = [akTop, akLeft, akRight]
    5656      AutoSize = False
    57       BorderSpacing.Around = 26
     57      BorderSpacing.Around = 30
    5858      Caption = 'Title'
    59       Font.Height = -52
     59      Font.Height = -60
    6060      ParentColor = False
    6161      ParentFont = False
    … …  
    6363    end
    6464    object ImageLogo: TImage
    65       Left = 21
    66       Height = 64
    67       Top = 26
    68       Width = 62
     65      Left = 24
     66      Height = 74
     67      Top = 30
     68      Width = 71
    6969      Proportional = True
    7070      Stretch = True
    … …  
    7373  object PanelButtons: TPanel
    7474    Left = 0
    75     Height = 65
    76     Top = 284
    77     Width = 609
     75    Height = 75
     76    Top = 327
     77    Width = 702
    7878    Align = alBottom
    7979    BevelOuter = bvNone
    80     ClientHeight = 65
    81     ClientWidth = 609
     80    ClientHeight = 75
     81    ClientWidth = 702
    8282    TabOrder = 1
    8383    object ButtonHomePage: TButton
    84       Left = 21
    85       Height = 33
    86       Top = 21
    87       Width = 229
     84      Left = 24
     85      Height = 38
     86      Top = 24
     87      Width = 264
    8888      Anchors = [akLeft, akBottom]
    8989      Caption = 'Home page'
    … …  
    9393    end
    9494    object ButtonClose: TButton
    95       Left = 461
    96       Height = 33
    97       Top = 21
    98       Width = 122
     95      Left = 531
     96      Height = 38
     97      Top = 24
     98      Width = 141
    9999      Anchors = [akRight, akBottom]
    100100      Caption = 'Close'

  • Common/Forms/FormAbout.pas

    r565 r566  
    55uses
    66  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
    7   StdCtrls, ExtCtrls, ApplicationInfo, Common, Translator, Theme;
     7  StdCtrls, ExtCtrls, ApplicationInfo, Common, Translator, Theme, FormEx;
    88
    99type
    1010  { TFormAbout }
    1111
    12   TFormAbout = class(TForm)
     12  TFormAbout = class(TFormEx)
    1313    ButtonClose: TButton;
    1414    ButtonHomePage: TButton;
    … …  
    2121    procedure ButtonHomePageClick(Sender: TObject);
    2222    procedure FormShow(Sender: TObject);
     23  private
     24    FApplicationInfo: TApplicationInfo;
    2325  public
    24     AboutDialog: TObject; //TAboutDialog
    2526    procedure UpdateInterface;
     27    property ApplicationInfo: TApplicationInfo read FApplicationInfo write
     28      FApplicationInfo;
    2629  end;
    2730
    … …  
    3033
    3134{$R *.lfm}
    32 
    33 uses
    34   AboutDialog;
    3535
    3636resourcestring
    … …  
    4343procedure TFormAbout.FormShow(Sender: TObject);
    4444begin
    45   if Assigned(AboutDialog) then
    46   with TAboutDialog(AboutDialog) do begin
    47     if Assigned(Translator) then
    48       Translator.TranslateComponentRecursive(Self);
    49     if Assigned(ThemeManager) then
    50       ThemeManager.UseTheme(Self);
    51 
    52     if Assigned(ApplicationInfo) then
    53     with ApplicationInfo do begin
    54       LabelAppName.Caption := AppName;
    55       LabelContent.Caption := SVersion + ': ' + Version + LineEnding +
    56         SReleaseDate + ': ' + DateToStr(ReleaseDate) + LineEnding +
    57         SLicense + ': ' + License;
    58       LabelDescription.Caption := Description;
    59       ImageLogo.Picture.Bitmap.Assign(Icon);
    60     end;
     45  if Assigned(ApplicationInfo) then
     46  with ApplicationInfo do begin
     47    LabelAppName.Caption := AppName;
     48    LabelContent.Caption := SVersion + ': ' + Version + LineEnding +
     49      SReleaseDate + ': ' + DateToStr(ReleaseDate) + LineEnding +
     50      SLicense + ': ' + License;
     51    LabelDescription.Caption := Description;
     52    ImageLogo.Picture.Bitmap.Assign(Icon);
    6153  end;
    6254  UpdateInterface;
    … …  
    6557procedure TFormAbout.UpdateInterface;
    6658begin
    67   ButtonHomePage.Enabled := Assigned(AboutDialog) and
    68     Assigned(TAboutDialog(AboutDialog).ApplicationInfo);
     59  ButtonHomePage.Enabled := Assigned(ApplicationInfo);
    6960end;
    7061
    7162procedure TFormAbout.ButtonHomePageClick(Sender: TObject);
    7263begin
    73   OpenWebPage(TAboutDialog(AboutDialog).ApplicationInfo.HomePage);
     64  OpenWebPage(ApplicationInfo.HomePage);
    7465end;
    7566

  • Common/Translator.pas

    r563 r566  
    4848    procedure TranslateProperty(Component: TPersistent; PropInfo: PPropInfo);
    4949    function IsExcluded(Component: TPersistent; PropertyName: string): Boolean;
    50     function GetLangFileDir: string;
     50    function GetLangFileDirs: TStrings;
    5151  public
    5252    ComponentExcludes: TComponentExcludesList;
    … …  
    7171  end;
    7272
     73const
     74  PoExt = '.po';
     75
    7376procedure Register;
    7477
    7578
    7679implementation
     80
     81uses
     82  Common;
    7783
    7884procedure Register;
    … …  
    161167  FileList: TStringList;
    162168  I: Integer;
     169  J: Integer;
    163170  LocaleShort: string;
    164171  SearchMask: string;
     172  LangDirs: TStrings;
    165173begin
    166174  FPoFiles.Clear;
    167   if Assigned(FLanguage) then
    168   try
     175  if Assigned(FLanguage) then begin
    169176    LocaleShort := GetLocaleShort;
    170     //ShowMessage(ExtractFileDir(Application.ExeName) +
    171     //  DirectorySeparator + 'Languages' + ' ' + '*.' + LocaleShort + '.po');
    172177    SearchMask := '*';
    173178    if LocaleShort <> '' then SearchMask := SearchMask + '.' + LocaleShort;
    174     SearchMask := SearchMask + '.po';
    175     FileList := FindAllFiles(GetLangFileDir, SearchMask);
    176     for I := 0 to FileList.Count - 1 do begin
    177       FileName := FileList[I];
    178       //FileName := FindLocaleFileName('.po');
    179       if FileExists(FileName) and (
    180       ((LocaleShort = '') and (Pos('.', FileName) = Pos('.po', FileName))) or
    181       (LocaleShort <> '')) then FPoFiles.Add(TPOFile.Create(FileName));
    182     end;
    183   finally
    184     FileList.Free;
     179    SearchMask := SearchMask + PoExt;
     180    LangDirs := GetLangFileDirs;
     181    for J := 0 to LangDirs.Count - 1 do begin
     182      FileList := FindAllFiles(LangDirs[J], SearchMask);
     183      try
     184        for I := 0 to FileList.Count - 1 do begin
     185          FileName := FileList[I];
     186          //FileName := FindLocaleFileName('.po');
     187           if FileExists(FileName) and (
     188          ((LocaleShort = '') and (Pos('.', FileName) = Pos(PoExt, FileName))) or
     189          (LocaleShort <> '')) then FPoFiles.Add(TPOFile.Create(FileName));
     190        end;
     191      finally
     192        FileList.Free;
     193      end;
     194    end;
     195    LangDirs.Free;
    185196  end;
    186197end;
    … …  
    299310end;
    300311
    301 function TTranslator.GetLangFileDir: string;
    302 begin
    303   Result := FPoFilesFolder;
    304   if Copy(Result, 1, 1) <> DirectorySeparator then
    305     Result := ExtractFileDir(Application.ExeName) +
    306       DirectorySeparator + Result;
     312function TTranslator.GetLangFileDirs: TStrings;
     313var
     314  I: Integer;
     315begin
     316  Result := TStringList.Create;
     317  Result.Delimiter := ';';
     318  Result.StrictDelimiter := True;
     319  Result.DelimitedText := FPoFilesFolder;
     320
     321  for I := 0 to Result.Count - 1 do begin
     322    Result[I] := StringReplace(Result[I], '/', DirectorySeparator, [rfReplaceAll]);
     323    Result[I] := StringReplace(Result[I], '\', DirectorySeparator, [rfReplaceAll]);
     324    if Copy(Result[I], 1, 1) <> DirectorySeparator then
     325      Result[I] := ExtractFileDir(Application.ExeName) +
     326        DirectorySeparator + Result[I];
     327  end;
    307328end;
    308329
    … …  
    371392var
    372393  I: Integer;
    373   LangDir: string;
    374 begin
    375   LangDir := GetLangFileDir;
     394  J: Integer;
     395  LangDirs: TStrings;
     396begin
     397  LangDirs := GetLangFileDirs;
    376398  Languages.SearchByCode('').Available := True; // Automatic
    377399
    378400  for I := 1 to Languages.Count - 1 do
    379401  with Languages[I] do begin
    380     Available := FileExists(LangDir + DirectorySeparator + ExtractFileNameOnly(Application.ExeName) +
    381       '.' + Code + ExtensionSeparator + 'po') or (Code = 'en');
    382   end;
     402    for J := 0 to LangDirs.Count - 1 do begin
     403      if FileExists(LangDirs[J] + DirectorySeparator + ExtractFileNameOnly(Application.ExeName) +
     404        '.' + Code + PoExt) or (Code = 'en') then begin
     405          Available := True;
     406          Continue;
     407        end;
     408    end;
     409  end;
     410  LangDirs.Free;
    383411end;
    384412
Note: See TracChangeset for help on using the changeset viewer.