📄 sale.frm
字号:
VERSION 5.00
Begin VB.Form salestone
BackColor = &H0080C0FF&
BorderStyle = 0 'None
ClientHeight = 2085
ClientLeft = 0
ClientTop = 0
ClientWidth = 7875
Icon = "sale.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 2085
ScaleWidth = 7875
ShowInTaskbar = 0 'False
Begin VB.TextBox txt
Alignment = 1 'Right Justify
Height = 270
Index = 7
Left = 6360
TabIndex = 19
Top = 1680
Width = 975
End
Begin VB.CommandButton CmdNO
Caption = "撤消"
Height = 375
Left = 4200
Picture = "sale.frx":0442
Style = 1 'Graphical
TabIndex = 17
Top = 1680
Width = 615
End
Begin VB.CommandButton CmdOK
Caption = "卖出"
Default = -1 'True
Height = 375
Left = 2400
Picture = "sale.frx":074C
Style = 1 'Graphical
TabIndex = 16
Top = 1680
Width = 735
End
Begin VB.Frame frm2
BackColor = &H0080C0FF&
ForeColor = &H000000FF&
Height = 1455
Left = 120
TabIndex = 0
Top = 120
Width = 7695
Begin VB.TextBox txtsl
Height = 270
Left = 4440
TabIndex = 18
Top = 1080
Width = 855
End
Begin VB.TextBox txt
Alignment = 1 'Right Justify
Height = 270
Index = 0
Left = 840
TabIndex = 7
Top = 360
Width = 975
End
Begin VB.TextBox txt
Alignment = 1 'Right Justify
Height = 270
Index = 1
Left = 2640
TabIndex = 6
Top = 360
Width = 975
End
Begin VB.TextBox txt
Alignment = 1 'Right Justify
Height = 270
Index = 2
Left = 4440
TabIndex = 5
Top = 360
Width = 855
End
Begin VB.TextBox txt
Alignment = 1 'Right Justify
Height = 270
Index = 3
Left = 6240
TabIndex = 4
Top = 360
Width = 975
End
Begin VB.TextBox txt
Alignment = 1 'Right Justify
Height = 270
Index = 4
Left = 840
TabIndex = 3
Top = 1080
Width = 975
End
Begin VB.TextBox txt
Alignment = 1 'Right Justify
ForeColor = &H00000000&
Height = 270
Index = 8
Left = 6240
TabIndex = 2
Top = 1080
Width = 975
End
Begin VB.TextBox txt
Alignment = 1 'Right Justify
Height = 270
Index = 5
Left = 2640
TabIndex = 1
Top = 1080
Width = 975
End
Begin VB.Label lbdh
BackStyle = 0 'Transparent
Caption = "代号："
ForeColor = &H00FF0000&
Height = 255
Left = 240
TabIndex = 15
Top = 360
Width = 735
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "名称："
ForeColor = &H00FF0000&
Height = 375
Left = 240
TabIndex = 14
Top = 1080
Width = 615
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "购买价："
ForeColor = &H00FF0000&
Height = 375
Left = 1920
TabIndex = 13
Top = 360
Width = 1215
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "费用："
ForeColor = &H00FF0000&
Height = 375
Left = 3720
TabIndex = 12
Top = 360
Width = 735
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "成本价："
ForeColor = &H00FF0000&
Height = 255
Left = 5520
TabIndex = 11
Top = 360
Width = 975
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
Caption = "卖出数量"
ForeColor = &H00FF0000&
Height = 375
Left = 3720
TabIndex = 10
Top = 1080
Width = 735
End
Begin VB.Label Label7
BackStyle = 0 'Transparent
Caption = "当前价："
ForeColor = &H00FF0000&
Height = 255
Left = 1920
TabIndex = 9
Top = 1080
Width = 855
End
Begin VB.Label Label8
BackStyle = 0 'Transparent
Caption = "卖出时间："
ForeColor = &H00FF0000&
Height = 255
Left = 5400
TabIndex = 8
Top = 1080
Width = 975
End
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "预测收益："
ForeColor = &H00FF0000&
Height = 375
Left = 5520
TabIndex = 20
Top = 1680
Width = 975
End
End
Attribute VB_Name = "salestone"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Download by http://www.codefans.net
Public dbs As Database
Public rec As Recordset
Public xg As Boolean
Public fl As Double
Public filename As String
Public reczj As Recordset
Public hj As Integer
Public gpzj As Double
Public zj As Recordset
Private Sub CmdNO_Click()
Unload Me
frmgu.Tlbar.Buttons(4).Enabled = True
frmgu.Tlbar.Buttons(5).Enabled = True
frmgu.Tlbar.Buttons(6).Enabled = True
frmgu.Tlbar.Buttons(7).Enabled = True
End Sub
Private Sub CmdOK_Click()
Dim sqlupdate As String
Dim recls As Recordset
Set reczj = dbs.OpenRecordset("投入资金明细")
Set zj = dbs.OpenRecordset("资金")
Set recls = dbs.OpenRecordset("股票卖出历史")
If Right(salestone.txtsl.Text, 1) <> 0 Or Right(salestone.txtsl.Text, 2) <> 0 Or Val(salestone.txtsl) = 0 Then
r = MsgBox("你输入的数量必须为一手及100的倍数！", 0 + 16, "个人股票管理")
txtsl.Text = ""
Exit Sub
End If
r = MsgBox("是否确认卖出【" & txt(4).Text & "】" + Chr(13) + "损益金额:" & txt(7).Text & "(Y/N)？", vbQuestion + vbOKCancel + vbDefaultButton1, "个人股票管理")
If r = 1 Then
sqlupdate = "update 个股购买记录" _
& " set 数量= 数量-" & txtsl.Text & "" _
& " WHERE ID =" & frmgu.grid.TextMatrix(frmgu.grid.Row, 0) & ";"
dbs.Execute sqlupdate
If Val(txtsl.Text) = Val(frmgu.txt(6).Text) Then
dbs.Execute "DELETE * from [个股购买记录] " _
& " WHERE ID =" & frmgu.grid.TextMatrix(frmgu.grid.Row, 0) & ";"
End If
If Val(txt(7).Text) <> 0 Then
reczj.AddNew
reczj.Fields("时间") = txt(8).Text
If Val(txt(7).Text) < 0 Then
reczj.Fields("方式") = "亏损"
Else
reczj.Fields("方式") = "赢利"
End If
reczj.Fields("资金量") = Val(txt(7).Text)
reczj.Update
End If
frmgu.d1.Refresh
hjje
trzjhj
r = MsgBox("卖出股票成功！", 0 + 48, "个人股票管理")
recls.AddNew
recls.Fields("代号") = txt(0).Text
recls.Fields("名称") = txt(4).Text
recls.Fields("买入价") = txt(1).Text
recls.Fields("费用") = txt(2).Text
recls.Fields("成本价") = txt(3).Text
recls.Fields("当前价") = txt(5).Text
recls.Fields("数量") = txtsl.Text
recls.Fields("收益") = txt(7).Text
recls.Fields("购买时间") = frmgu.txt(8).Text
recls.Fields("卖出时间") = txt(8).Text
recls.Update
Unload Me
Unload frmgu
frmgu.Show
frmgu.txt(0).Text = ""
frmgu.txt(1).Text = ""
frmgu.txt(2).Text = ""
frmgu.txt(3).Text = ""
frmgu.txt(4).Text = ""
frmgu.txt(5).Text = ""
frmgu.txt(6).Text = ""
frmgu.txt(7).Text = ""
frmgu.txt(8).Text = ""
Else
Exit Sub
End If
End Sub
Private Sub Form_Load()
salestone.Left = 2020
salestone.Top = 1260
Dim recfl As Recordset
filename = App.Path & "\股票.mdb"
Set dbs = OpenDatabase(filename)
Set rec = dbs.OpenRecordset("个股购买记录")
Set recfl = dbs.OpenRecordset("费率")
fl = Val(recfl.Fields(1)) + Val(recfl.Fields(2))
End Sub
Private Sub txtsl_Change()
If Val(salestone.txtsl.Text) > Val(frmgu.txt(6).Text) Then
r = MsgBox("你输入的数量超过该股票的现存量！", 0 + 16, "个人股票管理")
txtsl.Text = ""
Exit Sub
End If
txt(2).Text = (Val(txt(1)) + Val(txt(5).Text)) * fl
txt(3).Text = Val(txt(1)) + Val(txt(2).Text)
txt(7).Text = (Val(txt(5).Text) - Val(txt(3).Text)) * Val(txtsl.Text)
If Val(txt(7).Text) >= 0 Then
txt(7).ForeColor = &HFF&
Else
Val (txt(7).Text) < 0
txt(7).ForeColor = &HC000&
End If
End Sub
Public Sub trzjhj()
filename = App.Path & "\股票.mdb"
Set dbs = OpenDatabase(filename)
Set reczj = dbs.OpenRecordset("资金")
reczj.edit
reczj.Fields("股票市值") = hj
reczj.Fields("购股金额") = gpzj
reczj.Fields("损益金额") = hj - gpzj
reczj.Update
End Sub
Private Sub hjje()
filename = App.Path & "\股票.mdb"
Set dbs = OpenDatabase(filename)
Set rec = dbs.OpenRecordset("个股购买记录")
hj = 0
gpzj = 0
Do While Not rec.EOF
hj = hj + rec.Fields("当前价") * rec.Fields("数量")
gpzj = gpzj + rec.Fields("买入价") * rec.Fields("数量")
rec.MoveNext
Loop
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -