Tested under Win2000. If doesn't work under another OSes, pls, let me know.
Like sample, this code takes central part of desktop window (60% width / height)
------------------
Like sample, this code takes central part of desktop window (60% width / height)
Code:
#Compile Exe #Register None #Dim All #Include "Win32Api.Inc" $BmpFile = "C:\Bmp24.Bmp" '==================================================== Function CreateTrueColorBmpFile (FileBmp As String, hWnd As Long, rc As RECT) As Long Local f As Long, hDC As Long, hMemDC As Long Local hMemBmp As Long, bm As BITMAP, bmi As BITMAPINFO Local lpBITMAPFILEHEADER As BITMAPFILEHEADER, lpBITMAPINFOHEADER As BITMAPINFOHEADER hDC = GetDC(hWnd): hMemDC = CreateCompatibleDC (hDC) bmi.bmiHeader.biSize = SizeOf(bmi.bmiHeader) bmi.bmiHeader.biWidth = (rc.nRight - rc.nLeft) bmi.bmiHeader.biHeight = (rc.nBottom - rc.nTop) bmi.bmiHeader.biPlanes = 1 bmi.bmiHeader.biBitCount = 24 bmi.bmiHeader.biCompression = %BI_RGB hMemBmp = CreateDIBSection(hMemDC, bmi, %DIB_RGB_COLORS, 0, 0, 0) GlobalLock hMemBmp SelectObject hMemDC, hMemBmp GetObject hMemBmp, SizeOf(bm), bm BitBlt hMemDC, 0, 0, bm.bmWidth, bm.bmHeight, hDC, rc.nLeft, rc.nTop, %SRCCOPY lpBITMAPFILEHEADER.bfType = Cvi("BM") lpBITMAPFILEHEADER.bfSize = Len(lpBITMAPFILEHEADER) + Len(lpBITMAPINFOHEADER) + _ bm.bmWidthBytes * bm.bmHeight lpBITMAPFILEHEADER.bfOffBits = 54 lpBITMAPINFOHEADER.biSize = 40 lpBITMAPINFOHEADER.biWidth = bm.bmWidth lpBITMAPINFOHEADER.biHeight = bm.bmHeight lpBITMAPINFOHEADER.biPlanes = 1 lpBITMAPINFOHEADER.biBitCount = 24 lpBITMAPINFOHEADER.biSizeImage = 54& + bm.bmWidthBytes * bm.bmHeight f = FreeFile: Open FileBmp For Output As #f Print #f, lpBITMAPFILEHEADER lpBITMAPINFOHEADER _ Peek$(bm.bmBits, bm.bmWidthBytes * bm.bmHeight);: Close #f ReleaseDC hWnd, hDC: DeleteDC hMemDC: GlobalUnlock hMemBmp: DeleteObject hMemBmp End Function '============================================== CallBack Function ButProc Local rc As RECT rc.nLeft = 0.2 * GetSystemMetrics(%SM_CXSCREEN): rc.nRight = 4 * rc.nLeft rc.nTop = 0.2 * GetSystemMetrics(%SM_CYSCREEN): rc.nBottom = 4 * rc.nTop CreateTrueColorBmpFile $BmpFile, GetDesktopWindow, rc End Function Function PbMain Local hDlg As Long Dialog New 0, "Polus", ,, 200, 70, %WS_SYSMENU To hDlg Control Add TextBox, hDlg, 101, "", 5, 5, 190, 12 Control Add Button, hDlg, 102, "Copy client area", 30, 30, 140, 15 Call ButProc Dialog Show Modal hDlg End Function
Comment