Changeset 83


Ignore:
Timestamp:
Dec 28, 2021, 5:00:37 PM (2 years ago)
Author:
chronos
Message:
  • Modified: Update Common package to version 0.9.
Location:
trunk/Packages/Common
Files:
1 added
14 edited

Legend:

Unmodified
Added
Removed

  • trunk/Packages/Common/Common.lpk

    r76 r83  
    3737      </Other>
    3838    </CompilerOptions>
    39     <Description Value="Various libraries"/>
    40     <License Value="GNU/GPL"/>
    41     <Version Minor="7"/>
    42     <Files Count="27">
     39    <Description Value="Common package with various useful units.
     40
     41Source: https://svn.zdechov.net/PascalClassLibrary/Common/"/>
     42    <License Value="Copy left."/>
     43    <Version Minor="9"/>
     44    <Files Count="29">
    4345      <Item1>
    4446        <Filename Value="StopWatch.pas"/>
    … …  
    157159      </Item26>
    158160      <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>
    159170        <Filename Value="UPixelPointer.pas"/>
    160171        <UnitName Value="UPixelPointer"/>
    161       </Item27>
     172      </Item29>
    162173    </Files>
    163174    <i18n>

  • trunk/Packages/Common/Common.pas

    r76 r83  
    1313  UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort,
    1414  UPersistentForm, UFindFile, UScaleDPI, UTheme, UStringTable, UMetaCanvas,
    15   UGeometric, UTranslator, ULanguages, UPixelPointer, LazarusPackageIntf;
     15  UGeometric, UTranslator, ULanguages, UFormAbout, UAboutDialog,
     16  UPixelPointer, LazarusPackageIntf;
    1617
    1718implementation
    … …  
    3031  RegisterUnit('UTheme', @UTheme.Register);
    3132  RegisterUnit('UTranslator', @UTranslator.Register);
     33  RegisterUnit('UAboutDialog', @UAboutDialog.Register);
    3234end;
    3335

  • trunk/Packages/Common/UApplicationInfo.pas

    r60 r83  
    66
    77uses
    8   SysUtils, Classes, Forms, URegistry, Controls, Graphics;
     8  SysUtils, Classes, Forms, URegistry, Controls, Graphics, LCLType;
    99
    1010type
    … …  
    1414  TApplicationInfo = class(TComponent)
    1515  private
    16     FDescription: TCaption;
     16    FDescription: TTranslateString;
    1717    FIcon: TBitmap;
    1818    FIdentification: Byte;
    … …  
    4949    property EmailContact: string read FEmailContact write FEmailContact;
    5050    property AppName: string read FAppName write FAppName;
    51     property Description: string read FDescription write FDescription;
     51    property Description: TTranslateString read FDescription write FDescription;
    5252    property ReleaseDate: TDateTime read FReleaseDate write FReleaseDate;
    5353    property RegistryKey: string read FRegistryKey write FRegistryKey;

  • trunk/Packages/Common/UCommon.pas

    r63 r83  
    88  {$ifdef Windows}Windows,{$endif}
    99  {$ifdef Linux}baseunix,{$endif}
    10   Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf, LCLType, Forms, Controls,
     10  Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf,
    1111  FileUtil; //, ShFolder, ShellAPI;
    1212
    … …  
    4040{$ENDIF}
    4141
    42 function IntToBin(Data: Int64; Count: Byte): string;
     42function AddLeadingZeroes(const aNumber, Length : integer) : string;
    4343function BinToInt(BinStr: string): Int64;
    44 function TryHexToInt(Data: string; var Value: Integer): Boolean;
    45 function TryBinToInt(Data: string; var Value: Integer): Boolean;
    4644function BinToHexString(Source: AnsiString): string;
    4745//function DelTree(DirName : string): Boolean;
    … …  
    4947function BCDToInt(Value: Byte): Byte;
    5048function CompareByteArray(Data1, Data2: TArrayOfByte): Boolean;
     49procedure CopyStringArray(Dest: TStringArray; Source: array of string);
     50function CombinePaths(Path1, Path2: string): string;
     51function ComputerName: string;
     52procedure DeleteFiles(APath, AFileSpec: string);
     53procedure ExecuteProgram(Executable: string; Parameters: array of string);
     54procedure FileDialogUpdateFilterFileType(FileDialog: TOpenDialog);
     55procedure FreeThenNil(var Obj);
     56function GetDirCount(Dir: string): Integer;
    5157function GetUserName: string;
    52 function LoggedOnUserNameEx(Format: TUserNameFormat): string;
    53 function SplitString(var Text: string; Count: Word): string;
    5458function GetBitCount(Variable: QWord; MaxIndex: Integer): Integer;
    5559function GetBit(Variable: QWord; Index: Byte): Boolean;
     60function GetStringPart(var Text: string; Separator: string): string;
     61function GenerateNewName(OldName: string): string;
     62function GetFileFilterItemExt(Filter: string; Index: Integer): string;
     63function IntToBin(Data: Int64; Count: Byte): string;
     64function LastPos(const SubStr: String; const S: String): Integer;
     65function LoadFileToStr(const FileName: TFileName): AnsiString;
     66function LoggedOnUserNameEx(Format: TUserNameFormat): string;
     67function MergeArray(A, B: array of string): TArrayOfString;
     68function OccurenceOfChar(What: Char; Where: string): Integer;
     69procedure OpenWebPage(URL: string);
     70procedure OpenFileInShell(FileName: string);
     71function PosFromIndex(SubStr: string; Text: string;
     72  StartIndex: Integer): Integer;
     73function PosFromIndexReverse(SubStr: string; Text: string;
     74  StartIndex: Integer): Integer;
     75function RemoveQuotes(Text: string): string;
     76procedure SaveStringToFile(S, FileName: string);
    5677procedure SetBit(var Variable: Int64; Index: Byte; State: Boolean); overload;
    5778procedure SetBit(var Variable: QWord; Index: Byte; State: Boolean); overload;
    5879procedure SetBit(var Variable: Cardinal; Index: Byte; State: Boolean); overload;
    5980procedure 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);
    7781procedure SearchFiles(AList: TStrings; Dir: string;
    7882  FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil);
    79 function GetStringPart(var Text: string; Separator: string): string;
     83function SplitString(var Text: string; Count: Word): string;
    8084function 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);
     85function TryHexToInt(Data: string; var Value: Integer): Boolean;
     86function TryBinToInt(Data: string; var Value: Integer): Boolean;
     87procedure SortStrings(Strings: TStrings);
    8688
    8789
    … …  
    669671end;
    670672
     673function CombinePaths(Path1, Path2: string): string;
     674begin
     675  Result := Path1;
     676  if Result <> '' then Result := Result + DirectorySeparator + Path2
     677    else Result := Path2;
     678end;
     679
     680procedure SortStrings(Strings: TStrings);
     681var
     682  Tmp: TStringList;
     683begin
     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;
     701end;
     702
    671703
    672704initialization

  • trunk/Packages/Common/UFormAbout.lfm

    r60 r83  
    1111  OnShow = FormShow
    1212  Position = poScreenCenter
    13   LCLVersion = '2.0.2.0'
     13  LCLVersion = '2.0.10.0'
    1414  object LabelDescription: TLabel
    1515    Left = 30
    16     Height = 26
     16    Height = 24
    1717    Top = 135
    1818    Width = 642
    … …  
    2828  object LabelContent: TLabel
    2929    Left = 30
    30     Height = 26
    31     Top = 191
     30    Height = 24
     31    Top = 189
    3232    Width = 642
    3333    Align = alTop
    … …  
    5050    TabOrder = 0
    5151    object LabelAppName: TLabel
    52       Left = 96
    53       Height = 100
     52      Left = 108
     53      Height = 84
    5454      Top = 20
    55       Width = 572
     55      Width = 564
    5656      Anchors = [akTop, akLeft, akRight]
    5757      AutoSize = False
    … …  
    6868      Top = 30
    6969      Width = 72
     70      Proportional = True
     71      Stretch = True
    7072    end
    7173  end

  • trunk/Packages/Common/UFormAbout.pas

    r60 r83  
    5050  if Assigned(AboutDialog) then
    5151  with TAboutDialog(AboutDialog) do begin
    52     if Assigned(CoolTranslator) then
    53       CoolTranslator.TranslateComponentRecursive(Self);
     52    if Assigned(Translator) then
     53      Translator.TranslateComponentRecursive(Self);
    5454    if Assigned(ThemeManager) then
    5555      ThemeManager.UseTheme(Self);

  • trunk/Packages/Common/ULanguages.pas

    r60 r83  
    11unit ULanguages;
    22
    3 {$mode objfpc}{$H+}
     3{$mode delphi}{$H+}
    44
    55interface
    66
    77uses
    8   Classes, SysUtils, Contnrs;
     8  Classes, SysUtils, fgl;
    99
    1010type
    … …  
    1515  end;
    1616
    17   { TLanguageList }
    18 
    19   TLanguageList = class(TObjectList)
     17  { TLanguages }
     18
     19  TLanguages = class(TFPGObjectList<TLanguage>)
    2020    function SearchByCode(ACode: string): TLanguage;
    2121    procedure AddNew(Code: string; Name: string);
    22     constructor Create;
     22    constructor Create(FreeObjects: Boolean = True);
    2323  end;
    2424
    … …  
    223223
    224224
    225 { TLanguageList }
    226 
    227 function TLanguageList.SearchByCode(ACode: string): TLanguage;
     225{ TLanguages }
     226
     227function TLanguages.SearchByCode(ACode: string): TLanguage;
    228228var
    229229  I: Integer;
    … …  
    235235end;
    236236
    237 procedure TLanguageList.AddNew(Code: string; Name: string);
     237procedure TLanguages.AddNew(Code: string; Name: string);
    238238var
    239239  NewItem: TLanguage;
    … …  
    245245end;
    246246
    247 constructor TLanguageList.Create;
     247constructor TLanguages.Create(FreeObjects: Boolean);
    248248begin
    249   inherited Create;
     249  inherited;
    250250  AddNew('', SLangAuto);
    251251  AddNew('aa', SLang_aa);

  • trunk/Packages/Common/UListViewSort.pas

    r55 r83  
    8181    FOnChange: TNotifyEvent;
    8282    FStringGrid1: TStringGrid;
     83    procedure DoOnChange;
    8384    procedure GridDoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    8485    procedure GridDoOnResize(Sender: TObject);
    … …  
    9091    function TextEnteredColumn(Index: Integer): Boolean;
    9192    function GetColValue(Index: Integer): string;
     93    procedure Reset;
    9294    property StringGrid: TStringGrid read FStringGrid1 write FStringGrid1;
    9395  published
    … …  
    152154{ TListViewFilter }
    153155
     156procedure TListViewFilter.DoOnChange;
     157begin
     158  if Assigned(FOnChange) then FOnChange(Self);
     159end;
     160
    154161procedure TListViewFilter.GridDoOnKeyUp(Sender: TObject; var Key: Word;
    155162  Shift: TShiftState);
    156163begin
    157   if Assigned(FOnChange) then
    158     FOnChange(Self);
     164  DoOnChange;
    159165end;
    160166
    … …  
    227233    Result := StringGrid.Cells[Index, 0]
    228234    else Result := '';
     235end;
     236
     237procedure TListViewFilter.Reset;
     238var
     239  I: Integer;
     240begin
     241  with StringGrid do
     242  for I := 0 to ColCount - 1 do
     243    Cells[I, 0] := '';
     244  DoOnChange;
    229245end;
    230246

  • trunk/Packages/Common/UMetaCanvas.pas

    r67 r83  
    66
    77uses
    8   Classes, SysUtils, Graphics, Contnrs, Types, fgl;
     8  Classes, SysUtils, Graphics, Types, fgl;
    99
    1010type

  • trunk/Packages/Common/UPixelPointer.pas

    r77 r83  
    1515  private
    1616    procedure SetRGB(AValue: Cardinal);
     17    function GetRGB: Cardinal;   
    1718  public
    18     function GetRGB: Cardinal;
    1919    property RGB: Cardinal read GetRGB write SetRGB;
    2020    case Integer of
    … …  
    5757  function Color32ToPixel32(Color: TColor32): TPixel32;
    5858  function Pixel32ToColor32(Color: TPixel32): TColor32;
     59  function Color32ToColor(Color: TColor32): TColor;
     60  function ColorToColor32(Color: TColor): TColor32;
    5961
    6062implementation
    … …  
    136138var
    137139  SrcPtr, DstPtr: TPixelPointer;
    138   SubPtr: TPixelPointer;
    139140  X, Y: Integer;
    140141  XX, YY: Integer;
    … …  
    281282end;
    282283
     284function Color32ToColor(Color: TColor32): TColor;
     285begin
     286  Result := ((Color shr 16) and $ff) or (Color and $00ff00) or
     287    ((Color and $ff) shl 16);
     288end;
     289
     290function ColorToColor32(Color: TColor): TColor32;
     291begin
     292  Result := $ff000000 or ((Color shr 16) and $ff) or (Color and $00ff00) or
     293    ((Color and $ff) shl 16);
     294end;
     295
    283296function PixelPointer(Bitmap: TRasterImage; BaseX: Integer;
    284297  BaseY: Integer): TPixelPointer;

  • trunk/Packages/Common/UScaleDPI.pas

    r55 r83  
    227227    Temp[I] := TBitmap.Create;
    228228    Temp[I].SetSize(NewWidth, NewHeight);
     229    {$IFDEF Linux}
     230    Temp[I].PixelFormat := pf24bit;
     231    {$ELSE}
    229232    Temp[I].PixelFormat := pf32bit;
     233    {$ENDIF}
    230234    Temp[I].TransparentColor := TempBmp.TransparentColor;
    231235    //Temp[I].TransparentMode := TempBmp.TransparentMode;

  • trunk/Packages/Common/UTheme.pas

    r55 r83  
    55uses
    66  Classes, SysUtils, Graphics, ComCtrls, Controls, ExtCtrls, Menus, StdCtrls,
    7   Spin, Forms, Contnrs, Grids;
     7  Spin, Forms, fgl, Grids;
    88
    99type
    … …  
    1919  { TThemes }
    2020
    21   TThemes = class(TObjectList)
     21  TThemes = class(TFPGObjectList<TTheme>)
    2222    function AddNew(Name: string): TTheme;
    2323    function FindByName(Name: string): TTheme;
    … …  
    7474procedure TThemes.LoadToStrings(Strings: TStrings);
    7575var
    76   Theme: TTheme;
     76  I: Integer;
    7777begin
    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;
    8189end;
    8290
    … …  
    123131destructor TThemeManager.Destroy;
    124132begin
    125   Themes.Free;
    126   inherited Destroy;
     133  FreeAndNil(Themes);
     134  inherited;
    127135end;
    128136

  • trunk/Packages/Common/UThreading.pas

    r55 r83  
    66
    77uses
    8   Classes, SysUtils, Forms, Contnrs, SyncObjs;
     8  Classes, SysUtils, Forms, fgl, SyncObjs;
    99
    1010type
    … …  
    2222    function GetSuspended: Boolean; virtual; abstract;
    2323    function GetTerminated: Boolean; virtual; abstract;
    24     function GetThreadId: Integer; virtual; abstract;
     24    function GetThreadId: TThreadID; virtual; abstract;
    2525    procedure SetFreeOnTerminate(const AValue: Boolean); virtual; abstract;
    2626    procedure SetPriority(const AValue: TThreadPriority); virtual; abstract;
    … …  
    4242    property Terminated: Boolean read GetTerminated write SetTerminated;
    4343    property Finished: Boolean read GetFinished;
    44     property ThreadId: Integer read GetThreadId;
     44    property ThreadId: TThreadID read GetThreadId;
    4545  end;
    4646
    … …  
    6868    function GetSuspended: Boolean; override;
    6969    function GetTerminated: Boolean; override;
    70     function GetThreadId: Integer; override;
     70    function GetThreadId: TThreadID; override;
    7171    procedure SetFreeOnTerminate(const AValue: Boolean); override;
    7272    procedure SetPriority(const AValue: TThreadPriority); override;
    … …  
    102102  { TThreadList }
    103103
    104   TThreadList = class(TObjectList)
    105     function FindById(Id: Integer): TVirtualThread;
     104  TThreadList = class(TFPGObjectList<TVirtualThread>)
     105    function FindById(Id: TThreadID): TVirtualThread;
    106106    constructor Create; virtual;
    107107  end;
    … …  
    164164  if MainThreadID = ThreadID then Method
    165165  else begin
    166     Thread := ThreadList.FindById(ThreadID);
     166    try
     167      ThreadListLock.Acquire;
     168      Thread := ThreadList.FindById(ThreadID);
     169    finally
     170      ThreadListLock.Release;
     171    end;
    167172    if Assigned(Thread) then begin
    168173      Thread.Synchronize(Method);
    … …  
    173178{ TThreadList }
    174179
    175 function TThreadList.FindById(Id: Integer): TVirtualThread;
     180function TThreadList.FindById(Id: TThreadID): TVirtualThread;
    176181var
    177182  I: Integer;
    178183begin
    179184  I := 0;
    180   while (I < ThreadList.Count) and (TVirtualThread(ThreadList[I]).ThreadID <> Id) do
     185  while (I < ThreadList.Count) and (ThreadList[I].ThreadID <> Id) do
    181186    Inc(I);
    182   if I < ThreadList.Count then Result := TVirtualThread(ThreadList[I])
     187  if I < ThreadList.Count then Result := ThreadList[I]
    183188    else Result := nil;
    184189end;
    … …  
    233238end;
    234239
    235 function TListedThread.GetThreadId: Integer;
     240function TListedThread.GetThreadId: TThreadID;
    236241begin
    237242  Result := FThread.ThreadID;
    … …  
    356361ThreadListLock := TCriticalSection.Create;
    357362ThreadList := TThreadList.Create;
    358 ThreadList.OwnsObjects := False;
     363ThreadList.FreeObjects := False;
    359364
    360365finalization

  • trunk/Packages/Common/UTranslator.pas

    r60 r83  
    11unit UTranslator;
    22
    3 {$mode Delphi}{$H+}
     3{$mode delphi}{$H+}
    44
    55interface
    66
    77uses
    8   Classes, SysUtils, Forms, ExtCtrls, Controls, Contnrs, LazFileUtils, LazUTF8,
     8  Classes, SysUtils, Forms, ExtCtrls, Controls, fgl, LazFileUtils, LazUTF8,
    99  Translations, TypInfo, Dialogs, FileUtil, LCLProc, ULanguages, LCLType,
    1010  LCLVersion;
    … …  
    1212type
    1313  THandleStringEvent = function (AValue: string): string of object;
     14
     15  TPoFiles = class(TFPGObjectList<TPOFile>)
     16  end;
    1417
    1518  { TComponentExcludes }
    … …  
    2427  { TComponentExcludesList }
    2528
    26   TComponentExcludesList = class(TObjectList)
     29  TComponentExcludesList = class(TFPGObjectList<TComponentExcludes>)
    2730    function FindByClassType(AClassType: TClass): TComponentExcludes;
    2831    procedure DumpToStrings(Strings: TStrings);
    … …  
    3639    FOnAutomaticLanguage: THandleStringEvent;
    3740    FOnTranslate: TNotifyEvent;
    38     FPOFilesFolder: string;
    39     FPOFiles: TObjectList; // TObjectList<TPOFile>;
     41    FPoFilesFolder: string;
     42    FPoFiles: TPoFiles;
    4043    function GetLocale: string;
    4144    function GetLocaleShort: string;
    … …  
    5053  public
    5154    ComponentExcludes: TComponentExcludesList;
    52     Languages: TLanguageList;
     55    Languages: TLanguages;
    5356    procedure Translate;
    54     procedure LanguageListToStrings(Strings: TStrings);
     57    procedure LanguageListToStrings(Strings: TStrings; WithCode: Boolean = True);
    5558    procedure TranslateResourceStrings(PoFileName: string);
    5659    procedure TranslateUnitResourceStrings(UnitName: string; PoFileName: string);
    … …  
    6366    destructor Destroy; override;
    6467  published
    65     property POFilesFolder: string read FPOFilesFolder write SetPOFilesFolder;
     68    property POFilesFolder: string read FPoFilesFolder write SetPOFilesFolder;
    6669    property Language: TLanguage read FLanguage write SetLanguage;
    6770    property OnTranslate: TNotifyEvent read FOnTranslate write FOnTranslate;
    … …  
    7174
    7275procedure Register;
     76
    7377
    7478implementation
    … …  
    117121destructor TComponentExcludes.Destroy;
    118122begin
    119   PropertyExcludes.Free;
    120   inherited Destroy;
     123  FreeAndNil(PropertyExcludes);
     124  inherited;
    121125end;
    122126
    … …  
    128132  I, J: Integer;
    129133  Po: TPoFile;
    130   Item: TPOFileItem;
     134  Item: TPoFileItem;
    131135begin
    132136  TranslateComponentRecursive(Application);
    … …  
    134138  // Merge files to single translation file
    135139  try
    136     Po := TPOFile.Create;
    137     for I := 0 to FPOFiles.Count - 1 do
     140    Po := TPoFile.Create;
     141    for I := 0 to FPoFiles.Count - 1 do
    138142    with TPoFile(FPoFiles[I]) do
    139143      for J := 0 to Items.Count - 1 do
    … …  
    162166  SearchMask: string;
    163167begin
    164   FPOFiles.Clear;
     168  FPoFiles.Clear;
    165169  if Assigned(FLanguage) then
    166170  try
    … …  
    177181      if FileExists(FileName) and (
    178182      ((LocaleShort = '') and (Pos('.', FileName) = Pos('.po', FileName))) or
    179       (LocaleShort <> '')) then FPOFiles.Add(TPOFile.Create(FileName));
     183      (LocaleShort <> '')) then FPoFiles.Add(TPOFile.Create(FileName));
    180184    end;
    181185  finally
    … …  
    281285var
    282286  Item: TClass;
    283 
    284287  Excludes: TComponentExcludes;
    285288begin
    … …  
    301304function TTranslator.GetLangFileDir: string;
    302305begin
    303   Result := FPOFilesFolder;
     306  Result := FPoFilesFolder;
    304307  if Copy(Result, 1, 1) <> DirectorySeparator then
    305308    Result := ExtractFileDir(Application.ExeName) +
    … …  
    307310end;
    308311
    309 procedure TTranslator.LanguageListToStrings(Strings: TStrings);
     312procedure TTranslator.LanguageListToStrings(Strings: TStrings; WithCode: Boolean = True);
    310313var
    311314  I: Integer;
    … …  
    313316begin
    314317  with Strings do begin
    315     Clear;
    316     for I := 0 to Languages.Count - 1 do
    317     with TLanguage(Languages[I]) do
    318       if Available then begin
    319         ItemName := Name;
    320         if Code <> '' then ItemName := ItemName + ' (' + Code + ')';
    321         AddObject(ItemName, Languages[I]);
    322       end;
     318    BeginUpdate;
     319    try
     320      Clear;
     321      for I := 0 to Languages.Count - 1 do
     322      with Languages[I] do
     323        if Available then begin
     324          ItemName := Name;
     325          if WithCode and (Code <> '') then ItemName := ItemName + ' (' + Code + ')';
     326          AddObject(ItemName, Languages[I]);
     327        end;
     328    finally
     329      EndUpdate;
     330    end;
    323331  end;
    324332end;
    … …  
    342350  if Text <> '' then begin
    343351    for I := 0 to FPoFiles.Count - 1 do begin
    344       Result := TPoFile(FPOFiles[I]).Translate(Identifier, Text);
     352      Result := TPoFile(FPoFiles[I]).Translate(Identifier, Text);
    345353      if Result <> Text then Break;
    346354    end;
    … …  
    369377begin
    370378  LangDir := GetLangFileDir;
    371   TLanguage(Languages[0]).Available := True; // Automatic
     379  Languages.SearchByCode('').Available := True; // Automatic
    372380
    373381  for I := 1 to Languages.Count - 1 do
    374   with TLanguage(Languages[I]) do begin
     382  with Languages[I] do begin
    375383    Available := FileExists(LangDir + DirectorySeparator + ExtractFileNameOnly(Application.ExeName) +
    376384      '.' + Code + ExtensionSeparator + 'po') or (Code = 'en');
    … …  
    381389begin
    382390  inherited;
    383   FPOFiles := TObjectList.Create;
     391  FPoFiles := TPoFiles.Create;
    384392  ComponentExcludes := TComponentExcludesList.Create;
    385   Languages := TLanguageList.Create;
     393  Languages := TLanguages.Create;
    386394  POFilesFolder := 'Languages';
    387395  CheckLanguageFiles;
    … …  
    395403destructor TTranslator.Destroy;
    396404begin
    397   FPOFiles.Free;
    398   Languages.Free;
    399   ComponentExcludes.Free;
    400   inherited Destroy;
     405  FreeAndNil(FPoFiles);
     406  FreeAndNil(Languages);
     407  FreeAndNil(ComponentExcludes);
     408  inherited;
    401409end;
    402410
Note: See TracChangeset for help on using the changeset viewer.