BorlandTalk.com

ben · Guest

How to translate into delphi code?

HBITMAP CopyScreenToBitmap()
{
HDC hScrDC, hMemDC;
HBITMAP hBitmap, hOldBitmap;
int nX, nY, nX2, nY2;
int nWidth, nHeight;
hScrDC = CreateDC("DISPLAY", NULL, NULL, NULL);
hMemDC = CreateCompatibleDC(hScrDC);
nX = 0;
nY = 0;
nX2 = GetDeviceCaps(hScrDC, HORZRES);
nY2 = GetDeviceCaps(hScrDC, VERTRES);
nWidth = nX2 - nX;
nHeight = nY2 - nY;
hBitmap = CreateCompatibleBitmap(hScrDC, nWidth, nHeight);
hOldBitmap = (HBITMAP)SelectObject(hMemDC, hBitmap);
BitBlt(hMemDC, 0, 0, nWidth, nHeight, hScrDC, nX, nY, SRCCOPY);
hBitmap = (HBITMAP)SelectObject(hMemDC, hOldBitmap);
DeleteDC(hScrDC);
DeleteDC(hMemDC);
return hBitmap;

}

int SaveBitmapToFile(HBITMAP hBitmap, LPSTR lpFileName)
{
HDC hDC;
int iBits;
WORD wBitCount;
DWORD dwPaletteSize=0,
dwBmBitsSize,
dwDIBSize, dwWritten;
BITMAP Bitmap;
BITMAPFILEHEADER bmfHdr;
BITMAPINFOHEADER bi;
LPBITMAPINFOHEADER lpbi;
HANDLE fh, hDib, hPal,hOldPal=NULL;
hDC = CreateDC("DISPLAY",NULL,NULL,NULL);
iBits = GetDeviceCaps(hDC, BITSPIXEL) * GetDeviceCaps(hDC, PLANES);
DeleteDC(hDC);
if (iBits <= 1)
wBitCount = 1;
else if (iBits <= 4)
wBitCount = 4;
else if (iBits <= Cool

wBitCount = 8;
else if (iBits <= 24)
wBitCount = 24;
else if(iBits <= 32)
wBitCount = 32;
if (wBitCount <= Cool

dwPaletteSize = (1 << wBitCount) * sizeof(RGBQUAD);
GetObject(hBitmap, sizeof(BITMAP), (LPSTR)&Bitmap);
bi.biSize = sizeof(BITMAPINFOHEADER);
bi.biWidth = Bitmap.bmWidth;
bi.biHeight = Bitmap.bmHeight;
bi.biPlanes = 1;
bi.biBitCount = wBitCount;
bi.biCompression = BI_RGB;
bi.biSizeImage = 0;
bi.biXPelsPerMeter = 0;
bi.biYPelsPerMeter = 0;
bi.biClrUsed = 0;
bi.biClrImportant = 0;

dwBmBitsSize = ((Bitmap.bmWidth * wBitCount + 31) / 32) * 4 *
Bitmap.bmHeight ;
hDib = GlobalAlloc(GHND, dwBmBitsSize + dwPaletteSize +
sizeof(BITMAPINFOHEADER));
lpbi = (LPBITMAPINFOHEADER)GlobalLock(hDib);
*lpbi = bi;
hPal = GetStockObject(DEFAULT_PALETTE);
if(hPal)
{
hDC = GetDC(NULL);
hOldPal = SelectPalette(hDC, (HPALETTE)hPal, FALSE);
RealizePalette(hDC);
}
GetDIBits(hDC, hBitmap, 0, (UINT) Bitmap.bmHeight, (LPSTR)lpbi +
sizeof(BITMAPINFOHEADER)
+ dwPaletteSize, (BITMAPINFO *)lpbi, DIB_RGB_COLORS);
if(hOldPal)
{
SelectPalette(hDC, (HPALETTE)hOldPal, TRUE);
RealizePalette(hDC);
ReleaseDC(NULL, hDC);
}
fh = CreateFile(lpFileName, GENERIC_WRITE, 0, NULL, CREATE_ALWAYS,
FILE_ATTRIBUTE_NORMAL | FILE_FLAG_SEQUENTIAL_SCAN,
NULL);
if(fh == INVALID_HANDLE_VALUE)
return FALSE;
bmfHdr.bfType = 0x4D42; // "BM"
dwDIBSize = sizeof(BITMAPFILEHEADER) + sizeof(BITMAPINFOHEADER) +
dwPaletteSize + dwBmBitsSize;
bmfHdr.bfSize = dwDIBSize;
bmfHdr.bfReserved1 = 0;
bmfHdr.bfReserved2 = 0;
bmfHdr.bfOffBits = (DWORD)sizeof(BITMAPFILEHEADER) +
(DWORD)sizeof(BITMAPINFOHEADER) + dwPaletteSize;
WriteFile(fh, (LPSTR)&bmfHdr, sizeof(BITMAPFILEHEADER), &dwWritten,
NULL);
WriteFile(fh, (LPSTR)lpbi, dwDIBSize, &dwWritten, NULL);
GlobalUnlock(hDib);
GlobalFree(hDib);
CloseHandle(fh);
return dwWritten;

}

willem van deursen · Guest

Hello Ben,

I'm not sure what exactly you are trying to do, but this code (see
below) will grab the active window or the desktop and save it to file.

You definitely should think more in VCL terms and avoiding direct access
to the windows and GDI APIs. Delphi is meant to shed this away from you.

One good source of info might be
http://www.bitwisemag.com/copy/delphi/delphi1.html

found by googling for
Delphi screen bitmap

Many more sources might be available.

Willem

procedure TForm1.Button1Click(Sender: TObject);
var
DestRect, SourceRect: TRect;
h: THandle;
hdcSrc : THandle;
bm : TBitmap;
begin
{Use this line to grab the foregroundwindow/active window}
// h := GetForeGroundWindow;
{Use this line to grab the desktop}
h := GetDesktopWindow;
bm:=TBitmap.Create;
try
if h <> 0 then
hdcSrc := GetWindowDC(h);
GetWindowRect(h, SourceRect);
bm.Width := SourceRect.Right - SourceRect.Left;
bm.Height := SourceRect.Bottom - SourceRect.Top;
DestRect := Rect(0, 0,
SourceRect.Right - SourceRect.Left,
SourceRect.Bottom - SourceRect.Top);
StretchBlt(bm.Canvas.Handle, 0, 0, bm.Width,
bm.Height, hdcSrc, 0, 0,bm.Width,bm.Height,
SRCCOPY);
bm.SaveToFile('c:\test.bmp');
finally
ReleaseDC(0, hdcSrc);
bm.Free;
end;
end;

ben wrote:

JD · Guest

"ben" <wtu_ben (AT) 163 (DOT) com> wrote: