Ignore:
Timestamp:
Dec 25, 2023, 11:35:51 AM (11 months ago)
Author:
chronos
Message:
Location:
trunk/Packages/DpiControls
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • trunk/Packages/DpiControls/Dpi.Graphics.pas

    r487 r506  
    706706      SrcPtr.SetXY(Min(ScaleFromNative(xx), Src.Width - 1),
    707707        Min(ScaleFromNative(yy), Src.Height - 1));
    708       DstPtr.Pixel^.B := SrcPtr.Pixel^.B;
    709       DstPtr.Pixel^.G := SrcPtr.Pixel^.G;
    710       DstPtr.Pixel^.R := SrcPtr.Pixel^.R;
     708      DstPtr.PixelB := SrcPtr.PixelB;
     709      DstPtr.PixelG := SrcPtr.PixelG;
     710      DstPtr.PixelR := SrcPtr.PixelR;
    711711      DstPtr.NextPixel;
    712712    end;
    … …  
    720720        DstWidth := ScaleToNative(SrcX + 1) - ScaleToNative(SrcX);
    721721        for DstX := 0 to DstWidth - 1 do begin
    722           DstPtr.Pixel^.B := SrcPtr.Pixel^.B;
    723           DstPtr.Pixel^.G := SrcPtr.Pixel^.G;
    724           DstPtr.Pixel^.R := SrcPtr.Pixel^.R;
     722          DstPtr.PixelB := SrcPtr.PixelB;
     723          DstPtr.PixelG := SrcPtr.PixelG;
     724          DstPtr.PixelR := SrcPtr.PixelR;
    725725          DstPtr.NextPixel;
    726726        end;

  • trunk/Packages/DpiControls/Dpi.PixelPointer.pas

    r501 r506  
    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;
     37    function GetPixelR: Byte; inline;
     38    function GetPixelA: Byte; inline;
     39    function GetPixelPlanes: TColor32Planes;
     40    function GetPixelRGB: Cardinal;
     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);
     45    procedure SetPixelR(Value: Byte); inline;
     46    procedure SetPixelA(Value: Byte); inline;
     47    procedure SetPixelRGB(Value: Cardinal);
     48  public
    3149    Base: PPixel32;
    3250    Pixel: PPixel32;
    … …  
    4664    procedure CheckRange; inline; // Check if current pixel position is not out of range
    4765    class function Create(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; static;
     66    property PixelARGB: TColor32 read GetPixelARGB write SetPixelARGB;
     67    property PixelRGB: Cardinal read GetPixelRGB write SetPixelRGB;
     68    property PixelB: Byte read GetPixelB write SetPixelB;
     69    property PixelG: Byte read GetPixelG write SetPixelG;
     70    property PixelR: Byte read GetPixelR write SetPixelR;
     71    property PixelA: Byte read GetPixelA write SetPixelA;
     72    property PixelPlane[Index: Byte]: Byte read GetPixelPlane write SetPixelPlane;
    4873  end;
    4974  PPixelPointer = ^TPixelPointer;
    … …  
    91116  Line := Pointer(Line) + BytesPerLine;
    92117  Pixel := Line;
    93   CheckRange;
    94118end;
    95119
    … …  
    98122  Line := Pointer(Line) - BytesPerLine;
    99123  Pixel := Line;
    100   CheckRange;
    101124end;
    102125
    … …  
    104127begin
    105128  Pixel := Pointer(Pixel) + BytesPerPixel;
    106   CheckRange;
    107129end;
    108130
    … …  
    110132begin
    111133  Pixel := Pointer(Pixel) - BytesPerPixel;
    112   CheckRange;
    113134end;
    114135
    … …  
    122143begin
    123144  Pixel := Pointer(Line) + X * BytesPerPixel;
    124   CheckRange;
    125145end;
    126146
    127147procedure TPixelPointer.CheckRange;
     148{$IFOPT R+}
    128149var
    129150  X: Integer;
    130151  Y: Integer;
     152{$ENDIF}
    131153begin
    132154  {$IFOPT R+}
    133155  if (PByte(Pixel) < PByte(Data)) or
    134     (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine + BytesPerLine) then begin
     156    (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine) then begin
    135157    X := PByte(Pixel) - PByte(Data);
    136158    Y := Floor(X / BytesPerLine);
    … …  
    140162  end;
    141163  {$ENDIF}
     164end;
     165
     166function TPixelPointer.GetPixelPlanes: TColor32Planes;
     167begin
     168  CheckRange;
     169  Result := Pixel^.Planes;
     170end;
     171
     172function TPixelPointer.GetPixelRGB: Cardinal;
     173begin
     174  CheckRange;
     175  Result := Pixel^.RGB;
     176end;
     177
     178procedure TPixelPointer.SetPixelARGB(Value: TColor32);
     179begin
     180  CheckRange;
     181  Pixel^.ARGB := Value;
     182end;
     183
     184procedure TPixelPointer.SetPixelB(Value: Byte);
     185begin
     186  CheckRange;
     187  Pixel^.B := Value;
     188end;
     189
     190procedure TPixelPointer.SetPixelG(Value: Byte);
     191begin
     192  CheckRange;
     193  Pixel^.G := Value;
     194end;
     195
     196procedure TPixelPointer.SetPixelPlane(Index: Byte; AValue: Byte);
     197begin
     198  CheckRange;
     199  Pixel^.Planes[Index] := AValue;
     200end;
     201
     202procedure TPixelPointer.SetPixelR(Value: Byte);
     203begin
     204  CheckRange;
     205  Pixel^.R := Value;
     206end;
     207
     208procedure TPixelPointer.SetPixelA(Value: Byte);
     209begin
     210  CheckRange;
     211  Pixel^.A := Value;
     212end;
     213
     214function TPixelPointer.GetPixelARGB: TColor32;
     215begin
     216  CheckRange;
     217  Result := Pixel^.ARGB;
     218end;
     219
     220function TPixelPointer.GetPixelB: Byte;
     221begin
     222  CheckRange;
     223  Result := Pixel^.B;
     224end;
     225
     226function TPixelPointer.GetPixelG: Byte;
     227begin
     228  CheckRange;
     229  Result := Pixel^.G;
     230end;
     231
     232function TPixelPointer.GetPixelPlane(Index: Byte): Byte;
     233begin
     234  CheckRange;
     235  Result := Pixel^.Planes[Index];
     236end;
     237
     238function TPixelPointer.GetPixelR: Byte;
     239begin
     240  CheckRange;
     241  Result := Pixel^.R;
     242end;
     243
     244function TPixelPointer.GetPixelA: Byte;
     245begin
     246  CheckRange;
     247  Result := Pixel^.A;
     248end;
     249
     250procedure TPixelPointer.SetPixelRGB(Value: Cardinal);
     251begin
     252  CheckRange;
     253  Pixel^.RGB := Value;
    142254end;
    143255
    … …  
    154266  for Y := 0 to DstRect.Height - 1 do begin
    155267    for X := 0 to DstRect.Width - 1 do begin
    156       DstPtr.Pixel^.ARGB := SrcPtr.Pixel^.ARGB;
     268      DstPtr.PixelARGB := SrcPtr.PixelARGB;
    157269      SrcPtr.NextPixel;
    158270      DstPtr.NextPixel;
    … …  
    190302      DstPtr.SetXY(X, Y);
    191303      SrcPtr.SetXY(R.Left, R.Top);
    192       C := SrcPtr.Pixel^.ARGB;
    193       DstPtr.Pixel^.ARGB := C;
     304      C := SrcPtr.PixelARGB;
     305      DstPtr.PixelARGB := C;
    194306      for YY := 0 to R.Height - 1 do begin
    195307        for XX := 0 to R.Width - 1 do begin
    196           DstPtr.Pixel^.ARGB := C;
     308          DstPtr.PixelARGB := C;
    197309          DstPtr.NextPixel;
    198310        end;
    … …  
    214326  for Y := 0 to Bitmap.Height - 1 do begin
    215327    for X := 0 to Bitmap.Width - 1 do begin
    216       Ptr.Pixel^.ARGB := Color;
     328      Ptr.PixelARGB := Color;
    217329      Ptr.NextPixel;
    218330    end;
    … …  
    231343  for Y := 0 to Rect.Height - 1 do begin
    232344    for X := 0 to Rect.Width - 1 do begin
    233       Ptr.Pixel^.ARGB := Color;
     345      Ptr.PixelARGB := Color;
    234346      Ptr.NextPixel;
    235347    end;
    … …  
    248360  for Y := 0 to Bitmap.Height - 1 do begin
    249361    for X := 0 to Bitmap.Width - 1 do begin
    250       Ptr.Pixel^.ARGB := SwapRedBlue(Ptr.Pixel^.ARGB);
     362      Ptr.PixelARGB := SwapRedBlue(Ptr.PixelARGB);
    251363      Ptr.NextPixel;
    252364    end;
    … …  
    265377  for Y := 0 to Bitmap.Height - 1 do begin
    266378    for X := 0 to Bitmap.Width - 1 do begin
    267       Ptr.Pixel^.ARGB := Ptr.Pixel^.ARGB xor $ffffff;
     379      Ptr.PixelARGB := Ptr.PixelARGB xor $ffffff;
    268380      Ptr.NextPixel;
    269381    end;
    … …  
    285397  for Y := 0 to Bitmap.Height - 1 do begin
    286398    for X := 0 to Bitmap.Width - 1 do begin
    287       A := Ptr.Pixel^.A; //(Ptr.Pixel^.A + Pixel.A) shr 1;
    288       R := (Ptr.Pixel^.R + Pixel.R) shr 1;
    289       G := (Ptr.Pixel^.G + Pixel.G) shr 1;
    290       B := (Ptr.Pixel^.B + Pixel.B) shr 1;
    291       Ptr.Pixel^.ARGB := Color32(A, R, G, B);
     399      A := Ptr.PixelA; //(Ptr.PixelA + Pixel.A) shr 1;
     400      R := (Ptr.PixelR + Pixel.R) shr 1;
     401      G := (Ptr.PixelG + Pixel.G) shr 1;
     402      B := (Ptr.PixelB + Pixel.B) shr 1;
     403      Ptr.PixelARGB := Color32(A, R, G, B);
    292404      Ptr.NextPixel;
    293405    end;

  • trunk/Packages/DpiControls/NativePixelPointer.pas

    r487 r506  
    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 }
    1314
    1415  TPixel32 = packed record
    15     procedure SetRGB(Color: TColor32);
    16     function GetRGB: TColor32;
     16  private
     17    procedure SetRGB(AValue: Cardinal); inline;
     18    function GetRGB: Cardinal; inline;
     19  public
     20    property RGB: Cardinal read GetRGB write SetRGB;
    1721    case Integer of
    1822      0: (B, G, R, A: Byte);
    1923      1: (ARGB: TColor32);
    20       2: (Planes: array[0..3] of Byte);
     24      2: (Planes: TColor32Planes);
    2125      3: (Components: array[TColor32Component] of Byte);
    2226  end;
    … …  
    2630
    2731  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;
     37    function GetPixelR: Byte; inline;
     38    function GetPixelA: Byte; inline;
     39    function GetPixelPlanes: TColor32Planes;
     40    function GetPixelRGB: Cardinal;
     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);
     45    procedure SetPixelR(Value: Byte); inline;
     46    procedure SetPixelA(Value: Byte); inline;
     47    procedure SetPixelRGB(Value: Cardinal);
     48  public
    2849    Base: PPixel32;
    2950    Pixel: PPixel32;
    … …  
    4364    procedure CheckRange; inline; // Check if current pixel position is not out of range
    4465    class function Create(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; static;
     66    property PixelARGB: TColor32 read GetPixelARGB write SetPixelARGB;
     67    property PixelRGB: Cardinal read GetPixelRGB write SetPixelRGB;
     68    property PixelB: Byte read GetPixelB write SetPixelB;
     69    property PixelG: Byte read GetPixelG write SetPixelG;
     70    property PixelR: Byte read GetPixelR write SetPixelR;
     71    property PixelA: Byte read GetPixelA write SetPixelA;
     72    property PixelPlane[Index: Byte]: Byte read GetPixelPlane write SetPixelPlane;
    4573  end;
    4674  PPixelPointer = ^TPixelPointer;
    4775
     76  function SwapRedBlue(Color: TColor32): TColor32;
     77  procedure BitmapCopyRect(DstBitmap: TRasterImage; DstRect: TRect; SrcBitmap: TRasterImage; SrcPos: TPoint);
     78  procedure BitmapStretchRect(DstBitmap: TRasterImage; DstRect: TRect;
     79    SrcBitmap: TRasterImage; SrcRect: TRect);
     80  procedure BitmapFill(Bitmap: TRasterImage; Color: TColor32);
     81  procedure BitmapFillRect(Bitmap: TRasterImage; Color: TColor32; Rect: TRect);
     82  procedure BitmapSwapRedBlue(Bitmap:TRasterImage);
     83  procedure BitmapInvert(Bitmap: TRasterImage);
     84  procedure BitmapBlendColor(Bitmap: TRasterImage; Color: TColor32);
     85  function Color32(A, R, G, B: Byte): TColor32;
     86  function Color32ToPixel32(Color: TColor32): TPixel32;
     87  function Pixel32ToColor32(Color: TPixel32): TColor32;
    4888  function Color32ToColor(Color: TColor32): TColor;
    4989  function ColorToColor32(Color: TColor): TColor32;
    … …  
    5393
    5494resourcestring
    55   SOutOfRange = 'Pixel pointer out of range';
     95  SOutOfRange = 'Pixel pointer out of range [X: %d. Y: %d]';
    5696  SWrongBitmapSize = 'Wrong bitmap size [width: %d, height: %d]';
    5797
    58   { TPixel32 }
    59 
    60 procedure TPixel32.SetRGB(Color: TColor32);
    61 begin
    62   B := Color and $ff;
    63   G := (Color shr 8) and $ff;
    64   R := (Color shr 16) and $ff;
    65 end;
    66 
    67 function TPixel32.GetRGB: TColor32;
     98{ TPixel32 }
     99
     100function TPixel32.GetRGB: Cardinal;
    68101begin
    69102  Result := ARGB and $ffffff;
     103end;
     104
     105procedure TPixel32.SetRGB(AValue: Cardinal);
     106begin
     107  R := (AValue shr 16) and $ff;
     108  G := (AValue shr 8) and $ff;
     109  B := (AValue shr 0) and $ff;
    70110end;
    71111
    … …  
    106146
    107147procedure TPixelPointer.CheckRange;
     148{$IFOPT R+}
     149var
     150  X: Integer;
     151  Y: Integer;
     152{$ENDIF}
    108153begin
    109154  {$IFOPT R+}
    110155  if (PByte(Pixel) < PByte(Data)) or
    111     (PByte(Pixel) >= PByte(Data) + (Width + Height * BytesPerLine) * BytesPerPixel) then
    112     raise Exception.Create(SOutOfRange);
     156    (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine) then begin
     157    X := PByte(Pixel) - PByte(Data);
     158    Y := Floor(X / BytesPerLine);
     159    X := X - Y * BytesPerLine;
     160    X := Floor(X / BytesPerPixel);
     161    raise Exception.Create(Format(SOutOfRange, [X, Y]));
     162  end;
    113163  {$ENDIF}
     164end;
     165
     166function TPixelPointer.GetPixelPlanes: TColor32Planes;
     167begin
     168  CheckRange;
     169  Result := Pixel^.Planes;
     170end;
     171
     172function TPixelPointer.GetPixelRGB: Cardinal;
     173begin
     174  CheckRange;
     175  Result := Pixel^.RGB;
     176end;
     177
     178procedure TPixelPointer.SetPixelARGB(Value: TColor32);
     179begin
     180  CheckRange;
     181  Pixel^.ARGB := Value;
     182end;
     183
     184procedure TPixelPointer.SetPixelB(Value: Byte);
     185begin
     186  CheckRange;
     187  Pixel^.B := Value;
     188end;
     189
     190procedure TPixelPointer.SetPixelG(Value: Byte);
     191begin
     192  CheckRange;
     193  Pixel^.G := Value;
     194end;
     195
     196procedure TPixelPointer.SetPixelPlane(Index: Byte; AValue: Byte);
     197begin
     198  CheckRange;
     199  Pixel^.Planes[Index] := AValue;
     200end;
     201
     202procedure TPixelPointer.SetPixelR(Value: Byte);
     203begin
     204  CheckRange;
     205  Pixel^.R := Value;
     206end;
     207
     208procedure TPixelPointer.SetPixelA(Value: Byte);
     209begin
     210  CheckRange;
     211  Pixel^.A := Value;
     212end;
     213
     214function TPixelPointer.GetPixelARGB: TColor32;
     215begin
     216  CheckRange;
     217  Result := Pixel^.ARGB;
     218end;
     219
     220function TPixelPointer.GetPixelB: Byte;
     221begin
     222  CheckRange;
     223  Result := Pixel^.B;
     224end;
     225
     226function TPixelPointer.GetPixelG: Byte;
     227begin
     228  CheckRange;
     229  Result := Pixel^.G;
     230end;
     231
     232function TPixelPointer.GetPixelPlane(Index: Byte): Byte;
     233begin
     234  CheckRange;
     235  Result := Pixel^.Planes[Index];
     236end;
     237
     238function TPixelPointer.GetPixelR: Byte;
     239begin
     240  CheckRange;
     241  Result := Pixel^.R;
     242end;
     243
     244function TPixelPointer.GetPixelA: Byte;
     245begin
     246  CheckRange;
     247  Result := Pixel^.A;
     248end;
     249
     250procedure TPixelPointer.SetPixelRGB(Value: Cardinal);
     251begin
     252  CheckRange;
     253  Pixel^.RGB := Value;
     254end;
     255
     256procedure BitmapCopyRect(DstBitmap: TRasterImage; DstRect: TRect;
     257  SrcBitmap: TRasterImage; SrcPos: TPoint);
     258var
     259  SrcPtr, DstPtr: TPixelPointer;
     260  X, Y: Integer;
     261begin
     262  SrcBitmap.BeginUpdate(True);
     263  DstBitmap.BeginUpdate(True);
     264  SrcPtr := TPixelPointer.Create(SrcBitmap, SrcPos.X, SrcPos.Y);
     265  DstPtr := TPixelPointer.Create(DstBitmap, DstRect.Left, DstRect.Top);
     266  for Y := 0 to DstRect.Height - 1 do begin
     267    for X := 0 to DstRect.Width - 1 do begin
     268      DstPtr.PixelARGB := SrcPtr.PixelARGB;
     269      SrcPtr.NextPixel;
     270      DstPtr.NextPixel;
     271    end;
     272    SrcPtr.NextLine;
     273    DstPtr.NextLine;
     274  end;
     275  SrcBitmap.EndUpdate;
     276  DstBitmap.EndUpdate;
     277end;
     278
     279procedure BitmapStretchRect(DstBitmap: TRasterImage; DstRect: TRect;
     280  SrcBitmap: TRasterImage; SrcRect: TRect);
     281var
     282  SrcPtr, DstPtr: TPixelPointer;
     283  X, Y: Integer;
     284  XX, YY: Integer;
     285  R: TRect;
     286  C: TColor32;
     287begin
     288  if (DstRect.Width = SrcRect.Width) and (DstRect.Height = SrcRect.Height) then begin
     289    BitmapCopyRect(DstBitmap, DstRect, SrcBitmap, Point(SrcRect.Left, SrcRect.Top));
     290    Exit;
     291  end;
     292  SrcBitmap.BeginUpdate(True);
     293  DstBitmap.BeginUpdate(True);
     294  SrcPtr := TPixelPointer.Create(SrcBitmap, SrcRect.Left, SrcRect.Top);
     295  DstPtr := TPixelPointer.Create(DstBitmap, DstRect.Left, DstRect.Top);
     296  for Y := 0 to DstRect.Height - 1 do begin
     297    for X := 0 to DstRect.Width - 1 do begin
     298      R := Rect(Trunc(X * SrcRect.Width / DstRect.Width),
     299        Trunc(Y * SrcRect.Height / DstRect.Height),
     300        Trunc((X + 1) * SrcRect.Width / DstRect.Width),
     301        Trunc((Y + 1) * SrcRect.Height / DstRect.Height));
     302      DstPtr.SetXY(X, Y);
     303      SrcPtr.SetXY(R.Left, R.Top);
     304      C := SrcPtr.PixelARGB;
     305      DstPtr.PixelARGB := C;
     306      for YY := 0 to R.Height - 1 do begin
     307        for XX := 0 to R.Width - 1 do begin
     308          DstPtr.PixelARGB := C;
     309          DstPtr.NextPixel;
     310        end;
     311        DstPtr.NextLine;
     312      end;
     313    end;
     314  end;
     315  SrcBitmap.EndUpdate;
     316  DstBitmap.EndUpdate;
     317end;
     318
     319procedure BitmapFill(Bitmap: TRasterImage; Color: TColor32);
     320var
     321  X, Y: Integer;
     322  Ptr: TPixelPointer;
     323begin
     324  Bitmap.BeginUpdate(True);
     325  Ptr := TPixelPointer.Create(Bitmap);
     326  for Y := 0 to Bitmap.Height - 1 do begin
     327    for X := 0 to Bitmap.Width - 1 do begin
     328      Ptr.PixelARGB := Color;
     329      Ptr.NextPixel;
     330    end;
     331    Ptr.NextLine;
     332  end;
     333  Bitmap.EndUpdate;
     334end;
     335
     336procedure BitmapFillRect(Bitmap: TRasterImage; Color: TColor32; Rect: TRect);
     337var
     338  X, Y: Integer;
     339  Ptr: TPixelPointer;
     340begin
     341  Bitmap.BeginUpdate(True);
     342  Ptr := TPixelPointer.Create(Bitmap, Rect.Left, Rect.Top);
     343  for Y := 0 to Rect.Height - 1 do begin
     344    for X := 0 to Rect.Width - 1 do begin
     345      Ptr.PixelARGB := Color;
     346      Ptr.NextPixel;
     347    end;
     348    Ptr.NextLine;
     349  end;
     350  Bitmap.EndUpdate;
     351end;
     352
     353procedure BitmapSwapRedBlue(Bitmap: TRasterImage);
     354var
     355  X, Y: Integer;
     356  Ptr: TPixelPointer;
     357begin
     358  Bitmap.BeginUpdate(True);
     359  Ptr := TPixelPointer.Create(Bitmap);
     360  for Y := 0 to Bitmap.Height - 1 do begin
     361    for X := 0 to Bitmap.Width - 1 do begin
     362      Ptr.PixelARGB := SwapRedBlue(Ptr.PixelARGB);
     363      Ptr.NextPixel;
     364    end;
     365    Ptr.NextLine;
     366  end;
     367  Bitmap.EndUpdate;
     368end;
     369
     370procedure BitmapInvert(Bitmap: TRasterImage);
     371var
     372  X, Y: Integer;
     373  Ptr: TPixelPointer;
     374begin
     375  Bitmap.BeginUpdate(True);
     376  Ptr := TPixelPointer.Create(Bitmap);
     377  for Y := 0 to Bitmap.Height - 1 do begin
     378    for X := 0 to Bitmap.Width - 1 do begin
     379      Ptr.PixelARGB := Ptr.PixelARGB xor $ffffff;
     380      Ptr.NextPixel;
     381    end;
     382    Ptr.NextLine;
     383  end;
     384  Bitmap.EndUpdate;
     385end;
     386
     387procedure BitmapBlendColor(Bitmap: TRasterImage; Color: TColor32);
     388var
     389  X, Y: Integer;
     390  Ptr: TPixelPointer;
     391  A, R, G, B: Word;
     392  Pixel: TPixel32;
     393begin
     394  Pixel := Color32ToPixel32(Color);
     395  Bitmap.BeginUpdate(True);
     396  Ptr := TPixelPointer.Create(Bitmap);
     397  for Y := 0 to Bitmap.Height - 1 do begin
     398    for X := 0 to Bitmap.Width - 1 do begin
     399      A := Ptr.PixelA; //(Ptr.PixelA + Pixel.A) shr 1;
     400      R := (Ptr.PixelR + Pixel.R) shr 1;
     401      G := (Ptr.PixelG + Pixel.G) shr 1;
     402      B := (Ptr.PixelB + Pixel.B) shr 1;
     403      Ptr.PixelARGB := Color32(A, R, G, B);
     404      Ptr.NextPixel;
     405    end;
     406    Ptr.NextLine;
     407  end;
     408  Bitmap.EndUpdate;
     409end;
     410
     411function Color32(A, R, G, B: Byte): TColor32;
     412begin
     413  Result := ((A and $ff) shl 24) or ((R and $ff) shl 16) or
     414    ((G and $ff) shl 8) or ((B and $ff) shl 0);
     415end;
     416
     417function Color32ToPixel32(Color: TColor32): TPixel32;
     418begin
     419  Result.ARGB := Color;
     420end;
     421
     422function Pixel32ToColor32(Color: TPixel32): TColor32;
     423begin
     424  Result := Color.ARGB;
     425end;
     426
     427function Color32ToColor(Color: TColor32): TColor;
     428begin
     429  Result := ((Color shr 16) and $ff) or (Color and $00ff00) or
     430    ((Color and $ff) shl 16);
     431end;
     432
     433function ColorToColor32(Color: TColor): TColor32;
     434begin
     435  Result := $ff000000 or ((Color shr 16) and $ff) or (Color and $00ff00) or
     436    ((Color and $ff) shl 16);
    114437end;
    115438
    … …  
    129452end;
    130453
    131 function Color32ToColor(Color: TColor32): TColor;
    132 begin
    133   Result := ((Color shr 16) and $ff) or (Color and $00ff00) or
    134     ((Color and $ff) shl 16);
    135 end;
    136 
    137 function ColorToColor32(Color: TColor): TColor32;
    138 begin
    139   Result := $ff000000 or ((Color shr 16) and $ff) or (Color and $00ff00) or
    140     ((Color and $ff) shl 16);
     454function SwapRedBlue(Color: TColor32): TColor32;
     455begin
     456  Result := (Color and $ff00ff00) or ((Color and $ff) shl 16) or ((Color shr 16) and $ff);
    141457end;
    142458
    143459end.
    144 
Note: See TracChangeset for help on using the changeset viewer.