VBAからGDI+を使う資料集
inet上の達人の方々から御教示いただいたコードを少しアレンジさせてもらっています(切り貼りとも言います)。
  1. ホーム
  2. GDI+
  3. 画像を任意角度で回転


GDI+のbitmapを任意角度で回転する

GDI+のbitmapを任意の角度で回転したbitmapを戻します

'使い方
Call RotateImage(pSrcBmp, pDestBmp, angle, &HFFFFFFFF)

Private Sub RotateImage(ByRef pSrcBmp As Long, ByRef pDestBmp As Long, ByVal angle As Single, Optional lBackColor 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
    
     GdipGetImageHeight pSrcBmp, lHeight
     GdipGetImageWidth pSrcBmp, 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
     GdipCreateBitmapFromScan0 newWidth, newHeight, 0, PixelFormat32bppARGB, ByVal 0&, pDestBmp
     GdipGetImageGraphicsContext pDestBmp, imgGraphics
     GdipCreateSolidFill lBackColor, hBrush
     GdipFillRectangle imgGraphics, hBrush, 0, 0, newWidth, newHeight
     GdipDeleteBrush hBrush
    '回転
     GdipTranslateWorldTransform imgGraphics, -lWidth / 2, -lHeight / 2, MatrixOrderAppend
     GdipRotateWorldTransform imgGraphics, angle, MatrixOrderAppend
     GdipTranslateWorldTransform imgGraphics, newWidth / 2, newHeight / 2, MatrixOrderAppend
     GdipDrawImageRectRectI imgGraphics, pSrcBmp, 0, 0, lWidth, lHeight, 0, 0, lWidth, lHeight, UnitPixel, 0, 0, 0
    
     GdipDeleteGraphics imgGraphics
     GdipDisposeImage pSrcBmp
End Sub

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