reccord.bas

来自「一款小仿真软件」· BAS 代码 · 共 110 行

Attribute VB_Name = "reccord"
'文件保存读取
Option Explicit
Public Type Dpoint
  x As Single
  y As Single
End Type

Public Type Dline
  p() As Dpoint
End Type

Public myl() As Dline
Public curline As Long
Public curpoint As Long
Dim i As Long, j As Long, k As Long

Public Sub Maddline()
curline = UBound(myl) + 1
ReDim Preserve myl(curline)
ReDim Preserve myl(curline).p(0)
curpoint = 0
End Sub

Public Sub Maddpoint(ByVal x As Integer, ByVal y As Integer)
With Form1.Picture2
If x < 0 Then x = 0
If y < 0 Then y = 0
If x > .Width Then x = .Width
If y > .Height Then y = .Height
Form1.Picture2.Line -(x, y)
End With

curpoint = curpoint + 1
With myl(curline)
ReDim Preserve .p(curpoint)
.p(curpoint).x = x
.p(curpoint).y = y
End With
End Sub

Public Sub Mlineini()
ReDim Preserve myl(0)
curline = 0
curpoint = 0
Form1.Picture2.Cls
End Sub

Public Sub ClearMyRobot()

End Sub

Public Sub SaveMyRobot()
Open App.Path & "\" & Form1.Text3.Text For Output As #1
Write #1, curline
For i = 1 To curline
Write #1, "line" & i, UBound(myl(i).p)
For j = 1 To UBound(myl(i).p)
Write #1, myl(i).p(j).x, myl(i).p(j).y
Next
Next

'Print #1, 3333, 555
Close (1)
End Sub

Public Sub LoadMyRobot()
Dim MyString As String, MyNumber As Long, TMyline As Long, lon As Long
On Error GoTo qmark
Open App.Path & "\" & Form1.Text3.Text For Input As #1   ' 打开输入文件。
  Input #1, TMyline
 ReDim Preserve myl(TMyline)
curline = TMyline

For j = 1 To curline

Input #1, MyString, MyNumber
If InStr(MyString, "line") = 0 Then Close #1: MsgBox "file err": Exit Sub
lon = lon + 1
ReDim Preserve myl(lon).p(MyNumber)
For i = 1 To MyNumber
Input #1, myl(lon).p(i).x, myl(lon).p(i).y
Next

Next

Close #1    ' 关闭文件。
curpoint = MyNumber

qmark:
Err.Clear
End Sub


Public Sub DrawMyRobot()
Dim lon As Long
For j = 1 To curline
lon = UBound(myl(j).p)
Form1.Picture2.CurrentX = myl(j).p(1).x
Form1.Picture2.CurrentY = myl(j).p(1).y
For i = 1 To lon
Form1.Picture2.Line -(myl(j).p(i).x, myl(j).p(i).y)
Next

Next
End Sub