C# と VB.NET の質問掲示板

ASP.NET、C++/CLI、Java 何でもどうぞ

C# と VB.NET の入門サイト

VB.NETでSusieプラグインを使いたい [1]

[トピック内 25 記事 (21 - 25 表示)]  << 0 | 1 >>

■85462 / inTopicNo.21)  Re[18]: VB.NETでSusieプラグインを使いたい
  
□投稿者/ 魔界の仮面弁士 (1440回)-(2017/10/23(Mon) 23:45:04)
2017/10/24(Tue) 08:55:09 編集(投稿者)

No85461 (K-1 さん) に返信
> Private Declare Function LocalFree Lib "kernel32" (ByVal MemHandle As IntPtr) As Integer
> LocalMemoryInf = CType(LocalLock(BitMapInf), IntPtr)

いや、そういうことではなくて……宣言を見直す必要があるという意味です。

 Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As IntPtr) As IntPtr
 Private Declare Function LocalLock Lib "kernel32" (ByVal hMem As IntPtr) As IntPtr
 Private Declare Function LocalSize Lib "kernel32" (ByVal hMem As IntPtr) As UInteger
 Private Declare Function LocalUnlock Lib "kernel32" (ByVal hMem As IntPtr) As Boolean

LocalFree の場合、引数は HLOCAL で、戻り値も HLOCAL です。引数と同じ値が返されます。
LocalLock の場合、引数は HLOCAL で、戻り値は LPVOID です。メモリブロックのポインタが返されます。
LocalSize の場合、引数は HLOCAL で、戻り値は UINT です。メモリブロックのサイズが返されます。
LocalUnlock の場合、引数は HLOCAL で、戻り値は BOOL です。

HLOCAL とはローカルメモリオブジェクトのハンドルのことであり、
32bit 環境では 32bit サイズ、64bit 環境では 64bit サイズの値として扱われます。

そして HLOCAL は、VB6 では As Long または As OLE_HANDLE で宣言されますが、
VB.NET では、Integer や Long ではなく、IntPtr で宣言されるのが正しいです。



> Dim BitMapHeader As BITMAPINFOHEADER
BITMAPINFOHEADER を Strucuture にするか Class にするかで
API の呼び方も変わります。StrucutLayout の有無も気になるところなので、
構造体宣言も合わせて見せてください。


> Private Declare Function GetPicture Lib "ifdds.spi" (ByVal FileSTR As String, ByVal OffSet As Integer, ByVal Mode As Integer, ByRef MemoryHandle As IntPtr, ByRef InfoHandle As IntPtr, ByVal CallBack As IntPtr, ByVal CallBackLong As IntPtr) As Integer
> ret = GetPicture(temp_dds_name, 0, 0, BitMapInf, BitMapMemoryHandle, Nothing, Nothing) '画像の展開

命名部にまだ混乱が見えますね…。利用側のコードは
 BitMapInf, BitMapMemoryHandle
と指定されていますが、Declare 宣言を見ると、
 MemoryHandle, InfoHandle
となっていて、「Inf」と名の付く引数の位置が、
宣言と利用時として左右入れ替わってしまっています。
分かりにくなってしまうので、きちんと統一しておきましょう。

本来の Susie API 宣言に合わせるなら、Declare 側は
左側(第4引数)が ByRef pHBInfo As IntPtr で
右側(第5引数)が ByRef pHBm As IntPtr などとします。
http://www2f.biglobe.ne.jp/~kana/spi_api/spi_getpicture.html

左側には「BITMAPINFO構造体が納められたメモリハンドル」が返され、
右側には「ビットマップデータ本体のメモリハンドル」が返されます。


そして、BITMAPINFO は可変長サイズの構造体なので、
> MoveMemory(BitMapHeader, LocalMemoryInf, Len(BitMapHeader)) 'メモリ移動
このようなメモリアクセスの仕方は、本来 NG です。

