.bfOffBitsと.bfSizeが反転してしまいます。
下記コードを実行してファイルを確認すると
.bfOffBits = 30360000 .... 00003036
.bfSize = 00360000 .... 00000036
なので上下を入れ替えないとビットマップとして表示されません。
突然ビットマップが作成できなくなったので半日悩みましたバグではない
かも知れませんが調査していただけると嬉しいです。
コード: 全て選択
Dim hFile as LONG
Dim htDC as HDC
Dim htBmp as HBITMAP
Dim Bmf as BITMAPFILEHEADER
Dim Bmi as BITMAPINFO
Dim Dsz as DWORD
Dim Dps as BytePtr
Dim Wtp as LONG
Bmi.bmiHeader.biSize = 40
Bmi.bmiHeader.biWidth = 64
Bmi.bmiHeader.biHeight = 64
Bmi.bmiHeader.biPlanes = 1
Bmi.bmiHeader.biBitCount = 24
Bmi.bmiHeader.biCompression = BI_RGB
Bmi.bmiHeader.biSizeImage = 0
Bmi.bmiHeader.biXPelsPerMeter = 0
Bmi.bmiHeader.biYPelsPerMeter = 0
Bmi.bmiHeader.biClrUsed = 0
Bmi.bmiHeader.biClrImportant = 0
Dsz = ((24*Bmi.bmiHeader.biWidth+31)\32)*4*Abs(Bmi.bmiHeader.biHeight)
Bmf.bfType = &H4D42
Bmf.bfReserved1 = 0
Bmf.bfReserved2 = 0
Bmf.bfOffBits = 54
Bmf.bfSize = Dsz+Bmf.bfOffBits
Dps = GlobalAlloc(GPTR, Dsz)
htDC = CreateCompatibleDC(0)
htBmp = CreateCompatibleBitmap(htDC,64,64)
SelectObject(htDC, Binfo[Cbuf].hmBmp)
GetDIBits(htDC,htBmp,0,64,Dps,Bmi,DIB_RGB_COLORS)
DeleteDC(htDC)
hFile = CreateFile(FN,GENERIC_WRITE,0,ByVal NULL,
CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,NULL)
WriteFile(hFile,VarPtr(Bmf),14,VarPtr(Wtp),ByVal NULL)
WriteFile(hFile,VarPtr(Bmi),Bmf.bfOffBits-14,VarPtr(Wtp),ByVal NULL)
WriteFile(hFile,Dps,Dsz,VarPtr(Wtp),ByVal NULL)
CloseHandle(hFile)
GlobalFree(Dps)