'================================================================
'= 画像を回転させる(�U)
'=    (RotateBitmap.bas)
'================================================================
#include "Windows.bi"

#define IMAGE_BITMAP 0                  'ビットマップ
#define LR_LOADFROMFILE &H10            '外部ファイルからロードする
#define LR_CREATEDIBSECTION &H2000      'デバイス独立ビットマップとしてロードする
#define SRCCOPY &HCC0020                'そのまま転送
#define PI 3.14159

Type BITMAP
    bmType       As Long                'ビットマップ タイプを指定(0)
    bmWidth      As Long                'ビットマップの幅を指定
    bmHeight     As Long                'ビットマップの高さを指定
    bmWidthBytes As Long                '1 走査線あたりのバイト数を指定
    bmPlanes     As Integer             'カラープレーンを指定(通常1)
    bmBitsPixel  As Integer             '1 ピクセルを定義するのに必要なビット数を指定
    bmBits       As Long                'ビット データが格納されているの配列へのポインタを指定
End Type

' 画像ファイルの読み込み
Declare Function Api_LoadImage& Lib "user32" Alias "LoadImageA" (ByVal hInst&, ByVal lpszName$, ByVal uType&, ByVal cxDesired&, ByVal cyDesired&, ByVal fuLoad&)

' 指定されたデバイスコンテキストに関連するデバイスと互換性のあるメモリデバイスコンテキストを作成
Declare Function Api_CreateCompatibleDC& Lib "gdi32" Alias "CreateCompatibleDC" (ByVal hDC&)

' 指定されたデバイスコンテキストのオブジェクトを選択
Declare Function Api_SelectObject& Lib "gdi32" Alias "SelectObject" (ByVal hDC&, ByVal hObject&)

' ビットブロック転送を行う。コピー元からコピー先のデバイスコンテキストへ、指定された長方形内の各ピクセルの色データをコピー
Declare Function Api_BitBlt& Lib "gdi32" Alias "BitBlt" (ByVal hDestDC&, ByVal X&, ByVal Y&, ByVal nWidth&, ByVal nHeight&, ByVal hSrcDC&, ByVal xSrc&, ByVal ySrc&, ByVal dwRop&)

' オブジェクト取得
Declare Function Api_GetObject& Lib "gdi32" Alias "GetObjectA" (ByVal hObject&, ByVal nCount&, lpObject As Any)

' デバイスコンテキストと互換性のあるビットマップを作成
Declare Function Api_CreateCompatibleBitmap& Lib "gdi32" Alias "CreateCompatibleBitmap" (ByVal hDC&, ByVal nWidth&, ByVal nHeight&)

' 指定されたデバイスコンテキストを削除
Declare Function Api_DeleteDC& Lib "gdi32" Alias "DeleteDC" (ByVal hDC&)

' 論理オブジェクトを削除し、そのオブジェクトに関連付けられていたすべてのシステムリソースを解放
Declare Function Api_DeleteObject& Lib "gdi32" Alias "DeleteObject" (ByVal hObject&)

' 指定されたウィンドウのデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

' デバイスコンテキストを解放
Declare Function Api_ReleaseDC& Lib "user32" Alias "ReleaseDC" (ByVal hWnd&, ByVal hDC&)

Var Shared Timer1 As Object
Var Shared Picture1 As Object
Var Shared Picture2 As Object
Var Shared Edit1 As Object
Var Shared Button1 As Object

Timer1.Attach GetDlgItem("Timer1")
Picture1.Attach GetDlgItem("Picture1")
Picture2.Attach GetDlgItem("Picture2")
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

Var Shared sFileName As String
Var Shared hBitmap As Long
Var Shared lBMDC As Long
Var Shared bm As BITMAP
Var Shared Degrees As Long
Var Shared phDC1 As Long
Var Shared phDC2 As Long

'================================================================
'=
'================================================================
Declare Function Min(X1 As Long, Y1 As Long) As Long
Function Min(X1 As Long, Y1 As Long) As Long
    If X1 >= Y1 Then
        Min = Y1
    Else
        Min = X1
    End If
End Function

'================================================================
'=
'================================================================
Declare Function Max(X1 As Long, Y1 As Long) As Long
Function Max(X1 As Long, Y1 As Long) As Long
    If X1 >= Y1 Then
        Max = X1
    Else
        Max = Y1
    End If
End Function

