Changeset 90 for trunk/Packages/Common


Ignore:
Timestamp:
Feb 2, 2022, 2:55:58 PM (3 years ago)
Author:
chronos
Message:
  • Modified: Build under Lazarus 2.2.0.
  • Modified: Updated Common package.
  • Added: Read Me file with app description and development information.
  • Added: Test form available in debug mode from Tools menu with list of test cases to better support app testability.
Location:
trunk/Packages/Common
Files:
9 added
10 deleted
15 edited

Legend:

Unmodified
Added
Removed

  • trunk/Packages/Common/Common.lpk

    r22 r90  
    11<?xml version="1.0" encoding="UTF-8"?>
    22<CONFIG>
    3   <Package Version="4">
     3  <Package Version="5">
    44    <PathDelim Value="\"/>
    55    <Name Value="Common"/>
    … …  
    3333      <Other>
    3434        <CompilerMessages>
    35           <IgnoredMessages idx5024="True"/>
     35          <IgnoredMessages idx6058="True" idx5024="True" idx3124="True" idx3123="True"/>
    3636        </CompilerMessages>
    3737      </Other>
    … …  
    4141Source: https://svn.zdechov.net/PascalClassLibrary/Common/"/>
    4242    <License Value="Copy left."/>
    43     <Version Minor="8"/>
     43    <Version Minor="9"/>
    4444    <Files Count="29">
    4545      <Item1>
    … …  
    172172      </Item29>
    173173    </Files>
     174    <CompatibilityMode Value="True"/>
    174175    <i18n>
    175176      <EnableI18N Value="True"/>

  • trunk/Packages/Common/Languages/UJobProgressView.cs.po

    r21 r90  
    1313
    1414#: ujobprogressview.sestimatedtime
     15#, object-pascal-format
    1516msgid "Estimated time: %s"
    1617msgstr "Odhadovaný čas: %s"
    … …  
    3334
    3435#: ujobprogressview.stotalestimatedtime
     36#, object-pascal-format
    3537msgid "Total estimated time: %s"
    3638msgstr "Celkový odhadovaný čas: %s"

  • trunk/Packages/Common/Languages/UScaleDPI.cs.po

    r21 r90  
    1313
    1414#: uscaledpi.swrongdpi
     15#, object-pascal-format
    1516msgid "Wrong DPI [%d,%d]"
    1617msgstr "Chybné DPI [%d,%d]"

  • trunk/Packages/Common/Languages/UThreading.cs.po

    r1 r90  
    1111
    1212#: uthreading.scurrentthreadnotfound
     13#, object-pascal-format
    1314msgid "Current thread ID %d not found in virtual thread list."
    1415msgstr "Aktuální vlákno ID %d nenalezeno v seznamu virtuálních vláken."

  • trunk/Packages/Common/UAboutDialog.pas

    r83 r90  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
    9   StdCtrls, ExtCtrls, UApplicationInfo, UCommon, UTranslator, UTheme, UFormAbout;
     9  ExtCtrls, UApplicationInfo, UCommon, UTranslator, UTheme, UFormAbout;
    1010
    1111type

  • trunk/Packages/Common/UCommon.pas

    r68 r90  
    66
    77uses
    8   {$ifdef Windows}Windows,{$endif}
    9   {$ifdef Linux}baseunix,{$endif}
     8  {$IFDEF WINDOWS}Windows,{$ENDIF}
     9  {$IFDEF UNIX}baseunix,{$ENDIF}
    1010  Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf,
    1111  FileUtil; //, ShFolder, ShellAPI;
    … …  
    3535  DLLHandle1: HModule;
    3636
    37 {$IFDEF Windows}
     37{$IFDEF WINDOWS}
    3838  GetUserNameEx: procedure (NameFormat: DWORD;
    3939    lpNameBuffer: LPSTR; nSize: PULONG); stdcall;
    … …  
    292292function Explode(Separator: char; Data: string): TArrayOfString;
    293293begin
     294  Result := nil;
    294295  SetLength(Result, 0);
    295296  while Pos(Separator, Data) > 0 do begin
    … …  
    346347  Name: UtsName;
    347348begin
     349  Name := Default(UtsName);
    348350  fpuname(Name);
    349351  Result := Name.Nodename;
    … …  
    505507  I: Integer;
    506508begin
     509  Result := Default(TArrayOfString);
    507510  SetLength(Result, Length(A) + Length(B));
    508511  for I := 0 to Length(A) - 1 do

  • trunk/Packages/Common/UFindFile.pas

    r21 r90  
    5959  FilterAll = '*.*';
    6060{$ENDIF}
    61 {$IFDEF LINUX}
     61{$IFDEF UNIX}
    6262  FilterAll = '*';
    6363{$ENDIF}

  • trunk/Packages/Common/UGeometric.pas

    r22 r90  
    9696  I: Integer;
    9797begin
     98  Result := Default(TPointArray);
    9899  SetLength(Result, Length(P));
    99100  for I := 0 to High(P) do

  • trunk/Packages/Common/UJobProgressView.lfm

    r21 r90  
    11object FormJobProgressView: TFormJobProgressView
    22  Left = 467
    3   Height = 345
     3  Height = 414
    44  Top = 252
    5   Width = 539
     5  Width = 647
    66  BorderIcons = [biSystemMenu]
    7   ClientHeight = 345
    8   ClientWidth = 539
    9   DesignTimePPI = 120
     7  ClientHeight = 414
     8  ClientWidth = 647
     9  DesignTimePPI = 144
    1010  OnClose = FormClose
    1111  OnCloseQuery = FormCloseQuery
    1212  OnCreate = FormCreate
    13   OnDestroy = FormDestroy
    1413  OnHide = FormHide
    1514  OnShow = FormShow
    1615  Position = poScreenCenter
    17   LCLVersion = '2.0.2.0'
     16  LCLVersion = '2.2.0.4'
    1817  object PanelOperationsTitle: TPanel
    1918    Left = 0
    20     Height = 32
     19    Height = 38
    2120    Top = 0
    22     Width = 539
     21    Width = 647
    2322    Align = alTop
    2423    BevelOuter = bvNone
    25     ClientHeight = 32
    26     ClientWidth = 539
     24    ClientHeight = 38
     25    ClientWidth = 647
    2726    FullRepaint = False
    2827    TabOrder = 0
    2928    object LabelOperation: TLabel
    30       Left = 8
    31       Height = 20
    32       Top = 8
    33       Width = 76
     29      Left = 10
     30      Height = 26
     31      Top = 10
     32      Width = 99
    3433      Caption = 'Operations:'
    35       ParentColor = False
    3634      ParentFont = False
    3735    end
    … …  
    3937  object PanelLog: TPanel
    4038    Left = 0
    41     Height = 133
    42     Top = 212
    43     Width = 539
     39    Height = 161
     40    Top = 253
     41    Width = 647
    4442    Align = alClient
    4543    BevelOuter = bvSpace
    46     ClientHeight = 133
    47     ClientWidth = 539
     44    ClientHeight = 161
     45    ClientWidth = 647
    4846    TabOrder = 1
    4947    object MemoLog: TMemo
    50       Left = 8
    51       Height = 117
    52       Top = 8
    53       Width = 523
     48      Left = 10
     49      Height = 141
     50      Top = 10
     51      Width = 627
    5452      Anchors = [akTop, akLeft, akRight, akBottom]
    5553      ReadOnly = True
    … …  
    6058  object PanelProgress: TPanel
    6159    Left = 0
    62     Height = 54
    63     Top = 106
    64     Width = 539
     60    Height = 65
     61    Top = 126
     62    Width = 647
    6563    Align = alTop
    6664    BevelOuter = bvNone
    67     ClientHeight = 54
    68     ClientWidth = 539
     65    ClientHeight = 65
     66    ClientWidth = 647
    6967    TabOrder = 2
    7068    object ProgressBarPart: TProgressBar
    71       Left = 10
    72       Height = 24
    73       Top = 24
    74       Width = 523
     69      Left = 12
     70      Height = 29
     71      Top = 29
     72      Width = 628
    7573      Anchors = [akTop, akLeft, akRight]
    7674      TabOrder = 0
    7775    end
    7876    object LabelEstimatedTimePart: TLabel
    79       Left = 8
    80       Height = 20
     77      Left = 10
     78      Height = 26
    8179      Top = -2
    82       Width = 103
     80      Width = 132
    8381      Caption = 'Estimated time:'
    84       ParentColor = False
    8582    end
    8683  end
    8784  object PanelOperations: TPanel
    8885    Left = 0
    89     Height = 42
    90     Top = 64
    91     Width = 539
     86    Height = 50
     87    Top = 76
     88    Width = 647
    9289    Align = alTop
    9390    BevelOuter = bvNone
    94     ClientHeight = 42
    95     ClientWidth = 539
     91    ClientHeight = 50
     92    ClientWidth = 647
    9693    FullRepaint = False
    9794    TabOrder = 3
    9895    object ListViewJobs: TListView
    99       Left = 8
    100       Height = 32
    101       Top = 5
    102       Width = 523
     96      Left = 10
     97      Height = 38
     98      Top = 6
     99      Width = 627
    103100      Anchors = [akTop, akLeft, akRight, akBottom]
    104101      AutoWidthLastColumn = True
    … …  
    107104      Columns = <     
    108105        item
    109           Width = 523
     106          Width = 614
    110107        end>
    111108      OwnerData = True
    … …  
    120117  object PanelProgressTotal: TPanel
    121118    Left = 0
    122     Height = 52
    123     Top = 160
    124     Width = 539
     119    Height = 62
     120    Top = 191
     121    Width = 647
    125122    Align = alTop
    126123    BevelOuter = bvNone
    127     ClientHeight = 52
    128     ClientWidth = 539
     124    ClientHeight = 62
     125    ClientWidth = 647
    129126    TabOrder = 4
    130127    object LabelEstimatedTimeTotal: TLabel
    131       Left = 8
    132       Height = 20
     128      Left = 10
     129      Height = 26
    133130      Top = 0
    134       Width = 141
     131      Width = 178
    135132      Caption = 'Total estimated time:'
    136       ParentColor = False
    137133    end
    138134    object ProgressBarTotal: TProgressBar
    139       Left = 8
    140       Height = 24
    141       Top = 24
    142       Width = 523
     135      Left = 10
     136      Height = 29
     137      Top = 29
     138      Width = 627
    143139      Anchors = [akTop, akLeft, akRight]
    144140      TabOrder = 0
    … …  
    147143  object PanelText: TPanel
    148144    Left = 0
    149     Height = 32
    150     Top = 32
    151     Width = 539
     145    Height = 38
     146    Top = 38
     147    Width = 647
    152148    Align = alTop
    153149    BevelOuter = bvNone
    154     ClientHeight = 32
    155     ClientWidth = 539
     150    ClientHeight = 38
     151    ClientWidth = 647
    156152    TabOrder = 5
    157153    object LabelText: TLabel
    158       Left = 8
    159       Height = 24
    160       Top = 8
    161       Width = 525
     154      Left = 10
     155      Height = 29
     156      Top = 10
     157      Width = 630
    162158      Anchors = [akTop, akLeft, akRight]
    163159      AutoSize = False
    164       ParentColor = False
    165160    end
    166161  end
    167162  object ImageList1: TImageList
    168     BkColor = clForeground
    169     left = 200
    170     top = 8
     163    Left = 240
     164    Top = 10
    171165    Bitmap = {
    172       4C69020000001000000010000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
    173       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    174       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    175       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    176       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    177       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    178       FF00000000FF000000FFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    179       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000
    180       00FF000000FF000000FFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    181       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FF0000
    182       00FF000000FF000000FFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    183       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FF000000FF0000
    184       00FF000000FFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    185       FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FF000000FF000000FF0000
    186       00FFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FFFF00FF00FF00
    187       FF00FF00FF00FF00FF00FF00FF00000000FF000000FF000000FF000000FFFF00
    188       FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FF000000FF000000FFFF00
    189       FF00FF00FF00FF00FF00000000FF000000FF000000FF000000FFFF00FF00FF00
    190       FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FF000000FF000000FF0000
    191       00FFFF00FF00000000FF000000FF000000FF000000FFFF00FF00FF00FF00FF00
    192       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FF000000FF0000
    193       00FF000000FF000000FF000000FF000000FFFF00FF00FF00FF00FF00FF00FF00
    194       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FF0000
    195       00FF000000FF000000FF000000FFFF00FF00FF00FF00FF00FF00FF00FF00FF00
    196       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000
    197       00FF000000FF000000FFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    198       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    199       FF00000000FFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    200       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    201       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    202       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    203       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    204       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    205       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    206       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    207       FF00FF00FF00FF00FF00FF00FF00000000FFFF00FF00FF00FF00FF00FF00FF00
    208       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    209       FF00FF00FF00FF00FF00FF00FF00000000FF000000FFFF00FF00FF00FF00FF00
    210       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    211       FF00FF00FF00FF00FF00FF00FF00000000FF000084FF000000FFFF00FF00FF00
    212       FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FF000000FF000000FF0000
    213       00FF000000FF000000FF000000FF000000FF0000FFFF000084FF000000FFFF00
    214       FF00FF00FF00FF00FF00FF00FF00FF00FF00000000FF0000FFFF0000FFFF0000
    215       FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF000084FF0000
    216       00FFFF00FF00FF00FF00FF00FF00FF00FF00000000FF0000FFFF0000FFFF0000
    217       FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000
    218       84FF000000FFFF00FF00FF00FF00FF00FF00000000FF0000FFFF0000FFFF0000
    219       FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000
    220       FFFF000084FF000000FFFF00FF00FF00FF00000000FF0000FFFF0000FFFF0000
    221       FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000
    222       84FF000000FFFF00FF00FF00FF00FF00FF00000000FF0000FFFF0000FFFF0000
    223       FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF000084FF0000
    224       00FFFF00FF00FF00FF00FF00FF00FF00FF00000000FF000000FF000000FF0000
    225       00FF000000FF000000FF000000FF000000FF0000FFFF000084FF000000FFFF00
    226       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    227       FF00FF00FF00FF00FF00FF00FF00000000FF000084FF000000FFFF00FF00FF00
    228       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    229       FF00FF00FF00FF00FF00FF00FF00000000FF000000FFFF00FF00FF00FF00FF00
    230       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    231       FF00FF00FF00FF00FF00FF00FF00000000FFFF00FF00FF00FF00FF00FF00FF00
    232       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    233       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    234       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    235       FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
    236       FF00FF00FF00FF00FF00FF00FF00
     166      4C7A0200000010000000100000006A0000000000000078DAE593490E00100C45
     167      7B78F72E5684A63A1142C382BE4F0708F89C955117F4B016BE67B5FC6E96DB97
     168      B0D4B9F4CD949F36DED1DF922B0F1BD11FAB5AFC68DE5C44D40220A9FA779EC8
     169      6A349FD5A435E43CADA1E3678D73F773F1DBF3EFADFFEEFEBBF97F6696BE9D36
    237170    }
    238171  end
    … …  
    241174    Interval = 100
    242175    OnTimer = TimerUpdateTimer
    243     left = 320
    244     top = 8
     176    Left = 384
     177    Top = 10
    245178  end
    246179end

  • trunk/Packages/Common/UJobProgressView.pas

    r21 r90  
    77uses
    88  SysUtils, Variants, Classes, Graphics, Controls, Forms, Syncobjs,
    9   Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading, Math,
     9  Dialogs, ComCtrls, StdCtrls, ExtCtrls, fgl, UThreading, Math,
    1010  DateUtils;
    1111
    … …  
    7171  end;
    7272
    73   TJobs = class(TObjectList)
     73  TJobs = class(TFPGObjectList<TJob>)
    7474  end;
    7575
    … …  
    105105    procedure ReloadJobList;
    106106    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    107     procedure FormDestroy(Sender: TObject);
    108107    procedure ListViewJobsData(Sender: TObject; Item: TListItem);
    109108    procedure TimerUpdateTimer(Sender: TObject);
    … …  
    286285end;
    287286
    288 procedure TFormJobProgressView.FormDestroy(Sender:TObject);
    289 begin
    290 end;
    291 
    292287procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);
    293288begin
    294289  if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then
    295   with TJob(JobProgressView.Jobs[Item.Index]) do begin
     290  with JobProgressView.Jobs[Item.Index] do begin
    296291    Item.Caption := Title;
    297292    if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1
    … …  
    405400    I := 0;
    406401    while I < Jobs.Count do
    407     with TJob(Jobs[I]) do begin
     402    with Jobs[I] do begin
    408403      CurrentJobIndex := I;
    409       CurrentJob := TJob(Jobs[I]);
     404      CurrentJob := Jobs[I];
    410405      JobProgressChange(Self);
    411406      StartTime := Now;
    … …  
    420415        Method(CurrentJob);
    421416      end else begin
     417        Thread := TJobThread.Create(True);
    422418        try
    423           Thread := TJobThread.Create(True);
    424419          with Thread do begin
    425420            FreeOnTerminate := False;
    … …  
    494489  if AValue = FTerminate then Exit;
    495490  for I := 0 to Jobs.Count - 1 do
    496     TJob(Jobs[I]).Terminate := AValue;
     491    Jobs[I].Terminate := AValue;
    497492  FTerminate := AValue;
    498493end;
    … …  
    620615procedure TProgress.Increment;
    621616begin
    622   try
    623     FLock.Acquire;
     617  FLock.Acquire;
     618  try
    624619    Value := Value + 1;
    625620  finally
    … …  
    630625procedure TProgress.Reset;
    631626begin
    632   try
    633     FLock.Acquire;
     627  FLock.Acquire;
     628  try
    634629    FValue := 0;
    635630  finally
    … …  
    678673destructor TJob.Destroy;
    679674begin
    680   Progress.Free;
     675  FreeAndNil(Progress);
    681676  inherited;
    682677end;

  • trunk/Packages/Common/ULanguages.pas

    r22 r90  
    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/UMetaCanvas.pas

    r22 r90  
    142142    procedure RoundRect(const Rect: TRect; RX,RY: Integer); overload;
    143143    procedure TextOut(X,Y: Integer; const Text: String); override;
    144     procedure Polygon(Points: PPoint; NumPts: Integer; Winding: boolean = False); override;
     144    procedure Polygon(Points: PPoint; NumPts: Integer; Winding: Boolean = False); override;
    145145    procedure Ellipse(x1, y1, x2, y2: Integer); override;
    146146    procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); override;
    … …  
    502502end;
    503503
    504 procedure TMetaCanvas.Polygon(Points: PPoint; NumPts: Integer; Winding: boolean
     504procedure TMetaCanvas.Polygon(Points: PPoint; NumPts: Integer; Winding: Boolean
    505505  );
    506506var
    … …  
    508508  I: Integer;
    509509begin
     510  APoints := nil;
    510511  SetLength(APoints, NumPts);
    511512  for I := 0 to High(APoints) do

  • trunk/Packages/Common/URegistry.pas

    r22 r90  
    132132function TRegistryEx.OpenKey(const Key: string; CanCreate: Boolean): Boolean;
    133133begin
    134   {$IFDEF Linux}
     134  {$IFDEF UNIX}
    135135  //CloseKey;
    136136  {$ENDIF}
    … …  
    140140function TRegistryEx.GetCurrentContext: TRegistryContext;
    141141begin
    142   Result.Key := CurrentPath;
     142  Result.Key := String(CurrentPath);
    143143  Result.RootKey := RootKey;
    144144end;

  • trunk/Packages/Common/UScaleDPI.pas

    r22 r90  
    88
    99uses
    10   Classes, Forms, Graphics, Controls, ComCtrls, LCLType, SysUtils, StdCtrls,
    11   Contnrs;
     10  Classes, Forms, Graphics, Controls, ComCtrls, LCLType, SysUtils, fgl;
    1211
    1312type
     13  TControlDimensions = class;
    1414
    1515  { TControlDimension }
    … …  
    1818    BoundsRect: TRect;
    1919    FontHeight: Integer;
    20     Controls: TObjectList; // TList<TControlDimension>
     20    Controls: TControlDimensions;
    2121    // Class specifics
    2222    ButtonSize: TPoint; // TToolBar
    … …  
    2626    constructor Create;
    2727    destructor Destroy; override;
     28  end;
     29
     30  TControlDimensions = class(TFPGObjectList<TControlDimension>)
    2831  end;
    2932
    … …  
    7376constructor TControlDimension.Create;
    7477begin
    75   Controls := TObjectList.Create;
     78  Controls := TControlDimensions.Create;
    7679end;
    7780
    … …  
    7982begin
    8083  FreeAndNil(Controls);
    81   inherited Destroy;
     84  inherited;
    8285end;
    8386
    … …  
    212215  TempBmp: TBitmap;
    213216  Temp: array of TBitmap;
    214   NewWidth, NewHeight: integer;
     217  NewWidth: Integer;
     218  NewHeight: Integer;
    215219  I: Integer;
    216220begin
    217221  ImgList.BeginUpdate;
    218   NewWidth := ScaleX(ImgList.Width, FromDPI.X);
    219   NewHeight := ScaleY(ImgList.Height, FromDPI.Y);
    220 
    221   SetLength(Temp, ImgList.Count);
    222   for I := 0 to ImgList.Count - 1 do
    223   begin
    224     TempBmp := TBitmap.Create;
    225     TempBmp.PixelFormat := pf32bit;
    226     ImgList.GetBitmap(I, TempBmp);
    227     Temp[I] := TBitmap.Create;
    228     Temp[I].SetSize(NewWidth, NewHeight);
    229     {$IFDEF Linux}
    230     Temp[I].PixelFormat := pf24bit;
    231     {$ELSE}
    232     Temp[I].PixelFormat := pf32bit;
    233     {$ENDIF}
    234     Temp[I].TransparentColor := TempBmp.TransparentColor;
    235     //Temp[I].TransparentMode := TempBmp.TransparentMode;
    236     Temp[I].Transparent := True;
    237     Temp[I].Canvas.Brush.Style := bsSolid;
    238     Temp[I].Canvas.Brush.Color := Temp[I].TransparentColor;
    239     Temp[I].Canvas.FillRect(0, 0, Temp[I].Width, Temp[I].Height);
    240 
    241     if (Temp[I].Width = 0) or (Temp[I].Height = 0) then Continue;
    242     Temp[I].Canvas.StretchDraw(Rect(0, 0, Temp[I].Width, Temp[I].Height), TempBmp);
    243     TempBmp.Free;
    244   end;
    245 
    246   ImgList.Clear;
    247   ImgList.Width := NewWidth;
    248   ImgList.Height := NewHeight;
    249 
    250   for I := 0 to High(Temp) do
    251   begin
    252     ImgList.Add(Temp[I], nil);
    253     Temp[i].Free;
    254   end;
    255   ImgList.EndUpdate;
     222  try
     223    NewWidth := ScaleX(ImgList.Width, FromDPI.X);
     224    NewHeight := ScaleY(ImgList.Height, FromDPI.Y);
     225
     226    Temp := nil;
     227    SetLength(Temp, ImgList.Count);
     228    for I := 0 to ImgList.Count - 1 do
     229    begin
     230      TempBmp := TBitmap.Create;
     231      try
     232        TempBmp.PixelFormat := pf32bit;
     233        ImgList.GetBitmap(I, TempBmp);
     234        Temp[I] := TBitmap.Create;
     235        Temp[I].SetSize(NewWidth, NewHeight);
     236        {$IFDEF UNIX}
     237        Temp[I].PixelFormat := pf24bit;
     238        {$ELSE}
     239        Temp[I].PixelFormat := pf32bit;
     240        {$ENDIF}
     241        Temp[I].TransparentColor := TempBmp.TransparentColor;
     242        //Temp[I].TransparentMode := TempBmp.TransparentMode;
     243        Temp[I].Transparent := True;
     244        Temp[I].Canvas.Brush.Style := bsSolid;
     245        Temp[I].Canvas.Brush.Color := Temp[I].TransparentColor;
     246        Temp[I].Canvas.FillRect(0, 0, Temp[I].Width, Temp[I].Height);
     247
     248        if (Temp[I].Width = 0) or (Temp[I].Height = 0) then Continue;
     249        Temp[I].Canvas.StretchDraw(Rect(0, 0, Temp[I].Width, Temp[I].Height), TempBmp);
     250      finally
     251        TempBmp.Free;
     252      end;
     253    end;
     254
     255    ImgList.Clear;
     256    ImgList.Width := NewWidth;
     257    ImgList.Height := NewHeight;
     258
     259    for I := 0 to High(Temp) do
     260    begin
     261      ImgList.Add(Temp[I], nil);
     262      Temp[i].Free;
     263    end;
     264  finally
     265    ImgList.EndUpdate;
     266  end;
    256267end;
    257268
    … …  
    331342  with TCoolBar(Control) do begin
    332343    BeginUpdate;
    333     for I := 0 to Bands.Count - 1 do
    334       with Bands[I] do begin
    335         MinWidth := ScaleX(MinWidth, FromDPI.X);
    336         MinHeight := ScaleY(MinHeight, FromDPI.Y);
    337         // Workaround to bad band width auto sizing
    338         //Width := ScaleX(Width, FromDPI.X);
    339         Width := ScaleX(Control.Width + 28, FromDPI.X);
    340         //Control.Invalidate;
     344    try
     345      for I := 0 to Bands.Count - 1 do
     346        with Bands[I] do begin
     347          MinWidth := ScaleX(MinWidth, FromDPI.X);
     348          MinHeight := ScaleY(MinHeight, FromDPI.Y);
     349          // Workaround to bad band width auto sizing
     350          //Width := ScaleX(Width, FromDPI.X);
     351          Width := ScaleX(Control.Width + 28, FromDPI.X);
     352          //Control.Invalidate;
     353        end;
     354      // Workaround for bad autosizing of coolbar
     355      if AutoSize then begin
     356        AutoSize := False;
     357        Height := ScaleY(Height, FromDPI.Y);
     358        AutoSize := True;
    341359      end;
    342     // Workaround for bad autosizing of coolbar
    343     if AutoSize then begin
    344       AutoSize := False;
    345       Height := ScaleY(Height, FromDPI.Y);
    346       AutoSize := True;
    347     end;
    348     EndUpdate;
     360    finally
     361      EndUpdate;
     362    end;
    349363  end;
    350364

  • trunk/Packages/Common/UTranslator.pas

    r22 r90  
    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.