title image


Smiley Re: Bild in 30 Grad Schritten drehen
Mangels konkreter Angaben geht das Beispiel davon aus, dass das Bild in einer Picturebox ist und der Ausdruck von dort aus erfolgt.







      

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 SetPixel Lib "gdi32" ( _

    ByVal hdc As Long, _

    ByVal x As Long, _

    ByVal y As Long, _

    ByVal crColor As Long) As Long



Private Declare Function SelectObject Lib "gdi32" ( _

    ByVal hdc As Long, _

    ByVal hObject As Long) As Long



Private Declare Function DeleteObject Lib "gdi32" ( _

    ByVal hObject As Long) As Long



Private Declare Function CreateCompatibleBitmap Lib "gdi32" ( _

    ByVal hdc As Long, _

    ByVal nWidth As Long, _

    ByVal nHeight As Long) As Long



Private Declare Function CreateCompatibleDC Lib "gdi32" ( _

    ByVal hdc As Long) As Long



Private 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

    

Private Declare Function DeleteDC Lib "gdi32.dll" ( _

     ByVal hdc As Long) As Long



Private Const Pi = 3.14159265359



Sub RotatePicture(picSource As PictureBox, ByVal Winkel As Single)

    Dim w1 As Long, h1 As Long

    Dim w2 As Long, h2 As Long

    Dim p1hDC As Long

    Dim p2hDC As Long

    Dim a As Single

    Dim p1x As Long, p1y As Long

    Dim p2x As Long, p2y As Long

    Dim n As Long

    Dim r As Long

    Dim hBitmap As Long



    picSource.ScaleMode = vbPixels



    w1 = picSource.ScaleWidth \ 2

    h1 = picSource.ScaleHeight \ 2

    w2 = w1

    h2 = h1



    If w2 < h2 Then n = h2 Else n = w2

    n = n - 1

    p1hDC = picSource.hdc



    hBitmap = CreateCompatibleBitmap(Me.hdc, picSource.ScaleWidth, picSource.ScaleHeight)

    p2hDC = CreateCompatibleDC(Me.hdc)

    SelectObject p2hDC, hBitmap



    For p2x = 0 To n

         For p2y = 0 To n

                If p2x = 0 Then a = Pi / 2 Else a = Atn(p2y / p2x)

                r = Sqr(p2x * p2x + p2y * p2y)

                p1x = r * Cos(a + Winkel)

                p1y = r * Sin(a + Winkel)



                SetPixel p2hDC, w2 + p2x, h2 + p2y, GetPixel(p1hDC, w1 + p1x, h1 + p1y)

                SetPixel p2hDC, w2 - p2x, h2 - p2y, GetPixel(p1hDC, w1 - p1x, h1 - p1y)

                SetPixel p2hDC, w2 + p2y, h2 - p2x, GetPixel(p1hDC, w1 + p1y, h1 - p1x)

                SetPixel p2hDC, w2 - p2y, h2 + p2x, GetPixel(p1hDC, w1 - p1y, h1 + p1x)

     Next p2y, p2x



     BitBlt p1hDC, 0, 0, picSource.ScaleWidth, picSource.ScaleHeight, p2hDC, 0, 0, vbSrcCopy

     DeleteObject hBitmap

     DeleteDC p2hDC

End Sub





 



Code eingefügt mit Syntaxhighlighter 3.0







Anwendung:



Private Sub Command1_Click()

RotatePicture Picture1, Pi / 4

End Sub


geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: