Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


7007 / 76736 ←次へ | 前へ→

【75323】Re:数値配列からビットマップ画像を出力する方法
回答  ちび坊主  - 14/2/12(水) 15:24 -

引用なし
パスワード
   こんにちは。

見直したら、おかしなところがいろいろあったので、消しました。

Private Type BITMAPFILEHEADER
   bfType As Integer
   bfSize As Long
   bfReserved1 As Integer
   bfReserved2 As Integer
   bfOffBits As Long
End Type
Private Type BITMAPINFOHEADER '40 bytes
   biSize As Long
   biWidth As Long
   biHeight As Long
   biPlanes As Integer
   biBitCount As Integer
   biCompression As Long
   biSizeImage As Long
   biXPelsPerMeter As Long
   biYPelsPerMeter As Long
   biClrUsed As Long
   biClrImportant As Long
End Type

Private Sub CreateBmpFile(PixData(), BmpPath As String)
 Dim bmH As BITMAPFILEHEADER
 Dim BmI As BITMAPINFOHEADER
 Dim buf() As Byte
 Dim lBmpByteWidth As Long
 Dim lBMPWidth As Long
 Dim lBMPHeight As Long
 Dim i As Long, j As Long, k As Long
 Dim fio As Integer

 lBMPWidth = UBound(PixData, 1) - LBound(PixData, 1) + 1
 lBMPHeight = UBound(PixData, 2) - LBound(PixData, 2) + 1
 lBmpByteWidth = 3 * lBMPWidth + ((4 - (3 * lBMPWidth Mod 4)) * _
         Sgn(3 * lBMPWidth Mod 4))
 ReDim buf(0 To lBmpByteWidth - 1, 0 To lBMPHeight - 1)
 For i = 0 To lBmpByteWidth - 3 Step 3
  k = 0
  For j = lBMPHeight To 1 Step -1
   buf(i, k) = PixData(i \ 3, j - 1)   'B
   buf(i + 1, k) = PixData(i \ 3, j - 1) 'G
   buf(i + 2, k) = PixData(i \ 3, j - 1) 'R
   k = k + 1
  Next
 Next

 With bmH
  .bfType = CInt("&H" & VBA.Hex(Asc("M")) & VBA.Hex(Asc("B")))
  .bfOffBits = Len(bmH) + Len(BmI)
  .bfSize = lBMPHeight * lBmpByteWidth + .bfOffBits
 End With

 With BmI
  .biSize = Len(BmI)
  .biWidth = lBMPWidth
  .biHeight = lBMPHeight
  .biPlanes = 1
  .biBitCount = 24
  .biSizeImage = lBmpByteWidth
 End With

 fio = FreeFile()
 Open BmpPath For Binary As fio
  Put fio, , bmH
  Put fio, , BmI
  Put fio, , buf()
 Close fio
End Sub


Sub Sample02()
 Dim i As Long, j As Long
 Dim colorb()
 ReDim colorb(0 To 200, 0 To 99)

 For i = LBound(colorb, 1) To UBound(colorb, 1)
  For j = LBound(colorb, 2) To UBound(colorb, 2)
   colorb(i, j) = i
  Next
 Next

 CreateBmpFile colorb, "D:\temp\test01.bmp"
End Sub
0 hits

【75310】数値配列からビットマップ画像を出力する方法 www 14/2/11(火) 10:34 質問
【75323】Re:数値配列からビットマップ画像を出力す... ちび坊主 14/2/12(水) 15:24 回答

7007 / 76736 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free