家庭/个人应用

开发平台：
Visual Basic

frm_borrowgo.frm：源码内容
							VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx"
Begin VB.Form frm_borrowgo 
   Caption         =   "借出款"
   ClientHeight    =   4065
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5055
   Icon            =   "frm_borrowgo.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4065
   ScaleWidth      =   5055
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Cmdsave 
      Caption         =   "保存"
      Height          =   300
      Left            =   2400
      TabIndex        =   23
      Top             =   3120
      Width           =   735
   End
   Begin VB.CommandButton Command4 
      Caption         =   "末条"
      Height          =   300
      Left            =   3360
      TabIndex        =   19
      Top             =   3600
      Width           =   735
   End
   Begin VB.CommandButton Command3 
      Caption         =   "下一条"
      Height          =   300
      Left            =   2640
      TabIndex        =   18
      Top             =   3600
      Width           =   735
   End
   Begin VB.CommandButton Command2 
      Caption         =   "上一条"
      Height          =   300
      Left            =   1920
      TabIndex        =   17
      Top             =   3600
      Width           =   735
   End
   Begin VB.CommandButton Command1 
      Caption         =   "首条"
      Height          =   300
      Left            =   1200
      TabIndex        =   16
      Top             =   3600
      Width           =   735
   End
   Begin VB.CheckBox Check1 
      Caption         =   "已还"
      Height          =   255
      Left            =   960
      TabIndex        =   15
      Top             =   2640
      Width           =   1095
   End
   Begin VB.CommandButton cmd_close 
      Caption         =   "关闭"
      Height          =   300
      Left            =   3840
      TabIndex        =   14
      Top             =   3120
      Width           =   735
   End
   Begin VB.CommandButton cmd_del 
      Caption         =   "删除"
      Height          =   300
      Left            =   3120
      TabIndex        =   13
      Top             =   3120
      Width           =   735
   End
   Begin VB.CommandButton cmd_edit 
      Caption         =   "修改"
      Height          =   300
      Left            =   1680
      TabIndex        =   12
      Top             =   3120
      Width           =   735
   End
   Begin VB.CommandButton cmd_add 
      Caption         =   "添加"
      Height          =   300
      Left            =   960
      TabIndex        =   11
      Top             =   3120
      Width           =   735
   End
   Begin VB.Frame Frame1 
      Height          =   2175
      Left            =   0
      TabIndex        =   0
      Top             =   360
      Width           =   5055
      Begin VB.ComboBox Combo1 
         Height          =   300
         Left            =   960
         TabIndex        =   5
         Top             =   720
         Width           =   1215
      End
      Begin VB.TextBox txt_money 
         Height          =   300
         Left            =   3360
         TabIndex        =   4
         Top             =   240
         Width           =   1335
      End
      Begin VB.TextBox txt_man 
         Height          =   300
         Left            =   960
         TabIndex        =   3
         Top             =   240
         Width           =   1215
      End
      Begin VB.TextBox txt_way 
         Height          =   735
         Left            =   960
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   1
         Top             =   1200
         Width           =   3735
      End
      Begin MSComCtl2.DTPicker DTPicker1 
         Height          =   300
         Left            =   3360
         TabIndex        =   2
         Top             =   720
         Width           =   1335
         _ExtentX        =   2355
         _ExtentY        =   529
         _Version        =   393216
         Format          =   25362433
         CurrentDate     =   37819
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "得款人："
         Height          =   255
         Left            =   120
         TabIndex        =   10
         Top             =   240
         Width           =   855
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "借款金额："
         Height          =   255
         Left            =   2400
         TabIndex        =   9
         Top             =   240
         Width           =   975
      End
      Begin VB.Label Label4 
         BackStyle       =   0  'Transparent
         Caption         =   "出借人："
         Height          =   255
         Left            =   120
         TabIndex        =   8
         Top             =   720
         Width           =   855
      End
      Begin VB.Label Label5 
         BackStyle       =   0  'Transparent
         Caption         =   "借款日期："
         Height          =   255
         Left            =   2400
         TabIndex        =   7
         Top             =   720
         Width           =   1095
      End
      Begin VB.Label Label6 
         BackStyle       =   0  'Transparent
         Caption         =   "借款原因："
         Height          =   255
         Left            =   120
         TabIndex        =   6
         Top             =   1200
         Width           =   1095
      End
   End
   Begin VB.Label Label8 
      BackStyle       =   0  'Transparent
      Caption         =   "记录"
      Height          =   255
      Left            =   1560
      TabIndex        =   22
      Top             =   120
      Width           =   495
   End
   Begin VB.Label Label7 
      BackStyle       =   0  'Transparent
      Height          =   255
      Left            =   1200
      TabIndex        =   21
      Top             =   120
      Width           =   615
   End
   Begin VB.Label Label3 
      BackStyle       =   0  'Transparent
      Caption         =   "当前共有："
      Height          =   255
      Left            =   240
      TabIndex        =   20
      Top             =   120
      Width           =   975
   End
End
Attribute VB_Name = "frm_borrowgo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Mydb As New ADODB.Recordset
Dim Mydb1 As New ADODB.Recordset
Dim Str_text As String
Dim strflag As String
Private Sub cmd_add_Click()
    txt_man.Locked = False
    txt_way.Locked = False
    txt_money.Locked = False
    Combo1.Locked = False
    Check1.Enabled = True
    DTPicker1.Enabled = True
    txt_man.Text = ""
    txt_way.Text = ""
    txt_money.Text = ""
    Combo1.Text = ""
    strflag = "添加"
    Cmdsave.Enabled = True
