VBAで、GDI+を使って画像を回転させるには?

解決


mitarashi  2008-12-15 06:30:11  No: 141076

エクセルのVBAで、GDI+を使って画像を回転、リサイズしてワークシートに貼付ようとしています。
海外サイトで下記のコード(元がVB6用のため若干修正)を見つけたのですが、回転により元画像のサイズからはみ出す部分は切れてしまいます。Graphicsオブジェクトのサイズを変更してやれば良いと考えたのですが、方々いじったり、サイズの大きいビットマップから作成したGraphicsとすげ替えてみたりと、試行錯誤はしてみたのですが無理でした。御教示いただきたく、お願いします。GraphicsとImageは連動している様ですが、そのあたりは良く理解できておりません。なお、リサイズの方は(自力ではありませんが)出来ております。
Public Function RotateImage(ByRef hImage As Long, ByVal angle As Single, Optional lBackColour As Long = -1)
    Dim retval As Long
    Dim hGraphics As Long
    Dim hClone As Long
    Dim lHeight As Long
    Dim lWidth As Long
    Dim hBrush As Long
    
    retval = GdipGetImageHeight(hImage, lHeight)
    retval = GdipGetImageWidth(hImage, lWidth)
    If angle > 0 And angle < 360 Then angle = angle - 180
    '元画像(Image)のクローンを作成
    retval = GdipCloneImage(hImage, hClone)
    '元画像(Image)から、Graphicsオブジェクトを生成
    retval = GdipGetImageGraphicsContext(hImage, hGraphics)
    If lHeight <> lWidth Then
        retval = GdipCreateSolidFill(lBackColour, hBrush)
        retval = GdipFillRectangle(hGraphics, hBrush, 0, 0, lWidth, lHeight)
        retval = GdipDeleteBrush(hBrush)
    End If
    retval = GdipRotateWorldTransform(hGraphics, angle, MatrixOrderPrepend)
    retval = GdipTranslateWorldTransform(hGraphics, lWidth / 2, lHeight / 2, MatrixOrderAppend)
    retval = GdipDrawImageRectI(hGraphics, hClone, lWidth / 2, lHeight / 2, -lWidth, -lHeight)
'Graphicsオブジェクトに元画像のコピーを描画
    'retval = GdipDrawImageRectI(pGraphicsDesktop, hClone, lWidth / 2, lHeight / 2, -lWidth, -lHeight)
    retval = GdipDeleteGraphics(hGraphics)
    retval = GdipDisposeImage(hClone)
End Function


subaru  2008-12-16 01:07:48  No: 141077

サイズや描画位置は計算が必要になるでしょうが
基本的にサイズの大きいビットマップに転送すれば収まるはず。
提示のコードで使用しているGdipDrawImageRectIでは転送先のイメージのサイズに
合わせてスケーリングされて拡大表示になってしまうので
GdipDrawImagePointRectIなどを使うようにすればいいんじゃないでしょうか。


mitarashi  2008-12-16 09:50:10  No: 141078

アドバイスありがとうございます。
教えていただいた関数を用いて、いろいろ試行錯誤してみましたが、
retval = GdipDrawImagePointRectI(hGraphics, hClone, x, y, srcx, srcy, srcwidth, srcheight, Unitpixel)
srcwidth, srcheightをいじってみても、Graphicsのサイズが変わる訳ではないので、はみ出すのは相変わらずでした。
コピーしておいた、hCloneを、元画像よりも大きくした、Graphicsに貼り付けるにはどうやったら良いのか、教えていただきたく、お願いします。
また、今回のコードは、回転させたり、移動する処理を施したGraphicsに、元のimageを貼り付けるという分かりにくい事をしておりますが、もっと分かりやすい方法がありましたら、合わせてお願いします。


subaru  2008-12-16 22:10:35  No: 141079

>コピーしておいた、hCloneを、元画像よりも大きくした、Graphicsに貼り付けるにはどうやったら良いのか、教えていただきたく、お願いします。
描画できる領域はGraphicsのサイズというよりGraphicsに関連付けられている画像のサイズに依存します。
まず元画像からGraphicsオブジェクトを生成するのではなく、描画したいサイズの画像から作るようにしてください。
元記事でリサイズの方はできているとありますが同様の方法は使えないでしょうか?
まあ空のビットマップでいいのでGdipCreateBitmapFromScan0でサイズ指定で作ることもできます。

>また、今回のコードは、回転させたり、移動する処理を施したGraphicsに、元のimageを貼り付けるという分かりにくい事をしておりますが、もっと分かりやすい方法がありましたら、合わせてお願いします。
元記事の
>retval = GdipDrawImageRectI(hGraphics, hClone, lWidth / 2, lHeight / 2, -lWidth, -lHeight)
の部分がわかりにくいかも。
幅と高さが負ということは水平反転と垂直反転の適用で180度回転した状態からの描画を意図してるんでしょうか?
これを適用するにはGdipDrawImageRectRectIじゃないとダメかも?
(てかピクセル単位ならこっちでしたね・・・)

他にもGDI+のGraphics::DrawImageには平行四辺形の座標を渡すタイプの
メソッドがありますが、手間はあまり変わらないかもしれません。


