form1.frm

一款我自己开发的利用历史数据进行期货买卖操作练习的工具

         Top             =   2000
         Width           =   615
      End
      Begin VB.Label Label9 
         BackColor       =   &H00000000&
         Caption         =   "0"
         ForeColor       =   &H000000FF&
         Height          =   255
         Index           =   0
         Left            =   16080
         TabIndex        =   19
         Top             =   1000
         Width           =   615
      End
      Begin VB.Line Line7 
         BorderColor     =   &H000000FF&
         X1              =   16000
         X2              =   16000
         Y1              =   0
         Y2              =   7000
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
'picdata中依次为 开盘 最高 最低 收盘 成交 持仓

mypoint = mypoint + 1

If mypoint = num_data Then Command1.Enabled = False
'使能进行买卖操作
Command4.Enabled = True
Command8.Enabled = True
Command7.Enabled = True
Command9.Enabled = True
'画图开始
Call my_draw(mypoint, 1, 1, 0)

End Sub

Private Sub Command10_Click()
 Call my_draw(120, 0, 1, 0)
End Sub

Private Sub Command11_Click()
 Call my_draw(120, 0, 0, 1)
End Sub

Private Sub Command12_Click()
If mypoint >= 2 Then
mypoint = mypoint - 1

Call my_draw(mypoint, 1, 1, 0)
End If
End Sub

Private Sub Command2_Click()
Dim i
i = InputBox("请输入资金")
If i <> "" Then Text1.Text = i

End Sub

Private Sub Command3_Click()
Dim i
i = InputBox("请输入手数")
If i <> "" Then Text7.Text = i

End Sub

Private Sub Command4_Click()

    If Text1.Text - myrecord(mypoint, 7) * Text7.Text > 0 Then
    Text1.Text = Text1.Text - myrecord(mypoint, 7) * Text7.Text
    Text2.Text = Val(Text2.Text) + Val(Text7.Text)
    Text5.Text = myrecord(mypoint, 7)
    End If

End Sub

Private Sub Command5_Click()
Close #3
CommonDialog1.ShowOpen
If CommonDialog1.FileName <> "" Then
'初始化
mypoint = 0
If Option1.Value = True Then Picture1.Cls
Text1.Text = 10000
Text2.Text = 0
Text3.Text = 0
Text4.Text = 0
Text5.Text = 0
Text6.Text = 0
'初始化绘图矩阵
Dim pp As Single
Dim ppp As Single
For pp = 1 To 100
    mydrawdate(pp) = ""
    For ppp = 1 To 4
    mydraw(pp, ppp) = 0
    Next ppp
Next pp
For pp = 0 To 5
    Label9(5 - pp).Caption = 0
Next pp
y_min = 0
y_max = 0
'初始化结束
Open CommonDialog1.FileName For Input As #3
CommonDialog1.FileName = ""
Dim i As Single
i = 0
Do Until EOF(3)
i = i + 1
ReDim Preserve jilu(i) As String
Line Input #3, jilu(i)
Loop
num_data = i
ReDim myrecord(i, 9) As Single

Dim j As Integer '定义数组复制循环
Dim k As Integer '定义字符记录长度
Dim l As Integer '定义每个记录中指针位置
Dim m As Integer '定义提取数据的起始位置
Dim n As Integer '定义已经提取数据的个数
m = 1
n = 0
For j = 1 To i
k = Len(jilu(j))
    For l = 1 To k
  If Mid(jilu(j), l, 1) < "0" Or Mid(jilu(j), l, 1) > "9" Then
  n = n + 1
  myrecord(j, n) = Mid(jilu(j), m, l - m)
  m = l + 1
  End If
  If l = k Then
  n = n + 1
  myrecord(j, n) = Mid(jilu(j), m, l - m + 1)
  m = 1
  n = 0
  End If
    Next l

