Private Declare Function SetWorldTransform Lib "GDI32.dll" ( _ ByVal hDC As Long, ByRef lpXForm As XForm) As Long Private Declare Function GetWorldTransform Lib "GDI32.dll" ( _ ByVal hDC As Long, ByRef lpXForm As XForm) As Long Private Declare Function CombineTransform Lib "GDI32.dll" ( _ ByRef lpXFormResult As XForm, ByRef lpXForm1 As XForm, _ ByRef lpXForm2 As XForm) As Long Private Declare Function SetViewportOrgEx Lib "GDI32.dll" ( _ ByVal hDC As Long, ByVal nX As Long, ByVal nY As Long, _ ByRef lpPoint As Any) As Long Private Declare Function SetGraphicsMode Lib "GDI32.dll" ( _ ByVal hDC As Long, ByVal iMode As Long) As Long Private Declare Function TextOut Lib "GDI32.dll" Alias "TextOutA" ( _ ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, _ ByVal lpString As String, ByVal nCount As Long) As Long Private Declare Function SetTextColor Lib "GDI32.dll" ( _ ByVal hDC As Long, ByVal crColor As Long) As Long Private Declare Function Ellipse 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 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 CurAng As Single
Private Sub Form_Load() Timer1.Interval = 20 Picture1.ScaleMode = 3 With Picture1.Font .Name = "Arial" .Size = 12 End With End Sub
Private Sub Timer1_Timer() CurAng = (CurAng + 1) Mod 360 Call Picture1.Refresh End Sub
Private Sub Picture1_Paint() Dim OldGM As Long Dim OldXForm As XForm Dim RotXForm As XForm Dim OldOrg As PointAPI Dim OldCol As Long Dim LoopAngs As Long
Const DrawString As String = "Hello, world!"
OldCol = SetTextColor(Picture1.hDC, vbRed) OldGM = SetGraphicsMode(Picture1.hDC, GM_ADVANCED) Call GetWorldTransform(Picture1.hDC, OldXForm) Call SetViewportOrgEx(Picture1.hDC, Picture1.ScaleWidth / 2, Picture1.ScaleHeight / 2, OldOrg)
Call Ellipse(Picture1.hDC, -2, -2, 2, 2)
RotXForm = NewRotationXForm(CurAng)
For LoopAngs = 0 To 3 Call SetTextColor(Picture1.hDC, QBColor(LoopAngs + 9)) Call SetWorldTransform(Picture1.hDC, CombineXForm( _ NewReflectionXForm(CBool(LoopAngs And &H2), _ CBool(LoopAngs And &H1)), RotXForm)) Call TextOut(Picture1.hDC, 0, 0, DrawString, Len(DrawString)) Next LoopAngs
Call SetViewportOrgEx(Picture1.hDC, OldOrg.X, OldOrg.Y, ByVal 0&) Call SetWorldTransform(Picture1.hDC, OldXForm) Call SetGraphicsMode(Picture1.hDC, OldGM) Call SetTextColor(Picture1.hDC, OldCol) End Sub
Private Function NewXForm( _ ByVal inM11 As Single, ByVal inM12 As Single, _ ByVal inM21 As Single, ByVal inM22 As Single, _ ByVal inDx As Single, ByVal inDy As Single) As XForm With NewXForm .eM11 = inM11 .eM12 = inM12 .eM21 = inM21 .eM22 = inM22 .eDx = inDx .eDy = inDy End With End Function
Private Function NewIdentityXForm() As XForm NewIdentityXForm = NewXForm(1, 0, 0, 1, 0, 0) End Function
Private Function NewRotationXForm(ByVal inAngle As Single) As XForm Dim AngRad As Single
AngRad = (inAngle / 180) * 3.14159 NewRotationXForm = NewXForm(Cos(AngRad), _ Sin(AngRad), -Sin(AngRad), Cos(AngRad), 0, 0) End Function
Private Function NewReflectionXForm( _ ByVal inHoriz As Boolean, ByVal inVert As Boolean) As XForm NewReflectionXForm = NewXForm( _ IIf(inHoriz, -1, 1), 0, 0, IIf(inVert, -1, 1), 0, 0) End Function
Private Function CombineXForm( _ ByRef inA As XForm, ByRef inB As XForm) As XForm Call CombineTransform(CombineXForm, inA, inB) End Function
Private Sub l8_Click() Shell "explorer http://www.binaryworld.net", vbNormalFocus End Sub |