'================================================================
'=
'================================================================
Declare Sub RotateBitmap(hBitmapDC As Long, lWidth As Long, lHeight As Long, lRadians As Long)
Sub RotateBitmap(hBitmapDC As Long, lWidth As Long, lHeight As Long, lRadians As Long)
    Var hNewBitmapDC As Long
    Var hNewBitmap As Long
    Var lSine As Long
    Var lCosine As Long
    Var X1 As Long
    Var X2 As Long
    Var X3 As Long
    Var Y1 As Long
    Var Y2 As Long
    Var Y3 As Long
    Var lMinX As Long
    Var lMaxX As Long
    Var lMinY As Long
    Var lMaxY As Long
    Var lNewWidth As Long
    Var lNewHeight As Long
    Var i As Long
    Var j As Long
    Var lSourceX As Long
    Var lSourceY As Long
    Var Ret As Long

    hNewBitmapDC = Api_CreateCompatibleDC(hBitmapDC)

    lSine = Sin(lRadians)
    lCosine = Cos(lRadians)

    X1 = -lHeight * lSine
    Y1 = lHeight * lCosine
    X2 = lWidth * lCosine - lHeight * lSine
    Y2 = lHeight * lCosine + lWidth * lSine
    X3 = lWidth * lCosine
    Y3 = lWidth * lSine

    '新しいBitmapの最大/最小サイズ
    lMinX = Min(0, Min(X1, Min(X2, X3)))
    lMinY = Min(0, Min(Y1, Min(Y2, Y3)))
    lMaxX = Max(X1, Max(X2, X3))
    lMaxY = Max(Y1, Max(Y2, Y3))

    '新しいBitpamの幅/高さ
    lNewWidth = lMaxX - lMinX
    lNewHeight = lMaxY - lMinY

    '新しい幅/高さで回転するBitmapを作成
    hNewBitmap = Api_CreateCompatibleBitmap(hBitmapDC, lNewWidth, lNewHeight)

    'デバイスコンテキストのオブジェクトを選択
    Ret = Api_SelectObject(hNewBitmapDC, hNewBitmap)

    '各pixelを計算
    For i = 0 To lNewHeight
        For j = 0 To lNewWidth
            lSourceX = (j + lMinX) * lCosine + (i + lMinY) * lSine
            lSourceY = (i + lMinY) * lCosine - (j + lMinX) * lSine
            If (lSourceX >= 0) And (lSourceX <= lWidth) And (lSourceY >= 0) And (lSourceY <= lHeight) Then
                Ret = Api_BitBlt(hNewBitmapDC, j, i, 1, 1, hBitmapDC, lSourceX, lSourceY, SRCCOPY)
            End If
        Next j
    Next i

    '新しいBitmapの幅/高さをリセット
    lWidth = lNewWidth
    lHeight = lNewHeight

    '新しいBitmapにデバイスコンテキストを返す
    hBitmapDC = hNewBitmapDC

    'オブジェクトを削除
    Ret = Api_DeleteObject(hNewBitmap)
End Sub

'================================================================
'=
'================================================================
Declare Sub LoadBMPFromFile ()
Sub LoadBMPFromFile()
    '初期角度設定
    Degrees = 0
    sFileName = Edit1.GetWindowText
    Picture1.Cls
    Picture2.Cls

    'Bitmapをメモリにロード
    hBitmap = Api_LoadImage(0, sFileName, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)

    '呼び出し失敗の場合終了
    If (hBitmap = 0) Then
        A% = MessageBox("Bitmap Load Error", "Error, Bitmapファイルではありません！", 0, 2)
        End
    End If

    'ロードしたBitmapのデバイスコンテキストを作成
    lBMDC = Api_CreateCompatibleDC(0)

    '失敗した場合プロシージャを抜ける
    If (lBMDC = 0) Then
        A% = MessageBox("Device Context Error", "Error, デバイスコンテキストを作成できません！", 0, 2)
        Exit Sub
    End If

    '作成されたデバイスコンテキストにBitmapをAttach
    Ret = Api_SelectObject(lBMDC, hBitmap)

    'イメージ情報を取得
    Ret = Api_GetObject(hBitmap, Len(bm), bm)

    'Pictureに描画
    Ret = Api_BitBlt(phDC1, 0, 0, bm.bmWidth, bm.bmHeight, lBMDC, 0, 0, SRCCOPY)
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    phDC1 = Api_GetDC(Picture1.GethWnd)
    phDC2 = Api_GetDC(Picture2.GethWnd)

    'タイマーインターバルセット
    Timer1.SetInterval 100
    Timer1.Enable False
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    'ファイルからBitmapを読み込む
    LoadBMPFromFile

    If Timer1.IsEnabled = -1 Then
        Timer1.Enable 0
        Button1.SetWindowText "Start >>"
    Else
        Timer1.Enable -1
        Button1.SetWindowText "Stop >>"
        LoadBMPFromFile
    End If
End Sub

'================================================================
'= 
'================================================================
Declare Sub Timer1_Timer edecl ()
Sub Timer1_Timer()
    Var hRotatedBitmapDC As Long
    Var lWidth As Long
    Var lHeight As Long
    Var lRadians As Long

    Picture2.Cls

    'Bitmapイメージの幅/高さを設定
    lWidth = bm.bmWidth
    lHeight = bm.bmHeight

    '回転角度をラジアンに変換
    lRadians = PI * Degrees / 180

    'Picture1デバイスコンテキストを回転デバイスコンテキストに
    hRotatedBitmapDC = phDC1

    '新しい角度に回転させる
    RotateBitmap hRotatedBitmapDC, lWidth, lHeight, lRadians

    '回転イメージを転送
    Ret = Api_BitBlt(phDC2, 0, 0, lWidth, lHeight, hRotatedBitmapDC, 0, 0, SRCCOPY)

    'デバイスコンテキストを破棄
    Ret = Api_DeleteDC(hRotatedBitmapDC)

    '角度を90°増加。一巡したら0°に戻す
    Degrees = Degrees + 90

    If Degrees = 360 Then
        Degrees = 0
    End If
End Sub

'================================================================
'= シェルドロップされたファイル名を取得
'================================================================
Declare Sub Edit1_DropFiles edecl (ByVal DF As Long)
Sub Edit1_DropFiles(ByVal DF As Long)
    Var CN As Long

    CN = GetDropFileCount(DF)
    sFileName = GetDropFileName(DF, 0)
    Edit1.SetWindowText sFileName

    Button1.SetWindowText "Start >>"
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_QueryClose edecl ()
Sub MainForm_QueryClose()
    Var Ret As Long

    Ret = Api_ReleaseDC(Picture1.GethWnd, phDC1)
    Ret = Api_ReleaseDC(Picture2.GethWnd, phDC2)
    End
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End