(CodeLib-Manager)
Registriert seit: 10. Jun 2002
4.648 Beiträge
Delphi XE Professional
|
Re: ScreenShot-Programm zu groß
17. Feb 2005, 14:18
Delphi-Quellcode:
procedure ScreenShot(x: Integer;
y: Integer; //(x, y) = Left-top coordinate
Width: Integer;
Height: Integer; //(Width-Height) = Bottom-Right coordinate
bm: TBitMap); //Destination
var
dc: HDC;
lpPal: PLOGPALETTE;
begin
{test width and height}
if ((Width = 0) or
(Height = 0)) then
Exit;
bm.Width := Width;
bm.Height := Height;
{get the screen dc}
dc := GetDc(0);
if ( dc = 0) then
Exit;
{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(TPALETTEENTRY)));
{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);
if (lpPal^.PalNumEntries <> 0) then
{create the palette}
bm.Palette := CreatePalette(lpPal^);
FreeMem(lpPal, SizeOf(TLOGPALETTE) +
(255 * SizeOf(TPALETTEENTRY)));
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;
Thomas
|
|
Zitat
|