وعليكم السلام ورحمة الله
استخدامتها كثيرة نسخ صورة جزء من صورة تصوير سطح المكتب يبدو ان لها عدة استخدامات
How to Capture Desktop and Save as Image
كود :
How to Capture Desktop and Save as Image
Author: Raymond Alexander
Homepage: http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=134&lngWId=7
Category: Graphic
{This example demonstrates how to capture the windows
desktop and save it to a bitmap on disk.
}
unit Unit_Form_Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls;
type
TForm_Main = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
btnCaptureDesktop: TButton;
cbHideProgramOnCapture: TCheckBox;
cbCreateBMPFile: TCheckBox;
procedure btnCaptureDesktopClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form_Main: TForm_Main;
implementation
uses Unit_Form_DrawingBoard;
{$R *.DFM}
procedure TForm_Main.btnCaptureDesktopClick(Sender: TObject);
var
hdcWindowsDesktop : HDC; //DC handle
hdcTempBitmap : HDC;
hbmTempBitmap : HBITMAP; //Bitmap handle
HRes, VRes : Integer;
MyBitmap : TBitmap;
begin
//Terms:
//DC = display device context
//HDC = a handle for a display device context
//You can use one of the following methods to get and HDC to the windows desktop
//Create a DC of the desktop window and get its handle
//hdcWindowsDesktop := CreateDC('DISPLAY', nil, nil, nil);
// or
//Get the HDC of the desktop window
//hdcWindowsDesktop := GetDC(GetDesktopWindow);
//I decided to use this one
hdcWindowsDesktop := GetDC(GetDesktopWindow);
//Create a DC for the bitmap that will be created
hdcTempBitmap := CreateCompatibleDC(hdcWindowsDesktop);
if hdcTempBitmap = NULL then ShowMessage('CreateCompatibleDC Failed');
//Get the width and hight parameters of the windows desktop
HRes := GetDeviceCaps(hdcWindowsDesktop, HORZRES);
VRes := GetDeviceCaps(hdcWindowsDesktop, VERTRES);
//Create the bitmap that will hold the windows desktop image
hbmTempBitmap := CreateCompatibleBitmap(hdcWindowsDesktop, HRes, VRes);
if hbmTempBitmap = 0 then ShowMessage('CreateCompatibleBitmap Failed');
//Select the bitmap into the DC created for it
if SelectObject(hdcTempBitmap, hbmTempBitmap) = NULL then ShowMessage('SelectObject Failed');
//Now the bitmap can be accessed using the HDC, the HDC is used for the windows GDI functions
if cbHideProgramOnCapture.Checked then
begin
Form_Main.Visible := False;
Form_DrawingBoard.Visible := False;
//Make sure the forms have enough time to hide or they will be caputred too!
Application.ProcessMessages;
Sleep(1000);
end;
//Copy the windows desktop image to the bitmap
if not BitBlt(hdcTempBitmap, 0, 0, VRes, HRes, hdcWindowsDesktop, 0, 0, SRCCOPY) then
ShowMessage('BitBlt Failed');
if cbHideProgramOnCapture.Checked then
begin
Form_Main.Visible := True;
Form_DrawingBoard.Visible := True;
end;
//Copy the image to the form canvas for visual feedback
if not BitBlt(Form_DrawingBoard.Canvas.Handle, 0, 0, VRes, HRes, hdcTempBitmap, 0, 0, SRCCOPY) then
ShowMessage('BitBlt Failed');
if (cbCreateBMPFile.Checked) then
begin
MyBitmap := TBitmap.Create;
MyBitmap.Handle := hbmTempBitmap;
MyBitmap.SaveToFile('Test.bmp');
MyBitmap.Free;
end;
//Delete the bitmap
if not DeleteObject(hbmTempBitmap) then ShowMessage('DeleteObject Failed');
//Delete the bitmap DC
if not DeleteDC(hdcTempBitmap) then ShowMessage('DeleteDC Failed');
//Release the desktop DC
if ReleaseDC(GetDesktopWindow, hdcWindowsDesktop) <> 1 then ShowMessage('ReleaseDC Failed');
end;
end.
make a desktop screenshot
كود :
make a desktop screenshot
Author: Simon Grossenbacher
Homepage: http://www.swissdelphicenter.ch
Category: Forms
{---------------------1---------------------}
function GetScreenShot: TBitmap;
var
Desktop: HDC;
begin
Result := TBitmap.Create;
Desktop := GetDC(0);
try
try
Result.PixelFormat := pf32bit;
Result.Width := Screen.Width;
Result.Height := Screen.Height;
BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, Desktop, 0, 0, SRCCOPY);
Result.Modified := True;
finally
ReleaseDC(0, Desktop);
end;
except
Result.Free;
Result := nil;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Image1.Picture.Bitmap := GetScreenShot;
end;
{---------------------2---------------------}
procedure TForm1.Button1Click(Sender: TObject);
var DCDesk: HDC; // hDC of Desktop
bmp: TBitmap;
begin
{Create a bitmap}
bmp := TBitmap.Create;
{Set a bitmap sizes}
bmp.Height := Screen.Height;
bmp.Width := Screen.Width;
{Get a desktop DC handle - handle of a display device context}
DCDesk := GetWindowDC(GetDesktopWindow);
{Copy to any canvas, here canvas of an image}
BitBlt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,
DCDesk, 0, 0, SRCCOPY);
{Save the bitmap}
bmp.SaveToFile('ScreenShot.bmp');
{Release desktop DC handle}
ReleaseDC(GetDesktopWindow, DCDesk);
{Release a bitmap}
bmp.Free;
end;
{---------------------3---------------------}
{
If you will try to capture the screen to bitmap using BitBlt function
and have a layered (transparent) window visible,
you will get only a picture of the screen without this window.
To fix it we have to use the new raster-operation code for BitBlt
function CAPTUREBLT that introduced in Windows 2000 for including
any windows that are layered on top of your window in the resulting image.
}
procedure CaptureScreen(AFileName: string);
const
CAPTUREBLT = $40000000;
var
hdcScreen: HDC;
hdcCompatible: HDC;
bmp: TBitmap;
hbmScreen: HBITMAP;
begin
// Create a normal DC and a memory DC for the entire screen. The
// normal DC provides a "snapshot" of the screen contents. The
// memory DC keeps a copy of this "snapshot" in the associated
// bitmap.
hdcScreen := CreateDC('DISPLAY', nil, nil, nil);
hdcCompatible := CreateCompatibleDC(hdcScreen);
// Create a compatible bitmap for hdcScreen.
hbmScreen := CreateCompatibleBitmap(hdcScreen,
GetDeviceCaps(hdcScreen, HORZRES),
GetDeviceCaps(hdcScreen, VERTRES));
// Select the bitmaps into the compatible DC.
SelectObject(hdcCompatible, hbmScreen);
bmp := TBitmap.Create;
bmp.Handle := hbmScreen;
BitBlt(hdcCompatible,
0, 0,
bmp.Width, bmp.Height,
hdcScreen,
0, 0,
SRCCOPY or CAPTUREBLT);
bmp.SaveToFile(AFileName);
bmp.Free;
DeleteDC(hdcScreen);
DeleteDC(hdcCompatible);
end;
include the mouse-cursor in a screen shot
كود :
include the mouse-cursor in a screen shot
Author: Thomas Stutz
Category: Graphic
// 1. Get the handle to the current mouse-cursor and its position
function GetCursorInfo2: TCursorInfo;
var
hWindow: HWND;
pt: TPoint;
pIconInfo: TIconInfo;
dwThreadID, dwCurrentThreadID: DWORD;
begin
Result.hCursor := 0;
ZeroMemory(@Result, SizeOf(Result));
// Find out which window owns the cursor
if GetCursorPos(pt) then
begin
Result.ptScreenPos := pt;
hWindow := WindowFromPoint(pt);
if IsWindow(hWindow) then
begin
// Get the thread ID for the cursor owner.
dwThreadID := GetWindowThreadProcessId(hWindow, nil);
// Get the thread ID for the current thread
dwCurrentThreadID := GetCurrentThreadId;
// If the cursor owner is not us then we must attach to
// the other thread in so that we can use GetCursor() to
// return the correct hCursor
if (dwCurrentThreadID <> dwThreadID) then
begin
if AttachThreadInput(dwCurrentThreadID, dwThreadID, True) then
begin
// Get the handle to the cursor
Result.hCursor := GetCursor;
AttachThreadInput(dwCurrentThreadID, dwThreadID, False);
end;
end
else
begin
Result.hCursor := GetCursor;
end;
end;
end;
end;
// 2. Capture the screen
function CaptureScreen: TBitmap;
var
DC: HDC;
ABitmap: TBitmap;
MyCursor: TIcon;
CursorInfo: TCursorInfo;
IconInfo: TIconInfo;
begin
// Capture the Desktop screen
DC := GetDC(GetDesktopWindow);
ABitmap := TBitmap.Create;
try
ABitmap.Width := GetDeviceCaps(DC, HORZRES);
ABitmap.Height := GetDeviceCaps(DC, VERTRES);
// BitBlt on our bitmap
BitBlt(ABitmap.Canvas.Handle,
0,
0,
ABitmap.Width,
ABitmap.Height,
DC,
0,
0,
SRCCOPY);
// Create temp. Icon
MyCursor := TIcon.Create;
try
// Retrieve Cursor info
CursorInfo := GetCursorInfo2;
if CursorInfo.hCursor <> 0 then
begin
MyCursor.Handle := CursorInfo.hCursor;
// Get Hotspot information
GetIconInfo(CursorInfo.hCursor, IconInfo);
// Draw the Cursor on our bitmap
ABitmap.Canvas.Draw(CursorInfo.ptScreenPos.X - IconInfo.xHotspot,
CursorInfo.ptScreenPos.Y - IconInfo.yHotspot, MyCursor);
end;
finally
// Clean up
MyCursor.ReleaseHandle;
MyCursor.Free;
end;
finally
ReleaseDC(GetDesktopWindow, DC);
end;
Result := ABitmap;
end;
// Example: Capture the screen and include the cursor.
// Show the Screenshot in Image1
procedure TForm1.Button1Click(Sender: TObject);
begin
Image1.Picture.Assign(CaptureScreen);
end;