Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Games in DeltaCad using the Macro feature?
#3
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
Reply


Messages In This Thread
RE: Games in DeltaCad using the Macro feature? - AlwMVMO - 11-06-2015, 12:01 PM

Forum Jump:


Users browsing this thread: 1 Guest(s)