VBAで、GDI+を使って画像を回転させるには?
解決エクセルの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
サイズや描画位置は計算が必要になるでしょうが
基本的にサイズの大きいビットマップに転送すれば収まるはず。
提示のコードで使用しているGdipDrawImageRectIでは転送先のイメージのサイズに
合わせてスケーリングされて拡大表示になってしまうので
GdipDrawImagePointRectIなどを使うようにすればいいんじゃないでしょうか。
アドバイスありがとうございます。
教えていただいた関数を用いて、いろいろ試行錯誤してみましたが、
retval = GdipDrawImagePointRectI(hGraphics, hClone, x, y, srcx, srcy, srcwidth, srcheight, Unitpixel)
srcwidth, srcheightをいじってみても、Graphicsのサイズが変わる訳ではないので、はみ出すのは相変わらずでした。
コピーしておいた、hCloneを、元画像よりも大きくした、Graphicsに貼り付けるにはどうやったら良いのか、教えていただきたく、お願いします。
また、今回のコードは、回転させたり、移動する処理を施したGraphicsに、元のimageを貼り付けるという分かりにくい事をしておりますが、もっと分かりやすい方法がありましたら、合わせてお願いします。
>コピーしておいた、hCloneを、元画像よりも大きくした、Graphicsに貼り付けるにはどうやったら良いのか、教えていただきたく、お願いします。
描画できる領域はGraphicsのサイズというよりGraphicsに関連付けられている画像のサイズに依存します。
まず元画像からGraphicsオブジェクトを生成するのではなく、描画したいサイズの画像から作るようにしてください。
元記事でリサイズの方はできているとありますが同様の方法は使えないでしょうか？
まあ空のビットマップでいいのでGdipCreateBitmapFromScan0でサイズ指定で作ることもできます。
>また、今回のコードは、回転させたり、移動する処理を施したGraphicsに、元のimageを貼り付けるという分かりにくい事をしておりますが、もっと分かりやすい方法がありましたら、合わせてお願いします。
元記事の
>retval = GdipDrawImageRectI(hGraphics, hClone, lWidth / 2, lHeight / 2, -lWidth, -lHeight)
の部分がわかりにくいかも。
幅と高さが負ということは水平反転と垂直反転の適用で180度回転した状態からの描画を意図してるんでしょうか？
これを適用するにはGdipDrawImageRectRectIじゃないとダメかも？
（てかピクセル単位ならこっちでしたね・・・）
他にもGDI+のGraphics::DrawImageには平行四辺形の座標を渡すタイプの
メソッドがありますが、手間はあまり変わらないかもしれません。
アドバイスありがとうございます。
教えていただいた、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
Const PixelFormat32bppARGB = &H26200A
でいいです。
戻り値はなんでしょうか？
ご回答ありがとうございます。夜しかアクセスできないため、レスポンスが悪くて申し訳ありません。戻り値は２です。
関係ありそうなソース部分を補足でお知らせいたします。ご検討の程、よろしくお願いします。
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
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
>PixelFormat32bppARGBを後押ししていただいたので、VB6のコードを検索してみた結果、
> retval = GdipCreateBitmapFromScan0(300, 300, 0, PixelFormat32bppARGB, ByVal 0&, imgImage)
>とすると、エラーにならない事が判明しました。（理屈は分かりませんが）
第５引数はポインタの値渡しと考えると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)
ありがとうございました。
おかげさまで、うまく回転ができました。
中味はこれから勉強させていただきますが、とりあえず今日出来たところをお知らせいたします。
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
一部コメントアウトしながら実行して、内容の確認ができました。
デジカメの画像を、回転・リサイズして、Exifの撮影時間情報（秒まで）と共にワークシートに貼り付けたいというのが、今回の目的でしたが、おかげさまで実現できました。GDI+のflat APIについては日本語の情報が乏しく、英語の解説は画像処理用語が多くて、なかなか理解できずにおりました。
ありがとうございました。
| ツイート |  |