Changeset 207 for trunk/Packages/Common


Ignore:
Timestamp:
Sep 20, 2021, 10:16:37 AM (3 years ago)
Author:
chronos
Message:
  • Modified: Updated Common package.
  • Modified: CoolTranslator package merged into Common package.
  • Fixed: Build with Lazarus 2.0.12
Location:
trunk/Packages/Common
Files:
16 added
9 edited

Legend:

Unmodified
Added
Removed

  • trunk/Packages/Common/Common.lpk

    r204 r207  
    3737      </Other>
    3838    </CompilerOptions>
    39     <Description Value="Various libraries"/>
    40     <License Value="GNU/GPL"/>
    41     <Version Minor="7"/>
    42     <Files Count="22">
     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="8"/>
     44    <Files Count="29">
    4345      <Item1>
    4446        <Filename Value="StopWatch.pas"/>
    … …  
    139141        <UnitName Value="UStringTable"/>
    140142      </Item22>
     143      <Item23>
     144        <Filename Value="UMetaCanvas.pas"/>
     145        <UnitName Value="UMetaCanvas"/>
     146      </Item23>
     147      <Item24>
     148        <Filename Value="UGeometric.pas"/>
     149        <UnitName Value="UGeometric"/>
     150      </Item24>
     151      <Item25>
     152        <Filename Value="UTranslator.pas"/>
     153        <HasRegisterProc Value="True"/>
     154        <UnitName Value="UTranslator"/>
     155      </Item25>
     156      <Item26>
     157        <Filename Value="ULanguages.pas"/>
     158        <UnitName Value="ULanguages"/>
     159      </Item26>
     160      <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>
     170        <Filename Value="UPixelPointer.pas"/>
     171        <UnitName Value="UPixelPointer"/>
     172      </Item29>
    141173    </Files>
    142174    <i18n>

  • trunk/Packages/Common/Common.pas

    r204 r207  
    1212  UMemory, UResetableThread, UPool, ULastOpenedList, URegistry,
    1313  UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort,
    14   UPersistentForm, UFindFile, UScaleDPI, UTheme, UStringTable,
    15   LazarusPackageIntf;
     14  UPersistentForm, UFindFile, UScaleDPI, UTheme, UStringTable, UMetaCanvas,
     15  UGeometric, UTranslator, ULanguages, UFormAbout, UAboutDialog,
     16  UPixelPointer, LazarusPackageIntf;
    1617
    1718implementation
    … …  
    2930  RegisterUnit('UScaleDPI', @UScaleDPI.Register);
    3031  RegisterUnit('UTheme', @UTheme.Register);
     32  RegisterUnit('UTranslator', @UTranslator.Register);
     33  RegisterUnit('UAboutDialog', @UAboutDialog.Register);
    3134end;
    3235

  • trunk/Packages/Common/UApplicationInfo.pas

    r181 r207  
    66
    77uses
    8   SysUtils, Classes, Forms, URegistry, Controls;
     8  SysUtils, Classes, Forms, URegistry, Controls, Graphics, LCLType;
    99
    1010type
    … …  
    1414  TApplicationInfo = class(TComponent)
    1515  private
    16     FDescription: TCaption;
     16    FDescription: TTranslateString;
     17    FIcon: TBitmap;
    1718    FIdentification: Byte;
    1819    FLicense: string;
    … …  
    3334  public
    3435    constructor Create(AOwner: TComponent); override;
     36    destructor Destroy; override;
    3537    property Version: string read GetVersion;
    3638    function GetRegistryContext: TRegistryContext;
    … …  
    4749    property EmailContact: string read FEmailContact write FEmailContact;
    4850    property AppName: string read FAppName write FAppName;
    49     property Description: string read FDescription write FDescription;
     51    property Description: TTranslateString read FDescription write FDescription;
    5052    property ReleaseDate: TDateTime read FReleaseDate write FReleaseDate;
    5153    property RegistryKey: string read FRegistryKey write FRegistryKey;
    5254    property RegistryRoot: TRegistryRoot read FRegistryRoot write FRegistryRoot;
    5355    property License: string read FLicense write FLicense;
     56    property Icon: TBitmap read FIcon write FIcon;
    5457  end;
    5558
    … …  
    7477constructor TApplicationInfo.Create(AOwner: TComponent);
    7578begin
    76   inherited Create(AOwner);
     79  inherited;
    7780  FVersionMajor := 1;
    7881  FIdentification := 1;
    … …  
    8083  FRegistryKey := '\Software\' + FAppName;
    8184  FRegistryRoot := rrKeyCurrentUser;
     85  FIcon := TBitmap.Create;
     86end;
     87
     88destructor TApplicationInfo.Destroy;
     89begin
     90  FreeAndNil(FIcon);
     91  inherited;
    8292end;
    8393

  • trunk/Packages/Common/UCommon.pas

    r204 r207  
    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;
    8687
    8788
    … …  
    669670end;
    670671
     672function CombinePaths(Path1, Path2: string): string;
     673begin
     674  Result := Path1;
     675  if Result <> '' then Result := Result + DirectorySeparator + Path2
     676    else Result := Path2;
     677end;
     678
    671679
    672680initialization

  • trunk/Packages/Common/UListViewSort.pas

    r204 r207  
    11unit UListViewSort;
    22
    3 // Date: 2010-11-03
     3// Date: 2019-05-17
    44
    55{$mode delphi}
    … …  
    88
    99uses
    10   {$IFDEF Windows}Windows, CommCtrl, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils,
     10  {$IFDEF Windows}Windows, CommCtrl, LMessages, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils,
    1111  Controls, DateUtils, Dialogs, fgl, Forms, Grids, StdCtrls, ExtCtrls,
    12   LclIntf, LMessages, LclType, LResources;
     12  LclIntf, LclType, LResources;
    1313
    1414type

  • trunk/Packages/Common/UPersistentForm.pas

    r200 r207  
    33{$mode delphi}
    44
    5 // Date: 2015-04-18
     5// Date: 2020-11-26
    66
    77interface
    … …  
    99uses
    1010  Classes, SysUtils, Forms, URegistry, LCLIntf, Registry, Controls, ComCtrls,
    11   ExtCtrls;
     11  ExtCtrls, LCLType;
    1212
    1313type
    … …  
    2626    FormRestoredSize: TRect;
    2727    FormWindowState: TWindowState;
     28    FormFullScreen: Boolean;
    2829    Form: TForm;
    2930    procedure LoadFromRegistry(RegistryContext: TRegistryContext);
    … …  
    3132    function CheckEntireVisible(Rect: TRect): TRect;
    3233    function CheckPartVisible(Rect: TRect; Part: Integer): TRect;
    33     procedure Load(Form: TForm; DefaultMaximized: Boolean = False);
     34    procedure Load(Form: TForm; DefaultMaximized: Boolean = False;
     35      DefaultFullScreen: Boolean = False);
    3436    procedure Save(Form: TForm);
    3537    constructor Create(AOwner: TComponent); override;
     38    procedure SetFullScreen(State: Boolean);
    3639    property RegistryContext: TRegistryContext read FRegistryContext
    3740      write FRegistryContext;
    … …  
    4346procedure Register;
    4447
     48
    4549implementation
    46 
    4750
    4851procedure Register;
    … …  
    169172      + FormRestoredSize.Top;
    170173    // Other state
    171     FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(wsNormal)));
     174    FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(FormWindowState)));
     175    FormFullScreen := ReadBoolWithDefault('FullScreen', FormFullScreen);
    172176  finally
    173177    Free;
    … …  
    193197    // Other state
    194198    WriteInteger('WindowState', Integer(FormWindowState));
     199    WriteBool('FullScreen', FormFullScreen);
    195200  finally
    196201    Free;
    … …  
    250255end;
    251256
    252 procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False);
     257procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False;
     258  DefaultFullScreen: Boolean = False);
    253259begin
    254260  Self.Form := Form;
    … …  
    258264  FormRestoredSize := Bounds((Screen.Width - Form.Width) div 2,
    259265    (Screen.Height - Form.Height) div 2, Form.Width, Form.Height);
     266  FormWindowState := Form.WindowState;
     267  FormFullScreen := DefaultFullScreen;
    260268
    261269  LoadFromRegistry(RegistryContext);
    … …  
    277285      Form.BoundsRect := FormNormalSize;
    278286  end;
     287  if FormFullScreen then SetFullScreen(True);
    279288  LoadControl(Form);
    280289end;
    … …  
    284293  Self.Form := Form;
    285294  FormNormalSize := Bounds(Form.Left, Form.Top, Form.Width, Form.Height);
    286   FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth,
    287     Form.RestoredHeight);
     295  if not FormFullScreen then
     296    FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth,
     297      Form.RestoredHeight);
    288298  FormWindowState := Form.WindowState;
    289299  SaveToRegistry(RegistryContext);
    … …  
    300310end;
    301311
     312procedure TPersistentForm.SetFullScreen(State: Boolean);
     313begin
     314  if State then begin
     315    FormFullScreen := True;
     316    FormNormalSize := Form.BoundsRect;
     317    FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth,
     318      Form.RestoredHeight);
     319    FormWindowState := Form.WindowState;
     320    ShowWindow(Form.Handle, SW_SHOWFULLSCREEN);
     321    {$IFDEF WINDOWS}
     322    Form.BorderStyle := bsNone;
     323    {$ENDIF}
     324  end else begin
     325    FormFullScreen := False;
     326    {$IFDEF WINDOWS}
     327    Form.BorderStyle := bsSizeable;
     328    {$ENDIF}
     329    ShowWindow(Form.Handle, SW_SHOWNORMAL);
     330    if FormWindowState = wsNormal then begin
     331      Form.BoundsRect := FormNormalSize;
     332    end else
     333    if FormWindowState = wsMaximized then begin
     334      Form.BoundsRect := FormRestoredSize;
     335      Form.WindowState := wsMaximized;
     336    end;
     337  end;
     338end;
     339
    302340end.
    303341

  • trunk/Packages/Common/URegistry.pas

    r204 r207  
    11unit URegistry;
    22
    3 {$MODE Delphi}
     3{$MODE delphi}
    44
    55interface
    … …  
    1717    RootKey: HKEY;
    1818    Key: string;
     19    class function Create(RootKey: TRegistryRoot; Key: string): TRegistryContext; static; overload;
     20    class function Create(RootKey: HKEY; Key: string): TRegistryContext; static; overload;
    1921    class operator Equal(A, B: TRegistryContext): Boolean;
    20     function Create(RootKey: TRegistryRoot; Key: string): TRegistryContext; overload;
    21     function Create(RootKey: HKEY; Key: string): TRegistryContext; overload;
    2222  end;
    2323
    … …  
    5858end;
    5959
    60 function TRegistryContext.Create(RootKey: TRegistryRoot; Key: string): TRegistryContext;
     60class function TRegistryContext.Create(RootKey: TRegistryRoot; Key: string): TRegistryContext;
    6161begin
    6262  Result.RootKey := RegistryRootHKEY[RootKey];
    … …  
    6464end;
    6565
    66 function TRegistryContext.Create(RootKey: HKEY; Key: string): TRegistryContext;
     66class function TRegistryContext.Create(RootKey: HKEY; Key: string): TRegistryContext;
    6767begin
    6868  Result.RootKey := RootKey;
    … …  
    133133begin
    134134  {$IFDEF Linux}
    135   CloseKey;
     135  //CloseKey;
    136136  {$ENDIF}
    137137  Result := inherited OpenKey(Key, CanCreate);

  • trunk/Packages/Common/UScaleDPI.pas

    r200 r207  
    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/UThreading.pas

    r181 r207  
    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
Note: See TracChangeset for help on using the changeset viewer.