Ignore:
Timestamp:
Jul 19, 2024, 11:24:06 PM (2 months ago)
Author:
chronos
Message:
  • Fixed: Full screen mode switching on Windows.
  • Modified: Updated Common package.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/Packages/Common/PixelPointer.pas

    r74 r107  
    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);
Note: See TracChangeset for help on using the changeset viewer.