Changeset 570 for Common


Ignore:
Timestamp:
May 14, 2024, 5:26:00 PM (7 months ago)
Author:
chronos
Message:
  • Modified: Updated Common package.
Location:
Common
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • Common/Languages.pas

    r563 r570  
    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;

  • Common/PixelPointer.pas

    r563 r570  
    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
    1920    property RGB: Cardinal read GetRGB write SetRGB;
    … …  
    2122      0: (B, G, R, A: Byte);
    2223      1: (ARGB: TColor32);
    23       2: (Planes: array[0..3] of Byte);
     24      2: (Planes: TColor32Planes);
    2425      3: (Components: array[TColor32Component] of Byte);
    2526  end;
    … …  
    2930
    3031  TPixelPointer = record
     32  private
     33    function GetPixelARGB: TColor32; inline;
     34    function GetPixelB: Byte; inline;
     35    function GetPixelG: Byte; inline;
     36    function GetPixelPlane(Index: Byte): Byte; inline;
     37    function GetPixelR: Byte; inline;
     38    function GetPixelA: Byte; inline;
     39    function GetPixelPlanes: TColor32Planes;
     40    function GetPixelRGB: Cardinal; inline;
     41    procedure SetPixelARGB(Value: TColor32); inline;
     42    procedure SetPixelB(Value: Byte); inline;
     43    procedure SetPixelG(Value: Byte); inline;
     44    procedure SetPixelPlane(Index: Byte; AValue: Byte); inline;
     45    procedure SetPixelR(Value: Byte); inline;
     46    procedure SetPixelA(Value: Byte); inline;
     47    procedure SetPixelRGB(Value: Cardinal); inline;
     48  public
    3149    Base: PPixel32;
    3250    Pixel: PPixel32;
    … …  
    3553    BytesPerPixel: Integer;
    3654    BytesPerLine: Integer;
     55    Data: PPixel32;
     56    Width: Integer;
     57    Height: Integer;
    3758    procedure NextLine; inline; // Move pointer to start of next line
    3859    procedure PreviousLine; inline; // Move pointer to start of previous line
    … …  
    4162    procedure SetXY(X, Y: Integer); inline; // Set pixel position relative to base
    4263    procedure SetX(X: Integer); inline; // Set horizontal pixel position relative to base
     64    procedure CheckRange; inline; // Check if current pixel position is not out of range
     65    function PosValid: Boolean;
     66    class function Create(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; static;
     67    property PixelARGB: TColor32 read GetPixelARGB write SetPixelARGB;
     68    property PixelRGB: Cardinal read GetPixelRGB write SetPixelRGB;
     69    property PixelB: Byte read GetPixelB write SetPixelB;
     70    property PixelG: Byte read GetPixelG write SetPixelG;
     71    property PixelR: Byte read GetPixelR write SetPixelR;
     72    property PixelA: Byte read GetPixelA write SetPixelA;
     73    property PixelPlane[Index: Byte]: Byte read GetPixelPlane write SetPixelPlane;
    4374  end;
    4475  PPixelPointer = ^TPixelPointer;
    4576
    46   function PixelPointer(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; inline;
    4777  function SwapRedBlue(Color: TColor32): TColor32;
    4878  procedure BitmapCopyRect(DstBitmap: TRasterImage; DstRect: TRect; SrcBitmap: TRasterImage; SrcPos: TPoint);
    … …  
    6393implementation
    6494
     95resourcestring
     96  SOutOfRange = 'Pixel pointer out of range [X: %d, Y: %d, Width: %d, Height: %d]';
     97  SWrongBitmapSize = 'Wrong bitmap size [width: %d, height: %d]';
     98
    6599{ TPixel32 }
    66100
    … …  
    72106procedure TPixel32.SetRGB(AValue: Cardinal);
    73107begin
    74   R := (AValue shr 16) and $ff;
    75   G := (AValue shr 8) and $ff;
    76   B := (AValue shr 0) and $ff;
     108  ARGB := (ARGB and $ff000000) or (AValue and $ffffff);
    77109end;
    78110
    … …  
    112144end;
    113145
     146procedure TPixelPointer.CheckRange;
     147{$IFOPT R+}
     148var
     149  X: Integer;
     150  Y: Integer;
     151{$ENDIF}
     152begin
     153  {$IFOPT R+}
     154  if (PByte(Pixel) < PByte(Data)) or
     155    (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine) then begin
     156    X := PByte(Pixel) - PByte(Data);
     157    Y := Floor(X / BytesPerLine);
     158    X := X - Y * BytesPerLine;
     159    X := Floor(X / BytesPerPixel);
     160    raise Exception.Create(Format(SOutOfRange, [X, Y, Width, Height]));
     161  end;
     162  {$ENDIF}
     163end;
     164
     165function TPixelPointer.PosValid: Boolean;
     166begin
     167  Result := not ((PByte(Pixel) < PByte(Data)) or
     168    (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine));
     169end;
     170
     171function TPixelPointer.GetPixelPlanes: TColor32Planes;
     172begin
     173  CheckRange;
     174  Result := Pixel^.Planes;
     175end;
     176
     177function TPixelPointer.GetPixelRGB: Cardinal;
     178begin
     179  CheckRange;
     180  Result := Pixel^.RGB;
     181end;
     182
     183procedure TPixelPointer.SetPixelARGB(Value: TColor32);
     184begin
     185  CheckRange;
     186  Pixel^.ARGB := Value;
     187end;
     188
     189procedure TPixelPointer.SetPixelB(Value: Byte);
     190begin
     191  CheckRange;
     192  Pixel^.B := Value;
     193end;
     194
     195procedure TPixelPointer.SetPixelG(Value: Byte);
     196begin
     197  CheckRange;
     198  Pixel^.G := Value;
     199end;
     200
     201procedure TPixelPointer.SetPixelPlane(Index: Byte; AValue: Byte);
     202begin
     203  CheckRange;
     204  Pixel^.Planes[Index] := AValue;
     205end;
     206
     207procedure TPixelPointer.SetPixelR(Value: Byte);
     208begin
     209  CheckRange;
     210  Pixel^.R := Value;
     211end;
     212
     213procedure TPixelPointer.SetPixelA(Value: Byte);
     214begin
     215  CheckRange;
     216  Pixel^.A := Value;
     217end;
     218
     219function TPixelPointer.GetPixelARGB: TColor32;
     220begin
     221  CheckRange;
     222  Result := Pixel^.ARGB;
     223end;
     224
     225function TPixelPointer.GetPixelB: Byte;
     226begin
     227  CheckRange;
     228  Result := Pixel^.B;
     229end;
     230
     231function TPixelPointer.GetPixelG: Byte;
     232begin
     233  CheckRange;
     234  Result := Pixel^.G;
     235end;
     236
     237function TPixelPointer.GetPixelPlane(Index: Byte): Byte;
     238begin
     239  CheckRange;
     240  Result := Pixel^.Planes[Index];
     241end;
     242
     243function TPixelPointer.GetPixelR: Byte;
     244begin
     245  CheckRange;
     246  Result := Pixel^.R;
     247end;
     248
     249function TPixelPointer.GetPixelA: Byte;
     250begin
     251  CheckRange;
     252  Result := Pixel^.A;
     253end;
     254
     255procedure TPixelPointer.SetPixelRGB(Value: Cardinal);
     256begin
     257  CheckRange;
     258  Pixel^.RGB := Value;
     259end;
     260
    114261procedure BitmapCopyRect(DstBitmap: TRasterImage; DstRect: TRect;
    115262  SrcBitmap: TRasterImage; SrcPos: TPoint);
    … …  
    120267  SrcBitmap.BeginUpdate(True);
    121268  DstBitmap.BeginUpdate(True);
    122   SrcPtr := PixelPointer(SrcBitmap, SrcPos.X, SrcPos.Y);
    123   DstPtr := PixelPointer(DstBitmap, DstRect.Left, DstRect.Top);
     269  SrcPtr := TPixelPointer.Create(SrcBitmap, SrcPos.X, SrcPos.Y);
     270  DstPtr := TPixelPointer.Create(DstBitmap, DstRect.Left, DstRect.Top);
    124271  for Y := 0 to DstRect.Height - 1 do begin
    125272    for X := 0 to DstRect.Width - 1 do begin
    126       DstPtr.Pixel^.ARGB := SrcPtr.Pixel^.ARGB;
     273      DstPtr.PixelARGB := SrcPtr.PixelARGB;
    127274      SrcPtr.NextPixel;
    128275      DstPtr.NextPixel;
    … …  
    150297  SrcBitmap.BeginUpdate(True);
    151298  DstBitmap.BeginUpdate(True);
    152   SrcPtr := PixelPointer(SrcBitmap, SrcRect.Left, SrcRect.Top);
    153   DstPtr := PixelPointer(DstBitmap, DstRect.Left, DstRect.Top);
     299  SrcPtr := TPixelPointer.Create(SrcBitmap, SrcRect.Left, SrcRect.Top);
     300  DstPtr := TPixelPointer.Create(DstBitmap, DstRect.Left, DstRect.Top);
    154301  for Y := 0 to DstRect.Height - 1 do begin
    155302    for X := 0 to DstRect.Width - 1 do begin
    … …  
    160307      DstPtr.SetXY(X, Y);
    161308      SrcPtr.SetXY(R.Left, R.Top);
    162       C := SrcPtr.Pixel^.ARGB;
    163       DstPtr.Pixel^.ARGB := C;
     309      C := SrcPtr.PixelARGB;
     310      DstPtr.PixelARGB := C;
    164311      for YY := 0 to R.Height - 1 do begin
    165312        for XX := 0 to R.Width - 1 do begin
    166           DstPtr.Pixel^.ARGB := C;
     313          DstPtr.PixelARGB := C;
    167314          DstPtr.NextPixel;
    168315        end;
    … …  
    181328begin
    182329  Bitmap.BeginUpdate(True);
    183   Ptr := PixelPointer(Bitmap);
     330  Ptr := TPixelPointer.Create(Bitmap);
    184331  for Y := 0 to Bitmap.Height - 1 do begin
    185332    for X := 0 to Bitmap.Width - 1 do begin
    186       Ptr.Pixel^.ARGB := Color;
     333      Ptr.PixelARGB := Color;
    187334      Ptr.NextPixel;
    188335    end;
    … …  
    198345begin
    199346  Bitmap.BeginUpdate(True);
    200   Ptr := PixelPointer(Bitmap, Rect.Left, Rect.Top);
     347  Ptr := TPixelPointer.Create(Bitmap, Rect.Left, Rect.Top);
    201348  for Y := 0 to Rect.Height - 1 do begin
    202349    for X := 0 to Rect.Width - 1 do begin
    203       Ptr.Pixel^.ARGB := Color;
     350      Ptr.PixelARGB := Color;
    204351      Ptr.NextPixel;
    205352    end;
    … …  
    215362begin
    216363  Bitmap.BeginUpdate(True);
    217   Ptr := PixelPointer(Bitmap);
     364  Ptr := TPixelPointer.Create(Bitmap);
    218365  for Y := 0 to Bitmap.Height - 1 do begin
    219366    for X := 0 to Bitmap.Width - 1 do begin
    220       Ptr.Pixel^.ARGB := SwapRedBlue(Ptr.Pixel^.ARGB);
     367      Ptr.PixelARGB := SwapRedBlue(Ptr.PixelARGB);
    221368      Ptr.NextPixel;
    222369    end;
    … …  
    232379begin
    233380  Bitmap.BeginUpdate(True);
    234   Ptr := PixelPointer(Bitmap);
     381  Ptr := TPixelPointer.Create(Bitmap);
    235382  for Y := 0 to Bitmap.Height - 1 do begin
    236383    for X := 0 to Bitmap.Width - 1 do begin
    237       Ptr.Pixel^.ARGB := Ptr.Pixel^.ARGB xor $ffffff;
     384      Ptr.PixelARGB := Ptr.PixelARGB xor $ffffff;
    238385      Ptr.NextPixel;
    239386    end;
    … …  
    252399  Pixel := Color32ToPixel32(Color);
    253400  Bitmap.BeginUpdate(True);
    254   Ptr := PixelPointer(Bitmap);
     401  Ptr := TPixelPointer.Create(Bitmap);
    255402  for Y := 0 to Bitmap.Height - 1 do begin
    256403    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);
     404      A := Ptr.PixelA; //(Ptr.PixelA + Pixel.A) shr 1;
     405      R := (Ptr.PixelR + Pixel.R) shr 1;
     406      G := (Ptr.PixelG + Pixel.G) shr 1;
     407      B := (Ptr.PixelB + Pixel.B) shr 1;
     408      Ptr.PixelARGB := Color32(A, R, G, B);
    262409      Ptr.NextPixel;
    263410    end;
    … …  
    295442end;
    296443
    297 function PixelPointer(Bitmap: TRasterImage; BaseX: Integer;
     444class function TPixelPointer.Create(Bitmap: TRasterImage; BaseX: Integer;
    298445  BaseY: Integer): TPixelPointer;
    299446begin
     447  Result.Width := Bitmap.Width;
     448  Result.Height := Bitmap.Height;
     449  if (Result.Width < 0) or (Result.Height < 0) then
     450    raise Exception.Create(Format(SWrongBitmapSize, [Result.Width, Result.Height]));
    300451  Result.BytesPerLine := Bitmap.RawImage.Description.BytesPerLine;
    301452  Result.BytesPerPixel := Bitmap.RawImage.Description.BitsPerPixel shr 3;
     453  Result.Data := PPixel32(Bitmap.RawImage.Data);
    302454  Result.Base := PPixel32(Bitmap.RawImage.Data + BaseX * Result.BytesPerPixel +
    303455    BaseY * Result.BytesPerLine);

  • Common/PrefixMultiplier.pas

    r563 r570  
    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),
Note: See TracChangeset for help on using the changeset viewer.