Sample 04

角度固定回転

DownLoad

Command1
Picture1
Picture2
List1

をフォームに貼り付けて、以下のコードを、フォームのソースコードへコピーして貼り付けてください。

Picture2　にお好きな画像を貼り付ければ実行できます。

VB4以降であれば、問題なく実行可能なはずです。

Option Explicit

Private Declare Function GetPixel Lib "gdi32" _
                     (ByVal hdc As Long, _
                      ByVal x As Long, _
                      ByVal y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" _
                     (ByVal hdc As Long, _
                      ByVal x As Long, _
                      ByVal y As Long, _
                      ByVal crColor As Long) As Long
'----------------------------------
'　実行する
'----------------------------------
Private Sub Command1_Click()
    Dim LisIndex As Integer

    Screen.MousePointer = 11
    LisIndex = List1.ListIndex

    'Picture1の画像をクリアする
    Picture1.Picture = LoadPicture("")
    Picture1.Cls
    Picture1.Refresh

    Select Case LisIndex
        Case 0, 2
            '90/270 回転の場合
            Picture1.Width = Picture2.Height
            Picture1.Height = Picture2.Width
        Case 1
            '180 回転の場合
            Picture1.Width = Picture2.Width
            Picture1.Height = Picture2.Height
    End Select

    Call BitMapAngleFixedRotation(Picture2.hdc, _
                                        Picture1.hdc, _
                                        Picture2.ScaleWidth, _
                                        Picture2.ScaleHeight, _
                                        LisIndex)
    Picture1.Refresh
    Screen.MousePointer = 0
End Sub
'-----------------------------------
'　初期設定
'-----------------------------------
Private Sub Form_Load()
    '初期設定(サンプルということで...)

    Me.ScaleMode = vbPixels 'ピクセル

    Picture1.AutoSize = False
    Picture1.AutoRedraw = True
    Picture1.BorderStyle = 0
    Picture1.ScaleMode = vbPixels 'ピクセル

    Picture2.AutoSize = True
    Picture2.AutoRedraw = True
    Picture2.BorderStyle = 0
    Picture2.ScaleMode = vbPixels 'ピクセル
    '
    '
    List1.Clear
    List1.AddItem " 90度回転"
    List1.AddItem "180度回転"
    List1.AddItem "270度回転"
    List1.ListIndex = 0
End Sub
'------------------------------------
'角度固定回転
'------------------------------------
Private Sub BitMapAngleFixedRotation(ByVal PichDC As Long, _
                                                    ByVal OuthDC As Long, _
                                                    ByVal PictX As Long, _
                                                    ByVal PictY As Long, _
                                                    ByVal modoindex As Integer)
    Dim y As Long, x As Long
    Dim COL As Long

    For y = 0 To PictY '最初に縦のループを作成する
        For x = 0 To PictX - 1
            '読込む
            COL = GetPixel(PichDC, x, y)
            If modoindex = 0 Then
                '90度
                Call SetPixelV(OuthDC, PictY - 1 - y, x, COL&)
            Else
                If modoindex = 1 Then
                    '180度
                    Call SetPixelV(OuthDC, PictX - 1 - x, PictY - 1 - y, COL&)
                Else
                    '270度
                    Call SetPixelV(OuthDC, y, PictX - 1 - x, COL&)
                End If
            End If
        Next x
        DoEvents
    Next y
End Sub