Creating a bitmap for toolbar

[Semen Matusovski]

This utility accepts BMP, as well as ICO.
Before usage it's necessary to create own list (see DATA)

   #Compile Exe
   #Register None
   #Dim All
   #Include "Win32Api.Inc"

   Declare Function CreateTrueColorBmpFile (FileBmp As String, hDC As Long, rc As RECT) As Long
   
   CallBack Function DlgProc
      '============= Correct here ==================
      Data 24 ' Width of single image (pixels)
      Data 24 ' Height
      Data &H00FF00 ' Background; standart is &HC0C0C0
      Data "C:\ToolBar Image.Bmp" ' Output file
      ' List of Ico, Bmp
      Data 5 ' Number
      Data "C:\BmpIco\New.Bmp"
      Data "C:\BmpIco\Graph09.Ico"
      Data "C:\BmpIco\Open.Bmp"
      Data "C:\BmpIco\Pc04.Ico"
      Data "C:\BmpIco\Files10.Ico"
      '==================================
   
      Select Case CbMsg
         Case %WM_PAINT
            Local nPic As Long, dx As Long, dy As Long, clr As Long, BmpFileDst As String
            Local hDC As Long, hMemDc As Long, hIcon As Long, hBmp As Long, hBrush As Long, rc As RECT
            Local TmpString As String, i As Long

            TmpString = Read$(1): dx = Val(TmpString)
            TmpString = Read$(2): dy = Val(TmpString)
            TmpString = Read$(3): clr = Val(TmpString)
            BmpFileDst = Read$(4)
            TmpString = Read$(5): nPic = Val(TmpString)

            hDC = GetDC(CbHndl)
            rc.nRight = nPic * dx: rc.nBottom = dy

            hBrush = CreateSolidBrush(clr)
            FillRect hDC, rc, hBrush
            DeleteObject hBrush

            For i = 1 To nPic
               TmpString = Read$(5 + i)
               Select Case Right$(UCase$(TmpString), 4)
                  Case ".ICO":
                     hIcon = LoadImage(ByVal 0&, ByCopy TmpString, %IMAGE_ICON, 0, 0, %LR_LOADFROMFILE)
                     DrawIconEx hDC, dx * (i - 1), 0, hIcon, dx, dy, 0, 0, %DI_NORMAL
                     DeleteObject hIcon
                  Case ".BMP":
                     hBmp = LoadImage(ByVal 0&, ByCopy TmpString, %IMAGE_BITMAP, dx, dy, %LR_LOADFROMFILE)
                     hMemDC = CreateCompatibleDC (hDC)
                     SelectObject hMemDC, hBmp
                     BitBlt hDC, dx * (i - 1), 0, dx, dy, hMemDC, 0, 0, %SRCCOPY
                     DeleteDC hMemDc: DeleteObject hBmp
               End Select
            Next
            
            CreateTrueColorBmpFile BmpFileDst, hDC, rc
            ReleaseDC CbHndl, hDC
            
            i = Shell ("mspaint.exe " + Chr$(34) + BmpFileDst + Chr$(34), 1)
            PostMessage CbHndl, %WM_SYSCOMMAND, %SC_CLOSE, 0
     End Select
   End Function

   Function PbMain As Long
      Local hDlg As Long, i1 As Long, i2 As Long
      Dialog New hDlg, " Creating BMP for toolbar", , , 0 , 0, %WS_POPUP To hDlg
      SetWindowPos hDlg, 0, 0, 0, GetSystemMetrics(%SM_CXSCREEN), GetSystemMetrics(%SM_CYSCREEN), 0
      Dialog Show Modal hDlg, Call DlgProc
   End Function
   
   Function CreateTrueColorBmpFile (FileBmp As String, hDC As Long, rc As RECT) As Long
      Local f As Long, hMemDC As Long
      Local hMemBmp As Long, bm As BITMAP, bmi As BITMAPINFO
      Local lpBITMAPFILEHEADER As BITMAPFILEHEADER, lpBITMAPINFOHEADER As BITMAPINFOHEADER

      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

      DeleteDC hMemDC: GlobalUnlock hMemBmp: DeleteObject hMemBmp
   End Function

------------------
E-MAIL: [email protected]