Changeset 539 for trunk/Packages


Ignore:
Timestamp:
Apr 16, 2024, 11:43:51 AM (7 months ago)
Author:
chronos
Message:
  • Modified: Optimized scaled bitmap drawing.
Location:
trunk/Packages
Files:
5 edited

Legend:

Unmodified
Added
Removed

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

    r506 r539  
    44#: pixelpointer.soutofrange
    55#, object-pascal-format
    6 msgid "Pixel pointer out of range [X: %d. Y: %d]"
     6msgid "Pixel pointer out of range [X: %d, Y: %d, Width: %d, Height: %d]"
    77msgstr ""
    88

  • trunk/Packages/Common/PixelPointer.pas

    r506 r539  
    3434    function GetPixelB: Byte; inline;
    3535    function GetPixelG: Byte; inline;
    36     function GetPixelPlane(Index: Byte): Byte;
     36    function GetPixelPlane(Index: Byte): Byte; inline;
    3737    function GetPixelR: Byte; inline;
    3838    function GetPixelA: Byte; inline;
    3939    function GetPixelPlanes: TColor32Planes;
    40     function GetPixelRGB: Cardinal;
     40    function GetPixelRGB: Cardinal; inline;
    4141    procedure SetPixelARGB(Value: TColor32); inline;
    4242    procedure SetPixelB(Value: Byte); inline;
    4343    procedure SetPixelG(Value: Byte); inline;
    44     procedure SetPixelPlane(Index: Byte; AValue: Byte);
     44    procedure SetPixelPlane(Index: Byte; AValue: Byte); inline;
    4545    procedure SetPixelR(Value: Byte); inline;
    4646    procedure SetPixelA(Value: Byte); inline;
    47     procedure SetPixelRGB(Value: Cardinal);
     47    procedure SetPixelRGB(Value: Cardinal); inline;
    4848  public
    4949    Base: PPixel32;
    … …  
    6363    procedure SetX(X: Integer); inline; // Set horizontal pixel position relative to base
    6464    procedure CheckRange; inline; // Check if current pixel position is not out of range
     65    function PosValid: Boolean;
    6566    class function Create(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; static;
    6667    property PixelARGB: TColor32 read GetPixelARGB write SetPixelARGB;
    … …  
    9394
    9495resourcestring
    95   SOutOfRange = 'Pixel pointer out of range [X: %d. Y: %d]';
     96  SOutOfRange = 'Pixel pointer out of range [X: %d, Y: %d, Width: %d, Height: %d]';
    9697  SWrongBitmapSize = 'Wrong bitmap size [width: %d, height: %d]';
    9798
    … …  
    105106procedure TPixel32.SetRGB(AValue: Cardinal);
    106107begin
    107   R := (AValue shr 16) and $ff;
    108   G := (AValue shr 8) and $ff;
    109   B := (AValue shr 0) and $ff;
     108  ARGB := (ARGB and $ff000000) or (AValue and $ffffff);
    110109end;
    111110
    … …  
    159158    X := X - Y * BytesPerLine;
    160159    X := Floor(X / BytesPerPixel);
    161     raise Exception.Create(Format(SOutOfRange, [X, Y]));
     160    raise Exception.Create(Format(SOutOfRange, [X, Y, Width, Height]));
    162161  end;
    163162  {$ENDIF}
     163end;
     164
     165function TPixelPointer.PosValid: Boolean;
     166begin
     167  Result := not ((PByte(Pixel) < PByte(Data)) or
     168    (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine));
    164169end;
    165170

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

    r538 r539  
    6666  XNative, YNative: Integer;
    6767  DstPixelWidth, DstPixelHeight: Integer;
     68  NewX, NewY: Integer;
    6869begin
    6970  if Frac(ScreenInfo.Dpi / 96) = 0 then
    7071  begin
    7172    // Use faster non-fractional scaling
    72     Result := BitBlt(Dest.Canvas.Handle, X, Y, Width, Height, Src.Canvas.Handle, XSrc, YSrc, Rop);
     73    Result := BitBlt(Dest.Canvas.Handle, X, Y, Width, Height, Src.Canvas.Handle,
     74      XSrc, YSrc, Rop);
    7375    Exit;
    7476  end;
    … …  
    101103  SrcPixel := TPixelPointer.Create(Src.NativeBitmap);
    102104  DstPixel := TPixelPointer.Create(Dest.NativeBitmap);
    103   for YY := 0 to Height - 1 do begin
    104     DstPixelHeight := ScaleToNative(Y + YY + 1) - ScaleToNative(Y + YY);
    105     for DstPixelY := 0 to DstPixelHeight - 1 do begin
    106       for XX := 0 to Width - 1 do begin
    107         SrcPixel.SetXY(ScaleToNative(XSrc + XX), ScaleToNative(YSrc + YY));
    108         DstPixel.SetXY(ScaleToNative(X + XX), ScaleToNative(Y + YY) + DstPixelY);
    109         DstPixelWidth := ScaleToNative(X + XX + 1) - ScaleToNative(X + XX);
    110         for DstPixelX := 0 to DstPixelWidth - 1 do begin
    111 {$IFDEF DEBUG}
    112           if SrcPixel.PosValid and DstPixel.PosValid then
    113 {$ENDIF}
    114             if Rop = SRCCOPY then begin
    115               DstPixel.PixelB := SrcPixel.PixelB;
    116               DstPixel.PixelG := SrcPixel.PixelG;
    117               DstPixel.PixelR := SrcPixel.PixelR;
    118             end else
    119             if Rop = SRCPAINT then begin
    120               DstPixel.PixelB := SrcPixel.PixelB or DstPixel.PixelB;
    121               DstPixel.PixelG := SrcPixel.PixelG or DstPixel.PixelG;
    122               DstPixel.PixelR := SrcPixel.PixelR or DstPixel.PixelR;
    123             end else
    124             if Rop = SRCAND then begin
    125               DstPixel.PixelB := SrcPixel.PixelB and DstPixel.PixelB;
    126               DstPixel.PixelG := SrcPixel.PixelG and DstPixel.PixelG;
    127               DstPixel.PixelR := SrcPixel.PixelR and DstPixel.PixelR;
    128             end else
    129             if Rop = DSTINVERT then begin
    130               DstPixel.PixelB := not DstPixel.PixelB;
    131               DstPixel.PixelG := not DstPixel.PixelG;
    132               DstPixel.PixelR := not DstPixel.PixelR;
    133             end else begin
    134               raise Exception.Create(SUnsupportedPaintOperationType);
    135             end;
    136           DstPixel.NextPixel;
     105  if Rop = SRCCOPY then begin
     106    for YY := 0 to Height - 1 do begin
     107      NewY := ScaleToNative(Y + YY);
     108      DstPixelHeight := ScaleToNative(Y + YY + 1) - NewY;
     109      SrcPixel.SetXY(0, ScaleToNative(YSrc + YY));
     110      for DstPixelY := 0 to DstPixelHeight - 1 do begin
     111        DstPixel.SetXY(0, NewY + DstPixelY);
     112        for XX := 0 to Width - 1 do begin
     113          SrcPixel.SetX(ScaleToNative(XSrc + XX));
     114          NewX := ScaleToNative(X + XX);
     115          DstPixel.SetX(NewX);
     116          DstPixelWidth := ScaleToNative(X + XX + 1) - NewX;
     117          for DstPixelX := 0 to DstPixelWidth - 1 do begin
     118            DstPixel.PixelRGB := SrcPixel.PixelARGB;
     119            DstPixel.NextPixel;
     120          end;
    137121        end;
    138122      end;
    139       //DstPixel.NextLine;
    140     end;
    141   end;
     123    end;
     124  end else
     125  if Rop = SRCPAINT then begin
     126    for YY := 0 to Height - 1 do begin
     127      NewY := ScaleToNative(Y + YY);
     128      DstPixelHeight := ScaleToNative(Y + YY + 1) - NewY;
     129      SrcPixel.SetXY(0, ScaleToNative(YSrc + YY));
     130      for DstPixelY := 0 to DstPixelHeight - 1 do begin
     131        DstPixel.SetXY(0, NewY + DstPixelY);
     132        for XX := 0 to Width - 1 do begin
     133          SrcPixel.SetX(ScaleToNative(XSrc + XX));
     134          NewX := ScaleToNative(X + XX);
     135          DstPixel.SetX(NewX);
     136          DstPixelWidth := ScaleToNative(X + XX + 1) - NewX;
     137          for DstPixelX := 0 to DstPixelWidth - 1 do begin
     138            DstPixel.PixelRGB := SrcPixel.PixelARGB or DstPixel.PixelARGB;
     139            DstPixel.NextPixel;
     140          end;
     141        end;
     142      end;
     143    end;
     144  end else
     145  if Rop = SRCAND then begin
     146    for YY := 0 to Height - 1 do begin
     147      NewY := ScaleToNative(Y + YY);
     148      DstPixelHeight := ScaleToNative(Y + YY + 1) - NewY;
     149      SrcPixel.SetXY(0, ScaleToNative(YSrc + YY));
     150      for DstPixelY := 0 to DstPixelHeight - 1 do begin
     151        DstPixel.SetXY(0, NewY + DstPixelY);
     152        for XX := 0 to Width - 1 do begin
     153          SrcPixel.SetX(ScaleToNative(XSrc + XX));
     154          NewX := ScaleToNative(X + XX);
     155          DstPixel.SetX(NewX);
     156          DstPixelWidth := ScaleToNative(X + XX + 1) - NewX;
     157          for DstPixelX := 0 to DstPixelWidth - 1 do begin
     158            DstPixel.PixelRGB := SrcPixel.PixelARGB and DstPixel.PixelARGB;
     159            DstPixel.NextPixel;
     160          end;
     161        end;
     162      end;
     163    end;
     164  end else
     165  if Rop = DSTINVERT then begin
     166    for YY := 0 to Height - 1 do begin
     167      NewY := ScaleToNative(Y + YY);
     168      DstPixelHeight := ScaleToNative(Y + YY + 1) - NewY;
     169      SrcPixel.SetXY(0, ScaleToNative(YSrc + YY));
     170      for DstPixelY := 0 to DstPixelHeight - 1 do begin
     171        DstPixel.SetXY(0, NewY + DstPixelY);
     172        for XX := 0 to Width - 1 do begin
     173          SrcPixel.SetX(ScaleToNative(XSrc + XX));
     174          NewX := ScaleToNative(X + XX);
     175          DstPixel.SetX(NewX);
     176          DstPixelWidth := ScaleToNative(X + XX + 1) - NewX;
     177          for DstPixelX := 0 to DstPixelWidth - 1 do begin
     178            DstPixel.PixelRGB := not DstPixel.PixelARGB;
     179            DstPixel.NextPixel;
     180          end;
     181        end;
     182      end;
     183    end;
     184  end else raise Exception.Create(SUnsupportedPaintOperationType);
    142185  Dest.EndUpdate;
    143186  Result := True;

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

    r538 r539  
    3434    function GetPixelB: Byte; inline;
    3535    function GetPixelG: Byte; inline;
    36     function GetPixelPlane(Index: Byte): Byte;
     36    function GetPixelPlane(Index: Byte): Byte; inline;
    3737    function GetPixelR: Byte; inline;
    3838    function GetPixelA: Byte; inline;
    3939    function GetPixelPlanes: TColor32Planes;
    40     function GetPixelRGB: Cardinal;
     40    function GetPixelRGB: Cardinal; inline;
    4141    procedure SetPixelARGB(Value: TColor32); inline;
    4242    procedure SetPixelB(Value: Byte); inline;
    4343    procedure SetPixelG(Value: Byte); inline;
    44     procedure SetPixelPlane(Index: Byte; AValue: Byte);
     44    procedure SetPixelPlane(Index: Byte; AValue: Byte); inline;
    4545    procedure SetPixelR(Value: Byte); inline;
    4646    procedure SetPixelA(Value: Byte); inline;
    47     procedure SetPixelRGB(Value: Cardinal);
     47    procedure SetPixelRGB(Value: Cardinal); inline;
    4848  public
    4949    Base: PPixel32;
    … …  
    6363    procedure SetX(X: Integer); inline; // Set horizontal pixel position relative to base
    6464    procedure CheckRange; inline; // Check if current pixel position is not out of range
     65    function PosValid: Boolean;
    6566    class function Create(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; static;
    6667    property PixelARGB: TColor32 read GetPixelARGB write SetPixelARGB;
    … …  
    105106procedure TPixel32.SetRGB(AValue: Cardinal);
    106107begin
    107   R := (AValue shr 16) and $ff;
    108   G := (AValue shr 8) and $ff;
    109   B := (AValue shr 0) and $ff;
     108  ARGB := (ARGB and $ff000000) or (AValue and $ffffff);
    110109end;
    111110
    … …  
    148147{$IFOPT R+}
    149148var
    150   B: Integer;
    151149  X: Integer;
    152150  Y: Integer;
    … …  
    156154  if (PByte(Pixel) < PByte(Data)) or
    157155    (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine) then begin
    158     B := PByte(Pixel) - PByte(Data);
    159     Y := Floor(B / BytesPerLine);
    160     X := B - Y * BytesPerLine;
     156    X := PByte(Pixel) - PByte(Data);
     157    Y := Floor(X / BytesPerLine);
     158    X := X - Y * BytesPerLine;
    161159    X := Floor(X / BytesPerPixel);
    162160    raise Exception.Create(Format(SOutOfRange, [X, Y, Width, Height]));
    163161  end;
    164162  {$ENDIF}
     163end;
     164
     165function TPixelPointer.PosValid: Boolean;
     166begin
     167  Result := not ((PByte(Pixel) < PByte(Data)) or
     168    (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine));
    165169end;
    166170

  • trunk/Packages/DpiControls/NativePixelPointer.pas

    r538 r539  
    3434    function GetPixelB: Byte; inline;
    3535    function GetPixelG: Byte; inline;
    36     function GetPixelPlane(Index: Byte): Byte;
     36    function GetPixelPlane(Index: Byte): Byte; inline;
    3737    function GetPixelR: Byte; inline;
    3838    function GetPixelA: Byte; inline;
    3939    function GetPixelPlanes: TColor32Planes;
    40     function GetPixelRGB: Cardinal;
     40    function GetPixelRGB: Cardinal; inline;
    4141    procedure SetPixelARGB(Value: TColor32); inline;
    4242    procedure SetPixelB(Value: Byte); inline;
    4343    procedure SetPixelG(Value: Byte); inline;
    44     procedure SetPixelPlane(Index: Byte; AValue: Byte);
     44    procedure SetPixelPlane(Index: Byte; AValue: Byte); inline;
    4545    procedure SetPixelR(Value: Byte); inline;
    4646    procedure SetPixelA(Value: Byte); inline;
    47     procedure SetPixelRGB(Value: Cardinal);
     47    procedure SetPixelRGB(Value: Cardinal); inline;
    4848  public
    4949    Base: PPixel32;
    … …  
    106106procedure TPixel32.SetRGB(AValue: Cardinal);
    107107begin
    108   R := (AValue shr 16) and $ff;
    109   G := (AValue shr 8) and $ff;
    110   B := (AValue shr 0) and $ff;
     108  ARGB := (ARGB and $ff000000) or (AValue and $ffffff);
    111109end;
    112110
Note: See TracChangeset for help on using the changeset viewer.