jdarling
26-04-2007, 05:27 PM
Well, I know that the Laz guys hang out here now and again, and I can't find a good forum to post this code to so here will do and hopefully they pick it up. I'm using RGB Graphics in an application that I've been working on and found that there was no way to do a fast blit with transparency within it. That just plain sucked as I needed full transparency.
After a bit of playing around I managed to get it to work, and the overall speed seems quite good. Below is my method for fast blits and the modifications needed to the TRGB32Bitmap to make use of it.
// Add this to rgbroutines.pas
procedure BltRGB32Bitmap(Dst: TRGB32BitmapCore; X, Y: Integer;
Src: TRGB32BitmapCore; TransparentColor: TRGB32Pixel);
var
SrcX, SrcWidth, SrcY, SrcHeight: Integer;
C, I: Integer;
PS, PD: PRGB32Pixel;
begin
if (Dst = nil) or (Src = nil) then Exit;
if (Dst.Width <= 0) or (Dst.Height <= 0) or (Src.Width <= 0) or (Src.Height <= 0) then Exit;
if (X >= Dst.Width) or (Y >= Dst.Height) then Exit;
if (X + Src.Width <= 0) or (Y + Src.Height <= 0) then Exit;
SrcX := 0;
SrcY := 0;
SrcWidth := Src.Width;
SrcHeight := Src.Height;
if X < 0 then
begin
SrcX := -X;
Inc(SrcWidth, X);
X := 0;
end;
if Y < 0 then
begin
SrcY := -Y;
Inc(SrcHeight, Y);
Y := 0;
end;
if X + SrcWidth > Dst.Width then
Dec(SrcWidth, X + SrcWidth - Dst.Width);
if Y + SrcHeight > Dst.Height then
Dec(SrcHeight, Y + SrcHeight - Dst.Height);
for I := 0 to Pred(SrcHeight) do
begin
PS := Src.GetPixelPtrUnsafeInline(SrcX, SrcY + I);
PD := Dst.GetPixelPtrUnsafeInline(X, Y + I);
C := 0;
while C < SrcWidth do
begin
if PS^<>TransparentColor then
PD^ := PS^;
inc(PS);
inc(PD);
inc(C);
end;
end;
end;
// Add this to TRGB32Bitmap in rgbgraphics.pas
procedure TRGB32Bitmap.Blit(X, Y: Integer; ABitmap: TRGB32Bitmap;
TransparentColor: TColor);
begin
BltRGB32Bitmap(Self, X, Y, ABitmap, ColorToRGB32PixelInline(TransparentColor));
end;
On another note, does anyone know how to speed up the standard PaintBox? Even with using RGB Graphics my drawing times are VERY VERY slow. I don't want to use SDL, OpenGL, or DirectX for this project as they would be MAJOR overkill. But, the paintbox in Lazarus is still too slow. The same code using Graphics32 in Delphi runs just fine on a paintbox yet with RGB in Lazarus its painfully slow when you hit a threshold of objects (system dependent). I can create a simple sample to show what I mean if anyone wants to take a look.
After a bit of playing around I managed to get it to work, and the overall speed seems quite good. Below is my method for fast blits and the modifications needed to the TRGB32Bitmap to make use of it.
// Add this to rgbroutines.pas
procedure BltRGB32Bitmap(Dst: TRGB32BitmapCore; X, Y: Integer;
Src: TRGB32BitmapCore; TransparentColor: TRGB32Pixel);
var
SrcX, SrcWidth, SrcY, SrcHeight: Integer;
C, I: Integer;
PS, PD: PRGB32Pixel;
begin
if (Dst = nil) or (Src = nil) then Exit;
if (Dst.Width <= 0) or (Dst.Height <= 0) or (Src.Width <= 0) or (Src.Height <= 0) then Exit;
if (X >= Dst.Width) or (Y >= Dst.Height) then Exit;
if (X + Src.Width <= 0) or (Y + Src.Height <= 0) then Exit;
SrcX := 0;
SrcY := 0;
SrcWidth := Src.Width;
SrcHeight := Src.Height;
if X < 0 then
begin
SrcX := -X;
Inc(SrcWidth, X);
X := 0;
end;
if Y < 0 then
begin
SrcY := -Y;
Inc(SrcHeight, Y);
Y := 0;
end;
if X + SrcWidth > Dst.Width then
Dec(SrcWidth, X + SrcWidth - Dst.Width);
if Y + SrcHeight > Dst.Height then
Dec(SrcHeight, Y + SrcHeight - Dst.Height);
for I := 0 to Pred(SrcHeight) do
begin
PS := Src.GetPixelPtrUnsafeInline(SrcX, SrcY + I);
PD := Dst.GetPixelPtrUnsafeInline(X, Y + I);
C := 0;
while C < SrcWidth do
begin
if PS^<>TransparentColor then
PD^ := PS^;
inc(PS);
inc(PD);
inc(C);
end;
end;
end;
// Add this to TRGB32Bitmap in rgbgraphics.pas
procedure TRGB32Bitmap.Blit(X, Y: Integer; ABitmap: TRGB32Bitmap;
TransparentColor: TColor);
begin
BltRGB32Bitmap(Self, X, Y, ABitmap, ColorToRGB32PixelInline(TransparentColor));
end;
On another note, does anyone know how to speed up the standard PaintBox? Even with using RGB Graphics my drawing times are VERY VERY slow. I don't want to use SDL, OpenGL, or DirectX for this project as they would be MAJOR overkill. But, the paintbox in Lazarus is still too slow. The same code using Graphics32 in Delphi runs just fine on a paintbox yet with RGB in Lazarus its painfully slow when you hit a threshold of objects (system dependent). I can create a simple sample to show what I mean if anyone wants to take a look.