画像を回転させる(V)          <TOP>


画像を指定の角度に回転させます。

GetPixel 指定された座標のピクセルのRGB値を取得

SetPixel 指定した座標に点を配置する

GetDC デバイスコンテキストを取得

ReleaseDC デバイスコンテキストの解放

 

 

'================================================================
'= 画像を回転させる(V)
'=    (SetPixel2.bas)
'================================================================
#include "Windows.bi"

' 指定された座標のピクセルのRGB値を取得
Declare Function Api_GetPixel& Lib "gdi32" Alias "GetPixel" (ByVal hDc&, ByVal X&, ByVal Y&)

' 指定した座標に点を配置する
Declare Function Api_SetPixel& Lib "gdi32" Alias "SetPixel" (ByVal hDc&, ByVal X&, ByVal Y&, ByVal crColor&)

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

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

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

Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Picture1.Attach GetDlgItem("Picture1")
Picture2.Attach GetDlgItem("Picture2")
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14
Var Shared Bitmap As Object
BitmapObject Bitmap

Var Shared pi As Double
Var Shared hDc1 As Long
Var Shared hDc2 As Long

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    pi = 3.14159265358979

    Bitmap.LoadFile "flower.bmp"
    Picture1.DrawBitmap Bitmap, 0, 0
    Bitmap.DeleteObject
    
    hDc1 = Api_GetDC(Picture1.GethWnd)
    hDc2 = Api_GetDC(Picture2.GethWnd)
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var px As Integer
    Var py As Integer
    Var x As Integer
    Var y As Integer
    Var r As Integer
    Var s As Double
    Var a As Double
    Var Ret As Long

    On Error Goto *Er_Trap

    r = Val(Edit1.GetWindowText)

    s = -r * pi / 180

    px = Picture1.GetWidth * Cos(r * pi / 180) + Picture1.GetHeight * Sin(r * pi / 180)
    py = Picture1.GetHeight * Cos(r * pi / 180) + Picture1.GetWidth * Sin(r * pi / 180)

    Picture2.SetWindowSize px, py
    Picture2.Cls

    Var p(Picture1.GetWidth, Picture1.GetHeight) As Long

    For x = 0 To Picture1.GetWidth
        CallEvent
        For y = 0 To Picture1.GetHeight
            p(x, y) = Api_GetPixel(hDc1, x, y)
        Next
    Next

    a = Picture1.GetHeight * Sin(r * pi / 180)

    For x = -a To px
        CallEvent
        For y = 0 To py
           Ret = Api_SetPixel(hDc2, x + a, y, p(Int(x * Cos(s) - y * Sin(s)), Int(y * Cos(s) + x * Sin(s))))
        Next
    Next
    Exit Sub

*Er_Trap
    Resume Next
End Sub

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

    Ret = Api_ReleaseDC(Picture1.GethWnd, hDc1)
    Ret = Api_ReleaseDC(Picture2.GethWnd, hDc2)
End Sub

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