11-06-2015, 12:01 PM
Here is a simple macro that draws a short line in 8 different directions, could be used to navigate thru a maze or use as a Etch-A Sketch ®.
Code:
Sub Main
Dim scale As Double
Dim vLeft As Double
Dim vBottom As Double
Dim vRight As Double
Dim vTop As Double
Dim LastLine(1000,3)
MV=.25 '<- Amount of X & Y movement
DColor=0: LastL=1
Xpos=0: Ypos=0: Xstart=0: Ystart=0
dcSetLineParms DColor, dcSOLID, dcTHIN '<- dcThin dcNormal dcThick dcHeavy
dcCreateBox -11.5, -5, 11.5, 5 '<- Lower Left and Upper Right corners of Drawing Area
dcViewAll
dcGetViewScaleandRect scale, vLeft, vBottom, vRight, vTop
dcSelectObjInBox vLeft, vBottom, vRight, vTop
dcEraseSelObjs
dcCreateCircle Xpos, Ypos, .05
Begin Dialog Sketch 10,0, 95, 145, "DeltaCAD-A-Sketch", .Enable
TextBox 7,70,40,15, .StringX
TextBox 47,70,40,15, .StringY
PushButton 18, 4,20,20, "\", .UpLeft
PushButton 38, 4,20,20, "/\", .Up
PushButton 58, 4,20,20, "/", .UpRight
PushButton 18,24,20,20, "<", .Left
PushButton 58,24,20,20, ">", .Right
PushButton 18,44,20,20, "/", .DownLeft
PushButton 38,44,20,20, "\/", .Down
PushButton 58,44,20,20, "\", .DownRight
PushButton 38,24,20,20, "Color",.DCColor
PushButton 23,90,50,15, "Clear",.Clear
PushButton 23,105,50,15, "Quit", .Quit
PushButton 23,120,50,15, "Back", .Back
End Dialog
Dim Dlg1 As Sketch
GetButton:
Dlg1.StringX = "X" + Str$(Xpos)
Dlg1.StringY = "Y" + Str$(Ypos)
B = Dialog( Dlg1 )
If B=1 Or B=4 Or B=6 Then
If Xpos>=vLeft+MV-.05 Then Xpos=Xpos-MV
End If
If B=3 Or B=5 Or B=8 Then
If Xpos<=vRight-MV+.05 Then Xpos=Xpos+MV
End If
If B=1 Or B=2 Or B=3 Then
If Ypos<=vTop-MV+.05 Then Ypos=Ypos+MV
End If
If B=6 Or B=7 Or B=8 Then
If Ypos>=vBottom+MV-.05 Then Ypos=Ypos-MV
End If
If B>0 And B<9 Then
dcCreateLine Xstart, Ystart,Xpos, Ypos
LastLine(LastL,1) = Xpos
LastLine(LastL,2) = Ypos
LastLine(LastL,3) = DColor
LastL = LastL + 1
Xstart=Xpos:Ystart=Ypos
End If
If B=9 Then
DColor=DColor+1
If DColor>14 Then DColor=0
dcSetLineParms DColor, dcSOLID, dcTHIN
End If
If B=10 Then
dcSelectObjInBox vLeft, vBottom, vRight, vTop
Xpos=0: Ypos=0: Xstart=0: Ystart=0
dcEraseSelObjs
dcCreateCircle 0, 0, .05
DColor=0: LastL=1
End If
If B=11 Then End
If B=12 And LastL>1 Then
Xpos=0: Ypos=0: Xstart=0: Ystart=0
dcSelectObjInBox vLeft, vBottom, vRight, vTop
dcEraseSelObjs
dcCreateCircle 0, 0, .05
LastL=LastL-1
For L=1 to LastL-1
Xpos=LastLine(L,1)
Ypos=LastLine(L,2)
DColor=LastLine(L,3)
dcSetLineParms DColor, dcSOLID, dcTHIN
dcCreateLine Xstart, Ystart,Xpos, Ypos
Xstart=Xpos:Ystart=Ypos
Next L
End If
GoTo GetButton
End Sub