屏幕的图象拷贝
屏 幕 的 图 象 拷 贝 了。
var //变量声明
Fullscreen:Tbitmap;
FullscreenCanvas:TCanvas;
dc:HDC;
//------------------------------------------------------------
DC := GetDC (0); //取得屏幕的 DC，参数0指的是屏幕
FullscreenCanvas := TCanvas.Create; //创建一个CANVAS对象
FullscreenCanvas.Handle := DC; //将屏幕的DC赋给HANDLE
Fullscreen.Canvas.CopyRect
(Rect (0, 0, screen.Width,screen.Height),
fullscreenCanvas,
Rect (0, 0, Screen.Width, Screen.Height));
//把整个屏幕复制到BITMAP中
FullscreenCanvas.Free; //释放CANVAS对象
ReleaseDC (0, DC); //释放DC
//SCREEN对象是DELPHI预先定义的屏幕对象，直接使用就行了。
****************************
下面的代码抓窗口：
procedure ScreenShot(hWindow: HWND; bm: TBitmap);
var
Left, Top, Width, Height: Word;
R: TRect;
dc: HDC;
lpPal: PLOGPALETTE;
begin
{Check if valid window handle}
if not IsWindow(hWindow) then Exit;
{Retrieves the rectangular coordinates of the specified window}
GetWindowRect(hWindow, R);
Left := R.Left;
Top := R.Top;
Width := R.Right - R.Left;
Height := R.Bottom - R.Top;
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(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
begin
{create the palette}
bm.Palette := CreatePalette(lpPal^);
end;
FreeMem(lpPal, SizeOf(TLOGPALETTE) +
(255 * SizeOf(TPALETTEENTRY)));
end;
{copy from the screen to the bitmap}
BitBlt(bm.Canvas.Handle,
0,
0,
Width,
Height,
Dc,
Left,
Top,
SRCCOPY);
{release the screen dc}
ReleaseDc(0, dc);
end;
// Example: Capture the foreground window:
procedure TForm1.Button1Click(Sender: TObject);
begin
ScreenShot(GetForeGroundWindow, Image1.Picture.Bitmap);
end;
***********************
以下代码抓(X,Y)和指定宽度的屏幕内容，并且能够保存调色板
Most of the screenshot code you will see forgets about
the possibility of a palette.
Here is some code that will take a palette into account (if needed).
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(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 begin
{create the palette}
bm.Palette := CreatePalette(lpPal^);
end;
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;
Joe
******************
下面的代码抓矩形：
function CaptureScreen(const Rect: TRect; const BitDepth: TPixelFormat =
pfDevice): TBitmap;
var
hDC: Windows.HDC;
hDesktop: THandle;
begin
// create and define the bitmap
Result := Graphics.TBitmap.Create;
try
case BitDepth of
pfCustom, pfDevice:
Result.PixelFormat := pfDevice;
else
Result.PixelFormat := BitDepth;
end;
Result.Width := Rect.Right - Rect.Left;
Result.Height := Rect.Bottom - Rect.Top;
hDesktop := GetDeskTopWindow();
hDC := GetDC(hDesktop);
try
BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, hDC,
Rect.Left, Rect.Top, SRCCOPY);
finally
ReleaseDC(hDesktop, hDC);
end;
except
FreeAndNil(Result);
end;
end;
