Capture an image to a fully paletted bitmap
This code does not look like it was mine originally, but I found it in a stray file on my hard drive. I decided I didn’t want to lose it.
It takes a picture of any component you pass in and populates a TBitmap with an image using a custom palette built from device context of the component you are capturing.
DELPHI:
-
-
-
{******************************************************************************
-
ComponentToImg
-
******************************************************************************}
-
procedure TForm1.ComponentToImg(CHandle: HWND; x: Integer; y: Integer; Width: Integer; Height: Integer; bm: TBitMap);
-
var
-
dc: HDC;
-
lpPal : PLOGPALETTE;
-
begin // ComponentToImg
-
// Test width and height
-
if ((Width = 0) OR (Height = 0)) then exit;
-
bm.Width := Width;
-
bm.Height := Height;
-
-
// Get the screen dc
-
dc := GetDc(CHandle);
-
try
-
// If the device doesn’t have a handle, we can’t do anything with it.
-
if (dc = 0) then exit;
-
// Do we have a palette device?
-
if (GetDeviceCaps(dc, RASTERCAPS) AND RC_PALETTE = RC_PALETTE)
-
then begin
-
// If so, allocate memory for a logical palette
-
GetMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
-
try
-
// Zero it out to be neat
-
FillChar(lpPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0);
-
// Fill in the palette version
-
lpPal^.palVersion := $300;
-
// Grab the system palette entries
-
lpPal^.palNumEntries :=GetSystemPaletteEntries(dc,0,256,lpPal^.palPalEntry);
-
// Create the palette
-
if (lpPal^.PalNumEntries <> 0) then bm.Palette := CreatePalette(lpPal^);
-
finally
-
FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
-
end;
-
end;
-
// Copy from the screen to the bitmap}
-
BitBlt(bm.Canvas.Handle, 0, 0, Width, Height, Dc, x, y, SRCCOPY);
-
-
// Release the screen dc no matter what happened above.
-
finally
-
ReleaseDc(0, dc);
-
end
-
end; // ComponentToImg
-
-
procedure TForm1.Button1Click(Sender: TObject);
-
begin
-
ComponentToImg(self.Handle, 0, 0, 800, 600, Image1.Picture.Bitmap);
-
end;
A GetMem and FreeMem without try..finally? brr... Maybe this code could use some tweaking. Otherwise it is a very nice snippet!
Comment by Walter Heck — April 23, 2007 @ 3:46 am
Good catch! Glad I said it wasn't my code
Comment by Brian — April 23, 2007 @ 6:57 am
Thanx, Same thing goes for GetDc and ReleaseDC by the way
Comment by Walter Heck — April 23, 2007 @ 7:59 am