Changeset 172 for trunk


Ignore:
Timestamp:
Jun 14, 2024, 9:41:40 PM (5 months ago)
Author:
chronos
Message:
  • Fixed: Avoid error in case of invalid import data.
  • Modified: Updated Common package.
Location:
trunk
Files:
2 added
25 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/FormImport.lfm

    r168 r172  
    1212  OnDestroy = FormDestroy
    1313  OnShow = FormShow
    14   LCLVersion = '2.2.6.0'
     14  LCLVersion = '3.0.0.3'
    1515  object ButtonCancel: TButton
    1616    Left = 578
    … …  
    3232    Caption = 'Import'
    3333    ModalResult = 1
    34     OnClick = ButtonImportClick
    3534    ParentFont = False
    3635    TabOrder = 1
     36    OnClick = ButtonImportClick
    3737  end
    3838  object ScrollBox1: TScrollBox
    … …  
    6161      Width = 225
    6262      ItemHeight = 0
    63       OnChange = ComboBoxInputFormatChange
    6463      ReadOnly = True
    6564      Style = csDropDownList
    6665      TabOrder = 0
     66      OnChange = ComboBoxInputFormatChange
    6767    end
    6868    object Label2: TLabel
    … …  
    8080      Width = 464
    8181      Anchors = [akTop, akLeft, akRight]
     82      TabOrder = 1
    8283      OnChange = EditInputFileChange
    83       TabOrder = 1
    8484    end
    8585    object ButtonBrowse: TButton
    … …  
    9090      Anchors = [akTop, akRight]
    9191      Caption = 'Browse'
     92      TabOrder = 2
    9293      OnClick = ButtonBrowseClick
    93       TabOrder = 2
    9494    end
    9595    object ListView1: TListView

  • trunk/Forms/FormImport.pas

    r170 r172  
    136136  if not FileExists(EditInputFile.Text) then Exit;
    137137
    138   Table.SetInput(TableFormat, LoadFileToStr(EditInputFile.Text));
    139   Table.Title := ExtractFileNameWithoutExt(EditInputFile.Text);
     138  try
     139    Table.SetInput(TableFormat, LoadFileToStr(EditInputFile.Text));
     140    Table.Title := ExtractFileNameWithoutExt(EditInputFile.Text);
     141  except
     142    // It may fail due to invalid format
     143  end;
    140144end;
    141145

  • trunk/Packages/Common/FindFile.pas

    r148 r172  
    7575constructor TFindFile.Create(AOwner: TComponent);
    7676begin
    77   inherited Create(AOwner);
     77  inherited;
    7878  Path := IncludeTrailingBackslash(UTF8Encode(GetCurrentDir));
    7979  FileMask := FilterAll;

  • trunk/Packages/Common/FormEx.pas

    r165 r172  
    6868  end;
    6969
    70   PersistentForm.Load(Self);
    7170  Translator.TranslateComponentRecursive(Self);
    7271  ThemeManager.UseTheme(Self);

  • trunk/Packages/Common/Languages.pas

    r148 r172  
    216216  SLang_za = 'Zhuang';
    217217  SLang_zh = 'Chinese';
     218  SLang_zh_Hans = 'Simplified Chinese';
     219  SLang_zh_Hant = 'Traditional Chinese';
    218220  SLang_zu = 'Zulu';
     221
    219222
    220223implementation
    … …  
    228231begin
    229232  I := 0;
    230   while (I < Count) and (TLanguage(Items[I]).Code < ACode) do Inc(I);
    231   if I < Count then Result := TLanguage(Items[I])
     233  while (I < Count) and (Items[I].Code <> ACode) do Inc(I);
     234  if I < Count then Result := Items[I]
    232235    else Result := nil;
    233236end;
    … …  
    439442  AddNew('za', SLang_za);
    440443  AddNew('zh', SLang_zh);
     444  AddNew('zh-Hant', SLang_zh_Hant);
     445  AddNew('zh-Hans', SLang_zh_Hans);
    441446  AddNew('zu', SLang_zu);
    442447end;

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

    r158 r172  
    2121msgid "Data file"
    2222msgstr "Datový soubor"
    23 

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

    r158 r172  
    1616msgid "Filename not defined"
    1717msgstr "Neurčen soubor"
    18 

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

    r158 r172  
    1616msgid "Directory not found"
    1717msgstr "Adresář nenalezen"
    18 

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

    r164 r172  
    2727msgstr "Verze"
    2828
     29#: tformabout.caption
     30msgid "About"
     31msgstr "O aplikaci"

  • trunk/Packages/Common/Languages/FormAbout.pot

    r164 r172  
    1414msgstr ""
    1515
     16#: tformabout.caption
     17msgid "About"
     18msgstr ""
     19

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

    r158 r172  
    4343msgid "Total estimated time: %s"
    4444msgstr "Celkový odhadovaný čas: %s"
    45 

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

    r158 r172  
    981981msgid "Zulu"
    982982msgstr "Zuluština"
    983 

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

    r158 r172  
    2121msgid "Unknown object for release from pool"
    2222msgstr "Neznýmý objekt pro uvolnění ze zásobníku"
    23 

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

    r158 r172  
    1616msgid "WaitFor error"
    1717msgstr "Chyba WaitFor"
    18 

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

    r158 r172  
    1717msgid "Wrong DPI [%d,%d]"
    1818msgstr "Chybné DPI [%d,%d]"
    19 

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

    r167 r172  
    1010"Content-Type: text/plain; charset=UTF-8\n"
    1111"Content-Transfer-Encoding: 8bit\n"
    12 "X-Generator: Poedit 3.0.1\n"
     12"X-Generator: Poedit 3.4.2\n"
    1313
    1414#: table.sunsupportedformat

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

    r158 r172  
    2626msgid "Passed"
    2727msgstr "Prošlo"
    28 

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

    r158 r172  
    1717msgid "Current thread ID %d not found in virtual thread list."
    1818msgstr "Aktuální vlákno ID %d nenalezeno v seznamu virtuálních vláken."
    19 

  • trunk/Packages/Common/ListViewSort.pas

    r148 r172  
    136136constructor TListViewEx.Create(TheOwner: TComponent);
    137137begin
    138   inherited Create(TheOwner);
     138  inherited;
    139139  Filter := TListViewFilter.Create(Self);
    140140  Filter.Parent := Self;
    … …  
    172172constructor TListViewFilter.Create(AOwner: TComponent);
    173173begin
    174   inherited Create(AOwner);
     174  inherited;
    175175  FStringGrid1 := TStringGrid.Create(Self);
    176176  FStringGrid1.Align := alClient;

  • trunk/Packages/Common/PixelPointer.pas

    r148 r172  
    44
    55uses
    6   Classes, SysUtils, Graphics;
     6  Math, Classes, SysUtils, Graphics;
    77
    88type
    99  TColor32 = type Cardinal;
    1010  TColor32Component = (ccBlue, ccGreen, ccRed, ccAlpha);
     11  TColor32Planes = array[0..3] of Byte;
    1112
    1213  { TPixel32 }
    … …  
    1415  TPixel32 = packed record
    1516  private
    16     procedure SetRGB(AValue: Cardinal);
    17     function GetRGB: Cardinal;
     17    procedure SetRGB(AValue: Cardinal); inline;
     18    function GetRGB: Cardinal; inline;
    1819  public
     20    class function CreateRGB(R, G, B: Byte): TPixel32; static;
     21    class function CreateRGBA(R, G, B, A: Byte): TPixel32; static;
    1922    property RGB: Cardinal read GetRGB write SetRGB;
    2023    case Integer of
    2124      0: (B, G, R, A: Byte);
    2225      1: (ARGB: TColor32);
    23       2: (Planes: array[0..3] of Byte);
     26      2: (Planes: TColor32Planes);
    2427      3: (Components: array[TColor32Component] of Byte);
    2528  end;
    … …  
    2932
    3033  TPixelPointer = record
     34  private
     35    function GetPixelARGB: TColor32; inline;
     36    function GetPixelB: Byte; inline;
     37    function GetPixelG: Byte; inline;
     38    function GetPixelPlane(Index: Byte): Byte; inline;
     39    function GetPixelR: Byte; inline;
     40    function GetPixelA: Byte; inline;
     41    function GetPixelPlanes: TColor32Planes;
     42    function GetPixelRGB: Cardinal; inline;
     43    procedure SetPixelARGB(Value: TColor32); inline;
     44    procedure SetPixelB(Value: Byte); inline;
     45    procedure SetPixelG(Value: Byte); inline;
     46    procedure SetPixelPlane(Index: Byte; AValue: Byte); inline;
     47    procedure SetPixelR(Value: Byte); inline;
     48    procedure SetPixelA(Value: Byte); inline;
     49    procedure SetPixelRGB(Value: Cardinal); inline;
     50  public
    3151    Base: PPixel32;
    3252    Pixel: PPixel32;
    … …  
    3555    BytesPerPixel: Integer;
    3656    BytesPerLine: Integer;
     57    Data: PPixel32;
     58    Width: Integer;
     59    Height: Integer;
    3760    procedure NextLine; inline; // Move pointer to start of next line
    3861    procedure PreviousLine; inline; // Move pointer to start of previous line
    … …  
    4164    procedure SetXY(X, Y: Integer); inline; // Set pixel position relative to base
    4265    procedure SetX(X: Integer); inline; // Set horizontal pixel position relative to base
     66    procedure CheckRange; inline; // Check if current pixel position is not out of range
     67    function PosValid: Boolean;
     68    class function Create(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; static;
     69    property PixelARGB: TColor32 read GetPixelARGB write SetPixelARGB;
     70    property PixelRGB: Cardinal read GetPixelRGB write SetPixelRGB;
     71    property PixelB: Byte read GetPixelB write SetPixelB;
     72    property PixelG: Byte read GetPixelG write SetPixelG;
     73    property PixelR: Byte read GetPixelR write SetPixelR;
     74    property PixelA: Byte read GetPixelA write SetPixelA;
     75    property PixelPlane[Index: Byte]: Byte read GetPixelPlane write SetPixelPlane;
    4376  end;
    4477  PPixelPointer = ^TPixelPointer;
    4578
    46   function PixelPointer(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; inline;
    4779  function SwapRedBlue(Color: TColor32): TColor32;
    4880  procedure BitmapCopyRect(DstBitmap: TRasterImage; DstRect: TRect; SrcBitmap: TRasterImage; SrcPos: TPoint);
    … …  
    6395implementation
    6496
     97resourcestring
     98  SOutOfRange = 'Pixel pointer out of range [X: %d, Y: %d, Width: %d, Height: %d]';
     99  SWrongBitmapSize = 'Wrong bitmap size [width: %d, height: %d]';
     100
    65101{ TPixel32 }
    66102
    … …  
    70106end;
    71107
     108class function TPixel32.CreateRGB(R, G, B: Byte): TPixel32;
     109begin
     110  Result.R := R;
     111  Result.G := G;
     112  Result.B := B;
     113  Result.A := 0;
     114end;
     115
     116class function TPixel32.CreateRGBA(R, G, B, A: Byte): TPixel32;
     117begin
     118  Result.R := R;
     119  Result.G := G;
     120  Result.B := B;
     121  Result.A := A;
     122end;
     123
    72124procedure TPixel32.SetRGB(AValue: Cardinal);
    73125begin
    74   R := (AValue shr 16) and $ff;
    75   G := (AValue shr 8) and $ff;
    76   B := (AValue shr 0) and $ff;
     126  ARGB := (ARGB and $ff000000) or (AValue and $ffffff);
    77127end;
    78128
    … …  
    112162end;
    113163
     164procedure TPixelPointer.CheckRange;
     165{$IFOPT R+}
     166var
     167  X: Integer;
     168  Y: Integer;
     169{$ENDIF}
     170begin
     171  {$IFOPT R+}
     172  if (PByte(Pixel) < PByte(Data)) or
     173    (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine) then begin
     174    X := PByte(Pixel) - PByte(Data);
     175    Y := Floor(X / BytesPerLine);
     176    X := X - Y * BytesPerLine;
     177    X := Floor(X / BytesPerPixel);
     178    raise Exception.Create(Format(SOutOfRange, [X, Y, Width, Height]));
     179  end;
     180  {$ENDIF}
     181end;
     182
     183function TPixelPointer.PosValid: Boolean;
     184begin
     185  Result := not ((PByte(Pixel) < PByte(Data)) or
     186    (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine));
     187end;
     188
     189function TPixelPointer.GetPixelPlanes: TColor32Planes;
     190begin
     191  CheckRange;
     192  Result := Pixel^.Planes;
     193end;
     194
     195function TPixelPointer.GetPixelRGB: Cardinal;
     196begin
     197  CheckRange;
     198  Result := Pixel^.RGB;
     199end;
     200
     201procedure TPixelPointer.SetPixelARGB(Value: TColor32);
     202begin
     203  CheckRange;
     204  Pixel^.ARGB := Value;
     205end;
     206
     207procedure TPixelPointer.SetPixelB(Value: Byte);
     208begin
     209  CheckRange;
     210  Pixel^.B := Value;
     211end;
     212
     213procedure TPixelPointer.SetPixelG(Value: Byte);
     214begin
     215  CheckRange;
     216  Pixel^.G := Value;
     217end;
     218
     219procedure TPixelPointer.SetPixelPlane(Index: Byte; AValue: Byte);
     220begin
     221  CheckRange;
     222  Pixel^.Planes[Index] := AValue;
     223end;
     224
     225procedure TPixelPointer.SetPixelR(Value: Byte);
     226begin
     227  CheckRange;
     228  Pixel^.R := Value;
     229end;
     230
     231procedure TPixelPointer.SetPixelA(Value: Byte);
     232begin
     233  CheckRange;
     234  Pixel^.A := Value;
     235end;
     236
     237function TPixelPointer.GetPixelARGB: TColor32;
     238begin
     239  CheckRange;
     240  Result := Pixel^.ARGB;
     241end;
     242
     243function TPixelPointer.GetPixelB: Byte;
     244begin
     245  CheckRange;
     246  Result := Pixel^.B;
     247end;
     248
     249function TPixelPointer.GetPixelG: Byte;
     250begin
     251  CheckRange;
     252  Result := Pixel^.G;
     253end;
     254
     255function TPixelPointer.GetPixelPlane(Index: Byte): Byte;
     256begin
     257  CheckRange;
     258  Result := Pixel^.Planes[Index];
     259end;
     260
     261function TPixelPointer.GetPixelR: Byte;
     262begin
     263  CheckRange;
     264  Result := Pixel^.R;
     265end;
     266
     267function TPixelPointer.GetPixelA: Byte;
     268begin
     269  CheckRange;
     270  Result := Pixel^.A;
     271end;
     272
     273procedure TPixelPointer.SetPixelRGB(Value: Cardinal);
     274begin
     275  CheckRange;
     276  Pixel^.RGB := Value;
     277end;
     278
    114279procedure BitmapCopyRect(DstBitmap: TRasterImage; DstRect: TRect;
    115280  SrcBitmap: TRasterImage; SrcPos: TPoint);
    … …  
    120285  SrcBitmap.BeginUpdate(True);
    121286  DstBitmap.BeginUpdate(True);
    122   SrcPtr := PixelPointer(SrcBitmap, SrcPos.X, SrcPos.Y);
    123   DstPtr := PixelPointer(DstBitmap, DstRect.Left, DstRect.Top);
     287  SrcPtr := TPixelPointer.Create(SrcBitmap, SrcPos.X, SrcPos.Y);
     288  DstPtr := TPixelPointer.Create(DstBitmap, DstRect.Left, DstRect.Top);
    124289  for Y := 0 to DstRect.Height - 1 do begin
    125290    for X := 0 to DstRect.Width - 1 do begin
    126       DstPtr.Pixel^.ARGB := SrcPtr.Pixel^.ARGB;
     291      DstPtr.PixelARGB := SrcPtr.PixelARGB;
    127292      SrcPtr.NextPixel;
    128293      DstPtr.NextPixel;
    … …  
    150315  SrcBitmap.BeginUpdate(True);
    151316  DstBitmap.BeginUpdate(True);
    152   SrcPtr := PixelPointer(SrcBitmap, SrcRect.Left, SrcRect.Top);
    153   DstPtr := PixelPointer(DstBitmap, DstRect.Left, DstRect.Top);
     317  SrcPtr := TPixelPointer.Create(SrcBitmap, SrcRect.Left, SrcRect.Top);
     318  DstPtr := TPixelPointer.Create(DstBitmap, DstRect.Left, DstRect.Top);
    154319  for Y := 0 to DstRect.Height - 1 do begin
    155320    for X := 0 to DstRect.Width - 1 do begin
    … …  
    160325      DstPtr.SetXY(X, Y);
    161326      SrcPtr.SetXY(R.Left, R.Top);
    162       C := SrcPtr.Pixel^.ARGB;
    163       DstPtr.Pixel^.ARGB := C;
     327      C := SrcPtr.PixelARGB;
     328      DstPtr.PixelARGB := C;
    164329      for YY := 0 to R.Height - 1 do begin
    165330        for XX := 0 to R.Width - 1 do begin
    166           DstPtr.Pixel^.ARGB := C;
     331          DstPtr.PixelARGB := C;
    167332          DstPtr.NextPixel;
    168333        end;
    … …  
    181346begin
    182347  Bitmap.BeginUpdate(True);
    183   Ptr := PixelPointer(Bitmap);
     348  Ptr := TPixelPointer.Create(Bitmap);
    184349  for Y := 0 to Bitmap.Height - 1 do begin
    185350    for X := 0 to Bitmap.Width - 1 do begin
    186       Ptr.Pixel^.ARGB := Color;
     351      Ptr.PixelARGB := Color;
    187352      Ptr.NextPixel;
    188353    end;
    … …  
    198363begin
    199364  Bitmap.BeginUpdate(True);
    200   Ptr := PixelPointer(Bitmap, Rect.Left, Rect.Top);
     365  Ptr := TPixelPointer.Create(Bitmap, Rect.Left, Rect.Top);
    201366  for Y := 0 to Rect.Height - 1 do begin
    202367    for X := 0 to Rect.Width - 1 do begin
    203       Ptr.Pixel^.ARGB := Color;
     368      Ptr.PixelARGB := Color;
    204369      Ptr.NextPixel;
    205370    end;
    … …  
    215380begin
    216381  Bitmap.BeginUpdate(True);
    217   Ptr := PixelPointer(Bitmap);
     382  Ptr := TPixelPointer.Create(Bitmap);
    218383  for Y := 0 to Bitmap.Height - 1 do begin
    219384    for X := 0 to Bitmap.Width - 1 do begin
    220       Ptr.Pixel^.ARGB := SwapRedBlue(Ptr.Pixel^.ARGB);
     385      Ptr.PixelARGB := SwapRedBlue(Ptr.PixelARGB);
    221386      Ptr.NextPixel;
    222387    end;
    … …  
    232397begin
    233398  Bitmap.BeginUpdate(True);
    234   Ptr := PixelPointer(Bitmap);
     399  Ptr := TPixelPointer.Create(Bitmap);
    235400  for Y := 0 to Bitmap.Height - 1 do begin
    236401    for X := 0 to Bitmap.Width - 1 do begin
    237       Ptr.Pixel^.ARGB := Ptr.Pixel^.ARGB xor $ffffff;
     402      Ptr.PixelARGB := Ptr.PixelARGB xor $ffffff;
    238403      Ptr.NextPixel;
    239404    end;
    … …  
    252417  Pixel := Color32ToPixel32(Color);
    253418  Bitmap.BeginUpdate(True);
    254   Ptr := PixelPointer(Bitmap);
     419  Ptr := TPixelPointer.Create(Bitmap);
    255420  for Y := 0 to Bitmap.Height - 1 do begin
    256421    for X := 0 to Bitmap.Width - 1 do begin
    257       A := Ptr.Pixel^.A; //(Ptr.Pixel^.A + Pixel.A) shr 1;
    258       R := (Ptr.Pixel^.R + Pixel.R) shr 1;
    259       G := (Ptr.Pixel^.G + Pixel.G) shr 1;
    260       B := (Ptr.Pixel^.B + Pixel.B) shr 1;
    261       Ptr.Pixel^.ARGB := Color32(A, R, G, B);
     422      A := Ptr.PixelA; //(Ptr.PixelA + Pixel.A) shr 1;
     423      R := (Ptr.PixelR + Pixel.R) shr 1;
     424      G := (Ptr.PixelG + Pixel.G) shr 1;
     425      B := (Ptr.PixelB + Pixel.B) shr 1;
     426      Ptr.PixelARGB := Color32(A, R, G, B);
    262427      Ptr.NextPixel;
    263428    end;
    … …  
    295460end;
    296461
    297 function PixelPointer(Bitmap: TRasterImage; BaseX: Integer;
     462class function TPixelPointer.Create(Bitmap: TRasterImage; BaseX: Integer;
    298463  BaseY: Integer): TPixelPointer;
    299464begin
     465  Result.Width := Bitmap.Width;
     466  Result.Height := Bitmap.Height;
     467  if (Result.Width < 0) or (Result.Height < 0) then
     468    raise Exception.Create(Format(SWrongBitmapSize, [Result.Width, Result.Height]));
    300469  Result.BytesPerLine := Bitmap.RawImage.Description.BytesPerLine;
    301470  Result.BytesPerPixel := Bitmap.RawImage.Description.BitsPerPixel shr 3;
     471  Result.Data := PPixel32(Bitmap.RawImage.Data);
    302472  Result.Base := PPixel32(Bitmap.RawImage.Data + BaseX * Result.BytesPerPixel +
    303473    BaseY * Result.BytesPerLine);

  • trunk/Packages/Common/Pool.pas

    r148 r172  
    5757  try
    5858    Lock.Acquire;
    59     inherited SetTotalCount(AValue);
     59    inherited;
    6060  finally
    6161    Lock.Release;
    … …  
    6767  try
    6868    Lock.Acquire;
    69     Result := inherited GetUsedCount;
     69    Result := inherited;
    7070  finally
    7171    Lock.Release;
    … …  
    8888      end;
    8989    end;
    90     Result := inherited Acquire;
     90    Result := inherited;
    9191  finally
    9292    Lock.Release;
    … …  
    9898  try
    9999    Lock.Acquire;
    100     inherited Release(Item);
     100    inherited;
    101101  finally
    102102    Lock.Release;
    … …  
    113113begin
    114114  TotalCount := 0;
    115   Lock.Free;
     115  FreeAndNil(Lock);
    116116  inherited;
    117117end;

  • trunk/Packages/Common/PrefixMultiplier.pas

    r148 r172  
    3131  (
    3232    (ShortText: 'y'; FullText: 'yocto'; Value: 1e-24),
    33       (ShortText: 'z'; FullText: 'zepto'; Value: 1e-21),
     33    (ShortText: 'z'; FullText: 'zepto'; Value: 1e-21),
    3434    (ShortText: 'a'; FullText: 'atto'; Value: 1e-18),
    3535    (ShortText: 'f'; FullText: 'femto'; Value: 1e-15),
    … …  
    5252  (
    5353    (ShortText: 'ys'; FullText: 'yocto'; Value: 1e-24),
    54       (ShortText: 'zs'; FullText: 'zepto'; Value: 1e-21),
     54    (ShortText: 'zs'; FullText: 'zepto'; Value: 1e-21),
    5555    (ShortText: 'as'; FullText: 'atto'; Value: 1e-18),
    5656    (ShortText: 'fs'; FullText: 'femto'; Value: 1e-15),

  • trunk/Packages/Common/RegistryEx.pas

    r148 r172  
    133133  //CloseKey;
    134134  {$ENDIF}
    135   Result := inherited OpenKey(Key, CanCreate);
     135  Result := inherited;
    136136end;
    137137

  • trunk/Packages/Common/StopWatch.pas

    r135 r172  
    1313  TStopWatch = class
    1414  private
    15     fFrequency : TLargeInteger;
    16     fIsRunning: Boolean;
    17     fIsHighResolution: Boolean;
    18     fStartCount, fStopCount : TLargeInteger;
    19     procedure SetTickStamp(var lInt : TLargeInteger) ;
     15    FFrequency: TLargeInteger;
     16    FIsRunning: Boolean;
     17    FIsHighResolution: Boolean;
     18    FStartCount, fStopCount: TLargeInteger;
     19    procedure SetTickStamp(var Value: TLargeInteger);
    2020    function GetElapsedTicks: TLargeInteger;
    2121    function GetElapsedMiliseconds: TLargeInteger;
    2222    function GetElapsed: string;
    2323  public
    24     constructor Create(const startOnCreate : Boolean = False) ;
     24    constructor Create(const StartOnCreate: Boolean = False) ;
    2525    procedure Start;
    2626    procedure Stop;
    27     property IsHighResolution : Boolean read fIsHighResolution;
    28     property ElapsedTicks : TLargeInteger read GetElapsedTicks;
    29     property ElapsedMiliseconds : TLargeInteger read GetElapsedMiliseconds;
    30     property Elapsed : string read GetElapsed;
    31     property IsRunning : Boolean read fIsRunning;
     27    property IsHighResolution: Boolean read FIsHighResolution;
     28    property ElapsedTicks: TLargeInteger read GetElapsedTicks;
     29    property ElapsedMiliseconds: TLargeInteger read GetElapsedMiliseconds;
     30    property Elapsed: string read GetElapsed;
     31    property IsRunning: Boolean read FIsRunning;
    3232  end;
    3333
    … …  
    3535implementation
    3636
    37 constructor TStopWatch.Create(const startOnCreate : boolean = false) ;
     37constructor TStopWatch.Create(const StartOnCreate: Boolean = False);
    3838begin
    39   inherited Create;
    40 
    41   fIsRunning := False;
     39  FIsRunning := False;
    4240
    4341  {$IFDEF WINDOWS}
    4442  fIsHighResolution := QueryPerformanceFrequency(fFrequency) ;
    4543  {$ELSE}
    46   fIsHighResolution := False;
     44  FIsHighResolution := False;
    4745  {$ENDIF}
    48   if NOT fIsHighResolution then fFrequency := MSecsPerSec;
     46  if NOT FIsHighResolution then FFrequency := MSecsPerSec;
    4947
    5048  if StartOnCreate then Start;
    … …  
    5351function TStopWatch.GetElapsedTicks: TLargeInteger;
    5452begin
    55   Result := fStopCount - fStartCount;
     53  Result := FStopCount - FStartCount;
    5654end;
    5755
    58 procedure TStopWatch.SetTickStamp(var lInt : TLargeInteger) ;
     56procedure TStopWatch.SetTickStamp(var Value: TLargeInteger);
    5957begin
    60   if fIsHighResolution then
     58  if FIsHighResolution then
    6159    {$IFDEF Windows}
    62     QueryPerformanceCounter(lInt)
     60    QueryPerformanceCounter(Value)
    6361    {$ELSE}
    6462    {$ENDIF}
    6563  else
    66     lInt := MilliSecondOf(Now) ;
     64    Value := MilliSecondOf(Now);
    6765end;
    6866
    6967function TStopWatch.GetElapsed: string;
    7068var
    71   dt: TDateTime;
     69  Elapsed: TDateTime;
    7270begin
    73   dt := ElapsedMiliseconds / MSecsPerSec / SecsPerDay;
    74   result := Format('%d days, %s', [Trunc(dt), FormatDateTime('hh:nn:ss.z', Frac(dt))]) ;
     71  Elapsed := ElapsedMiliseconds / MSecsPerSec / SecsPerDay;
     72  Result := Format('%d days, %s', [Trunc(Elapsed), FormatDateTime('hh:nn:ss.z', Frac(Elapsed))]) ;
    7573end;
    7674
    7775function TStopWatch.GetElapsedMiliseconds: TLargeInteger;
    7876begin
    79   Result := (MSecsPerSec * (fStopCount - fStartCount)) div fFrequency;
     77  Result := (MSecsPerSec * (fStopCount - FStartCount)) div FFrequency;
    8078end;
    8179
    8280procedure TStopWatch.Start;
    8381begin
    84   SetTickStamp(fStartCount);
    85   fIsRunning := True;
     82  SetTickStamp(FStartCount);
     83  FIsRunning := True;
    8684end;
    8785
    8886procedure TStopWatch.Stop;
    8987begin
    90   SetTickStamp(fStopCount);
    91   fIsRunning := False;
     88  SetTickStamp(FStopCount);
     89  FIsRunning := False;
    9290end;
    9391

  • trunk/Packages/Common/Threading.pas

    r148 r172  
    188188constructor TThreadList.Create;
    189189begin
    190   inherited Create;
     190  inherited;
    191191end;
    192192
Note: See TracChangeset for help on using the changeset viewer.