Re:Taking Screen Shots!?
Quote
"Mike Shkolnik" <mshkol...@yahoo.com> wrote in message news:a7ni0r$n53$1@news.lucky.net...
> Check the next tips:
> #1: to product a screenshot in bitmap:
> http://www.scalabium.com/faq/dct0001.htm
A better version would account for screens that have palettes:
procedure ScreenShot(x : integer;
y : integer;
Width : integer;
Height : integer;
bm : TBitMap);
var
dc: HDC;
lpPal : PLOGPALETTE;
begin
{test width and height}
if ((Width = 0) OR
(Height = 0)) then begin
exit;
end;
bm.Width := Width;
bm.Height := Height;
{get the screen dc}
dc := GetDc(0);
if (dc = 0) then begin
exit;
end;
{do we have a palette device?}
if (GetDeviceCaps(dc, RASTERCAPS) AND
RC_PALETTE = RC_PALETTE) then begin
{allocate memory for a logical palette}
GetMem(lpPal,
sizeof(TLOGPALETTE) +
(255 * sizeof(TPALET{*word*249}TRY)));
{zero it out to be neat}
FillChar(lpPal^,
sizeof(TLOGPALETTE) +
(255 * sizeof(TPALET{*word*249}TRY)),
#0);
{fill in the palette version}
lpPal^.palVersion := $300;
{grab the system palette entries}
lpPal^.palNumEntries :=
GetSystemPalet{*word*249}tries(dc,
0,
256,
lpPal^.palPalEntry);
if (lpPal^.PalNumEntries <> 0) then begin
{create the palette}
bm.Palette := CreatePalette(lpPal^);
end;
FreeMem(lpPal, sizeof(TLOGPALETTE) +
(255 * sizeof(TPALET{*word*249}TRY)));
end;
{copy from the screen to the bitmap}
BitBlt(bm.Canvas.Handle,
0,
0,
Width,
Height,
Dc,
x,
y,
SRCCOPY);
{release the screen dc}
ReleaseDc(0, dc);
end;
Joe
--
Jimmy Page is having a charity artwork sale: Action For Brazil's Children Trust: http://www.zeppinhood.net/
Whole Lotta Love computing to cure cancer! http://www.wholelottalove.org/
