ビットマップを任意の角度に回転させるには (ID：74137)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

そこじゃなかったみたいです。ごめんなさいm(--)m
それで・・・。（＾＾；
90/180/270度回転ですが自分でサンプルを作ったので試して見てください。

Option Explicit

'//指定された座標のピクセルのRGB (赤、 緑、 青) カラー値を取得するAPI
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
'//指定された座標のピクセルに 指定された色に最も近い色を設定するAPI
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long

'//右90度回転
Private Sub Command1_Click()
Dim Y, X As Long

Form1.Enabled = False
Picture2.Cls

Picture2.Width = Picture1.Height
Picture2.Height = Picture1.Width

For Y = 0 To Picture1.ScaleHeight - 1
  For X = 0 To Picture1.ScaleWidth - 1
      Call SetPixelV(Picture2.hdc, Picture1.ScaleHeight - 1 - Y, X, GetPixel(Picture1.hdc, X, Y))
  Next
    Me.Caption = Y & " / " & Picture2.ScaleHeight - 1
    Picture2.Refresh
    DoEvents
Next

Me.Caption = ""
Picture2.Refresh
Me.Enabled = True

End Sub

'//右180度回転
Private Sub Command2_Click()
Dim Y, X As Long

Form1.Enabled = False
Picture2.Cls

Picture2.Width = Picture1.Width
Picture2.Height = Picture1.Height

For Y = 0 To Picture1.ScaleHeight - 1
  For X = 0 To Picture1.ScaleWidth - 1
      Call SetPixelV(Picture2.hdc, Picture1.ScaleWidth - 1 - X, Picture1.ScaleHeight - 1 - Y, GetPixel(Picture1.hdc, X, Y))
  Next
    Me.Caption = Y & " / " & Picture2.ScaleHeight - 1
    Picture2.Refresh
    DoEvents
Next

Me.Caption = ""
Picture2.Refresh
Me.Enabled = True

End Sub

'//右270度回転
Private Sub Command3_Click()
Dim Y, X As Long

Form1.Enabled = False
Picture2.Cls

Picture2.Width = Picture1.Height
Picture2.Height = Picture1.Width

For Y = 0 To Picture1.ScaleHeight - 1
  For X = 0 To Picture1.ScaleWidth - 1
      Call SetPixelV(Picture2.hdc, Y, Picture1.ScaleWidth - 1 - X, GetPixel(Picture1.hdc, X, Y))
  Next
    Me.Caption = Y & " / " & Picture2.ScaleHeight - 1
    Picture2.Refresh
    DoEvents
Next

Me.Caption = ""
Picture2.Refresh
Me.Enabled = True

End Sub

Private Sub Form_Load()
'//任意のビットマップを読込む
Picture1.Picture = LoadPicture("C:\windows\花見.bmp")
Picture1.AutoSize = True
Picture1.ScaleMode = vbPixels
Picture2.ScaleMode = vbPixels
Picture2.BackColor = RGB(255, 255, 255)
Picture1.AutoRedraw = True
Picture2.AutoRedraw = True

'//これは実行時には変更できないので設計時に変更してください。
If (Picture1.BorderStyle <> 0) Or (Picture2.BorderStyle <> 0) Then
 MsgBox ("PictureオブジェクトのBorderStyleプロパティを「0-なし」にして下さい。")
End If

End Sub

※このサンプルはVBの標準関数を使うより高速ですがフォットレタッチソフトなどの「回転」と比べると比較にならないぐらい遅いです。また、高速化するのには一般的にGetDIBits/SetDIBitsなどのAPIを使用します。Delphiでやるとめちゃ簡単に出来るのですがVBだとちょっと・・です。（＾＾；

←解決時は質問者本人がここをチェックしてください。

戻る