Before usage it's necessary to create own list (see DATA)
Code:
#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]