mitarashi  2008-12-17 06:42:33  No: 141080

アドバイスありがとうございます。
教えていただいた、GdipCreateBitmapFromScan0でやってみようと、WEB検索して、参考になりそうなCのコードを移植してみましたが、最初のGdipCreateBitmapFromScan0でエラーになってしまいます。どこがまずいのか教えていただけますでしょうか。Case PixelFormat32bppARGBの生成も自信が無いです。
なお、文中のコメントは元々のCのコードについていたコメントです。
Const PixelFormatGDI = &H20000            ' Is a GDI-supported format
Const PixelFormatAlpha = &H40000          ' Has an alpha component
Const PixelFormatCanonical = &H200000

Dim PixelFormat32bppARGB As Long

(中略)
    '#define    PixelFormat32bppARGB       (10 | (32 << 8) | PixelFormatAlpha | PixelFormatGDI | PixelFormatCanonical)  GdiPlusPixelFormats.hより
    PixelFormat32bppARGB = 10 Or BitShift(32, 8) Or PixelFormatAlpha Or PixelFormatGDI Or PixelFormatCanonical
    '; オフスクリーンバッファ Image 作成
    retval = GdipCreateBitmapFromScan0(300, 200, 0, PixelFormat32bppARGB, 0, imgImage)
    '; オフスクリーンバッファ Graphics 作成
    retval = GdipGetImageGraphicsContext(imgImage, imgGraphics)
    'SmoothingModeHighQuality
    retval = GdipSetSmoothingMode(imgGraphics, 2)
    'TextRenderingHintAntiAliasGridFit
    retval = GdipSetTextRenderingHint(imgGraphics, 4)
(中略)

Public Function BitShift(Value As Long, Shift As Long) As Long
    BitShift = Value * 2 ^ Shift
End Function


subaru  2008-12-17 20:13:10  No: 141081

Const PixelFormat32bppARGB = &H26200A
でいいです。
戻り値はなんでしょうか?


mitarashi  2008-12-18 06:08:48  No: 141082

ご回答ありがとうございます。夜しかアクセスできないため、レスポンスが悪くて申し訳ありません。戻り値は2です。
関係ありそうなソース部分を補足でお知らせいたします。ご検討の程、よろしくお願いします。
Private Declare Function GdipCreateBitmapFromScan0 Lib "gdiplus.dll" (ByVal nWidth As Long, ByVal Height As Long, ByVal stride As Long, ByVal PixelFormat As Long, scan0 As Any, nBitmap As Long) As Long
(中略)
Public Function RotateImage(ByRef hImage As Long, ByVal angle As Single, Optional lBackColour As Long = -1)

Dim imgImage As Long, imgGraphics As Long

    PixelFormat32bppARGB = 10 Or BitShift(32, 8) Or PixelFormatAlpha Or PixelFormatGDI Or PixelFormatCanonical
    retval = GdipCreateBitmapFromScan0(100, 100, 0, PixelFormat32bppARGB, 0, imgImage)
    Debug.Print "&H" & Hex(PixelFormat32bppARGB)
    Debug.Print "retval : ", retval
(中略)
end function

&H26200A
retval :       2


mitarashi  2008-12-18 10:20:10  No: 141083

PixelFormat32bppARGBを後押ししていただいたので、VB6のコードを検索してみた結果、
    retval = GdipCreateBitmapFromScan0(300, 300, 0, PixelFormat32bppARGB, ByVal 0&, imgImage)
とすると、エラーにならない事が判明しました。(理屈は分かりませんが)
手直ししたコードは下記の通りです。これにより、枠は大きくなりましたが、
GdipDrawImageRectI  で貼り付けた画像は枠に合わせて大きくなってしまっています。引き続きアドバイスをお願いいたします。

'大きいサイズのImageを別にimgImageで戻す様にした
Public Function RotateImage(ByRef hImage As Long, ByRef imgImage As Long, ByVal angle As Single, Optional lBackColour As Long = -1)
    Dim retval As Long
    Dim lHeight As Long
    Dim lWidth As Long
    Dim hBrush As Long
    Dim imgGraphics As Long
    
    retval = GdipGetImageHeight(hImage, lHeight)
    retval = GdipGetImageWidth(hImage, lWidth)
    If angle > 0 And angle < 360 Then angle = angle - 180

    '; オフスクリーンバッファ Image、Graphics 作成
    PixelFormat32bppARGB = 10 Or BitShift(32, 8) Or PixelFormatAlpha Or PixelFormatGDI Or PixelFormatCanonical
    retval = GdipCreateBitmapFromScan0(300, 300, 0, PixelFormat32bppARGB, ByVal 0&, imgImage)
    retval = GdipGetImageGraphicsContext(imgImage, imgGraphics)
    
    retval = GdipCreateSolidFill(lBackColour, hBrush)
    retval = GdipFillRectangle(imgGraphics, hBrush, 0, 0, 300, 300)
    retval = GdipDeleteBrush(hBrush)
    
    retval = GdipRotateWorldTransform(imgGraphics, angle, MatrixOrderPrepend)
    '数字は試行錯誤の途中
    retval = GdipDrawImageRectI(imgGraphics, hImage, lWidth / 2, lHeight / 2, -500, -400)
    
    retval = GdipDeleteGraphics(imgGraphics)
    retval = GdipDisposeImage(hImage)
