21/11/07 21:33
gius
Questo funz l'ho testato
Sempre 2 picture con la proprieta AutoRedraw su True
Nel Form_Load
In un modulo bas
Sempre 2 picture con la proprieta AutoRedraw su True
Nel Form_Load
Dim hRotatedBitmapDC As Long Dim lWidth As Long Dim lHeight As Long Dim lRadians As Long Dim sFileName As String Dim hBitmap As Long Dim lBMDC As Long Dim sBitmapInfo As BITMAP Dim Degrees As Long Degrees = 0 sFileName = "filename.bmp" hBitmap = LoadImage(0, sFileName, IMAGE_BITMAP, 0, 0,LR_LOADFROMFILE Or LR_CREATEDIBSECTION) If (hBitmap = 0) Then MsgBox "Error, Unable To Load Bitmap", vbOKOnly,"Bitmap Load Error" End End If lBMDC = CreateCompatibleDC(0) If (lBMDC = 0) Then MsgBox "Error, Unable To Create Device Context", vbOKOnly, "Device Context Error" Exit Sub End If Call SelectObject(lBMDC, hBitmap) Call GetObject(hBitmap, Len(sBitmapInfo), sBitmapInfo) Call BitBlt(Picture1.hdc, 0, 0,sBitmapInfo.bmWidth,sBitmapInfo.bmHeight,lBMDC, 0, 0, SRCCOPY) Picture1.Refresh lWidth = sBitmapInfo.bmWidth lHeight = sBitmapInfo.bmHeight lRadians = PI * Degrees / 180 hRotatedBitmapDC = Picture1.hdc RotateBitmap hRotatedBitmapDC, lWidth, lHeight, lRadians Set Picture2.Picture = LoadPicture Call BitBlt(Picture2.hdc, 0, 0, hRotatedBitmapDC, 0, 0, SRCCOPY) Picture2.Refresh Call DeleteDC(hRotatedBitmapDC) Degrees = Degrees + 90 If Degrees = 360 Then Degrees = 0 End If Picture1.Visible = False
In un modulo bas
Public Const IMAGE_BITMAP = &O0 ' used with LoadImage to load
' a bitmap
Public Const LR_LOADFROMFILE = 16 ' used with LoadImage
Public Const LR_CREATEDIBSECTION = 8192 ' used with LoadImage
Public Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Public Const PI = 3.14159
' Refer to the MSDN for more detailed information regarding the
' structures used in this sample.
Type BITMAP '14 bytes
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
' Refer to the MSDN for more detailed information regarding the API's
' used in this sample.
Declare Function LoadImage Lib "user32" Alias "LoadImageA" _
(ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, _
ByVal n1 As Long,ByVal n2 As Long, ByVal un2 As Long) As Long
Declare Function CreateCompatibleDC Lib "gdi32" _
(ByVal hdc As Long) As Long
Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, _
ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _
ByVal ySrc As Long, ByVal dwRop As Long) As Long
Declare Function GetObject Lib "gdi32" Alias "GetObjectA" _
(ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As
Long
Declare Function CreateCompatibleBitmap Lib "gdi32" _
(ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long)
As Long
Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
Public Sub RotateBitmap(hBitmapDC As Long, lWidth As Long, _
lHeight As Long, lRadians As Long)
Dim hNewBitmapDC As Long ' DC of the new bitmap
Dim hNewBitmap As Long ' handle to the new bitmap
Dim lSine As Long ' sine used in rotation
Dim lCosine As Long ' cosine used in rotation
Dim X1 As Long ' used in calculating new
' bitmap dimensions
Dim X2 As Long ' used in calculating new
' bitmap dimensions
Dim X3 As Long ' used in calculating new
' bitmap dimensions
Dim Y1 As Long ' used in calculating new
' bitmap dimensions
Dim Y2 As Long ' used in calculating new
' bitmap dimensions
Dim Y3 As Long ' used in calculating new
' bitmap dimensions
Dim lMinX As Long ' used in calculating new
' bitmap dimensions
Dim lMaxX As Long ' used in calculating new
' bitmap dimensions
Dim lMinY As Long ' used in calculating new
' bitmap dimensions
Dim lMaxY As Long ' used in calculating new
' bitmap dimensions
Dim lNewWidth As Long ' width of new bitmap
Dim lNewHeight As Long ' height of new bitmap
Dim I As Long ' loop counter
Dim J As Long ' loop counter
Dim lSourceX As Long ' x pixel coord we are blitting
' from the source image
Dim lSourceY As Long ' y pixel coord we are blitting
' from the source image
' create a compatible DC from the one just brought
' into this function
hNewBitmapDC = CreateCompatibleDC(hBitmapDC)
' compute the sine/cosinse of the radians used to
' rotate this image
lSine = Sin(lRadians)
lCosine = Cos(lRadians)
' compute the size of the new bitmap being created
X1 = -lHeight * lSine
Y1 = lHeight * lCosine
X2 = lWidth * lCosine - lHeight * lSine
Y2 = lHeight * lCosine + lWidth * lSine
X3 = lWidth * lCosine
Y3 = lWidth * lSine
' figure out the max/min size of the new 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))
' set the new bitmap width/height
lNewWidth = lMaxX - lMinX
lNewHeight = lMaxY - lMinY
' create a new bitmap based upon the new width/height of the
' rotated bitmap
hNewBitmap = CreateCompatibleBitmap _
(hBitmapDC, lNewWidth, lNewHeight)
' attach the new bitmap to the new device context created
' above before constructing the rotated bitmap
Call SelectObject(hNewBitmapDC, hNewBitmap)
' loop through and translate each pixel to its new location.
' this is using a standard rotation algorithm
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
Call BitBlt(hNewBitmapDC, J, I, 1, 1, hBitmapDC, _
lSourceX, lSourceY, SRCCOPY)
End If
Next J
Next I
' reset the new bitmap width and height
lWidth = lNewWidth
lHeight = lNewHeight
' return the DC to the new bitmap
hBitmapDC = hNewBitmapDC
' destroy the bitmap created
Call DeleteObject(hNewBitmap)
End Sub
Private Function Min(X1 As Long, Y1 As Long) As Long
If X1 >= Y1 Then
Min = Y1
Else
Min = X1
End If
End Function
Private Function Max(X1 As Long, Y1 As Long) As Long
If X1 >= Y1 Then
Max = X1
Else
Max = Y1
End If
End Function
aaa
