Binaryworld - Rotate graphics (Plygon, line, ellipse, image...) using world transfor ... [ VB -> Graphics ]

In this article I will show two different techniques to rotate an ellipse. First technique uses polygone points to draw an ellipse and second technique uses world transformation method which only applies to Win NT/2k/XP.

Step-By-Step Example

- Create a standard exe project
- Add two commandbutton controls on the form1
- Add two picturebox controls on the form1
- Assign an image to picture property of picturebox2. Try to keep image small (approx 20 x 20)
- Add the following code in form1

Click here to copy the following block

Private Declare Function SetWorldTransform Lib "gdi32" ( _
    ByVal hDC As Long, ByRef lpXform As XForm) As Long

Private Declare Function SetGraphicsMode Lib "gdi32" ( _
    ByVal hDC As Long, ByVal iMode As Long) As Long

Private Declare Function GetWorldTransform Lib "gdi32" ( _
    ByVal hDC As Long, ByRef lpXform As XForm) As Long

Private Declare Function SetViewportOrgEx Lib "gdi32" ( _
    ByVal hDC As Long, ByVal nX As Long, ByVal nY As Long, _
    ByRef lpPoint As Any) As Long

Private Declare Function Ellipse Lib "gdi32" ( _
    ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, _
    ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function SelectObject Lib "gdi32" ( _
    ByVal hDC As Long, ByVal hObject As Long) As Long

Private Declare Function GetStockObject Lib "gdi32" ( _
    ByVal nIndex As Long) As Long

Private Declare Function MoveToEx Lib "gdi32" ( _
    ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, _
    ByRef lpPoint As Any) As Long

Private Declare Function LineTo Lib "gdi32" ( _
    ByVal hDC As Long, ByVal X As Long, _
    ByVal Y As Long) As Long

Private Declare Function GetSysColor Lib "user32" ( _
    ByVal nIndex As Long) As Long

Private Declare Function Polygon Lib "gdi32" ( _
    ByVal hDC As Long, ByRef lpPoint As PointAPI, _
    ByVal nCount As Long) As Long

Private Declare Function CreatePen Lib "gdi32" ( _
    ByVal nPenStyle As Long, ByVal nWidth As Long, _
    ByVal crColor As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" ( _
    ByVal hObject As Long) As Long

Private Type XForm
  eM11 As Single
  eM12 As Single
  eM21 As Single
  eM22 As Single
  eDx As Single
  eDy As Single
End Type

Private Type PointAPI
  X As Long
  Y As Long
End Type

Private Const GM_ADVANCED As Long = &H2
Private Const COLOR_BTNSHADOW As Long = &H10
Private Const NULL_BRUSH As Long = &H5
Private Const BLACK_PEN As Long = &H7
Private Const PS_DOT As Long = &H2
Private Const PS_SOLID As Long = &H0

Const WD = 150 '//Width of PicBox
Const HT = 150 '//Height of PicBox

Dim EllipsePoints() As PointAPI

Private Sub DrawRotatedEllipse()
  Dim GenPoint As Long
  Dim RadPos As Single
  Dim CoordX As Single, CoordY As Single

  Const Pi As Single = 3.14159
  Const TwoPi As Single = Pi * 2

  ' Ellipse coordinates
  Const EllipseX As Long = 75
  Const EllipseY As Long = 75
  Const EllipseW As Long = 175
  Const EllipseH As Long = 100
  Const PointCount As Long = 5000

  ' Rotation angle in degrees and radians
  Const RotAng As Single = 45
  Const RotRad As Single = -(RotAng / 180) * Pi

  ' Declare point array
  ReDim EllipsePoints(PointCount - 1) As PointAPI

  ' Generate points
  For GenPoint = 0 To PointCount - 1
    With EllipsePoints(GenPoint)
      RadPos = (GenPoint / PointCount) * TwoPi
      .X = Cos(RadPos) * (EllipseW \ 2)
      .Y = Sin(RadPos) * (EllipseH \ 2)
    End With

    ' Generate ellipse's points, and transform
    '  them with the following 2*3 matrix:
    ' Cos(Ang) Sin(Ang)
    ' -Sin(Ang) Cos(Ang)
    ' EllipseX EllipseY

    With EllipsePoints(GenPoint)
      RadPos = (GenPoint / PointCount) * TwoPi
      CoordX = Cos(RadPos) * (EllipseW \ 2)
      CoordY = Sin(RadPos) * (EllipseH \ 2)

      .X = (CoordX * Cos(RotRad)) + _
          (CoordY * Sin(RotRad)) + EllipseX
      .Y = (CoordX * -Sin(RotRad)) + _
          (CoordY * Cos(RotRad)) + EllipseY
    End With
  Next GenPoint

  ' Draw ellipse
  Call Polygon(Picture1.hDC, EllipsePoints(0), PointCount)
End Sub

Private Sub DrawRotatedEllipseNT()
  Dim TransMatrix As XForm
  Dim OldMatrix As XForm
  Dim OldMode As Long
  Dim OldBrush As Long, OldPen As Long
  Dim OldOrg As PointAPI
  Dim EdgePens(2) As Long

  On Error Resume Next

  ReDim EllipsePoints(7)
  EllipsePoints(0).X = 20: EllipsePoints(0).Y = 0
  EllipsePoints(1).X = 50: EllipsePoints(1).Y = 0
  EllipsePoints(2).X = 50: EllipsePoints(2).Y = 40
  EllipsePoints(3).X = 55: EllipsePoints(3).Y = 40
  EllipsePoints(4).X = 35: EllipsePoints(4).Y = 55
  EllipsePoints(5).X = 15: EllipsePoints(5).Y = 40
  EllipsePoints(6).X = 20: EllipsePoints(6).Y = 40
  EllipsePoints(7).X = 20: EllipsePoints(7).Y = 0

  ' Set transform rotation
  Const RotAngle As Single = 45  ' 45°
  Const Pi As Single = 3.14159
  Const RotRad As Single = (RotAngle / 180) * Pi

  ' Create z-axis transformation matrix
  With TransMatrix
    .eM11 = Cos(RotRad)
    .eM12 = Sin(RotRad)
    .eM21 = -.eM12
    .eM22 = .eM11
  End With

  ' Set the graphics mode to advanced mode
  OldMode = SetGraphicsMode(Picture1.hDC, GM_ADVANCED)

  ' Set the centre of rotation
  Call SetViewportOrgEx(Picture1.hDC, 75, 75, OldOrg)

  ' Create pens (edges)
  EdgePens(0) = CreatePen(PS_DOT, 1, GetSysColor(COLOR_BTNSHADOW))
  EdgePens(1) = CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNSHADOW))
  EdgePens(2) = CreatePen(PS_SOLID, 2, vbBlack)

  ' Disable brush (fill), and set dotted 'faded' pen
  OldBrush = SelectObject(Picture1.hDC, GetStockObject(NULL_BRUSH))
  OldPen = SelectObject(Picture1.hDC, EdgePens(0))

  ' Draw centre of rotation
  Call MoveToEx(Picture1.hDC, 0, -75, ByVal 0&)
  Call LineTo(Picture1.hDC, 0, 75)
  Call MoveToEx(Picture1.hDC, -75, 0, ByVal 0&)
  Call LineTo(Picture1.hDC, 75, 0)

  ' Set solid faded pen
  Call SelectObject(Picture1.hDC, EdgePens(1))

  '///////////////////////////////////////////////////////
  'Before transformation
  '///////////////////////////////////////////////////////
  ' Draw image from picture2
  Picture1.PaintPicture Picture2.Picture, -50, 0

  ' Draw Polygone shape
  Call Polygon(Picture1.hDC, EllipsePoints(0), 8)

  ' Draw original geometry
  Call Ellipse(Picture1.hDC, -75, -50, 75, 50)

  ' Select black pen
  Call SelectObject(Picture1.hDC, EdgePens(2))

  ' Get the current transformation matrix and set new one
  Call GetWorldTransform(Picture1.hDC, OldMatrix)
  Call SetWorldTransform(Picture1.hDC, TransMatrix)

  '///////////////////////////////////////////////////////
  'After transformation
  '///////////////////////////////////////////////////////

  ' Draw image from picture2
  Picture1.PaintPicture Picture2.Picture, -50, 0

  ' Draw Polygone shape
  Call Polygon(Picture1.hDC, EllipsePoints(0), 8)

  ' Draw the transformed geometry
  Call Ellipse(Picture1.hDC, -75, -50, 75, 50)

  ' Clean up
  Call SetViewportOrgEx(Picture1.hDC, OldOrg.X, OldOrg.Y, ByVal 0&)
  Call SetWorldTransform(Picture1.hDC, OldMatrix)
  Call SetGraphicsMode(Picture1.hDC, OldMode)
  Call SelectObject(Picture1.hDC, OldBrush)
  Call SelectObject(Picture1.hDC, OldPen)

  For OldMode = 0 To 2   ' Destroy GDI pen's
    Call DeleteObject(EdgePens(OldMode))
  Next OldMode
End Sub

Private Sub Command1_Click()
  Picture1.Cls
  Call DrawRotatedEllipse
  Me.Caption = "Rotated Ellipse (Using polygon method)"
End Sub

Private Sub Command2_Click()
  Picture1.Cls
  DrawRotatedEllipseNT
  Me.Caption = "Rotated Ellipse, Polygon Shape and Image (Using world transformation method)"
End Sub

Private Sub Form_Load()
  '//Border style should be none (0) for exact scaling otherwise
  '//you may get upto 4 pixels difference when drawing on picturebox
  Picture1.BorderStyle = 0
  Picture1.Appearance = 0
  Picture1.AutoRedraw = True

  Picture1.Width = ScaleX(WD, vbPixels, vbTwips)
  Picture1.Height = ScaleY(HT, vbPixels, vbTwips)
  Picture1.ScaleMode = vbPixels
  Picture2.ScaleMode = vbPixels

  Command1.Caption = "Method-1 : Draw Rotated Ellipse"
  Command2.Caption = "Method-2 : Draw Rotated Ellipse (Only NT)"
End Sub