home *** CD-ROM | disk | FTP | other *** search
Wrap
VERSION 2.00 Begin Form Geo BackColor = &H00C0C0C0& BorderStyle = 1 'Fixed Single Caption = "Geometry" ClientHeight = 6885 ClientLeft = 1080 ClientTop = 1485 ClientWidth = 6390 Height = 7290 Left = 1020 LinkMode = 1 'Source LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 6885 ScaleWidth = 6390 Top = 1140 Width = 6510 Begin PictureBox Picture2 BackColor = &H00C0C0C0& BorderStyle = 0 'None Height = 615 Left = 120 ScaleHeight = 615 ScaleWidth = 6135 TabIndex = 1 Top = 6120 Width = 6135 Begin CommandButton ExitButton Caption = "Exit" Height = 375 Left = 4200 TabIndex = 2 Top = 120 Width = 1815 End Begin CommandButton StopButton Caption = "Stop" Height = 375 Left = 2160 TabIndex = 3 Top = 120 Width = 1815 End Begin CommandButton RunButton Caption = "Run" Height = 375 Left = 120 TabIndex = 4 Top = 120 Width = 1815 End End Begin PictureBox Picture1 BackColor = &H00C0C0C0& BorderStyle = 0 'None Height = 5055 Left = 5400 ScaleHeight = 5055 ScaleWidth = 855 TabIndex = 5 Top = 840 Width = 855 Begin VScrollBar VScroll2 Height = 4815 LargeChange = 5 Left = 480 Max = 40 Min = 70 TabIndex = 7 Top = 120 Value = 40 Width = 255 End Begin VScrollBar VScroll1 Height = 4815 LargeChange = 10 Left = 120 Max = 360 TabIndex = 6 Top = 120 Width = 255 End End Begin PictureBox GeoPic AutoRedraw = -1 'True BackColor = &H00C0C0C0& BorderStyle = 0 'None Height = 5055 Left = 120 ScaleHeight = 100.597 ScaleMode = 0 'User ScaleWidth = 100.597 TabIndex = 0 Top = 840 Width = 5055 End Begin PictureBox Picture3 BackColor = &H00C0C0C0& BorderStyle = 0 'None Height = 495 Left = 120 ScaleHeight = 495 ScaleWidth = 5055 TabIndex = 8 Top = 120 Width = 5055 Begin OptionButton CubeOpt BackColor = &H00C0C0C0& Caption = "Rotating Cube" Height = 255 Left = 3000 TabIndex = 10 Top = 120 Width = 1815 End Begin OptionButton LinkOpt BackColor = &H00C0C0C0& Caption = "Linkage" Height = 255 Left = 240 TabIndex = 9 Top = 120 Value = -1 'True Width = 1215 End End 'Geometry and animation from... 'Ivory Tower Software 'Richard Wagner, vice president, development 'CIS 76427,2611 Dim sfAngle1 As Single 'Input lever angle, single floating Dim dfLinkLen As Double 'Length of the link from the input lever to the output lever Dim dfLever2Len As Double 'Length of the output lever, double floating Dim dfLever2X As Double 'X coordinate of the output lever center of rotation Dim dfLever2Y As Double 'Y coordinate of the output lever center of rotation Dim dfAlpha As Double 'Spherical coordinate of axis of cube rotation (about Z from +X) Dim dfBeta As Double 'Spherical coordinate of axis of cube rotation (from X-Y plane) Dim dfCubeVertX0(8) As Double 'Array of cube vertices' X coordinates (start) Dim dfCubeVertY0(8) As Double 'Array of cube vertices' Y coordinates (start) Dim dfCubeVertZ0(8) As Double 'Array of cube vertices' Z coordinates (start) Dim dfCubeVertX1(8) As Double 'Array of cube vertices' X coordinates (end) Dim dfCubeVertY1(8) As Double 'Array of cube vertices' Y coordinates (end) Dim dfCubeVertZ1(8) As Double 'Array of cube vertices' Z coordinates (end) Sub BorderBoxRaised (Source1 As Control, Source2 As Form) 'This sub simulates a raised surface on the form by drawing lines. Source2.drawwidth = 1 Bleft% = Source1.Left - 20 BTop% = Source1.top - 20 BWide% = Source1.width + 15 BHigh% = Source1.height + 15 Source2.Line (Bleft%, BTop%)-Step(BWide%, 0), &HFFFFFF Source2.Line -Step(0, BHigh%), 0 Source2.Line -Step(-BWide%, 0), 0 Source2.Line -Step(0, -BHigh%), &HFFFFFF End Sub Sub CubeOpt_Click () For i% = 1 To 8 dfCubeVertX1(i%) = dfCubeVertX0(i%) dfCubeVertY1(i%) = dfCubeVertY0(i%) dfCubeVertZ1(i%) = dfCubeVertZ0(i%) Next i% GeoPic.scalewidth = 200 GeoPic.scaleheight = -200 GeoPic.scaletop = 100 GeoPic.scaleleft = -100 VScroll1.Max = -180 VScroll1.Min = 180 VScroll1.value = 0 VScroll1.smallchange = 1 VScroll1.largechange = 10 VScroll2.Max = 180 VScroll2.Min = 0 VScroll2.value = 90 VScroll2.smallchange = 1 VScroll2.largechange = 10 GeoPic.Cls NewCube DrawAxis End Sub Sub DrawAxis () p1# = Cos(dfAlpha) * Sin(dfBeta) * 90 'Point p defines the axis of rotation p2# = Sin(dfAlpha) * Sin(dfBeta) * 90 'which in this application passes through p3# = Cos(dfBeta) * 90 'the origin GeoPic.drawwidth = 1 GeoPic.drawstyle = 3 GeoPic.Line (p1#, p2#)-(-p1#, -p2#), QBColor(7) 'Erase the existing line dfAlpha = VScroll1.value * dfPi / 180 dfBeta = VScroll2.value * dfPi / 180 p1# = Cos(dfAlpha) * Sin(dfBeta) * 90 p2# = Sin(dfAlpha) * Sin(dfBeta) * 90 p3# = Cos(dfBeta) * 90 GeoPic.Line (p1#, p2#)-(-p1#, -p2#), QBColor(0) 'Draw the new line GeoPic.drawstyle = 0 End Sub Sub DrawCube (iErase As Integer) 'The cube to draw exists in 3-space. This drawing is a simple flat projection 'onto the X-Y plane so it will show no perspective (no sense of "depth"). 'See the demo application CSC.MAK for an example of true perspective rendering 'of 3d objects. 'Just to keep track of vertices, this routine tacks on a number for each corner. GeoPic.drawwidth = 3 'To erase, draw over previous with background color, using "Cls" makes a jumpy picture. If iErase Then GeoPic.forecolor = QBColor(7) 'Erase the cube GeoPic.Line (dfCubeVertX1(1), dfCubeVertY1(1))-(dfCubeVertX1(2), dfCubeVertY1(2)) GeoPic.Print 2 GeoPic.Line (dfCubeVertX1(2), dfCubeVertY1(2))-(dfCubeVertX1(3), dfCubeVertY1(3)) GeoPic.Print 3 GeoPic.Line (dfCubeVertX1(3), dfCubeVertY1(3))-(dfCubeVertX1(4), dfCubeVertY1(4)) GeoPic.Print 4 GeoPic.Line (dfCubeVertX1(4), dfCubeVertY1(4))-(dfCubeVertX1(1), dfCubeVertY1(1)) GeoPic.Print 1 GeoPic.Line (dfCubeVertX1(1), dfCubeVertY1(1))-(dfCubeVertX1(5), dfCubeVertY1(5)) GeoPic.Print 5 GeoPic.Line (dfCubeVertX1(2), dfCubeVertY1(2))-(dfCubeVertX1(6), dfCubeVertY1(6)) GeoPic.Print 6 GeoPic.Line (dfCubeVertX1(3), dfCubeVertY1(3))-(dfCubeVertX1(7), dfCubeVertY1(7)) GeoPic.Print 7 GeoPic.Line (dfCubeVertX1(4), dfCubeVertY1(4))-(dfCubeVertX1(8), dfCubeVertY1(8)) GeoPic.Print 8 GeoPic.Line (dfCubeVertX1(5), dfCubeVertY1(5))-(dfCubeVertX1(6), dfCubeVertY1(6)) GeoPic.Line (dfCubeVertX1(6), dfCubeVertY1(6))-(dfCubeVertX1(7), dfCubeVertY1(7)) GeoPic.Line (dfCubeVertX1(7), dfCubeVertY1(7))-(dfCubeVertX1(8), dfCubeVertY1(8)) GeoPic.Line (dfCubeVertX1(8), dfCubeVertY1(8))-(dfCubeVertX1(5), dfCubeVertY1(5)) Else GeoPic.forecolor = QBColor(0) 'Redraw the cube GeoPic.Line (dfCubeVertX1(1), dfCubeVertY1(1))-(dfCubeVertX1(2), dfCubeVertY1(2)), QBColor(4) GeoPic.Print 2 GeoPic.Line (dfCubeVertX1(2), dfCubeVertY1(2))-(dfCubeVertX1(3), dfCubeVertY1(3)), QBColor(4) GeoPic.Print 3 GeoPic.Line (dfCubeVertX1(3), dfCubeVertY1(3))-(dfCubeVertX1(4), dfCubeVertY1(4)), QBColor(4) GeoPic.Print 4 GeoPic.Line (dfCubeVertX1(4), dfCubeVertY1(4))-(dfCubeVertX1(1), dfCubeVertY1(1)), QBColor(4) GeoPic.Print 1 GeoPic.Line (dfCubeVertX1(1), dfCubeVertY1(1))-(dfCubeVertX1(5), dfCubeVertY1(5)), QBColor(4) GeoPic.Print 5 GeoPic.Line (dfCubeVertX1(2), dfCubeVertY1(2))-(dfCubeVertX1(6), dfCubeVertY1(6)), QBColor(4) GeoPic.Print 6 GeoPic.Line (dfCubeVertX1(3), dfCubeVertY1(3))-(dfCubeVertX1(7), dfCubeVertY1(7)), QBColor(4) GeoPic.Print 7 GeoPic.Line (dfCubeVertX1(4), dfCubeVertY1(4))-(dfCubeVertX1(8), dfCubeVertY1(8)), QBColor(4) GeoPic.Print 8 GeoPic.Line (dfCubeVertX1(5), dfCubeVertY1(5))-(dfCubeVertX1(6), dfCubeVertY1(6)), QBColor(4) GeoPic.Line (dfCubeVertX1(6), dfCubeVertY1(6))-(dfCubeVertX1(7), dfCubeVertY1(7)), QBColor(4) GeoPic.Line (dfCubeVertX1(7), dfCubeVertY1(7))-(dfCubeVertX1(8), dfCubeVertY1(8)), QBColor(4) GeoPic.Line (dfCubeVertX1(8), dfCubeVertY1(8))-(dfCubeVertX1(5), dfCubeVertY1(5)), QBColor(4) End If GeoPic.forecolor = QBColor(0) End Sub Sub DrawMech () GeoPic.forecolor = QBColor(0) GeoPic.drawwidth = 3 LeverEndX# = 30 - Cos(sfAngle1) * 10 'Radius is 10 in a scalewidth of 100 LeverEndY# = 40 + Sin(sfAngle1) * 10 'Double precision is used because CircInterSect needs it CircInter LeverEndX#, LeverEndY#, dfLever2X, dfLever2Y, dfLinkLen, dfLever2Len, x1#, x2#, Y1#, y2# GeoPic.Line (30, 40)-(LeverEndX#, LeverEndY#), QBColor(7) 'Erases previous line GeoPic.Line (LeverEndX#, LeverEndY#)-(x2#, y2#), QBColor(7) GeoPic.Line (x2#, y2#)-(dfLever2X, dfLever2Y), QBColor(7) sfAngle1 = VScroll1.value * dfPi / 180 'Convert input angle to radians LeverEndX# = 30 - Cos(sfAngle1) * 10 LeverEndY# = 40 + Sin(sfAngle1) * 10 'Call the GEO dll subroutine to find the intersection of the two circles: CircInter LeverEndX#, LeverEndY#, dfLever2X, dfLever2Y, dfLinkLen, dfLever2Len, x1#, x2#, Y1#, y2# GeoPic.Line (30, 40)-(LeverEndX#, LeverEndY#) GeoPic.Line (LeverEndX#, LeverEndY#)-(x2#, y2#), QBColor(4) GeoPic.Line (x2#, y2#)-(dfLever2X, dfLever2Y) End Sub Sub ExitButton_Click () End End Sub Sub Form_Load () dfLinkLen = 30 dfLever2Len = 40 dfLever2X = 70 dfLever2Y = 80 dfCubeVertX0(1) = 20 'double floating cube vertex X starting dfCubeVertY0(1) = 0 dfCubeVertZ0(1) = 0 dfCubeVertX0(2) = 60 dfCubeVertY0(2) = 0 dfCubeVertZ0(2) = 0 dfCubeVertX0(3) = 60 dfCubeVertY0(3) = 40 dfCubeVertZ0(3) = 0 dfCubeVertX0(4) = 20 dfCubeVertY0(4) = 40 dfCubeVertZ0(4) = 0 dfCubeVertX0(5) = 20 dfCubeVertY0(5) = 0 dfCubeVertZ0(5) = 40 dfCubeVertX0(6) = 60 dfCubeVertY0(6) = 0 dfCubeVertZ0(6) = 40 dfCubeVertX0(7) = 60 dfCubeVertY0(7) = 40 dfCubeVertZ0(7) = 40 dfCubeVertX0(8) = 20 dfCubeVertY0(8) = 40 dfCubeVertZ0(8) = 40 GeoPic.scalewidth = 100 GeoPic.scaleheight = 100 GeoPic.scaletop = 0 GeoPic.scaleleft = 0 DrawMech End Sub Sub Form_Paint () BorderBoxRaised GeoPic, Geo BorderBoxRaised Picture1, Geo BorderBoxRaised Picture2, Geo BorderBoxRaised Picture3, Geo End Sub Sub LinkOpt_Click () GeoPic.scalewidth = 100 GeoPic.scaleheight = 100 GeoPic.scaletop = 0 GeoPic.scaleleft = 0 VScroll1.Max = 360 VScroll1.Min = 0 VScroll1.value = 0 VScroll1.smallchange = 1 VScroll1.largechange = 10 VScroll2.Max = 40 VScroll2.Min = 70 VScroll2.value = 40 VScroll2.smallchange = 1 VScroll2.largechange = 5 DrawMech End Sub Sub NewCube () GeoPic.drawwidth = 3 GeoPic.forecolor = QBColor(4) 'Draw a virgin cube GeoPic.Line (dfCubeVertX0(1), dfCubeVertY0(1))-(dfCubeVertX0(2), dfCubeVertY0(2)) GeoPic.Line (dfCubeVertX0(2), dfCubeVertY0(2))-(dfCubeVertX0(3), dfCubeVertY0(3)) GeoPic.Line (dfCubeVertX0(3), dfCubeVertY0(3))-(dfCubeVertX0(4), dfCubeVertY0(4)) GeoPic.Line (dfCubeVertX0(4), dfCubeVertY0(4))-(dfCubeVertX0(1), dfCubeVertY0(1)) GeoPic.Line (dfCubeVertX0(1), dfCubeVertY0(1))-(dfCubeVertX0(5), dfCubeVertY0(5)) GeoPic.Line (dfCubeVertX0(2), dfCubeVertY0(2))-(dfCubeVertX0(6), dfCubeVertY0(6)) GeoPic.Line (dfCubeVertX0(3), dfCubeVertY0(3))-(dfCubeVertX0(7), dfCubeVertY0(7)) GeoPic.Line (dfCubeVertX0(4), dfCubeVertY0(4))-(dfCubeVertX0(8), dfCubeVertY0(8)) GeoPic.Line (dfCubeVertX0(5), dfCubeVertY0(5))-(dfCubeVertX0(6), dfCubeVertY0(6)) GeoPic.Line (dfCubeVertX0(6), dfCubeVertY0(6))-(dfCubeVertX0(7), dfCubeVertY0(7)) GeoPic.Line (dfCubeVertX0(7), dfCubeVertY0(7))-(dfCubeVertX0(8), dfCubeVertY0(8)) GeoPic.Line (dfCubeVertX0(8), dfCubeVertY0(8))-(dfCubeVertX0(5), dfCubeVertY0(5)) End Sub Sub RotateCube (ByVal o1 As Double, ByVal o2 As Double, ByVal o3 As Double, ByVal p1 As Double, ByVal p2 As Double, ByVal p3 As Double, ByVal Theta As Double) 'For each vertex, call SolidRotate to find its new point in 3-space for the angle it rotates through: For i% = 1 To 8 r1# = dfCubeVertX0(i%) 'These are "home" coordinates which never change r2# = dfCubeVertY0(i%) r3# = dfCubeVertZ0(i%) SolidRotate o1, o2, o3, p1, p2, p3, r1#, r2#, r3#, Theta dfCubeVertX1(i%) = r1# 'These are the new coordinates to draw the rotated cube dfCubeVertY1(i%) = r2# dfCubeVertZ1(i%) = r3# Next i% End Sub Sub RunButton_Click () Static iAngle% RunButton.enabled = 0 StopButton.enabled = -1 LinkOpt.enabled = 0 CubeOpt.enabled = 0 If LinkOpt.value Then Do While StopButton.enabled np% = DoEvents() VScroll1.value = iAngle% iAngle% = iAngle% + 2 '2 degree increments If iAngle% > 360 Then iAngle% = 0 Loop Else RunCubeRotation End If End Sub Sub RunCubeRotation () WipeNewCube o1# = 0 'A rotation axis point o2# = 0 o3# = 0 Do While StopButton.enabled i% = i% + 1 If i% > 360 / 5 Then i% = 0 Theta# = i% * 5 * dfPi / 180 '5 degree increments If Theta# > dfPi Then Theta# = Theta# - dfPi * 2 'Theta must be between -pi and pi End If DrawCube -1 'Erase previous cube drawing DrawAxis 'Put the axis back if needed p1# = Cos(dfAlpha) * Sin(dfBeta) * 90 'The other rotation axis point p2# = Sin(dfAlpha) * Sin(dfBeta) * 90 '90 makes a nice long line p3# = Cos(dfBeta) * 90 RotateCube o1#, o2#, o3#, p1#, p2#, p3#, Theta# DrawCube 0 'Draw the new cube DrawAxis np% = DoEvents() 'Be friendly Loop End Sub Sub StopButton_Click () StopButton.enabled = 0 RunButton.enabled = -1 LinkOpt.enabled = -1 CubeOpt.enabled = -1 VScroll1.visible = -1 VScroll2.visible = -1 If CubeOpt.value Then DrawCube -1 NewCube End If End Sub Sub VScroll1_Change () If LinkOpt.value Then DrawMech Else DrawAxis End If End Sub Sub VScroll1_GotFocus () ExitButton.SetFocus End Sub Sub VScroll2_Change () If LinkOpt.value Then dfLever2Len = VScroll2.value GeoPic.Cls DrawMech Else DrawAxis End If End Sub Sub VScroll2_GotFocus () ExitButton.SetFocus End Sub Sub WipeNewCube () GeoPic.drawwidth = 3 GeoPic.forecolor = QBColor(7) 'Erase a virgin cube GeoPic.Line (dfCubeVertX0(1), dfCubeVertY0(1))-(dfCubeVertX0(2), dfCubeVertY0(2)) GeoPic.Line (dfCubeVertX0(2), dfCubeVertY0(2))-(dfCubeVertX0(3), dfCubeVertY0(3)) GeoPic.Line (dfCubeVertX0(3), dfCubeVertY0(3))-(dfCubeVertX0(4), dfCubeVertY0(4)) GeoPic.Line (dfCubeVertX0(4), dfCubeVertY0(4))-(dfCubeVertX0(1), dfCubeVertY0(1)) GeoPic.Line (dfCubeVertX0(1), dfCubeVertY0(1))-(dfCubeVertX0(5), dfCubeVertY0(5)) GeoPic.Line (dfCubeVertX0(2), dfCubeVertY0(2))-(dfCubeVertX0(6), dfCubeVertY0(6)) GeoPic.Line (dfCubeVertX0(3), dfCubeVertY0(3))-(dfCubeVertX0(7), dfCubeVertY0(7)) GeoPic.Line (dfCubeVertX0(4), dfCubeVertY0(4))-(dfCubeVertX0(8), dfCubeVertY0(8)) GeoPic.Line (dfCubeVertX0(5), dfCubeVertY0(5))-(dfCubeVertX0(6), dfCubeVertY0(6)) GeoPic.Line (dfCubeVertX0(6), dfCubeVertY0(6))-(dfCubeVertX0(7), dfCubeVertY0(7)) GeoPic.Line (dfCubeVertX0(7), dfCubeVertY0(7))-(dfCubeVertX0(8), dfCubeVertY0(8)) GeoPic.Line (dfCubeVertX0(8), dfCubeVertY0(8))-(dfCubeVertX0(5), dfCubeVertY0(5)) End Sub