VB6でPictureBox.Pictureにビットマップを転送するには?

解決


ぺこ  2005-04-22 02:32:24  No: 89518

VB6で大きな画像(4500x3500ピクセル)を処理した後に、そのDIBのバイト配列でPictureBox.Pictureを変更したいのですが、SetDIBitsToDeviceで一旦.Imageを変更して
.Picture = .Image
とするとAutoRedrawイメージが作成されずに.Pictureが0になってしまいます。どのようにしたらいいでしょうか?


3−t  2005-04-26 07:07:04  No: 89519

回答がつかないのは説明を端折りすぎているからじゃないでしょうか。
場合によっては現象が再現できる必要最小限のコードを提示した方が分かり易いです。
ところで、ステップ実行してどこで処理が失敗しているのかぐらいは分かりましたか?


gtk2k  2005-04-27 06:08:52  No: 89520

ちょっと回りくどい方法となりますが、
SetDibitsで処理を行うとき、どのデバイスコンテキストおよびビットマップオブジェクト(ビットマップハンドル)で行っていますか?
とりあえず、CreateCompatibleBitmapでビットマップオブジェクトを作成して、このビットマップをSelectObjectでピクチャーボックス(のデバイスコンテキスト)に適用して、Refreshしてみてください。


ぺこ  2005-04-27 23:29:39  No: 89521

レスありがとうございます。内容を補足します。
現在やっている事は、
...
PictureBox.Picture = LoadPicture(...)
画像のサイズは4672x3504ピクセルです。
...
    Dim bytBits() As Byte
    ReDim bytBits(1 To byteWidth * lngHeight * 3)
    
    Dim bmpInfo As BITMAPINFO
    With bmpInfo.bmiHeader '構造体初期化
    .biSize = 40
    .biWidth = byteWidth
    .biHeight = -lngHeight
    .biPlanes = 1
    .biBitCount = 24 '24ビット
    .biCompression = 0 'BI_RGB
    .biSizeImage = 0 'BI_RGBの時は0
    .biClrUsed = 0
    End With
    
    Dim ret As Long
    Dim ppvBits As Long
    ppvBits = 0 'ダミー
    Dim hWorkDC As Long
    hWorkDC = CreateCompatibleDC(hSrcDC) 'メモリDC作成
    If hWorkDC <> 0 Then
        Dim hDIB As Long
        hDIB = CreateDIBSection(hSrcDC, bmpInfo, DIB_RGB_COLORS, _
            ppvBits, 0, 0) 'DIB作成
        If hDIB <> 0 Then
            Dim hPrevBmp As Long
            hPrevBmp = SelectObject(hWorkDC, hDIB)
            
            ret = BitBlt(hWorkDC, 0, 0, lngWidth, lngHeight, _
                hSrcDC, 0, 0, vbSrcCopy) 'DIBに画像を転送
            
            hDIB = SelectObject(hWorkDC, hPrevBmp)
            ret = DeleteObject(hPrevBmp)
            ret = DeleteDC(hWorkDC) 'メモリDC解放
            
            'DIBからRGB取得
            ret = GetDIBits(hSrcDC, hDIB, _
                0, lngHeight, bytBits(1), bmpInfo, DIB_RGB_COLORS)
            
            ret = DeleteObject(hDIB) 'DIB解放            
        End If
    End If

この後、配列で画像処理して

    Dim bmpInfo As BITMAPINFO
    With bmpInfo.bmiHeader '構造体初期化
        .biBitCount = 24
        .biClrUsed = 0
        .biCompression = 0
        .biHeight = -lngHeight
        .biWidth = byteWidth
        .biPlanes = 1
        .biSize = 40
        .biSizeImage = byteWidth * lngHeight * 3
    End With
    
    Dim ret As Long
    ret = SetDIBitsToDevice(hDestDC, 0, 0, lngWidth, lngHeight, _
        0, 0, 0, lngHeight, bytSource(1), bmpInfo, DIB_RGB_COLORS)

でPictureBoxに表示しています。
PictureBoxは
.AutoRedraw = True
にしているので、.Imageに書き込まれて

PictureBox.Refresh

とすると画面に表示されますが、この画像をバックグラウンドイメージにしたいので

PictureBox.Picture = PictureBox.Image

とすると
デバッグモードで.Picture = 0になって、次に.hDCを使おうとしたときに
"AutoRedrawイメージが作成できません。"のエラーがでます。
今日また試してみたら、
"0x....のメモリがReadになれませんでした。"とメッセージが出てVBが落ちました。
画像が大きくない場合はできているので、PictureBox.Pictureを使わずに、画像を開いた時にDIBを取っておいて、PictureBox.Clsを使う代わりにDIBを.Imageに転送するようにしようかと思っています。
他に良い対処方法はないでしょうか?
よろしくお願いします。


K.J.K.  2005-04-28 05:23:14  No: 89522

昔、pcdnでも同様のケースが報告されたことがあります。
そのときは、おそらく4096x3072pixel以上辺りを閾値と
して失敗と判定される、というものだったような。
# 数値はうろ覚え。もっと小さかったかも。

で、普通はこのような巨大(画面の大きさを超えるもの)な
ビットマップをそのまま使わず、表示するときはその都度
必要な部分だけを表示する、とかするのが一般的です。

DIBのデータをPictureとして使いたいのならば、API関数の
CreateDIBSectionとOleCreatePictureIndirectを併用すれば、
多分そのままPictureオブジェクトに出来るかと。


ぺこ  2005-04-28 22:13:58  No: 89523

K.J.I様、情報ありがとうございます。
OleCreatePictureIndirectも調べてみていました。
そちらの方向で進んでみようと思います。


※返信する前に利用規約をご確認ください。

※Google reCAPTCHA認証からCloudflare Turnstile認証へ変更しました。






  このエントリーをはてなブックマークに追加