frmgu.frm

小巧的个人股票、资金管理系统

            EndProperty
            BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "frmgu.frx":18E5
               Key             =   "First"
            EndProperty
            BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "frmgu.frx":1E39
               Key             =   "Previous"
            EndProperty
            BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "frmgu.frx":1F4D
               Key             =   "Next"
            EndProperty
            BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "frmgu.frx":2061
               Key             =   "Last"
            EndProperty
            BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "frmgu.frx":25B5
               Key             =   "Add"
            EndProperty
            BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "frmgu.frx":2909
               Key             =   "mc"
            EndProperty
         EndProperty
      End
   End
   Begin MSComctlLib.Toolbar Tlbar 
      Height          =   525
      Left            =   0
      TabIndex        =   11
      Top             =   0
      Width           =   7965
      _ExtentX        =   14049
      _ExtentY        =   926
      ButtonWidth     =   609
      ButtonHeight    =   926
      Appearance      =   1
      Style           =   1
      ImageList       =   "ImList"
      _Version        =   393216
      Begin VB.TextBox Text1 
         Height          =   270
         Index           =   6
         Left            =   6000
         TabIndex        =   13
         Text            =   "Text1"
         Top             =   1800
         Width           =   855
      End
      Begin VB.TextBox Text1 
         Height          =   270
         Index           =   3
         Left            =   2520
         TabIndex        =   12
         Text            =   "Text1"
         Top             =   1200
         Width           =   855
      End
   End
   Begin VB.Label Label5 
      BackStyle       =   0  'Transparent
      Caption         =   "预测收益："
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   5520
      TabIndex        =   3
      Top             =   2400
      Width           =   975
   End
End
Attribute VB_Name = "frmgu"
Attribute VB_GlobalNameSpace = False
'Download by http://www.codefans.net
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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 Cmd_Click(Index As Integer)
day.Visible = True
End Sub
Private Sub Command1_Click()
ARViewer1.PrintReport True
End Sub
Private Sub day_DateDblClick(ByVal DateDblClicked As Date)
  day.Visible = False
  txt(8).Text = day.Value
End Sub
Private Sub Form_Load()
frmgu.Left = 2000
frmgu.Top = 250
filename = App.Path & "\股票.mdb"
Set dbs = OpenDatabase(filename)
Set rec = dbs.OpenRecordset("个股购买记录")
d1.DatabaseName = filename
js
js
js
d1.RecordSource = "select * from 个股购买记录"
 Tlbar.Buttons.add 1, "Add", "买入", , "Add"
 Tlbar.Buttons.add 2, "mc", "卖出", , "mc"
 Tlbar.Buttons.add 3, , , tbrSeparator
 Tlbar.Buttons.add 4, "Edit", "修改", , "Edit"
 Tlbar.Buttons.add 5, "Del", "删除", , "Del"
 Tlbar.Buttons.add 6, , , tbrSeparator
 Tlbar.Buttons.add 7, "Save", "保存", , "Save"
 Tlbar.Buttons.add 8, , , tbrSeparator
 Tlbar.Buttons.add 9, "fl", "费率", , "fl"
 Tlbar.Buttons.add 10, , , tbrSeparator
 Tlbar.Buttons.add 11, "zj", "资金", , "zj"
  Tlbar.Buttons.add 12, , , tbrSeparator
 Tlbar.Buttons.add 13, "Exit", "退出", , "Exit"
 Tlbar.Buttons(2).Enabled = False
 Tlbar.Buttons(3).Enabled = False
 Tlbar.Buttons(5).Enabled = False
 txt(3).Enabled = False
 txt(7).Enabled = False
 txt(8).Enabled = False
 hjje
 Sbr.Panels(1).Width = 4000
 Sbr.Panels(1).Text = "当前个股市价总计：" & hj & "元"
 trzjhj
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
Public Sub js()
filename = App.Path & "\股票.mdb"
d1.DatabaseName = filename
Set dbs = OpenDatabase(filename)
Set rec = dbs.OpenRecordset("费率")
fl = Val(rec.Fields(1)) + Val(rec.Fields(2))
dbs.Execute "UPDATE 个股购买记录 SET 费用 = 买入价*" & fl & ", 成本价 = 买入价+费用, 收益 = (当前价-成本价)*数量;" _
            & ""
Set rec = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
   Unload salestone
End Sub
Private Sub grid_DblClick()
If grid.Row = 0 Then Exit Sub
 txt(0).Text = grid.TextMatrix(grid.Row, 1)
 txt(4).Text = grid.TextMatrix(grid.Row, 2)
 txt(1).Text = grid.TextMatrix(grid.Row, 3)
 txt(2).Text = grid.TextMatrix(grid.Row, 4)
 txt(3).Text = grid.TextMatrix(grid.Row, 5)
 txt(5).Text = grid.TextMatrix(grid.Row, 6)
 txt(6).Text = grid.TextMatrix(grid.Row, 7)
 txt(7).Text = grid.TextMatrix(grid.Row, 8)
 txt(8).Text = grid.TextMatrix(grid.Row, 9)
 txt(0).Enabled = False
 txt(1).Enabled = False
 txt(2).Enabled = False
 txt(3).Enabled = False
 txt(4).Enabled = False
 txt(5).Enabled = False
 txt(6).Enabled = False
 txt(7).Enabled = False
 Tlbar.Buttons(3).Enabled = True
 Tlbar.Buttons(2).Enabled = True
  Tlbar.Buttons(4).Enabled = True
