VBプログラマ質問スレ（6.0以前） Part52

Sub RotateField180(hdc As Long)
Dim lngWidth As Long, lngHeight As Long

lngWidth = FIELDW
lngHeight = FIELDH
'ファイルの幅が４の倍数であることを確認するべきである


'まずはメモリＤＣを作る
hMemDC = CreateCompatibleDC(hdc)

'DIBの情報を設定する
With bmi
.biSize = LenB(bmi)
.biWidth = lngWidth '４の倍数
.biHeight = -lngHeight '負の値
.biBitCount = 24
.biPlanes = 1 'これは１で固定
'あとは０
End With

'DIBSectionを作る
hDIBSection = CreateDIBSection(hMemDC, bmi, DIB_RGB_COLORS, lpDIB, 0, 0)
'これでlpDIBはDIBが存在する場所を指すようになります。
'この段階ではDIBを操作することは出来ません。

'DIBSectionとhMemDCを関連付ける
hOldBmp = SelectObject(hMemDC, hDIBSection)
'これでDIBとhMemDCとの間には相互関係が生じます。
'BitBlt等でhMemDCに描画するとDIBにも反映されるのです。
'これこそがDIBSectionの大きな利点です。

'hMemDCにpictの画像をコピーする（DIBにも反映される）
BitBlt hMemDC, 0, 0, lngWidth, lngHeight, _
hdc, 0, 0, vbSrcCopy

'DIBを取得する
'lpDIBの指す場所にあるデータをコピーする
ReDim Dib(lngWidth * lngHeight * 3 - 1) As Byte
CopyMemory Dib(0), ByVal lpDIB, lngWidth * lngHeight * 3
'これでようやくDIBを操作できるようになった。 'DIBをいじくる
Dim i As Long
Dim tmp As Long
Dim tbl(255) As Byte

For i = 0 To 250
tbl(i) = i + 5
Next i
tbl(251) = 255: tbl(252) = 255: tbl(253) = 255
tbl(254) = 255: tbl(255) = 255
'と事前に計算結果を用意しておいて
For i = 0 To lngWidth * lngHeight * 3 - 1
Dib(i) = tbl(Dib(i))
Next i

'描画する
StretchDIBits hdc, 10, 10, lngWidth, lngHeight, _
lngWidth, lngHeight, -lngWidth, -lngHeight, _
Dib(0), bmi, DIB_RGB_COLORS, vbSrcCopy

'次の方法でも描画できるが、メモリをコピーするコストを考えると上の方がいいかも
'CopyMemory lpDIB, Dib(0), lngWidth * lngHeight * 3
'BitBlt hdc, 10, 10, lngWidth, lngHeight, hMemDC, 0, 0, vbSrcCopy
End Sub
↑サンプルを値などを変えて作った関数がこれです｡
StretchBltと比較して1階の処理時間を計測してみましたら､
StretchBltが47msに対し､
上の関数RotateField180は281ms掛かっていました｡

>>911
試してみました｡ダメでしたorz