'Form contains
'Command buttons (Command1 to Command4)
'Label1 for direction
'Check1 if u want to hide / show line
'Shape1 inside picture box
'Picture1 for drawing area
'NEW CONTROLS SINCE LAST TIME
'Command Buttons (Command5 to Command7) for record, stop, play
'Timer1 for playback
Option Explicit
'NEW ------------------------------------.
Private Type LineType
X1 As Single
Y1 As Single
X2 As Single
Y2 As Single
'You could add stuff here for colours etc
End Type
Dim MyLine() As LineType
Dim LineCounter As Long
Dim RecorderOn As Boolean
'NEW ------------------------------------'
Dim CurX As Single 'starting / current positions
Dim CurY As Single
Private Sub Form_Load()
'NEW ------------------------------------
LineCounter = -1 'so that first item starts at zero by adding 1
Command5.Caption = "Record"
Command6.Caption = "Stop Recording"
Command7.Caption = "Playback"
Command6.Enabled = False
Command7.Enabled = False
RecorderOn = True 'set to on auto
Timer1.Interval = 500 '1/2 second playback
Timer1.Enabled = False 'Set timer off to start
'NEW ------------------------------------
'Set captions .. can be done at design time instead of here
Command1.Caption = "North"
Command2.Caption = "West"
Command3.Caption = "East"
Command4.Caption = "South"
'Set start position to centre bottom
With Picture1 'Work on Picture1 within With.. With End stmt
CurX = .Width \ 2 'Centre of picture
CurY = .Height 'Bottom of picture
.CurrentX = CurX 'Set drawing posn
.CurrentY = CurY
.AutoRedraw = True
End With
Check1.Caption = "Hide Line"
Shape1.Visible = False
End Sub
Private Sub Command1_Click()
Update 0, -300 'Tell sub to move X by 0 and Y by -300
Label1.Caption = "North" 'update caption
End Sub
Private Sub Command2_Click()
Update -300, 0
Label1.Caption = "West"
End Sub
Private Sub Command3_Click()
Update 300, 0
Label1.Caption = "East"
End Sub
Private Sub Command4_Click()
Update 0, 300
Label1.Caption = "South"
End Sub
Private Sub Update(ByVal MoveX As Single, ByVal MoveY As Single)
'Sub gets movement amounts of X and Y
'You can check for boundaries of picture or remove everything before and
'including the "Then" keyword
If CurX + MoveX > 0 And CurX + MoveX < Picture1.Width Then CurX = CurX + MoveX
If CurY + MoveY > 0 And CurY + MoveY < Picture1.Height Then CurY = CurY + MoveY
'NEW ------------------------------------.
'Put line into array
If RecorderOn And Shape1.Visible = False Then 'Only do if drawing a line
'NB u could also set some other flag if preferred
LineCounter = LineCounter + 1
ReDim Preserve MyLine(LineCounter)
With MyLine(LineCounter)
.X1 = Picture1.CurrentX
.Y1 = Picture1.CurrentY
.X2 = CurX
.Y2 = CurY
End With
End If
'NEW ------------------------------------'
'Draw line from current position to new position
Picture1.Line -(CurX, CurY)
With Shape1
.Move CurX - .Width \ 2, CurY - .Height \ 2
End With
End Sub
Private Sub Check1_Click()
If Check1.Value = vbChecked Then
Shape1.Visible = True
Picture1.DrawMode = 11 'Sorry cant remember constant name
Else
Shape1.Visible = False
Picture1.DrawMode = 13
End If
End Sub
'NEW ------------------------------------.
Private Sub Command5_Click()
'Start recording
With Picture1
'Remember current coordinates before clearing
CurX = .CurrentX
CurY = .CurrentY
.Cls 'Clear picture to start with
.CurrentX = CurX 'Reset coords
.CurrentY = CurY
End With
RecorderOn = True
LineCounter = -1
'Show applicable buttons
Command5.Enabled = False 'Record
Command6.Enabled = True 'Stop
Command7.Enabled = False 'Play
End Sub
Private Sub Command6_Click()
'Stop recording
RecorderOn = False
Command5.Enabled = True
Command6.Enabled = False
Command7.Enabled = True
End Sub
Private Sub Command7_Click()
'Playback using Timer 1
Command5.Enabled = False
Command6.Enabled = False
Command7.Enabled = False
If UBound(MyLine) >= 0 Then
Picture1.Cls 'Clear before redraw
Timer1.Enabled = True 'Only do if some to redraw
Else
Command5.Enabled = True 'Else reset to allow recording
End If
End Sub
Private Sub Timer1_Timer()
'Actual redraw
Static lNumLines As Long
If lNumLines <= UBound(MyLine) Then
With MyLine(lNumLines)
Picture1.Line (.X1, .Y1)-(.X2, .Y2)
End With
lNumLines = lNumLines + 1
Else
lNumLines = 0
Timer1.Enabled = False
Command5.Enabled = True
Command7.Enabled = True
End If
End Sub
'NEW ------------------------------------'