"ifdds.spi" の振る舞いによっては、それでも平気だったのかもしれませんし、
実際に VB6 のコードは、そのような記述になってしまっていたようですが、
既に述べているように、カラーテーブルの有無や長さは不定なので、
いきなり固定サイズでコピーするのは、本来は望ましく無いと思います。

(1) 全体長さを LocalSize で取り出す
(2) メモリブロックのオフセット 0 を Marshal.ReadInt32 で読み取る
(3) 1 の値から 2 の値を引いて、カラーテーブル部のサイズを求める。

などとしてみてください。(ただし、私は試していません)

なお、2 で読み取られる値から、どのバージョンの BITMAPHEADER が
使われていたのかを判断できるはずです。(おそらく 40 バイトの物だとは思いますが)

BITMAPV5HEADER 構造体 (125バイト)
BITMAPV4HEADER 構造体 (108バイト)
BITMAPINFOHEADER 構造体 (40バイト)
BITMAPCOREHEADER 構造体 (12バイト)
http://www5d.biglobe.ne.jp/~noocyte/Programming/Windows/BmpFileFormat.html#FileStructure


> 「DeleteObject(_bmp)」は「'DeleteObject' は宣言されていません。アクセスできない保護レベルになっています。」になってしまうので、
> とりあえずコメントにしておきました。
API なので、Declare しないと。
https://msdn.microsoft.com/ja-jp/library/cc428362.aspx
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As IntPtr) As Boolean



> 結果は真っ黒な画面が表示されるだけでした。
それでは、こんな感じにしてみるとどうでしょうk。

Using g = Graphics.FromImage(bmp)
 g.Clear(Color.Red)
End Using
bmp.Save("red.bmp") '赤い画像のはず
Dim hBmp = bmp.GetHbitmap()
Dim ret = SetDIBits(hDC, hBmp, …)
Dim newBmp = Image.FromHbitmap(hBmp, IntPtr.Zero)
bmp.Dispose()
DeleteObject(hBmp)
newBmp.Save("result.bmp") '赤? 黒?
引用返信 編集キー/
■85463 / inTopicNo.22)  Re[19]: VB.NETでSusieプラグインを使いたい
□投稿者/ K-1 (10回)-(2017/10/24(Tue) 10:33:11)
No85462 (魔界の仮面弁士 さん) に返信

>>Dim BitMapHeader As BITMAPINFOHEADER
> BITMAPINFOHEADER を Strucuture にするか Class にするかで
> API の呼び方も変わります。StrucutLayout の有無も気になるところなので、
> 構造体宣言も合わせて見せてください。
    Private Structure BITMAPINFOHEADER
        Dim biSize As Integer
        Dim biWidth As Integer
        Dim biHeight As Integer
        Dim biPlanes As Short
        Dim biBitCount As Short
        Dim biCompression As Integer
        Dim biSizeImage As Integer
        Dim biXPelsPerMeter As Integer
        Dim biYPelsPerMeter As Integer
        Dim biClrUsed As Integer
        Dim biClrImportant As Integer
    End Structure
上記のように定義してあります。

> そして、BITMAPINFO は可変長サイズの構造体なので、
>>MoveMemory(BitMapHeader, LocalMemoryInf, Len(BitMapHeader)) 'メモリ移動
> このようなメモリアクセスの仕方は、本来 NG です。
ここは「MoveMemory(BitMapHeader, LocalMemoryInf, LocalSize(BitMapInf)) 'メモリ移動」と修正しました。
デバッカで値を確認したところ、LocalSize(BitMapInf)で40の値が得られていたので、そのまま設定しました。

