Visual Basic 6 - ruotare un immagine

Postato originariamente da gius:

Ho dimenticato di scrivere questa funzione

in un modulo.bas

RotateBitmap(hBitmapDC As Long,lWidth As Long, lHeight As Long,lRadians As Long)

Vedi ora

stesso errore mi dice separatore di elenco oppure )

veramente c'è già nel codice.
rotate bitmap è una sub di base di msdn.

      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