End Sub
Private Sub cmd_close_Click()
    Unload Me
End Sub
Private Sub cmd_del_Click()
    Dim A As Boolean
    A = MsgBox("是否真的要删除这条记录？", vbOKCancel + 32 + 256, "删除")
    If A = True Then
        ExeCutesql "delete from 借出 where 得款人='" & txt_man.Text & "'", Str_text
        MsgBox "记录已删除！", , "删除"
        If Mydb.RecordCount > 0 Then
            Mydb.MoveNext
            If Mydb.EOF Then Mydb.MoveLast
            Call Db
            Call Bangding
            Label7.Caption = Mydb.RecordCount
        End If
    End If
End Sub
Private Sub cmd_edit_Click()
    On Error Resume Next
    Dim A As Boolean
    txt_man.Locked = False
    txt_way.Locked = False
    txt_money.Locked = False
    Combo1.Locked = False
    Check1.Enabled = True
    DTPicker1.Enabled = True
    strflag = "修改"
    Cmdsave.Enabled = True
End Sub
Private Sub Cmdsave_Click()
    On Error Resume Next
    Dim A As Boolean
    If strflag = "添加" Then
        A = MsgBox("是否添加前记录？", vbYesNo + 32, "添加记录")
        If A = True Then
            ExeCutesql "insert into 借出 values('" & txt_man.Text & "','" & txt_money.Text & "','" & Combo1.Text & "','" & DTPicker1.Value & "','" & txt_way.Text & "','" & Check1.Value & "')", Str_text
            MsgBox "数据已经保存！", vbOKOnly + 64, "成功"
            Call Db
            Label7.Caption = Mydb.RecordCount
        End If
    ElseIf strflag = "修改" Then
        A = MsgBox("是否修改前记录？", vbYesNo + 32, "添加记录")
        If A = True Then
            Mydb.Update
            'Mydb.Requery
            Call Db
            MsgBox "数据修改成功！", vbOKOnly + 64, "成功"
        End If
    End If
    Cmdsave.Enabled = False
    txt_man.Locked = True
    txt_way.Locked = True
    txt_money.Locked = True
    Combo1.Locked = True
    Check1.Enabled = False
    DTPicker1.Enabled = False
End Sub
Private Sub Combo1_Change()
    Dim A As Integer
    Set Mydb1 = ExeCutesql("select 姓名 from 成员", Str_text)
'    Set Combo1.DataSource = Mydb1
    A = Mydb1.RecordCount
    For I = 1 To A
        Combo1.AddItem Mydb1.Fields(0)
        Mydb1.MoveNext
        If Mydb1.EOF Then Exit For
    Next I
End Sub
Private Sub Command1_Click()
    On Error Resume Next
    'Call Db
    Mydb.MoveFirst
    Call Bangding
End Sub
Private Sub Command2_Click()
    On Error Resume Next
    'Call Db
    'If Not Mydb.BOF Then Mydb.MovePrevious
    Mydb.MovePrevious
    If Mydb.BOF Then
        MsgBox "这已经是第一条记录了！", vbOKOnly + 32, "注意"
        Mydb.MoveFirst
    End If
    Call Bangding
End Sub
Private Sub Command3_Click()
    On Error Resume Next
    'Call Db
    'Mydb.MovePrevious
    'If Mydb.BOF Then
    '   MsgBox "这已经是第一条记录了！", vbOKOnly + 32, "注意"
    '   Mydb.MoveFirst
    'End If
    Mydb.MoveNext
    If Mydb.EOF Then
        MsgBox "这已经是最后一条记录了！", vbOKOnly + 32, "注意"
        Mydb.MoveLast
    End If
    Call Bangding
End Sub
Private Sub Command4_Click()
    On Error Resume Next
    'Call Db
    Mydb.MoveLast
    Call Bangding
End Sub
Private Sub Form_Load()
    On Error Resume Next
    'Set Mydb = ExeCutesql("select * from 借出", Str_text)
    Call Db
    'Call Bangding
    Check1.Value = 0
    Label7.Caption = Mydb.RecordCount
    DTPicker1.Value = Date
    Cmdsave.Enabled = False
    txt_man.Locked = True
    txt_way.Locked = True
    txt_money.Locked = True
    Combo1.Locked = True
    Check1.Enabled = False
    DTPicker1.Enabled = False
End Sub
Private Function Db()
    On Error Resume Next
    Set Mydb = ExeCutesql("select * from 借出", Str_text)
End Function
Private Function Bangding()
    On Error Resume Next
    Set txt_man.DataSource = Mydb
    Set txt_money.DataSource = Mydb
    Set DTPicker1.DataSource = Mydb
    Set txt_way.DataSource = Mydb
    Set Check1.DataSource = Mydb
    txt_man.DataField = "得款人"
    txt_money.DataField = "金额"
    DTPicker1.Value = "日期"
    txt_way.DataField = "借款原因"
    Check1.DataField = "已还"
    Set Combo1.DataSource = Mydb
    Combo1.DataField = "出借人"
End Function

						