Next j
Command1.Enabled = True
Picture1.DrawStyle = 2
Dim p As Single
For p = 1000 To 6000 Step 1000
Picture1.Line (0, p)-(16000, p), vbRed
Next p
Picture1.DrawStyle = 0
'初始化绘图矩阵
For i = 1 To 100
    For j = 1 To 4
    mydraw(i, j) = 0
    Next j
Next i
End If
End Sub


Private Sub Command6_Click()
mypoint = 0
Picture1.Cls
Text1.Text = 20000
Text2.Text = 0
Text3.Text = 0
Text4.Text = 0
Text5.Text = 0
Text6.Text = 0
Command1.Enabled = True
Command4.Enabled = False
Command8.Enabled = False
Command7.Enabled = False
Command9.Enabled = False

Label10.Caption = "日期："
Label11.Caption = "当日开盘价："
Label12.Caption = "当日最高价："
Label13.Caption = "当日最低价："
Label14.Caption = "当日收盘价："
my_min = 50000
my_max = 0
Picture1.DrawStyle = 2
Dim p As Single
For p = 1000 To 6000 Step 1000
Picture1.Line (0, p)-(16000, p), vbRed
Next p
Picture1.DrawStyle = 0
'初始化绘图矩阵
Dim i As Single
Dim j As Single
For i = 1 To 100
    mydrawdate(i) = ""
    For j = 1 To 4
    mydraw(i, j) = 0
    Next j
Next i
For i = 0 To 5
    Label9(5 - i).Caption = 0
Next i
y_min = 50000
y_max = 0
End Sub

Private Sub Command7_Click()
If Text1.Text - myrecord(mypoint, 7) * Text7.Text > 0 Then
    Text1.Text = Text1.Text - myrecord(mypoint, 7) * Text7.Text
    Text3.Text = Val(Text3.Text) + Val(Text7.Text)
    Text6.Text = myrecord(mypoint, 7)
    End If

End Sub

Private Sub Command8_Click()
If Text3.Text >= Text7.Text Then
    Text1.Text = Text1.Text + myrecord(mypoint, 7) * Text7.Text
    Text3.Text = Val(Text3.Text) - Val(Text7.Text)
    If Text3.Text = 0 Then Text6.Text = 0
    End If
   

End Sub

Private Sub Command9_Click()
 If Text2.Text >= Text7.Text Then
    Text1.Text = Text1.Text + myrecord(mypoint, 7) * Text7.Text
    Text2.Text = Val(Text2.Text) - Val(Text7.Text)
    If Text2.Text = 0 Then Text5.Text = 0
    End If
    
End Sub

Private Sub Form_Load()
Me.Width = 18600
Me.Height = 11200
Me.Left = (Screen.Width - 18600) / 2
Me.Top = (Screen.Height - 11600) / 2
Picture1.Width = Me.Width
Picture1.Height = 7000
'定义各个空间位置

'全局变量初始化
bili = 1 '初始化绘制比例

'画横坐标虚线
Picture1.DrawStyle = 2
Dim i As Single
For i = 1000 To 6000 Step 1000
Picture1.Line (0, i)-(16000, i), vbRed
Next i
Picture1.DrawStyle = 0
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Line1.Visible = False
Line2.Visible = False
Text9.Visible = False
Text10.Visible = False

End Sub

Private Sub Option1_Click()
Frame1.Enabled = True
Frame2.Enabled = False
End Sub



Private Sub Option2_Click()
Frame2.Enabled = True
Frame1.Enabled = False
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'过界不显示
If X >= 16000 Then
Line1.Visible = False
Line2.Visible = False
Text9.Visible = False
Text10.Visible = False
Else
Line1.Visible = True
Line2.Visible = True
Text9.Visible = True
Text10.Visible = True
End If
'显示横总标尺
Line1.X1 = X
Line1.X2 = X
Line2.Y1 = Y
Line2.Y2 = Y
'日期显示框'价格框
Text9.Left = X

Dim datex As Single
If X <= 16000 Then
'日期框
datex = X \ 160
    If X >= datex * 160 And X <= datex * 160 + 80 Then
    Text9.Text = mydrawdate(datex + 1)
    If Text9.Text = "" Then Text9.Text = "0000/00/00/"
    
    Else
    Text9.Text = "0000/00/00/"
    End If
End If
'价格框
If Y >= 100 And Y <= 6900 Then
Text10.Top = Y - 100
End If
Text10.Text = y_min + (7000 - Y) * (y_max - y_min) / 7000


End Sub

Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Line1.Visible = False
Line2.Visible = False
End Sub

Private Sub Text1_Change()
If Val(Text1.Text) <= 100 Then MsgBox ("爆仓了！！！！！！！")

End Sub

Sub my_draw(X As Single, clsflag As Integer, redorgreenflag As Integer, yelloworblueflag As Integer)
'=======================
'初始化绘图矩阵
Dim i1 As Single
Dim j1 As Single
For i1 = 1 To 100
    mydrawdate(i1) = ""
    For j1 = 1 To 4
    mydraw(i1, j1) = 0
    Next j1
Next i1
For i1 = 0 To 5
    Label9(5 - i1).Caption = 0
Next i1
y_min = 50000
y_max = 0
'=======================
'==========================
'显示当天日期，各种价格
Label10.Caption = "日期：" + Trim(Str(myrecord(mypoint, 3))) + Trim("/") + Trim(Str(myrecord(mypoint, 1))) + Trim("/") + Trim(Str(myrecord(mypoint, 2)))
Label11.Caption = "开盘价：" + Str(myrecord(mypoint, 4))
Label12.Caption = "最高价：" + Str(myrecord(mypoint, 5))
Label13.Caption = "最低价：" + Str(myrecord(mypoint, 6))
Label14.Caption = "收盘价：" + Str(myrecord(mypoint, 7))
Text4.Text = myrecord(mypoint, 7) '显示当日价格
'对当日头寸进行结算
Text1.Text = Text1.Text + Val(myrecord(mypoint, 7) - myrecord(mypoint - 1, 7)) * 10 * Val(Text2.Text) - Val(myrecord(mypoint, 7) - myrecord(mypoint - 1, 7)) * 10 * Val(Text3.Text)

'==================================
'picdata中依次我 开盘 最高 最低 收盘 成交 持仓
'画横坐标虚线
If clsflag = 1 Then Picture1.Cls
Picture1.DrawStyle = 2
Dim i As Single
For i = 1000 To 6000 Step 1000
Picture1.Line (0, i)-(16000, i), vbRed
Next i
Picture1.DrawStyle = 0

'从myrecord中将需要数据读入绘图矩阵
If X <= 100 Then 'x<100情况
    For i = 1 To X
    mydraw(i, 1) = myrecord(i, 4)
    mydraw(i, 2) = myrecord(i, 5)
    mydraw(i, 3) = myrecord(i, 6)
    mydraw(i, 4) = myrecord(i, 7)
    mydrawdate(i) = Trim(Str(myrecord(i, 3)) + Trim("/") + Trim(Str(myrecord(i, 1))) + Trim("/") + Trim(Str(myrecord(i, 2))))
    
    Next i
End If

If X > 100 Then 'x>100情况
    For i = 1 To 100
    mydraw(i, 1) = myrecord(X - 100 + i, 4)
    mydraw(i, 2) = myrecord(X - 100 + i, 5)
    mydraw(i, 3) = myrecord(X - 100 + i, 6)
    mydraw(i, 4) = myrecord(X - 100 + i, 7)
    mydrawdate(i) = Trim(Str(myrecord(X - 100 + i, 3)) + Trim("/") + Trim(Str(myrecord(X - 100 + i, 1))) + Trim("/") + Trim(Str(myrecord(X - 100 + i, 2))))
    Next i
End If

'求绘图矩阵中最大值和最小值
y_max = 0
y_min = 50000

For i = 1 To 100
   If mydraw(i, 2) <> 0 Then
    If mydraw(i, 2) > y_max Then y_max = mydraw(i, 2)
    If mydraw(i, 3) < y_min Then y_min = mydraw(i, 3)
   End If
Next i
'计算比例
bili = 7000 / (y_max - y_min)
'画图(红绿)
Dim myjiange As Single
myjiange = 16000 / 100
If redorgreenflag = 1 Then
For i = 0 To 99
    If mydraw(i + 1, 4) > mydraw(i + 1, 1) Then
    Picture1.Line (myjiange * i, 7000 - (mydraw(i + 1, 1) - y_min) * bili)-(myjiange * i + 80, 7000 - (mydraw(i + 1, 4) - y_min) * bili), vbRed, BF
    Picture1.Line (myjiange * i + 40, 7000 - (mydraw(i + 1, 2) - y_min) * bili)-(myjiange * i + 40, 7000 - (mydraw(i + 1, 3) - y_min) * bili), vbRed
    End If
    If mydraw(i + 1, 4) < mydraw(i + 1, 1) Then
    Picture1.Line (myjiange * i, 7000 - (mydraw(i + 1, 1) - y_min) * bili)-(myjiange * i + 80, 7000 - (mydraw(i + 1, 4) - y_min) * bili), vbGreen, BF
    Picture1.Line (myjiange * i + 40, 7000 - (mydraw(i + 1, 2) - y_min) * bili)-(myjiange * i + 40, 7000 - (mydraw(i + 1, 3) - y_min) * bili), vbGreen
    End If
    If mydraw(i + 1, 4) = mydraw(i + 1, 1) Then
    Picture1.Line (myjiange * i, 7000 - (mydraw(i + 1, 1) - y_min) * bili)-(myjiange * i + 80, 7000 - (mydraw(i + 1, 4) - y_min) * bili), vbWhite, BF
    Picture1.Line (myjiange * i + 40, 7000 - (mydraw(i + 1, 2) - y_min) * bili)-(myjiange * i + 40, 7000 - (mydraw(i + 1, 3) - y_min) * bili), vbWhite
    End If
Next i
End If
'画图(黄蓝）
If yelloworblueflag = 1 Then
For i = 0 To 99
    If mydraw(i + 1, 4) > mydraw(i + 1, 1) Then
    Picture1.Line (myjiange * i, 7000 - (mydraw(i + 1, 1) - y_min) * bili)-(myjiange * i + 80, 7000 - (mydraw(i + 1, 4) - y_min) * bili), vbYellow, BF
    Picture1.Line (myjiange * i + 40, 7000 - (mydraw(i + 1, 2) - y_min) * bili)-(myjiange * i + 40, 7000 - (mydraw(i + 1, 3) - y_min) * bili), vbYellow
    End If
    If mydraw(i + 1, 4) < mydraw(i + 1, 1) Then
    Picture1.Line (myjiange * i, 7000 - (mydraw(i + 1, 1) - y_min) * bili)-(myjiange * i + 80, 7000 - (mydraw(i + 1, 4) - y_min) * bili), vbBlue, BF
    Picture1.Line (myjiange * i + 40, 7000 - (mydraw(i + 1, 2) - y_min) * bili)-(myjiange * i + 40, 7000 - (mydraw(i + 1, 3) - y_min) * bili), vbBlue
    End If
    If mydraw(i + 1, 4) = mydraw(i + 1, 1) Then
    Picture1.Line (myjiange * i, 7000 - (mydraw(i + 1, 1) - y_min) * bili)-(myjiange * i + 80, 7000 - (mydraw(i + 1, 4) - y_min) * bili), vbWhite, BF
    Picture1.Line (myjiange * i + 40, 7000 - (mydraw(i + 1, 2) - y_min) * bili)-(myjiange * i + 40, 7000 - (mydraw(i + 1, 3) - y_min) * bili), vbWhite
    End If
Next i
End If

'显示相应坐标
For i = 0 To 5
    Label9(5 - i).Caption = (i + 1) * (y_max - y_min) / 7 + y_min
Next i
End Sub