ab.com コミュニティ https://www.activebasic.com/forum/ |
|
フルカラーを256色ビットマップに https://www.activebasic.com/forum/viewtopic.php?t=121 |
ページ 1 / 1 |
作成者: | Sunshine [ 2005年6月18日(土) 23:16 ] |
記事の件名: | フルカラーを256色ビットマップに |
フルカラーを256色ビットマップにすることができたらゲーム作成の面でいいな、と思い、次のような関数を実装してみたのですが、うまくいきません。 ちなみに、ABVer.313です。 コード: '戻り値 ' 成功 … 0 ' 色数が256色以上 … COLOR_OVER256 ' ビットマップファイルではない … FILE_NOT_BITMAP ' フルカラービットマップではない … FILE_NOT_FULLCOLOR_BITMAP ' ファイルオープン失敗 … INVALID_BITMAPFILE Const COLOR_OVER256 = &H0010 Const FILE_NOT_BITMAP = &H0020 Const FILE_NOT_FULLCOLOR_BITMAP = &H0030 Const INVALID_BITMAPFILE = &H0040 Function Change256(filename As BytePtr) As Long '--------------------------元のファイル-------------------------- Dim hFile As DWord, bfh As BITMAPFILEHEADER, bih As BITMAPINFOHEADER, dwSize As DWord Dim lpBuffer As BytePtr 'ファイルから読み込み hFile = CreateFile(filename, GENERIC_READ, 0, ByVal 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0) If hFile = INVALID_HANDLE_VALUE Then Change256 = &H0040 : Exit Function End If ReadFile(hFile, VarPtr(bfh), 14, VarPtr(dwSize), ByVal 0) ReadFile(hFile, VarPtr(bih), 40, VarPtr(dwSize), ByVal 0) If bfh.bfType = "BM" Then CloseHandle(hFile) : Change256 = &H0020 : Exit Function End If If bih.biBitCount <> 24 Then CloseHandle(hFile) : Change256 = &H0030 : Exit Function End If lpBuffer = calloc(bih.biSizeImage) 'バッファ領域確保 ReadFile(hFile, lpBuffer, bih.biSizeImage, VarPtr(dwSize), ByVal 0) CloseHandle(hFile) '--------------------------減色後のファイル-------------------------- Dim hFileDest As DWord, bfhDest As BITMAPFILEHEADER, biDest As BITMAPINFO Dim lpcpyBuffer As BytePtr, BM[1] As Byte 'BITMAPINFOHEADER構造体の定義 biDest.bmiHeader.biSize = 40 biDest.bmiHeader.biWidth = bih.biWidth biDest.bmiHeader.biHeight = bih.biHeight biDest.bmiHeader.biPlanes = 1 biDest.bmiHeader.biBitCount = 8 biDest.bmiHeader.biCompression = BI_RLE8 If biDest.bmiHeader.biWidth mod 4 <> 0 Then biDest.bmiHeader.biSizeImage = (biDest.bmiHeader.biWidth + 4 - biDest.bmiHeader.biWidth mod 4) * biDest.bmiHeader.biHeight Else biDest.bmiHeader.biSizeImage = biDest.bmiHeader.biWidth * biDest.bmiHeader.biHeight End If 'BITMAPFILEHEADER構造体の定義 lstrcpy(BM, "BM") memcpy( VarPtr(bfh.bfType), BM, 2) bfhDest.bfSize = 40 + 14 + 256 * 4 + biDest.bmiHeader.biSizeImage bfhDest.bfOffBits = 40 + 14 + 256 * 4 'カラーパレット決定 Dim i As Long, j As Long, c As Integer, p As DWord, l As Long, key As Long c = -1 : p = 0 For j = 0 To bih.biHeight - 1 For i = 0 To bih.biWidth - 1 key = 0 Select Case c Case -1 biDest.bmpColors(0).rgbBlue = lpBuffer[p] biDest.bmpColors(0).rgbGreen = lpBuffer[p + 1] biDest.bmpColors(0).rgbRed = lpBuffer[p + 2] c = c + 1 Case 0 If biDest.bmpColors(0).rgbBlue <> lpBuffer[p] and _ biDest.bmpColors(0).rgbGreen <> lpBuffer[p + 1] and _ biDest.bmpColors(0).rgbRed <> lpBuffer[p + 2] Then biDest.bmpColors(1).rgbBlue = lpBuffer[p] biDest.bmpColors(1).rgbGreen = lpBuffer[p + 1] biDest.bmpColors(1).rgbRed = lpBuffer[p + 2] c = c + 1 End If Case Else If c = 255 Then free(lpBuffer) : Change256 = &H0010 : Exit Function End If For l = 0 To c If biDest.bmpColors(l).rgbBlue = lpBuffer[p] and _ biDest.bmpColors(l).rgbGreen = lpBuffer[p + 1] and _ biDest.bmpColors(l).rgbRed = lpBuffer[p + 2] Then key = key + 1 End If Next If key = 0 Then biDest.bmpColors(c + 1).rgbBlue = lpBuffer[p] biDest.bmpColors(c + 1).rgbGreen = lpBuffer[p + 1] biDest.bmpColors(c + 1).rgbRed = lpBuffer[p + 2] c = c + 1 End If End Select p = p + 3 Next If bih.biWidth mod 4 = 0 Then p = p + (4 - bih.biWidth mod 4) End If Next 'カラーパレットを元にバッファ内容決定 Dim col As Integer lpcpyBuffer = calloc(biDest.bmiHeader.biSizeImage) p = 0 : l = 0 For j = 0 To bih.biHeight - 1 For i = 0 To bih.biWidth - 1 For col = 0 To c If biDest.bmpColors(c).rgbBlue = lpBuffer[p] and _ biDest.bmpColors(c).rgbGreen = lpBuffer[p + 1] and _ biDest.bmpColors(c).rgbRed = lpBuffer[p + 2] Then lpcpyBuffer[l] = c Exit For End If Next p = p + 3 l = l + 1 Next If bih.biWidth mod 4 = 0 Then p = p + (4 - bih.biWidth mod 4) l = l + (4 - biDest.bmiHeader.biWidth mod 4) End If Next 'ファイルに書き込み hFile = CreateFile(filename, GENERIC_WRITE, 0, ByVal 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0) WriteFile(hFile, VarPtr(bfhDest), 14, VarPtr(dwSize), ByVal 0) WriteFile(hFile, VarPtr(biDest), 40 + 256 * 4, VarPtr(dwSize), ByVal 0) WriteFile(hFile, lpcpyBuffer, bfhDest.bfSize, VarPtr(dwSize), ByVal 0) CloseHandle(hFile) '--------------------------バッファ領域解放-------------------------- free(lpcpyBuffer) free(lpBuffer) Change256 = 0 End Function長くてすみません(^^; |
ページ 1 / 1 | 全ての表示時間は UTC+09:00 です |
Powered by phpBB® Forum Software © phpBB Limited https://www.phpbb.com/ |