> それでは、こんな感じにしてみるとどうでしょうk。
> 
> Using g = Graphics.FromImage(bmp)
>  g.Clear(Color.Red)
> End Using
> bmp.Save("red.bmp") '赤い画像のはず
> Dim hBmp = bmp.GetHbitmap()
> Dim ret = SetDIBits(hDC, hBmp, …)
> Dim newBmp = Image.FromHbitmap(hBmp, IntPtr.Zero)
> bmp.Dispose()
> DeleteObject(hBmp)
> newBmp.Save("result.bmp") '赤? 黒?
これを参考に
        Dim bmp As New Bitmap(BitMapHeader.biWidth, BitMapHeader.biHeight, System.Drawing.Imaging.PixelFormat.Format24bppRgb)

        'Graphicsのデバイスコンテキストを取得
        Using g As Graphics = Graphics.FromImage(bmp)
            g.Clear(Color.Red)
            Dim hDC As IntPtr = g.GetHdc()

            Dim _bmp As System.IntPtr = bmp.GetHbitmap

            ret = SetDIBits(hDC, _bmp, 0, Picture1.Height, LocalMemoryInf, LocalMemoryBMP, 0) 'ビットマップ表示

            Dim newBmp As Bitmap = Image.FromHbitmap(_bmp, IntPtr.Zero)
            bmp.Dispose()
            DeleteObject(_bmp)
            newBmp.Save("result.png") '赤? 黒?

            Picture1.Image = newBmp

            g.ReleaseHdc()
        End Using
結果は画面、ファイルともに赤一面の画像が出力されました。
処理的には赤で塗りつぶしたあと、SetDIBitsをしてるのですから、それでも赤となると
SetDIBitsが動作していないのだろうか・・・

引用返信 編集キー/
■85464 / inTopicNo.23)  Re[20]: VB.NETでSusieプラグインを使いたい
□投稿者/ K-1 (11回)-(2017/10/24(Tue) 11:26:31)
No85462 (魔界の仮面弁士 さん) に返信

SetDIBitsを下記のように修正したら無事画像が表示できました。
ret = SetDIBits(hDC, _bmp, 0, Picture1.Height, LocalMemoryBMP, LocalMemoryInf, 0) 'ビットマップ表示

ヽ(▽^〃ヽ)ヽ(〃^▽^〃)ノ(ノ〃^▽)ノ
長々と御教授ありがとうございました。
引用返信 編集キー/
■85465 / inTopicNo.24)  Re[20]: VB.NETでSusieプラグインを使いたい
□投稿者/ 魔界の仮面弁士 (1441回)-(2017/10/24(Tue) 12:34:16)
2017/10/24(Tue) 13:17:49 編集(投稿者)

# すれ違いで解決したようですが、解決済みマークはまだですし、
# 情報共有としてそのままにしておきます。

No85463 (K-1 さん) に返信
>>構造体宣言も合わせて見せてください。
> Private Structure BITMAPINFOHEADER
> 上記のように定義してあります。

御提供ありがとうございます。

ちなみに GetPictureInfo API を使う場合の PictureInfo 構造体の場合は
アライメント調整のために、StructLayout 属性の指定も必要です。

<StructLayout(LayoutKind.Sequential, Pack:=1)>
Private Structure PictureInfo
 Public left As Integer
 Public top As Integer
 Public width As Integer
 Public height As Integer
 Public x_density As UShort
 Public y_density As UShort
 Public colorDepth As Short
 Public hInfo As IntPtr
End Structure



>>そして、BITMAPINFO は可変長サイズの構造体なので、
>>> MoveMemory(BitMapHeader, LocalMemoryInf, Len(BitMapHeader)) 'メモリ移動
>>このようなメモリアクセスの仕方は、本来 NG です。
> ここは「MoveMemory(BitMapHeader, LocalMemoryInf, LocalSize(BitMapInf)) 'メモリ移動」と修正しました。
> デバッカで値を確認したところ、LocalSize(BitMapInf)で40の値が得られていたので、そのまま設定しました。

その修正だと、状況が余計に悪化してしまいます。

そもそも、GetPicture API が返す情報は BITMAPINFO 構造体 であって、
BITMAPINFOHEADER 構造体ではありません。
SetDIBits に渡す値も BITMAPINFO ですよね。

