Changeset 506 for trunk/Packages


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

Legend:

Unmodified
Added
Removed

  • trunk/Packages/CevoComponents/ScreenTools.pas

    r505 r506  
    404404  for Y := 0 to ScaleToNative(Src.Height - 1) do begin
    405405    for X := 0 to ScaleToNative(Src.Width - 1) do begin
    406       DstPtr.Pixel^.B := SrcPtr.Pixel^.B;
    407       DstPtr.Pixel^.G := SrcPtr.Pixel^.B;
    408       DstPtr.Pixel^.R := SrcPtr.Pixel^.B;
     406      DstPtr.PixelB := SrcPtr.PixelB;
     407      DstPtr.PixelG := SrcPtr.PixelB;
     408      DstPtr.PixelR := SrcPtr.PixelB;
    409409      SrcPtr.NextPixel;
    410410      DstPtr.NextPixel;
    … …  
    536536      for Y := 0 to ScaleToNative(Result.Data.Height) - 1 do begin
    537537        for X := 0 to ScaleToNative(Result.Data.Width) - 1 do begin
    538           OriginalColor := DataPixel.Pixel^.ARGB and $FFFFFF;
     538          OriginalColor := DataPixel.PixelARGB and $FFFFFF;
    539539          if (OriginalColor = TransparentColor1) or (OriginalColor = TransparentColor2) then begin
    540             MaskPixel.Pixel^.R := $FF;
    541             MaskPixel.Pixel^.G := $FF;
    542             MaskPixel.Pixel^.B := $FF;
    543             DataPixel.Pixel^.R := 0;
    544             DataPixel.Pixel^.G := 0;
    545             DataPixel.Pixel^.B := 0;
     540            MaskPixel.PixelR := $FF;
     541            MaskPixel.PixelG := $FF;
     542            MaskPixel.PixelB := $FF;
     543            DataPixel.PixelR := 0;
     544            DataPixel.PixelG := 0;
     545            DataPixel.PixelB := 0;
    546546          end else begin
    547             MaskPixel.Pixel^.R := $00;
    548             MaskPixel.Pixel^.G := $00;
    549             MaskPixel.Pixel^.B := $00;
     547            MaskPixel.PixelR := $00;
     548            MaskPixel.PixelG := $00;
     549            MaskPixel.PixelB := $00;
    550550          end;
    551551          DataPixel.NextPixel;
    … …  
    579579  for YY := 0 to ScaleToNative(Height) - 1 do begin
    580580    for XX := 0 to ScaleToNative(Width) - 1 do begin
    581       if PixelPtr.Pixel^.RGB = SwapRedBlue(OldColor) then begin
    582         PixelPtr.Pixel^.RGB := SwapRedBlue(NewColor);
     581      if PixelPtr.PixelRGB = SwapRedBlue(OldColor) then begin
     582        PixelPtr.PixelRGB := SwapRedBlue(NewColor);
    583583      end;
    584584      PixelPtr.NextPixel;
    … …  
    598598  for yy := 0 to ScaleToNative(Height) - 1 do begin
    599599    for xx := 0 to ScaleToNative(Width) - 1 do begin
    600       PixelPtr.Pixel^.B := PixelPtr.Pixel^.B div 2;
    601       PixelPtr.Pixel^.G := PixelPtr.Pixel^.G div 2;
    602       PixelPtr.Pixel^.R := PixelPtr.Pixel^.R div 2;
     600      PixelPtr.PixelB := PixelPtr.PixelB div 2;
     601      PixelPtr.PixelG := PixelPtr.PixelG div 2;
     602      PixelPtr.PixelR := PixelPtr.PixelR div 2;
    603603      PixelPtr.NextPixel;
    604604    end;
    … …  
    618618  for YY := 0 to ScaleToNative(Height) - 1 do begin
    619619    for XX := 0 to ScaleToNative(Width) - 1 do begin
    620       Gray := (Integer(PixelPtr.Pixel^.B) + Integer(PixelPtr.Pixel^.G) +
    621         Integer(PixelPtr.Pixel^.R)) * 85 shr 8;
    622       PixelPtr.Pixel^.B := 0;
    623       PixelPtr.Pixel^.G := 0;
    624       PixelPtr.Pixel^.R := Gray; // 255-(255-gray) div 2;
     620      Gray := (Integer(PixelPtr.PixelB) + Integer(PixelPtr.PixelG) +
     621        Integer(PixelPtr.PixelR)) * 85 shr 8;
     622      PixelPtr.PixelB := 0;
     623      PixelPtr.PixelG := 0;
     624      PixelPtr.PixelR := Gray; // 255-(255-gray) div 2;
    625625      PixelPtr.NextPixel;
    626626    end;
    … …  
    670670  for Y := 0 to Height - 1 do begin
    671671    for X := 0 to Width - 1 do  begin
    672       Brightness := PixelSrc.Pixel^.B; // One byte for 8-bit color
    673       Test := (PixelDst.Pixel^.R * Brightness) shr 7;
     672      Brightness := PixelSrc.PixelB; // One byte for 8-bit color
     673      Test := (PixelDst.PixelR * Brightness) shr 7;
    674674      if Test >= 256 then
    675         PixelDst.Pixel^.R := 255
     675        PixelDst.PixelR := 255
    676676      else
    677         PixelDst.Pixel^.R := Test; // Red
    678       Test := (PixelDst.Pixel^.G * Brightness) shr 7;
     677        PixelDst.PixelR := Test; // Red
     678      Test := (PixelDst.PixelG * Brightness) shr 7;
    679679      if Test >= 256 then
    680         PixelDst.Pixel^.G := 255
     680        PixelDst.PixelG := 255
    681681      else
    682         PixelDst.Pixel^.G := Test; // Green
    683       Test := (PixelDst.Pixel^.B * Brightness) shr 7;
     682        PixelDst.PixelG := Test; // Green
     683      Test := (PixelDst.PixelB * Brightness) shr 7;
    684684      if Test >= 256 then
    685         PixelDst.Pixel^.R := 255
     685        PixelDst.PixelR := 255
    686686      else
    687         PixelDst.Pixel^.B := Test; // Blue
     687        PixelDst.PixelB := Test; // Blue
    688688      PixelDst.NextPixel;
    689689      PixelSrc.NextPixel;
    … …  
    736736  for iy := 0 to Height - 1 do begin
    737737    for ix := 0 to Width - 1 do begin
    738       trans := SrcPixel.Pixel^.B * 2; // green channel = transparency
    739       amp1 := SrcPixel.Pixel^.G * 2;
    740       amp2 := SrcPixel.Pixel^.R * 2;
     738      trans := SrcPixel.PixelB * 2; // green channel = transparency
     739      amp1 := SrcPixel.PixelG * 2;
     740      amp2 := SrcPixel.PixelR * 2;
    741741      if trans <> $FF then begin
    742         Value := (DstPixel.Pixel^.B * trans + ((Color2 shr 16) and $FF) *
     742        Value := (DstPixel.PixelB * trans + ((Color2 shr 16) and $FF) *
    743743          amp2 + ((Color1 shr 16) and $FF) * amp1) div $FF;
    744         DstPixel.Pixel^.B := Min(Value, 255);
    745 
    746         Value := (DstPixel.Pixel^.G * trans + ((Color2 shr 8) and $FF) *
     744        DstPixel.PixelB := Min(Value, 255);
     745
     746        Value := (DstPixel.PixelG * trans + ((Color2 shr 8) and $FF) *
    747747          amp2 + ((Color1 shr 8) and $FF) * amp1) div $FF;
    748         DstPixel.Pixel^.G := Min(Value, 255);
    749 
    750         Value := (DstPixel.Pixel^.R * trans + (Color2 and $FF) *
     748        DstPixel.PixelG := Min(Value, 255);
     749
     750        Value := (DstPixel.PixelR * trans + (Color2 and $FF) *
    751751          amp2 + (Color1 and $FF) * amp1) div $FF;
    752         DstPixel.Pixel^.R := Min(Value, 255);
     752        DstPixel.PixelR := Min(Value, 255);
    753753      end;
    754754
    … …  
    793793  for iy := 0 to Height - 1 do begin
    794794    for ix := 0 to Width - 1 do begin
    795       trans := SrcPixel.Pixel^.B * 2; // green channel = transparency
    796       amp0 := SrcPixel.Pixel^.G * 2;
    797       amp1 := SrcPixel.Pixel^.R * 2;
     795      trans := SrcPixel.PixelB * 2; // green channel = transparency
     796      amp0 := SrcPixel.PixelG * 2;
     797      amp1 := SrcPixel.PixelR * 2;
    798798      if trans <> $FF then begin
    799         Value := (DstPixel.Pixel^.B * trans + (Color2 shr 16 and $FF) * amp1 +
     799        Value := (DstPixel.PixelB * trans + (Color2 shr 16 and $FF) * amp1 +
    800800          (Color0 shr 16 and $FF) * amp0) div $FF;
    801         DstPixel.Pixel^.B := Min(Value, 255);
    802 
    803         Value := (DstPixel.Pixel^.G * trans + (Color2 shr 8 and $FF) * amp1 +
     801        DstPixel.PixelB := Min(Value, 255);
     802
     803        Value := (DstPixel.PixelG * trans + (Color2 shr 8 and $FF) * amp1 +
    804804          (Color0 shr 8 and $FF) * amp0) div $FF;
    805         DstPixel.Pixel^.G := Min(Value, 255);
    806 
    807         Value := (DstPixel.Pixel^.R * trans + (Color2 and $FF) * amp1 +
     805        DstPixel.PixelG := Min(Value, 255);
     806
     807        Value := (DstPixel.PixelR * trans + (Color2 and $FF) * amp1 +
    808808          (Color0 and $FF) * amp0) div $FF;
    809         DstPixel.Pixel^.R := Min(Value, 255);
     809        DstPixel.PixelR := Min(Value, 255);
    810810      end;
    811811      SrcPixel.NextPixel;
    … …  
    846846  for YY := 0 to Height - 1 do begin
    847847    for XX := 0 to Width - 1 do begin
    848       Red := ((PixelPtr.Pixel^.B * (Color0 and $0000FF) + PixelPtr.Pixel^.G *
    849         (Color1 and $0000FF) + PixelPtr.Pixel^.R * (Color2 and $0000FF)) shr 8) and $ff;
    850       Green := ((PixelPtr.Pixel^.B * ((Color0 shr 8) and $0000FF) +
    851         PixelPtr.Pixel^.G * ((Color1 shr 8) and $0000FF) + PixelPtr.Pixel^.R *
     848      Red := ((PixelPtr.PixelB * (Color0 and $0000FF) + PixelPtr.PixelG *
     849        (Color1 and $0000FF) + PixelPtr.PixelR * (Color2 and $0000FF)) shr 8) and $ff;
     850      Green := ((PixelPtr.PixelB * ((Color0 shr 8) and $0000FF) +
     851        PixelPtr.PixelG * ((Color1 shr 8) and $0000FF) + PixelPtr.PixelR *
    852852        ((Color2 shr 8) and $0000FF)) shr 8) and $ff;
    853       PixelPtr.Pixel^.B := ((PixelPtr.Pixel^.B * ((Color0 shr 16) and $0000FF) +
    854         PixelPtr.Pixel^.G * ((Color1 shr 16) and $0000FF) + PixelPtr.Pixel^.R *
     853      PixelPtr.PixelB := ((PixelPtr.PixelB * ((Color0 shr 16) and $0000FF) +
     854        PixelPtr.PixelG * ((Color1 shr 16) and $0000FF) + PixelPtr.PixelR *
    855855        ((Color2 shr 16) and $0000FF)) shr 8) and $ff; // Blue
    856       PixelPtr.Pixel^.G := Green;
    857       PixelPtr.Pixel^.R := Red;
     856      PixelPtr.PixelG := Green;
     857      PixelPtr.PixelR := Red;
    858858      PixelPtr.NextPixel;
    859859    end;
    … …  
    10351035      if R < DpiGlowRange then
    10361036        for ch := 0 to 2 do
    1037           DstPtr.Pixel^.Planes[2 - ch] :=
    1038             (DstPtr.Pixel^.Planes[2 - ch] * (R - 1) + (cl shr (8 * ch) and $FF) *
     1037          DstPtr.PixelPlane[2 - ch] :=
     1038            (DstPtr.PixelPlane[2 - ch] * (R - 1) + (cl shr (8 * ch) and $FF) *
    10391039            (DpiGlowRange - R)) div (DpiGlowRange - 1);
    10401040      DstPtr.NextPixel;
    … …  
    10631063    for Y := 0 to ScaleToNative(Ornament.Height) - 1 do begin
    10641064      for X := 0 to ScaleToNative(Ornament.Width) - 1 do begin
    1065         P := Color32ToColor(PixelPtr.Pixel^.RGB);
    1066         if P = $0000FF then PixelPtr.Pixel^.RGB := Light
    1067         else if P = $FF0000 then PixelPtr.Pixel^.RGB := Shade;
     1065        P := Color32ToColor(PixelPtr.PixelRGB);
     1066        if P = $0000FF then PixelPtr.PixelRGB := Light
     1067        else if P = $FF0000 then PixelPtr.PixelRGB := Shade;
    10681068        PixelPtr.NextPixel;
    10691069      end;
    … …  
    10731073    for Y := 0 to ScaleToNative(Ornament.Height) - 1 do begin
    10741074      for X := 0 to ScaleToNative(Ornament.Width) - 1 do begin
    1075         P := Color32ToColor(PixelPtr.Pixel^.ARGB);
    1076         if P = $0000FF then PixelPtr.Pixel^.ARGB := Light
    1077         else if P = $FF0000 then PixelPtr.Pixel^.ARGB := Shade;
     1075        P := Color32ToColor(PixelPtr.PixelARGB);
     1076        if P = $0000FF then PixelPtr.PixelARGB := Light
     1077        else if P = $FF0000 then PixelPtr.PixelARGB := Shade;
    10781078        PixelPtr.NextPixel;
    10791079      end;
    … …  
    16161616  for Y := 0 to ScaleToNative(Dest.Height) - 1 do begin
    16171617    for X := 0 to ScaleToNative(Dest.Width) - 1 do begin
    1618       if (DstPixel.Pixel^.ARGB and $FFFFFF) = TransparentColor then begin
     1618      if (DstPixel.PixelARGB and $FFFFFF) = TransparentColor then begin
    16191619        SrcPixel.SetXY(X mod TexWidth, Y mod TexHeight);
    1620         DstPixel.Pixel^.B := SrcPixel.Pixel^.B;
    1621         DstPixel.Pixel^.G := SrcPixel.Pixel^.G;
    1622         DstPixel.Pixel^.R := SrcPixel.Pixel^.R;
     1620        DstPixel.PixelB := SrcPixel.PixelB;
     1621        DstPixel.PixelG := SrcPixel.PixelG;
     1622        DstPixel.PixelR := SrcPixel.PixelR;
    16231623      end;
    16241624      DstPixel.NextPixel;
    … …  
    16381638  for Y := 0 to ScaleToNative(Bitmap.Height) - 1 do begin
    16391639    for X := 0 to ScaleToNative(Bitmap.Width) - 1 do begin
    1640       PicturePixel.Pixel^.B := Max(PicturePixel.Pixel^.B - Change, 0);
    1641       PicturePixel.Pixel^.G := Max(PicturePixel.Pixel^.G - Change, 0);
    1642       PicturePixel.Pixel^.R := Max(PicturePixel.Pixel^.R - Change, 0);
     1640      PicturePixel.PixelB := Max(PicturePixel.PixelB - Change, 0);
     1641      PicturePixel.PixelG := Max(PicturePixel.PixelG - Change, 0);
     1642      PicturePixel.PixelR := Max(PicturePixel.PixelR - Change, 0);
    16431643      PicturePixel.NextPixel;
    16441644    end;

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

    r487 r506  
    33
    44#: pixelpointer.soutofrange
    5 msgid "Pixel pointer out of range"
     5#, object-pascal-format
     6msgid "Pixel pointer out of range [X: %d. Y: %d]"
    67msgstr ""
    78

  • trunk/Packages/Common/PixelPointer.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 }
    … …  
    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;
    … …  
    6893
    6994resourcestring
    70   SOutOfRange = 'Pixel pointer out of range';
     95  SOutOfRange = 'Pixel pointer out of range [X: %d. Y: %d]';
    7196  SWrongBitmapSize = 'Wrong bitmap size [width: %d, height: %d]';
    7297
    … …  
    121146
    122147procedure TPixelPointer.CheckRange;
     148{$IFOPT R+}
     149var
     150  X: Integer;
     151  Y: Integer;
     152{$ENDIF}
    123153begin
    124154  {$IFOPT R+}
    125155  if (PByte(Pixel) < PByte(Data)) or
    126     (PByte(Pixel) >= PByte(Data) + (Width + Height * BytesPerLine) * BytesPerPixel) then
    127     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;
    128163  {$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;
    129254end;
    130255
    … …  
    141266  for Y := 0 to DstRect.Height - 1 do begin
    142267    for X := 0 to DstRect.Width - 1 do begin
    143       DstPtr.Pixel^.ARGB := SrcPtr.Pixel^.ARGB;
     268      DstPtr.PixelARGB := SrcPtr.PixelARGB;
    144269      SrcPtr.NextPixel;
    145270      DstPtr.NextPixel;
    … …  
    177302      DstPtr.SetXY(X, Y);
    178303      SrcPtr.SetXY(R.Left, R.Top);
    179       C := SrcPtr.Pixel^.ARGB;
    180       DstPtr.Pixel^.ARGB := C;
     304      C := SrcPtr.PixelARGB;
     305      DstPtr.PixelARGB := C;
    181306      for YY := 0 to R.Height - 1 do begin
    182307        for XX := 0 to R.Width - 1 do begin
    183           DstPtr.Pixel^.ARGB := C;
     308          DstPtr.PixelARGB := C;
    184309          DstPtr.NextPixel;
    185310        end;
    … …  
    201326  for Y := 0 to Bitmap.Height - 1 do begin
    202327    for X := 0 to Bitmap.Width - 1 do begin
    203       Ptr.Pixel^.ARGB := Color;
     328      Ptr.PixelARGB := Color;
    204329      Ptr.NextPixel;
    205330    end;
    … …  
    218343  for Y := 0 to Rect.Height - 1 do begin
    219344    for X := 0 to Rect.Width - 1 do begin
    220       Ptr.Pixel^.ARGB := Color;
     345      Ptr.PixelARGB := Color;
    221346      Ptr.NextPixel;
    222347    end;
    … …  
    235360  for Y := 0 to Bitmap.Height - 1 do begin
    236361    for X := 0 to Bitmap.Width - 1 do begin
    237       Ptr.Pixel^.ARGB := SwapRedBlue(Ptr.Pixel^.ARGB);
     362      Ptr.PixelARGB := SwapRedBlue(Ptr.PixelARGB);
    238363      Ptr.NextPixel;
    239364    end;
    … …  
    252377  for Y := 0 to Bitmap.Height - 1 do begin
    253378    for X := 0 to Bitmap.Width - 1 do begin
    254       Ptr.Pixel^.ARGB := Ptr.Pixel^.ARGB xor $ffffff;
     379      Ptr.PixelARGB := Ptr.PixelARGB xor $ffffff;
    255380      Ptr.NextPixel;
    256381    end;
    … …  
    272397  for Y := 0 to Bitmap.Height - 1 do begin
    273398    for X := 0 to Bitmap.Width - 1 do begin
    274       A := Ptr.Pixel^.A; //(Ptr.Pixel^.A + Pixel.A) shr 1;
    275       R := (Ptr.Pixel^.R + Pixel.R) shr 1;
    276       G := (Ptr.Pixel^.G + Pixel.G) shr 1;
    277       B := (Ptr.Pixel^.B + Pixel.B) shr 1;
    278       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);
    279404      Ptr.NextPixel;
    280405    end;

  • 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.