End Sub
Private Sub Tlbar_ButtonClick(ByVal Button As MSComctlLib.Button)
 Select Case Button.Key
   Case "Add"
    add
   Case "Save"
    save
   Case "fl"
    frmfl.Show
   d1.Refresh
  Case "Del" '删除
     If txt(0).Text = "" Then Exit Sub
      r = MsgBox("是否确认删除【" & txt(4).Text & "】？(Y/N)", vbQuestion + vbOKCancel + vbDefaultButton1, "个人股票管理")
      If r = 1 Then
          dbs.Execute "DELETE * FROM " _
                      & " [个股购买记录] WHERE ID=" & grid.TextMatrix(grid.Row, 0) & ""
       d1.Refresh
       hjje
       trzjhj
       add
       End If
  Case "Exit"
   Unload Me
  Case "mc"
    sale

     Tlbar.Buttons(4).Enabled = False
     Tlbar.Buttons(5).Enabled = False
     Tlbar.Buttons(6).Enabled = False
     Tlbar.Buttons(7).Enabled = False
  Case "Edit"
   xg1
  Case "zj"
   frmzj.Show
 End Select
End Sub
'添加
Private Sub add()
 txt(0).Enabled = True
 txt(4).Enabled = True
 txt(1).Enabled = True
 txt(5).Enabled = True
 txt(6).Enabled = True
 txt(0).Text = ""
 txt(1).Text = ""
 txt(2).Text = ""
 txt(3).Text = ""
 txt(4).Text = ""
 txt(5).Text = ""
 txt(6).Text = ""
 txt(7).Text = ""
 txt(8).Text = ""
 txt(0).SetFocus
 xg = False
End Sub
'保存
Private Sub save()
d1.DatabaseName = filename
Set rec = dbs.OpenRecordset("个股购买记录")

  If txt(0).Text = "" Or txt(1).Text = "" Or txt(4).Text = "" & _
                   "" Or txt(5).Text = "" Or txt(6).Text = "" & _
                   "" Or txt(8).Text = "" Then
      r = MsgBox("数据不全，保存非法", 0 + 16, "个人股票管理")
      Exit Sub
  End If
  If xg = False Then
     rec.AddNew
     rec.Fields("代号") = txt(0).Text
     rec.Fields("名称") = txt(4).Text
     rec.Fields("买入价") = txt(1).Text
     rec.Fields("费用") = txt(2).Text
     rec.Fields("成本价") = txt(3).Text
     rec.Fields("当前价") = txt(5).Text
     rec.Fields("数量") = txt(6).Text
     rec.Fields("收益") = txt(7).Text
     rec.Fields("购买时间") = txt(8).Text
     rec.Update
     add
   d1.Refresh
   hjje
   Sbr.Panels(1).Text = "当前个股市价总计：" & hj & "元"
   Else
      rec.Index = "PrimaryKey"
      rec.Seek "=", grid.TextMatrix(grid.Row, 0)
      rec.edit
      rec.Fields("代号") = txt(0).Text
      rec.Fields("名称") = txt(4).Text
      rec.Fields("买入价") = txt(1).Text
      rec.Fields("费用") = txt(2).Text
      rec.Fields("成本价") = txt(3).Text
      rec.Fields("当前价") = txt(5).Text
      rec.Fields("数量") = txt(6).Text
      rec.Fields("收益") = txt(7).Text
      rec.Fields("购买时间") = txt(8).Text
      rec.Update
     d1.Refresh
     hjje
     Sbr.Panels(1).Text = "当前个股市价总计：" & hj & "元"
   End If
End Sub
Private Sub txt_Change(Index As Integer)
 Tlbar.Buttons(5).Enabled = True
 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(txt(6).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
Private Sub xg1()
 xg = True
 txt(0).Enabled = True
 txt(1).Enabled = True
 txt(2).Enabled = True
 txt(4).Enabled = True
 txt(3).Enabled = True
 txt(5).Enabled = True
 txt(6).Enabled = True
 txt(7).Enabled = True
 txt(8).Enabled = True
End Sub
Private Sub sale()
   Set reczj = dbs.OpenRecordset("投入资金明细")
   Set zj = dbs.OpenRecordset("资金")
   If txt(0).Text = "" Or txt(1).Text = "" Or txt(4).Text = "" & _
                   "" Or txt(5).Text = "" Or txt(6).Text = "" & _
                   "" Or txt(8).Text = "" Then
      r = MsgBox("请选择卖出股票，或数据不完整！", 0 + 16, "个人股票管理")
      Exit Sub
  End If
   If txt(0).Text = "" Then Exit Sub
       salestone.Show
       salestone.frm2.Caption = "股票【" & frmgu.grid.TextMatrix(grid.Row, 2) & "】资料，请输入你要卖的数量？"
       salestone.txt(0).Text = frmgu.grid.TextMatrix(grid.Row, 1)
       salestone.txt(1).Text = frmgu.grid.TextMatrix(grid.Row, 3)
       salestone.txt(2).Text = frmgu.grid.TextMatrix(grid.Row, 4)
       salestone.txt(3).Text = frmgu.grid.TextMatrix(grid.Row, 5)
       salestone.txt(4).Text = frmgu.grid.TextMatrix(grid.Row, 2)
       salestone.txt(5).Text = frmgu.grid.TextMatrix(grid.Row, 6)
       salestone.txt(8).Text = Date
       salestone.txt(0).Enabled = False
       salestone.txt(1).Enabled = False
       salestone.txt(2).Enabled = False
       salestone.txt(3).Enabled = False
       salestone.txt(4).Enabled = False
       salestone.txt(5).Enabled = False
       salestone.txt(8).Enabled = False
       salestone.txtsl.SetFocus
  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