イメージ的にはこんな感じかな…。

 Dim BITMAPINFOHEADER_SIZE As Integer = Marshal.SizeOf(GetType(BITMAPINFOHEADER)) 'これは 40 固定
 Dim BitmapHeaderSize As Integer = Marshal.ReadInt32(LocalMemoryInf, 0) '多分 40 だけど 108 や 124 の可能性も
 Dim BITMAPINFO_SIZE As Integer = LocalSize(BitMapInf) 'これは BitmapHeaderSize と同じかそれ以上の値
 If BitmapHeaderSize < BITMAPINFOHEADER_SIZE Then
  '
  '12 バイト版(BITMAPCOREHEADER)はまず使われないので、実装を省略して非対応形式扱いにする
  '
 Else

  '40, 108, 124 バイト版なら、先頭 40 バイト分のみ読み取って処理継続
  MoveMemory(BitMapHeader, LocalMemoryInf, BITMAPINFOHEADER_SIZE)

  If BitmapHeaderSize < BITMAPINFO_SIZE Then
   'LocalMemoryInf のオフセット BITMAPINFO_SIZE 以降の部分に
   'パレット情報が格納されているので、bmp.Palette に転送する
  End If

  '
  'LocalMemoryBMP が、RGB/RGBA 値またはパレットカラー番号を指すので
  'Scan0 プロパティに書き込んでいく(PixelForamt も一致させておくこと)
  '
 End If

上記は Scan0 に書き込むパターンをイメージしたものです。
SetDIBits を使うパターンなら、減色等は勝手にやってくれるはずなので、
最初の BITMAPCOREHEADER の除外判定だけで十分でしょう。


> Dim bmp As New Bitmap(BitMapHeader.biWidth, BitMapHeader.biHeight, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
Format24bppRgb なのは意図的なものですか?


> ret = SetDIBits(hDC, _bmp, 0, Picture1.Height, LocalMemoryInf, LocalMemoryBMP, 0) 'ビットマップ表示
> 処理的には赤で塗りつぶしたあと、SetDIBitsをしてるのですから、
SetDIBits API は
 第 5 引数が CONST VOID *lpvBits // ビットマップのビットからなる配列
 第 6 引数が CONST BITMAPINFO *lpbmi // ビットマップのデータ
ですよ。
LocalMemoryInf は BITMAPINFO だったはずでは?


それを見直してもうまくいかないようであれば、
LocalMemoryBMP のポインタが指し示す先の画素情報が
どういった内容になっているのかを確認しましょう。
引用返信 編集キー/
■85466 / inTopicNo.25)  Re[21]: VB.NETでSusieプラグインを使いたい
□投稿者/ K-1 (12回)-(2017/10/24(Tue) 14:58:59)
No85465 (魔界の仮面弁士 さん) に返信
とりあえず以下のようになりました。

'---宣言
    Private Structure BITMAPINFOHEADER
        Dim biSize As Integer
        Dim biWidth As Integer
        Dim biHeight As Integer
        Dim biPlanes As Short
        Dim biBitCount As Short
        Dim biCompression As Integer
        Dim biSizeImage As Integer
        Dim biXPelsPerMeter As Integer
        Dim biYPelsPerMeter As Integer
        Dim biClrUsed As Integer
        Dim biClrImportant As Integer
    End Structure

    Private Declare Function GetPicture Lib "ifdds.spi" (ByVal FileSTR As String, ByVal OffSet As Integer, ByVal Mode As Integer, ByRef MemoryHandle As IntPtr, ByRef InfoHandle As IntPtr, ByVal CallBack As IntPtr, ByVal CallBackLong As IntPtr) As Integer

    Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Dest As BITMAPINFOHEADER, ByVal Source As IntPtr, ByVal length As Integer)

    Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As IntPtr) As IntPtr
    Private Declare Function LocalLock Lib "kernel32" (ByVal hMem As IntPtr) As IntPtr
    Private Declare Function LocalSize Lib "kernel32" (ByVal hMem As IntPtr) As UInteger
    Private Declare Function LocalUnlock Lib "kernel32" (ByVal hMem As IntPtr) As Boolean

    Private Declare Function SetDIBits Lib "gdi32" (ByVal Pic_hDC As IntPtr, ByVal hBitmap As IntPtr, ByVal nStartScan As Integer, ByVal nNumScans As Integer, ByVal lpBits As IntPtr, ByVal lpBi As IntPtr, ByVal wUsage As Integer) As Integer
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As IntPtr) As Boolean