End Function


subaru  2008-12-19 00:39:39  No: 141084

>PixelFormat32bppARGBを後押ししていただいたので、VB6のコードを検索してみた結果、
>    retval = GdipCreateBitmapFromScan0(300, 300, 0, PixelFormat32bppARGB, ByVal 0&, imgImage)
>とすると、エラーにならない事が判明しました。(理屈は分かりませんが)

第5引数はポインタの値渡しと考えるとByValということになるのでしょう。

>手直ししたコードは下記の通りです。これにより、枠は大きくなりましたが、
>GdipDrawImageRectI  で貼り付けた画像は枠に合わせて大きくなってしまっています。引き続きアドバイスをお願いいたします。

前にも書きましたが、GdipDrawImageRectRectIです。

>    retval = GdipRotateWorldTransform(imgGraphics, angle, MatrixOrderPrepend)
>    '数字は試行錯誤の途中
>    retval = GdipDrawImageRectI(imgGraphics, hImage, lWidth / 2, lHeight / 2, -500, -400)

新しい画像に最低限必要なサイズを、円周率をpiとして
width = lWidth * Abs(Cos(angle * pi / 180)) + lHeight * Abs(Sin(angle * pi / 180))
height = lWidth * Abs(Sin(angle * pi / 180)) + lHeight * Abs(Cos(angle * pi / 180))
とします。
回転部分だけならこんな感じでできると思います。

retval = GdipTranslateWorldTransform(imgGraphics, -lWidth / 2, -lHeight / 2, MatrixOrderAppend)
retval = GdipRotateWorldTransform(imgGraphics, angle, MatrixOrderAppend)
retval = GdipTranslateWorldTransform(imgGraphics, width / 2, height / 2, MatrixOrderAppend)
retval = GdipDrawImageRectRectI(imgGraphics, hImage, 0, 0, lWidth, lHeight, 0, 0, lWidth, lHeight, UnitPixel, 0, 0, 0)


mitarashi  2008-12-19 08:24:55  No: 141085

ありがとうございました。
おかげさまで、うまく回転ができました。
中味はこれから勉強させていただきますが、とりあえず今日出来たところをお知らせいたします。
Private Sub RotateImage(ByRef hImage As Long, ByRef imgImage As Long, ByVal angle As Single, Optional lBackColour As Long = -1)
    Dim retval As Long
    Dim lHeight As Long, lWidth As Long
    Dim newHeight As Long, newWidth As Long
    Dim hBrush As Long
    Dim imgGraphics As Long
    Const pi As Single = 3.14159265
    
    retval = GdipGetImageHeight(hImage, lHeight)
    retval = GdipGetImageWidth(hImage, lWidth)
    '新しい画像に最低限必要なサイズ算出
    newWidth = lWidth * Abs(Cos(angle * pi / 180)) + lHeight * Abs(Sin(angle * pi / 180))
    newHeight = lWidth * Abs(Sin(angle * pi / 180)) + lHeight * Abs(Cos(angle * pi / 180))
    '; オフスクリーンバッファ Image、Graphics 作成
    PixelFormat32bppARGB = 10 Or BitShift(32, 8) Or PixelFormatAlpha Or PixelFormatGDI Or PixelFormatCanonical
    retval = GdipCreateBitmapFromScan0(newWidth, newHeight, 0, PixelFormat32bppARGB, ByVal 0&, imgImage)
    retval = GdipGetImageGraphicsContext(imgImage, imgGraphics)
    retval = GdipCreateSolidFill(lBackColour, hBrush)
    retval = GdipFillRectangle(imgGraphics, hBrush, 0, 0, newWidth, newHeight)
    retval = GdipDeleteBrush(hBrush)
    '回転
    retval = GdipTranslateWorldTransform(imgGraphics, -lWidth / 2, -lHeight / 2, MatrixOrderAppend)
    retval = GdipRotateWorldTransform(imgGraphics, angle, MatrixOrderAppend)
    retval = GdipTranslateWorldTransform(imgGraphics, newWidth / 2, newHeight / 2, MatrixOrderAppend)
    retval = GdipDrawImageRectRectI(imgGraphics, hImage, 0, 0, lWidth, lHeight, 0, 0, lWidth, lHeight, UnitPixel, 0, 0, 0)
    
    retval = GdipDeleteGraphics(imgGraphics)
    retval = GdipDisposeImage(hImage)
End Sub


mitarashi  2008-12-20 08:46:20  No: 141086

一部コメントアウトしながら実行して、内容の確認ができました。
デジカメの画像を、回転・リサイズして、Exifの撮影時間情報(秒まで)と共にワークシートに貼り付けたいというのが、今回の目的でしたが、おかげさまで実現できました。GDI+のflat APIについては日本語の情報が乏しく、英語の解説は画像処理用語が多くて、なかなか理解できずにおりました。
ありがとうございました。


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




  


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