Binaryworld - Scale, Translate, Shear, Reflect and Rotate graphics using World Trans ... [ VB -> Graphics ]

Step-By-Step Example

- Create a standard exe project
- Add six commandbutton controls on form1
- Add one picturebox controls on the form1
- 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 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 GetStockObject Lib "gdi32.dll" ( _
    ByVal nIndex As Long) As Long

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

Private Declare Function DPtoLP Lib "gdi32.dll" ( _
    ByVal hDC As Long, _
    ByRef lpPoint As Any, _
    ByVal nCount As Long) As Long

Private Declare Function GetClientRect Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByRef lpRect As RECT) 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 Rectangle Lib "gdi32.dll" ( _
    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 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 RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
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 BLACK_PEN As Long = &H7
Private Const PS_DOT As Long = &H2
Private Const PS_SOLID As Long = &H0
Private Const MM_LOENGLISH = 4

Private Const NULL_BRUSH As Long = &H5
Private Const HOLLOW_BRUSH = NULL_BRUSH

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

Enum TransFormOptions
  VW_NORMAL = 0
  VW_SCALE = 1
  VW_TRANSLATE = 2
  VW_ROTATE = 3
  VW_SHEAR = 4
  VW_REFLECT = 5
End Enum

Sub TransformAndDraw(iTransform)

  Dim NewMatrix As xForm, OldMatrix As xForm
  Dim R As RECT
  Dim hDC As Long, hWnd As Long, OldMode As Long, hOldBrush As Long

  Picture1.Cls
  Picture1.ScaleMode = vbPixels

  hDC = Picture1.hDC
  hWnd = Picture1.hWnd

  '// Set the mapping mode to LOENGLISH. This moves the
  '// client area origin from the upper left corner of the
  '// window to the lower left corner (this also reorients
  '// the y-axis so that drawing operations occur in a true
  '// Cartesian space). It guarantees portability so that
  '// the object drawn retains its dimensions on any display.

  OldMode = SetGraphicsMode(hDC, GM_ADVANCED)

  '// Set the appropriate world transformation (based on the
  '// user's menu selection).

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

  Select Case iTransform

    Case VW_SCALE    '// Scale to 1/2 of the original size.
      NewMatrix.eM11 = 0.5
      NewMatrix.eM12 = 0#
      NewMatrix.eM21 = 0#
      NewMatrix.eM22 = 0.5
      NewMatrix.eDx = 0#
      NewMatrix.eDy = 0#
      Call SetWorldTransform(hDC, NewMatrix)

    Case VW_TRANSLATE  '// Translate right by 3/4 inch.
      NewMatrix.eM11 = 1#
      NewMatrix.eM12 = 0#
      NewMatrix.eM21 = 0#
      NewMatrix.eM22 = 1#
      NewMatrix.eDx = 75#
      NewMatrix.eDy = 0#
      Call SetWorldTransform(hDC, NewMatrix)

    Case VW_ROTATE    '// Rotate 30 degrees counterclockwise.
      NewMatrix.eM11 = 0.866
      NewMatrix.eM12 = 0.5
      NewMatrix.eM21 = -0.5
      NewMatrix.eM22 = 0.866
      NewMatrix.eDx = 0#
      NewMatrix.eDy = 0#
      Call SetWorldTransform(hDC, NewMatrix)

    Case VW_SHEAR    '// Shear along the x-axis with a
      '// proportionality constant of 1.0.
      NewMatrix.eM11 = 1#
      NewMatrix.eM12 = 1#
      NewMatrix.eM21 = 0#
      NewMatrix.eM22 = 1#
      NewMatrix.eDx = 0#
      NewMatrix.eDy = 0#
      Call SetWorldTransform(hDC, NewMatrix)

    Case VW_REFLECT   '// Reflect about a horizontal axis.
      NewMatrix.eM11 = 1#
      NewMatrix.eM12 = 0#
      NewMatrix.eM21 = 0#
      NewMatrix.eM22 = -1#
      NewMatrix.eDx = 0#
      NewMatrix.eDy = 0#
      Call SetWorldTransform(hDC, NewMatrix)

    Case VW_NORMAL    '// Set the unity transformation.
      NewMatrix.eM11 = 1#
      NewMatrix.eM12 = 0#
      NewMatrix.eM21 = 0#
      NewMatrix.eM22 = 1#
      NewMatrix.eDx = 0#
      NewMatrix.eDy = 0#
      Call SetWorldTransform(hDC, NewMatrix)
  End Select

  '// Find the midpoint of the client area.

  Call GetClientRect(hWnd, R)
  Call DPtoLP(hDC, R, 2)

  '// Select a hollow brush.

  hOldBrush = SelectObject(hDC, GetStockObject(HOLLOW_BRUSH))

  '// Draw the exterior circle.

  Call Ellipse(hDC, (R.Right / 2 - 50), (R.Bottom / 2 + 50), _
      (R.Right / 2 + 50), (R.Bottom / 2 - 50))

  '// Draw the interior circle.

  Call Ellipse(hDC, (R.Right / 2 - 46), (R.Bottom / 2 + 46), _
      (R.Right / 2 + 46), (R.Bottom / 2 - 46))

  '// Draw the key.

  Call Rectangle(hDC, (R.Right / 2 - 6), (R.Bottom / 2 + 63), _
      (R.Right / 2 + 6), (R.Bottom / 2 + 15))

  '// Draw the horizontal lines.

  Call MoveToEx(hDC, (R.Right / 2 - 150), (R.Bottom / 2 + 0), 0)
  Call LineTo(hDC, (R.Right / 2 - 16), (R.Bottom / 2 + 0))

  Call MoveToEx(hDC, (R.Right / 2 - 13), (R.Bottom / 2 + 0), 0)
  Call LineTo(hDC, (R.Right / 2 + 13), (R.Bottom / 2 + 0))

  Call MoveToEx(hDC, (R.Right / 2 + 16), (R.Bottom / 2 + 0), 0)
  Call LineTo(hDC, (R.Right / 2 + 150), (R.Bottom / 2 + 0))

  '// Draw the vertical lines.

  Call MoveToEx(hDC, (R.Right / 2 + 0), (R.Bottom / 2 - 150), 0)
  Call LineTo(hDC, (R.Right / 2 + 0), (R.Bottom / 2 - 16))

  Call MoveToEx(hDC, (R.Right / 2 + 0), (R.Bottom / 2 - 13), 0)
  Call LineTo(hDC, (R.Right / 2 + 0), (R.Bottom / 2 + 13))

  Call MoveToEx(hDC, (R.Right / 2 + 0), (R.Bottom / 2 + 16), 0)
  Call LineTo(hDC, (R.Right / 2 + 0), (R.Bottom / 2 + 150))

  ' Clean up
  Call SetWorldTransform(hDC, OldMatrix)
  Call SetGraphicsMode(hDC, OldMode)
  Call SelectObject(hDC, hOldBrush)
End Sub

Private Sub Command1_Click()
  TransformAndDraw 0
End Sub
Private Sub Command2_Click()
  TransformAndDraw 1
End Sub
Private Sub Command3_Click()
  TransformAndDraw 2
End Sub
Private Sub Command4_Click()
  TransformAndDraw 3
End Sub
Private Sub Command5_Click()
  TransformAndDraw 4
End Sub
Private Sub Command6_Click()
  TransformAndDraw 5
End Sub

Private Sub Form_Load()
  Command1.Caption = "Normal"
  Command2.Caption = "Scale"
  Command3.Caption = "Translate"
  Command4.Caption = "Rotate"
  Command5.Caption = "Shear"
  Command6.Caption = "Reflect"
  Picture1.BorderStyle = 0
  Picture1.Appearance = 0
End Sub