'---本体
    Private Sub dds2bmp(ByVal temp_dds_name As String)
        Dim BitMapMemoryHandle As IntPtr
        Dim BitMapInf As IntPtr
        Dim LocalMemoryBMP As IntPtr
        Dim LocalMemoryInf As IntPtr
        Dim BitMapHeader As BITMAPINFOHEADER
        Dim ret As Integer


        ret = GetPicture(temp_dds_name, 0, 0, BitMapInf, BitMapMemoryHandle, Nothing, Nothing) '画像の展開

        LocalMemoryInf = LocalLock(BitMapInf)
        LocalMemoryBMP = LocalLock(BitMapMemoryHandle) 'メモリのロック

        'ヘッダ情報サイズの取得
        Dim BITMAPINFOHEADER_SIZE As Integer = Marshal.SizeOf(GetType(BITMAPINFOHEADER)) 'これは 40 固定
        Dim BitmapHeaderSize As Integer = Marshal.ReadInt32(LocalMemoryInf, 0) '多分 40 だけど 108 や 124 の可能性も
        Dim BITMAPINFO_SIZE As Integer = LocalSize(BitMapInf) 'これは BitmapHeaderSize と同じかそれ以上の値

        'ヘッダ情報を構造体にコピー
        MoveMemory(BitMapHeader, LocalMemoryInf, BITMAPINFO_SIZE) 'メモリ移動
        Picture1.Width = BitMapHeader.biWidth 'ピクチャーボックスおよびフォームの大きさを整える
        Picture1.Height = BitMapHeader.biHeight

        '色数に合せてBitmapを生成する
        Dim fmt As System.Drawing.Imaging.PixelFormat = PixelFormat.Format8bppIndexed
        If (BitMapHeader.biBitCount = 8) Then fmt = PixelFormat.Format8bppIndexed
        If (BitMapHeader.biBitCount = 24) Then fmt = PixelFormat.Format24bppRgb

        Dim bmp As New Bitmap(BitMapHeader.biWidth, BitMapHeader.biHeight, fmt)

        'Graphicsのデバイスコンテキストを取得
        Using g As Graphics = Graphics.FromImage(bmp)
            g.Clear(Color.Red)
            Dim hDC As IntPtr = g.GetHdc()

            Dim _bmp As System.IntPtr = bmp.GetHbitmap

            ret = SetDIBits(hDC, _bmp, 0, Picture1.Height, LocalMemoryBMP, LocalMemoryInf, 0) 'ビットマップ表示

            Dim newBmp As Bitmap = Image.FromHbitmap(_bmp, IntPtr.Zero)
            bmp.Dispose()
            DeleteObject(_bmp)

            Picture1.Image = newBmp

            g.ReleaseHdc()
        End Using

        LocalUnlock(BitMapMemoryHandle) 'メモリロック解除
        LocalUnlock(BitMapInf)

        LocalFree(BitMapMemoryHandle) 'メモリ開放
        LocalFree(BitMapInf)
    End Sub

外で加工や保存をおこなっているので、このメソッドにはその動作は入っていません。
これで希望の動作は全て行えるようになりました。
お世話様でした。ありがとうございます。


解決済み
引用返信 編集キー/

このトピックをツリーで一括表示

<前の20件
トピック内ページ移動 / << 0 | 1 >>

このトピックに書きこむ