We don't display ads so we rely on your Bitcoin donations to 1KWEk9QaiJb2NwP5YFmR24LyUBa4JyuKqZ
Post date: Mar 12, 2010 12:32:34 AM
The generic method of programmatically capturing the screen results in a large executable size. By employing one of the techniques discussed in this tutorial, Small Applications in Delphi - Tutorial by n0v4 and only using Windows API calls in the procedure, we can reduce the size of the final executable.
uses
Windows;
procedure Screenshot(shot: string);
var
dibH : hBitmap;
bits : pointer;
info : TBITMAPINFO;
width,height : integer;
screenDC,dibDC : hDC;
f : file of byte;
FileHeader : TBITMAPFILEHEADER;
begin
screenDC := getDC(getDeskTopWindow);
dibDC := createCompatibleDC(screenDC);
width := getDeviceCaps(screenDC,HORZRES);
height := getDeviceCaps(screenDC,VERTRES);
info.bmiHeader.biXPelsPerMeter := round(getDeviceCaps(screenDC,LOGPIXELSX)*39.37);
info.bmiHeader.biYPelsPerMeter := round(getDeviceCaps(screenDC,LOGPIXELSY)*39.37);
zeromemory(@info,sizeOf(info));
with info.bmiHeader do
begin
biSize := sizeOf(TBITMAPINFOHEADER);
biWidth := width;
biheight := height;
biplanes := 1;
biBitCount := 24;
biCompression := BI_RGB;
end;
dibH := createDIBSection(dibDC,info,DIB_RGB_COLORS,bits,0,0);
selectObject(dibDC,dibH);
bitblt(
dibDC,
0,0,width,height,
screenDC,
0,0,
SRCCOPY);
releaseDC(getDeskTopWindow,screenDC);
assignFile(f,shot);
reWrite(f);
if width and 3 <> 0 then
width := 4*((width div 4)+1);
with fileHeader do
begin
bfType := ord('B')+(ord('M')shl 8);
bfSize := sizeOf(TBITMAPFILEHEADER)+sizeOf(TBITMAPINFOHEADER)+width*height*3;
bfOffBits := sizeOf(TBITMAPINFOHEADER);
end;
blockWrite(f,fileHeader,sizeOf(TBITMAPFILEHEADER));
blockWrite(f,info.bmiHeader,sizeOf(TBITMAPINFOHEADER));
blockWrite(f,bits^,width*height*3);
closeFile(f);
deleteObject(dibH);
deleteDC(dibDC);
end;
To use in a form:
procedure TForm1.Button1Click(Sender: TObject);
var
shot:string;
begin
shot:='shot.jpg';
screenshot(shot);
end;