Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Creating 24 bits BMP-file

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Creating 24 bits BMP-file

    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)

    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
    ------------------

  • #2
    Work on Windows98SE!


    ------------------

    Comment

    Working...
    X