Dragon Curves v2.0
Submitted By:
hemmer
Rating:
Not rated (
Rate It)
VERSION 5.00
Begin VB.Form DrawForm
Caption = "Dragon Curves - Ewan Hemingway - Step 2. Draw the curves"
ClientHeight = 12270
ClientLeft = 60
ClientTop = 630
ClientWidth = 17160
LinkTopic = "Form1"
MaxButton = 0 'False
Moveable = 0 'False
ScaleHeight = 12270
ScaleWidth = 17160
WindowState = 2 'Maximized
Begin VB.HScrollBar HScroll1
Height = 255
Left = 480
Max = 17280
TabIndex = 1
Top = 11880
Value = 8640
Width = 16350
End
Begin VB.VScrollBar VScroll1
Height = 11895
Left = 16800
Max = 12960
TabIndex = 0
Top = 0
Value = 6480
Width = 255
End
Begin VB.Menu mnuFile
Caption = "File"
Begin VB.Menu mnuFileFoldLength
Caption = "Length of folds"
End
Begin VB.Menu mnuFileClear
Caption = "&Clear"
End
Begin VB.Menu mnuFilePrint
Caption = "Print"
End
Begin VB.Menu mnuFileColourInfo
Caption = "Colour Information"
End
Begin VB.Menu mnuFileSeperator
Caption = "-"
End
Begin VB.Menu mnuFileReturn
Caption = "Return to Step 1. "
End
Begin VB.Menu mnuFileExit
Caption = "E&xit"
Shortcut = ^Q
End
End
Begin VB.Menu mnuDraw
Caption = "&Draw!"
Begin VB.Menu mnuDrawCurve
Caption = "Draw &Curve"
End
Begin VB.Menu mnuDrawWarning
Caption = "Warning..."
End
End
End
Attribute VB_Name = "DrawForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim foldLength As Integer
Dim OutputObject As Object
Dim x1 As Integer
Dim y1 As Integer
Dim x2 As Integer
Dim y2 As Integer
Dim initialx1 As Integer
Dim initialx2 As Integer
Dim initialy1 As Integer
Dim initialy2 As Integer
Public Sub Draw_curves()
On Error GoTo error_handler
Dim i As Integer
Dim current_char As String
x1 = initialx1
x2 = initialx2
y1 = initialy1
y2 = initialy2
For i = 1 To Len(DragonForm.Text2.Text)
current_char = Mid(DragonForm.Text2.Text, i, 1) 'work through the characters of the dragon curve string
current_char = LCase(current_char)
If x2 = x1 - foldLength Then '/\/\/\/\/\/\ if we are heading left
x1 = x2
y1 = y2
x2 = x2
y2 = y2
If current_char = "l" Then ' if "l"
y2 = y2 + foldLength 'turn left
OutputObject.Line (x1, y1)-(x2, y2), vbRed
Else
y2 = y2 - foldLength 'else turn right
OutputObject.Line (x1, y1)-(x2, y2), vbYellow
End If
GoTo nextLabel
End If
If x2 = x1 + foldLength Then '/\/\/\/\/\/\ if we are heading right
x1 = x2
y1 = y2
x2 = x2
y2 = y2
If current_char = "l" Then 'if "l" then
y2 = y2 - foldLength 'turn left
OutputObject.Line (x1, y1)-(x2, y2), vbRed
Else
y2 = y2 + foldLength 'else turn Right
OutputObject.Line (x1, y1)-(x2, y2), vbYellow
End If
GoTo nextLabel
End If
If y2 = y1 - foldLength Then '/\/\/\/\/\ if we are heading up
x1 = x2
y1 = y2
x2 = x2
y2 = y2
If current_char = "l" Then 'if "l" then
x2 = x2 - foldLength ' turn left
OutputObject.Line (x1, y1)-(x2, y2), vbRed
Else
x2 = x2 + foldLength 'else turn right
OutputObject.Line (x1, y1)-(x2, y2), vbYellow
End If
GoTo nextLabel
End If
If y2 = y1 + foldLength Then '/\/\/\/\/\ if we are heading down
x1 = x2
y1 = y2
x2 = x2
y2 = y2
If current_char = "l" Then 'if "l" then
x2 = x2 + foldLength ' turn left
OutputObject.Line (x1, y1)-(x2, y2), vbRed
Else
x2 = x2 - foldLength 'else turn right
OutputObject.Line (x1, y1)-(x2, y2), vbYellow
End If
GoTo nextLabel
End If
nextLabel:
Next i
error_handler:
If Err.Number = 7 Then
MsgBox ("Too big a fold length!!!!!!!!")
foldLength = foldLength / 2
Call Setup
End If
End Sub
Private Sub Form_Load()
Set OutputObject = DrawForm
foldLength = 50
initialx1 = HScroll1.Value
initialx2 = HScroll1.Value - foldLength
initialy1 = VScroll1.Value
initialy2 = VScroll1.Value
End Sub
Public Sub mnuDrawCurve_Click()
Call Setup
End Sub
Sub Setup()
If TypeOf OutputObject Is Form Then
OutputObject.Cls
End If
OutputObject.Line (initialx1, initialy1)-(initialx2, initialy2), vbBlue
Call Draw_curves
End Sub
Private Sub mnuDrawWarning_Click()
MsgBox ("If the curve does not fit on a page, decrease the fold length through FILE/LENGTH OF FOLDS." + vbCrLf + "You can also use the scrollbars at the side to move the curve about.")
End Sub
Private Sub mnuFileClear_Click()
If TypeOf OutputObject Is Form Then
OutputObject.Cls
End If
End Sub
Private Sub mnuFileColourInfo_Click()
ColourForm.Show
End Sub
Private Sub mnuFileExit_Click()
If MsgBox("Do you wish to exit?", vbOKCancel + vbQuestion + vbApplicationModal, "Really Exit?") = vbOK Then
End
End If
End Sub
Private Sub mnuFileFoldLength_Click()
Dim fillerVar
here:
fillerVar = InputBox("Enter a length for the fold (1 to 1000): ", "Fold Length Query", Int(foldLength / 2))
If fillerVar = vbCancel Then
Exit Sub
End If
If Not IsNumeric(fillerVar) Then
MsgBox ("Number please!!!")
GoTo here
End If
If fillerVar > 1000 Or fillerVar < 1 Then
MsgBox ("Invalid amount entered for the length of the folds!!")
GoTo here
End If
foldLength = fillerVar
initialx1 = HScroll1.Value
initialx2 = HScroll1.Value - foldLength
initialy1 = VScroll1.Value
initialy2 = VScroll1.Value
Call Setup
End Sub
Private Sub mnuFilePrint_Click()
Set OutputObject = Printer
MsgBox "Warning - Can take a while to spool on some computers"
OutputObject.DrawWidth = 4
Call Setup
OutputObject.DrawWidth = 1
OutputObject.Print
OutputObject.Print "Dragon Curves"
OutputObject.Print "Blue = Initial Fold, Yellow = Left Fold, Red = Right Fold"
Set OutputObject = DrawForm
End Sub
Private Sub mnuFileReturn_Click()
Me.Hide
End Sub
Private Sub VScroll1_Change()
initialy1 = VScroll1.Value
initialy2 = VScroll1.Value
Setup
End Sub
Private Sub HScroll1_Change()
initialx1 = HScroll1.Value
initialx2 = HScroll1.Value - foldLength
Setup
End Sub
