Attribute VB_Name = "Rotation"
'/////////////////////////////////////////////////////////////////////
'Cover My Ass And Ensure Every one understands to whom it belongs =P
'Created By Paul Watts 2003
'Sailing Bright Eternity Software
'Please Ask Permission before useing ANY of this code for your
'own software.

'It is your own desision to run any program with this code in therefore
'i cannot and will not take responsibility for any damage this causes to
'your system (Not that it should =P)

'This program and ANY of its code is the property of Paul Watts (UK) and
'you must seek permission to use this code. Whatever is said by Paul Watts
'Stands and if permissions are cancelled then you must remove ANY code used

'Game Concept and design are owned of Paul Watts

'You Must Agree to the above before using or running any program with
'any code contained in this project

'Any Queries contact BodwadUK at www.vbforums.com

'///////////////////////////////////////////////////////////////////////////


Option Explicit
'Dim DX As DirectX7
'Dim DDraw As DirectDraw7
Const Pi = 3.14159265359
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
Public Const RotateOffset = 22.5


Public Function RotateImage(ByRef Pic1 As DirectDrawSurface7, ByVal I As Integer, UnitName As String, Position As String)
    
'Rotate The Images
       Dim c1x As Integer  ' Center of pic1.
       Dim c1y As Integer  '   "
       Dim c2x As Integer  ' Center of pic2.
       Dim c2y As Integer  '   "
       Dim a As Single     ' Angle of c2 to p2.
       Dim r As Integer    ' Radius from c2 to p2.
        Dim c0 As Long
        Dim C1 As Long
        Dim c2 As Long
        Dim c3 As Long
        
        Dim Angle As Single
        
       Dim p1x As Integer  ' Position on pic1.
       Dim p1y As Integer  '   "
       Dim p2x As Integer  ' Position on pic2.
       Dim p2y As Integer  '   "
       Dim n As Integer    ' Max width or height of pic2.

       Dim DDsd As DDSURFACEDESC2
       Dim DDsd2 As DDSURFACEDESC2
       Dim TempS As DirectDrawSurface7
       Dim Rotate As DirectDrawSurface7
        Dim SRect As RECT
        Dim DRect As RECT
        
        'First Create the Image To Rotate
    
        Angle = I
       DDsd2.lFlags = DDSD_CAPS
       DDsd2.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
       
       Set TempS = DDraw.CreateSurfaceFromFile(Path & "\" & UnitName & "\" & Position & ".bmp", DDsd2)
    
       'Now For Doubled Surface
       
       DDsd.lFlags = DDSD_CAPS + DDSD_HEIGHT + DDSD_WIDTH
       
       DDsd.lHeight = 200
       DDsd.lWidth = 200
       DDsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
       
       Angle = Angle * RotateOffset
       Set Rotate = DDraw.CreateSurface(DDsd)
       
       'Now blt Temp in Middle Of Rotate Surface
       
       Rotate.SetForeColor vbWhite
       Rotate.SetFillColor vbWhite
       Rotate.DrawBox 0, 0, 200, 200
       
       With DRect
            .Left = 50
            .Right = 150
            .Top = 50
            .Bottom = 150
        End With
       
        With SRect
            .Left = 0
            .Right = 100
            .Top = 0
            .Bottom = 100
        End With
        
        
       Rotate.Blt DRect, TempS, SRect, DDBLT_WAIT
       
       'Make Larger Surface
       Set TempS = DDraw.CreateSurface(DDsd)
       
        With DRect
            .Top = 0
            .Bottom = 200
            .Right = 200
            .Left = 0
        End With
        
        With SRect
            .Top = 0
            .Bottom = 200
            .Left = 0
            .Right = 200
        End With
        
       'Lock Down Surfaces
       
       Rotate.Lock DRect, DDsd, DDLOCK_WAIT, 0
       TempS.Lock SRect, DDsd2, DDLOCK_WAIT, 0
    
       'Angle = Angle * RotateOffset
       'blnDone = False
       ' Compute the centers.
       c1x = 100
       c1y = 100
       c2x = 100
       c2y = 100
    
        Angle = Angle * (Pi / 180)
        Angle = Angle - (2 * Angle)
        
       ' Compute the image size.
       n = DDsd.lWidth
       If n < DDsd.lHeight Then n = DDsd.lHeight
       n = n / 2 - 1
       ' For each pixel position on pic2.
       For p2x = 0 To n
          For p2y = 0 To n
             ' Compute polar coordinate of p2.
             If p2x = 0 Then
               a = Pi / 2
             Else
               a = Atn(p2y / p2x)
             End If
             r = Sqr(1& * p2x * p2x + 1& * p2y * p2y)

             ' Compute rotated position of p1.
             p1x = r * Cos(a + Angle)
             p1y = r * Sin(a + Angle)

             ' Copy pixels, 4 quadrants at once.
             c0& = Rotate.GetLockedPixel(c1x + p1x, c1y + p1y)
             C1& = Rotate.GetLockedPixel(c1x - p1x, c1y - p1y)

             c2& = Rotate.GetLockedPixel(c1x + p1y, c1y - p1x)
             c3& = Rotate.GetLockedPixel(c1x - p1y, c1y + p1x)
             
             If c0& <> -1 Then TempS.SetLockedPixel c2x + p2x, c2y + p2y, c0&
             If C1& <> -1 Then TempS.SetLockedPixel c2x - p2x, c2y - p2y, C1&
             If c2& <> -1 Then TempS.SetLockedPixel c2x + p2y, c2y - p2x, c2&
             If c3& <> -1 Then TempS.SetLockedPixel c2x - p2y, c2y + p2x, c3&
          Next
       Next
       
      ' blnDone = True
        Rotate.Unlock DRect
        TempS.Unlock SRect
        
        With DRect
            .Left = I * 100
            .Top = 0
            .Bottom = 100
            .Right = (I + 1) * 100
        End With
        
        With SRect
            .Left = 50
            .Right = 150
            .Top = 50
            .Bottom = 150
        End With
        
        
        Pic1.Blt DRect, TempS, SRect, DDBLT_WAIT
        
        Set TempS = Nothing
        Set Rotate = Nothing
        
End Function