API截屏的簡單演示
2010-03-18 15:30:49| 分类:
VNC
| 标签:
|举报
|字号大中小 订阅
有寫BMP文件部分,未處理字節對齊與顏色表。
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TfrmMain = class(TForm)
tmr1: TTimer;
img1: TImage;
procedure FormCreate(Sender: TObject);
procedure tmr1Timer(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
public
FStream: TMemoryStream;
end;
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
procedure CapScreen(ms: TMemoryStream);
var
bfh: TBitmapFileHeader;
hBmp: HBITMAP;
DC, CDC: HDC;
bi: TBitmapInfo;
pBuf: Pointer;
n, W, H: DWORD;
begin
W := GetSystemMetrics(SM_CXSCREEN);
H := GetSystemMetrics(SM_CYSCREEN);
//
FillChar(bi, SizeOf(bi), #0);
with bi.bmiHeader do
begin
biSize := SizeOf(bi);
biWidth := W;
biHeight := H;
biPlanes := 1;
biBitCount := 16; //no color table
biCompression := BI_RGB;
end;
pBuf := GlobalAllocPtr(64, W * H * 4); //size ? align ?
//
DC := GetDC(0);
CDC := CreateCompatibleDC(DC);
hBmp := CreateCompatibleBitmap(DC, W, H);
SelectObject(CDC, hBmp);
BitBlt(CDC, 0, 0, W, H, DC, 0, 0, SRCCOPY);
GetDIBits(CDC, hBmp, 0, H, pBuf, bi, DIB_RGB_COLORS);
//
n := W * H * 2; //align ?
with bfh do
begin
bfType := $4D42;
bfSize := SizeOf(bfh) + SizeOf(TBitmapInfoHeader) + n;
bfOffBits := SizeOf(bfh) + SizeOf(TBitmapInfoHeader);
bfReserved1 := 0;
bfReserved2 := 0;
end;
ms.Clear;
ms.Write(bfh, SizeOf(bfh));
ms.Write(bi, SizeOf(TBitmapInfoHeader));
ms.Write(pBuf^, n);
ms.Position := 0;
//
ReleaseDC(0, DC);
DeleteDC(CDC);
DeleteObject(hBmp);
GlobalFreePtr(pBuf);
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
FStream := TMemoryStream.Create;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
FStream.Free;
end;
procedure TfrmMain.tmr1Timer(Sender: TObject);
begin
CapScreen(FStream);
img1.Picture.Bitmap.LoadFromStream(FStream);
end;
end.
评论这张
转发至微博
转发至微博
评论