📄 cts.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form cts
AutoRedraw = -1 'True
ClientHeight = 3675
ClientLeft = 4860
ClientTop = 3930
ClientWidth = 9315
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3675
ScaleWidth = 9315
Begin VB.TextBox Acashtype
Height = 270
Left = 7560
TabIndex = 18
Top = 1800
Visible = 0 'False
Width = 1335
End
Begin VB.TextBox Acashname
Height = 270
Left = 7680
TabIndex = 17
Top = 2415
Width = 1095
End
Begin VB.TextBox Aabbrname
Height = 270
Left = 7680
TabIndex = 16
Top = 2895
Width = 1095
End
Begin VB.CommandButton exhh
Caption = "exit"
Height = 375
Left = 7920
TabIndex = 15
Top = 1080
Width = 855
End
Begin VB.CommandButton okModify
Caption = "ok Modify"
Height = 375
Left = 6480
TabIndex = 14
Top = 1080
Width = 975
End
Begin MSFlexGridLib.MSFlexGrid MSFGType
Height = 2295
Left = 2880
TabIndex = 13
Top = 1200
Width = 3255
_ExtentX = 5741
_ExtentY = 4048
_Version = 393216
Cols = 3
SelectionMode = 1
FormatString = ""
End
Begin VB.CommandButton ex
Caption = "exit"
Height = 255
Left = 1560
TabIndex = 10
Top = 3240
Width = 975
End
Begin VB.CommandButton savenew
Caption = "Save"
Height = 255
Left = 240
TabIndex = 9
Top = 3240
Width = 975
End
Begin VB.TextBox cashamount
Height = 270
Left = 1320
TabIndex = 8
Top = 2760
Width = 1095
End
Begin VB.TextBox ABBRNAME
Height = 270
Left = 1440
TabIndex = 6
Top = 2160
Width = 1095
End
Begin VB.TextBox CASHNAME
Height = 270
Left = 1440
TabIndex = 4
Top = 1680
Width = 1095
End
Begin VB.TextBox CASHTYPE
Height = 270
Left = 1320
TabIndex = 2
Top = 1065
Visible = 0 'False
Width = 1335
End
Begin VB.Label Label10
Caption = "No:"
Height = 255
Left = 6480
TabIndex = 21
Top = 1815
Visible = 0 'False
Width = 375
End
Begin VB.Label Label9
Caption = "Name:"
Height = 255
Left = 6360
TabIndex = 20
Top = 2415
Width = 615
End
Begin VB.Label Label8
Caption = "Abbr:"
Height = 255
Left = 6360
TabIndex = 19
Top = 2895
Width = 615
End
Begin VB.Label Label7
Alignment = 2 'Center
Caption = "Operation"
Height = 375
Left = 6960
TabIndex = 12
Top = 360
Width = 2175
End
Begin VB.Label Label6
Alignment = 2 'Center
Caption = "Type list"
Height = 255
Left = 3000
TabIndex = 11
Top = 360
Width = 2895
End
Begin VB.Label Label5
Caption = "ReAmount:"
Height = 255
Left = 120
TabIndex = 7
Top = 2760
Width = 855
End
Begin VB.Label Label4
Caption = "Abbr:"
Height = 255
Left = 120
TabIndex = 5
Top = 2160
Width = 615
End
Begin VB.Label Label3
Caption = "Name:"
Height = 255
Left = 120
TabIndex = 3
Top = 1680
Width = 615
End
Begin VB.Label Label2
Caption = "No:"
Height = 255
Left = 240
TabIndex = 1
Top = 1080
Visible = 0 'False
Width = 375
End
Begin VB.Label Label1
Caption = "Initail Cash Type"
Height = 255
Left = 600
TabIndex = 0
Top = 480
Width = 1575
End
End
Attribute VB_Name = "cts"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cashamount_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 48 To 57 '0-9,這裏還可以限制只能輸入哪幾個數字
Exit Sub
Case 8 '退格鍵
Exit Sub
Case 46 ' .键 Delete鍵
If InStr(cashamount, ".") = 0 Then
Exit Sub
Else
KeyAscii = 0
End If
Case 45
If InStr(cashamount, "-") = 0 Or InStr(cashamount, "-") = 1 Then
Exit Sub
Else
KeyAscii = 0
End If
Case Else
KeyAscii = 0
End Select
End Sub
'
'首先肯定是建立数据库(设置数据库名和密码,要将数据库文件和VB中创建的工程文件放在同一目录下。)
'2:呵呵~~你要知道的关键的问题:如何连接Access数据库(方法有:数据控件、数据对象、数据环境设计器等)我都不想写得详细拉.(楼主你想知道多一点加我Q:413237613)
'你可以参考一下我在网站查找到相关的资料啊.看看对你有没帮助啊:再不明白加我Q拉.
'1 ?使用控件
'
'① Data控件
'
'Data控件是Visual Basic 6.0中的一个内置数据控件，可以通过设置Data控件的connect、DatabaseName、RecordSource属性实现对数据库的连接和访问。 通过Data控件连接加密的数据库的方法有两种：
'
'一种方法是在设计状态时，在“属性窗口”中将Data控件的connect属性的缺省值”Access”改为”; pwd=1234”即可，其它属性的设置方法与没有加密的Access数据库的连接相同。
'
'另一种方法是在运行时，通过代码对connect属性赋值来实现。如：
'
'Data1.connect=”; pwd=1234”
'
'Data1.DatabaseName=APP.path + “\ssgl.mdb”
'
'其中，”1234”为Access数据库文件ssgl.mdb的密码，下同。
'
'②Adodc控件
'
'Adodc控件是一个ActiveX控件，它使用Microsoft ActiveX Data Objects(ADO)创建到数据库的连接。使用Adodc控件之前，要先将Adodc控件添加到控件工具箱中。方法如下：在VB 6.0种选择“工程”菜单，再点击“部件”菜单项，在弹出的“部件”对话框中选中“Microsoft ADO Data Control 6.0(OLEDB)”选项即可。
'
'通过Adodc控件连接加密的数据库的方法也有两种:
'
'一种方法是在设计状态时，在“属性窗口”中，对Adodc控件的ConnectionString属性设置一个有效的连接字符串，并在连接字符串后增加上”; Jet OLEDB: DataBase password=1234”，再设置Adodc控件的CommandType、RecordSource的属性就可以创建到加密的数据库的连接了。
'
'另一种方法是在运行时，通过代码动态地设置ConnectionString、CommandType和RecordSource属性来创建连接。 只要在ConnectionString属性的有效连接字符串后增加上”; Jet OLEDB: DataBase password=1234”即可。
'
'2 ?使用数据对象
'
'① DAO数据对象
'
'要能正确引用DAO数据对象来建立与数据库的连接，应先在VB集成开发环境中选择“工程”菜单，再点击“引用”菜单项，在弹出的“引用”对话框选择“Microsoft DAO 3.51 Object Library”选项来添加DAO数据对象类型库。
'
'接下来就可用如下代码来建立到加密的Access数据库ssgl.mdb的连接?
'
'Dim db As Database
'
'Set db=OpenDataBase(App.path + “\ssgl.mdb” , False , False , ” ; pwd=1234”)
'
'② ADO数据对象
'
'ADO是Microsoft推出的处理关系数据库和非关系数据库中信息的最新技术，也是Microsoft推崇的用于数据连接和访问的技术。在VB 6.0中，Adodc控件、ADO数据对象及DataEnvironment（数据环境设计器）都采用的是ADO技术，因而它们处理加密的Access数据库的方法类似。
'
'要能正确引用ADO数据对象，应在VB 6.0集成开发环境中选择“工程”菜单，再点击“引用”菜单项，在弹出的“引用”对话框中选中“Microsoft ActiveX Data Objects 2.1 Library”选项来添加ADO数据对象类型库。
'
'可用如下代码来建立到加密的Access数据库ssgl.mdb的连接?
'
'Dim cnn As ADODB.Connection
'
'Dim rst As ADODB.Recordset
'
'Set cnn = New ADODB.Connection
'
'Cnn.Provider= ”Microsoft.Jet.OLEDB.3.51”
'
'Cnn.ConnectionString= ”Data Source=” & App.path & ”\ssgl.mdb;” & _
'
'” ;Jet OLEDB:Database password=1234”
'
'cnn.Open
'
'③ 使用DataEnvironment(数据环境设计器)
'
'有两种方法可以通过DataEnvironment连接到加密的Access数据库:
'
'一种方法是在设计状态时，在DataEnvironment的connection对象的ConnectionSource属性的有效连接字符串后加上” ;
'
'Jet OLEDB: Database password=1234”
'
'另一种方法是在DataEnvironment_Initialize()事件中编写如下代码：
'
'Private Sub DataEnvironment_Initialize()
'
'Dim strconn As String
'
'Strconn=” Provider=Microsoft.Jet.OLEDB.3.51;” & _
'
'”Data Source=” & App.path & “\ssgl.mdb;” & _
'
'”; Jet OLEDB: Database password=1234”
'
'DataEnvironment1.connection1.connectionstring = strconn
'
'End Sub
'不知道你看得明不明白啊?^_^
Private Sub ex_Click()
Unload Me
End Sub
Private Sub exhh_Click()
Unload Me
End Sub
Private Sub Form_Load()
CASHNAME.Text = ""
ABBRNAME.Text = ""
Acashname.Text = ""
Aabbrname.Text = ""
Acashname.Enabled = False
Aabbrname.Enabled = False
Dim inttype As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = DAO.OpenDatabase(App.Path + "\cashsys.mdb") ', False , False , " ; pwd=1234")
Set rs = db.OpenRecordset("select max(cashtype) as type from cashtype")
If IsNull(rs("type")) Then
inttype = 1
Else
inttype = rs("type") + 1
End If
Cashtype.Text = inttype
Call fillgrid
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
okModify.Enabled = False
cashamount.Text = 0
End Sub
Private Sub MSFGType_Click()
MSFGType.Col = 0
Acashtype.Text = MSFGType.Text
MSFGType.Col = 1
Acashname.Text = MSFGType.Text
MSFGType.Col = 2
Aabbrname.Text = MSFGType.Text
Acashname.Enabled = True
Aabbrname.Enabled = True
okModify.Enabled = True
Acashname.SetFocus
End Sub
Private Sub fillgrid()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = DAO.OpenDatabase(App.Path + "\cashsys.mdb")
Set rs = db.OpenRecordset("SELECT CASHTYPE.ID, CASHTYPE.CASHTYPE, CASHTYPE.CASHNAME, CASHTYPE.ABBRNAME FROM CASHTYPE ORDER BY CASHTYPE.ID ")
MSFGType.FormatString = "TYPE ID| CASH NAME | ABBRNAME"
MSFGType.Rows = 1
Do While Not rs.EOF
MSFGType.Rows = MSFGType.Rows + 1
MSFGType.Row = MSFGType.Rows - 1
MSFGType.Col = 0
MSFGType.Text = Str(rs("CASHTYPE"))
MSFGType.Col = 1
MSFGType.Text = rs("CASHNAME")
MSFGType.Col = 2
MSFGType.Text = rs("ABBRNAME")
rs.MoveNext
Loop
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Sub
Private Sub okModify_Click()
On Error GoTo Err_modify_Click
Dim db As DAO.Database
Dim rs As DAO.Recordset
If Trim(Acashname.Text) = "" Then
MsgBox "pls select"
Acashname.SetFocus
Exit Sub
End If
Set db = DAO.OpenDatabase(App.Path + "\cashsys.mdb")
Set rs = db.OpenRecordset("select cashtype,cashname,abbrname from cashtype where cashtype=" + Acashtype)
rs.Edit
rs("cashname") = Acashname.Text
rs("abbrname") = Aabbrname.Text
rs.Update
Call fillgrid
Acashtype.Text = ""
Acashname.Text = ""
Aabbrname.Text = ""
MsgBox "modify success!"
Acashname.Enabled = False
Aabbrname.Enabled = False
CASHNAME.SetFocus
okModify.Enabled = False
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
Exit_modify_Click:
Exit Sub
Err_modify_Click:
MsgBox Err.Description
Resume Exit_modify_Click
End Sub
Private Sub savenew_Click()
On Error GoTo Err_SAVETYPE_Click
Dim db As DAO.Database
Dim rs As DAO.Recordset
If Trim(CASHNAME.Text) = "" Then
MsgBox "pls Cash Name"
CASHNAME.SetFocus
Exit Sub
End If
If Trim(cashamount.Text) = "" Then
MsgBox "pls Initial Amount"
cashamount.SetFocus
Exit Sub
End If
If Val(cashamount) < 0 Then
If MsgBox(" Initial Amount is 0 ? ", vbYesNo, "info") = vbNo Then
cashamount.SetFocus
Exit Sub
End If
End If
Set db = DAO.OpenDatabase(App.Path + "\cashsys.mdb")
Set rs = db.OpenRecordset("select cashname as type from cashtype where cashname='" + Trim(CASHNAME.Text) + "'")
If rs.EOF = False Then
CASHNAME.SetFocus
MsgBox "repeat!"
Exit Sub
End If
db.Execute "insert into cashtype (cashtype,cashname,abbrname) values (" + Trim(Cashtype.Text) + ",'" + CASHNAME.Text + "','" + ABBRNAME.Text + "')"
db.Execute " insert into cash (operdate,opertype,person,brief,cashtype,amount,remainamount,operator) " & _
"values ('" + Trim(Year(Now)) + "-" + Right("0" + Trim(Month(Now)), 2) + "-" + Right("0" + Trim(Day(Now)), 2) + "',2,'','initial'," + Trim(Cashtype.Text) + ",0," + Trim(cashamount.Text) + ",' ' )"
cashamount.Text = 0
MSFGType.Clear
Call fillgrid
CASHNAME.Text = ""
ABBRNAME.Text = ""
Set rs = db.OpenRecordset("select max(cashtype) as type from cashtype")
Cashtype.Text = rs("type") + 1
CASHNAME.SetFocus
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
Exit_SAVETYPE_Click:
Exit Sub
Err_SAVETYPE_Click:
MsgBox Err.Description
Resume Exit_SAVETYPE_Click
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -