Changeset 51 for trunk/Packages


Ignore:
Timestamp:
Dec 20, 2021, 6:45:12 PM (3 years ago)
Author:
chronos
Message:
  • Modified: Updated Common package.
  • Removed: CoolTranslator merged into Common package.
  • Modified: Code cleanup.
Location:
trunk/Packages
Files:
14 added
2 deleted
17 edited

Legend:

Unmodified
Added
Removed

  • trunk/Packages/Common/Common.lpk

    r38 r51  
    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

    r38 r51  
    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/Languages/UJobProgressView.cs.po

    r38 r51  
    2424msgstr "Dokončené"
    2525
    26 #: ujobprogressview.soperations
    27 #, fuzzy
    28 #| msgid "Operations"
    29 msgid "Operations:"
    30 msgstr "Operace"
    31 
    3226#: ujobprogressview.spleasewait
    3327msgid "Please wait..."

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

    r38 r51  
    1414msgstr ""
    1515
    16 #: ujobprogressview.soperations
    17 msgid "Operations:"
    18 msgstr ""
    19 
    2016#: ujobprogressview.spleasewait
    2117msgid "Please wait..."

  • trunk/Packages/Common/UApplicationInfo.pas

    r38 r51  
    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

    r38 r51  
    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/UJobProgressView.lfm

    r38 r51  
    1515  OnShow = FormShow
    1616  Position = poScreenCenter
    17   LCLVersion = '1.8.2.0'
     17  LCLVersion = '2.0.2.0'
    1818  object PanelOperationsTitle: TPanel
    1919    Left = 0
    … …  
    241241    Interval = 100
    242242    OnTimer = TimerUpdateTimer
    243     left = 264
     243    left = 320
    244244    top = 8
    245245  end

  • trunk/Packages/Common/UJobProgressView.pas

    r38 r51  
    175175  STotalEstimatedTime = 'Total estimated time: %s';
    176176  SFinished = 'Finished';
    177   SOperations = 'Operations:';
    178177
    179178procedure Register;

  • trunk/Packages/Common/UListViewSort.pas

    r38 r51  
    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
    … …  
    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/UMemory.pas

    r31 r51  
    112112procedure TMemory.WriteMemory(Position: Integer; Memory: TMemory);
    113113begin
    114   Move(Memory.FData, PByte(@FData + Position)^, Memory.Size);
     114  Move(Memory.FData, PByte(PByte(@FData) + Position)^, Memory.Size);
    115115end;
    116116
    117117procedure TMemory.ReadMemory(Position: Integer; Memory: TMemory);
    118118begin
    119   Move(PByte(@FData + Position)^, Memory.FData, Memory.Size);
     119  Move(PByte(PByte(@FData) + Position)^, Memory.FData, Memory.Size);
    120120end;
    121121

  • trunk/Packages/Common/UPersistentForm.pas

    r38 r51  
    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/UScaleDPI.pas

    r38 r51  
    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

    r38 r51  
    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

    r38 r51  
    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/CoolAudio/UCoolAudioConfig.inc

    r32 r51  
    11{$IFDEF Linux}
    22  {$DEFINE AudioSystemDSP}
    3   {$DEFINE AudioSystemMAD}
     3//  {$DEFINE AudioSystemMAD}
    44{$ENDIF}
    55{$IFDEF i386}

  • trunk/Packages/CoolAudio/UPlaylist.pas

    r32 r51  
    2626    procedure PlayNext;
    2727    procedure PlayPrevious;
    28     constructor Create(AOwner: TComponent);
     28    constructor Create(AOwner: TComponent); override;
    2929    destructor Destroy; override;
    3030  published

  • trunk/Packages/TemplateGenerics/Generic/GenericMatrix.inc

    r34 r51  
    3030    procedure PutItem(Index: TGMatrixIndex; const AValue: TGMatrixItem); virtual;
    3131    procedure SetCount(const AValue: TGMatrixIndex);
     32    procedure CheckRange(X: TGMatrixIndexX; Y: TGMatrixIndexY); inline;
    3233  public
     34    constructor Create; virtual;
    3335    function Add(Item: TGMatrixItem): TGMatrixIndex;
    3436    procedure AddMatrix(Values: array of TGMatrixRow);
    … …  
    140142begin
    141143  if (Capacity.X <> AValue.X) and (Capacity.Y <> AValue.Y) then begin
    142 (*    SetLength(FItems, AValue.Y);
     144    SetLength(FItems, AValue.Y);
    143145    Y := 0;
    144146    while Y < Length(FItems) do begin
    … …  
    146148      Y := Y + 1;
    147149    end;
    148   end;
    149   *)
    150     SetLength(FItems, AValue.Y, AValue.X);
     150
     151  {  SetLength(FItems, AValue.Y, AValue.X);}
    151152  end;
    152153end;
    153154
    154155function TGMatrix.GetItemXY(X: TGMatrixIndexX; Y: TGMatrixIndexY): TGMatrixItem;
     156begin
     157  CheckRange(X, Y);
     158  Result := FItems[Y, X];
     159end;
     160
     161function TGMatrix.GetItem(Index: TGMatrixIndex): TGMatrixItem;
     162begin
     163  CheckRange(Index.X, Index.Y);
     164  Result := FItems[Index.Y, Index.X];
     165end;
     166
     167procedure TGMatrix.PutItemXY(X: TGMatrixIndexX; Y: TGMatrixIndexY; const AValue: TGMatrixItem);
     168begin
     169  CheckRange(X, Y);
     170  FItems[Y, X] := AValue;
     171end;
     172
     173procedure TGMatrix.PutItem(Index: TGMatrixIndex; const AValue: TGMatrixItem);
     174begin
     175  CheckRange(Index.X, Index.Y);
     176  FItems[Index.Y, Index.X] := AValue;
     177end;
     178
     179procedure TGMatrix.SetCount(const AValue: TGMatrixIndex);
     180begin
     181  Capacity := AValue;
     182  FCount := AValue;
     183end;
     184
     185procedure TGMatrix.CheckRange(X: TGMatrixIndexX; Y: TGMatrixIndexY);
    155186begin
    156187  if (X < 0) or (X >= Count.X) or
    157188    (Y < 0) or (Y >= Count.Y) then
    158189    raise EListError.CreateFmt(SMatrixIndexError, [X, Y]);
    159   Result := FItems[Y, X];
    160 end;
    161 
    162 function TGMatrix.GetItem(Index: TGMatrixIndex): TGMatrixItem;
    163 begin
    164   if (Index.X < 0) or (Index.X >= Count.X) or
    165     (Index.Y < 0) or (Index.Y >= Count.Y) then
    166     raise EListError.CreateFmt(SMatrixIndexError, [Index.X, Index.Y]);
    167   Result := FItems[Index.Y, Index.X];
    168 end;
    169 
    170 procedure TGMatrix.PutItemXY(X: TGMatrixIndexX; Y: TGMatrixIndexY; const AValue: TGMatrixItem);
    171 begin
    172   if (X < 0) or (X >= Count.X) or
    173     (Y < 0) or (Y >= Count.Y) then
    174     raise EListError.CreateFmt(SMatrixIndexError, [X, Y]);
    175   FItems[Y, X] := AValue;
    176 end;
    177 
    178 procedure TGMatrix.PutItem(Index: TGMatrixIndex; const AValue: TGMatrixItem);
    179 begin
    180   if (Index.X < 0) or (Index.X >= Count.X) or
    181     (Index.Y < 0) or (Index.Y >= Count.Y) then
    182     raise EListError.CreateFmt(SMatrixIndexError, [Index.X, Index.Y]);
    183   FItems[Index.Y, Index.X] := AValue;
    184 end;
    185 
    186 procedure TGMatrix.SetCount(const AValue: TGMatrixIndex);
    187 begin
    188   Capacity := AValue;
    189   FCount := AValue;
    190190end;
    191191
    … …  
    555555end;
    556556
     557constructor TGMatrix.Create;
     558begin
     559  SetLength(FItems, 0, 0);
     560  FCount := CreateIndex(0, 0);
     561end;
     562
    557563procedure TGMatrix.Clear;
    558564begin
Note: See TracChangeset for help on using the changeset viewer.