procedure TForm1.Button1Click(Sender: TObject); var Rct : TRect; begin // Save file to bmp. Rct := Form1.ClientRect ; Image1.Canvas.CopyRect (Rct,Form1.canvas,Rct); Image1.Picture.SaveToFile ('C:\dd.bmp'); // Load file if using Image1.Picture.LoadFromFile ('C:\dd.bmp');end;
屏 幕 的 图 象 拷 贝 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;
function CaptureForm(Form: TForm): TBitmap; var DC: HDC; ABitmap: TBitmap; begin Form.BringToFront; DC := GetDC(GetDesktopWindow); ABitmap := TBitmap.Create; try ABitmap.Width := Form.Width; ABitmap.Height := Form.Height; BitBlt(ABitmap.Canvas.Handle, 0, 0, ABitmap.Width, ABitmap.Height, DC, Form.Left, Form.Top, SRCCOPY); finally ReleaseDC(GetDesktopWindow, DC); end; Result := ABitmap; end;procedure TForm1.Button1Click(Sender: TObject); begin CaptureForm(Form2).SaveToFile('d:\Form2.bmp'); end;
var
Rct : TRect;
begin
// Save file to bmp.
Rct := Form1.ClientRect ;
Image1.Canvas.CopyRect (Rct,Form1.canvas,Rct);
Image1.Picture.SaveToFile ('C:\dd.bmp');
// Load file if using
Image1.Picture.LoadFromFile ('C:\dd.bmp');end;
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;
var
DC: HDC;
ABitmap: TBitmap;
begin
Form.BringToFront;
DC := GetDC(GetDesktopWindow);
ABitmap := TBitmap.Create;
try
ABitmap.Width := Form.Width;
ABitmap.Height := Form.Height;
BitBlt(ABitmap.Canvas.Handle,
0, 0,
ABitmap.Width, ABitmap.Height,
DC,
Form.Left, Form.Top,
SRCCOPY);
finally
ReleaseDC(GetDesktopWindow, DC);
end;
Result := ABitmap;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
CaptureForm(Form2).SaveToFile('d:\Form2.bmp');
end;