www.pudn.com > 档案管理系统源码VB.zip > frmModifyGuest.frm
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmModifyGuest
AutoRedraw = -1 'True
BackColor = &H00C0C0C0&
BorderStyle = 3 'Fixed Dialog
Caption = "修改客户档案信息："
ClientHeight = 5715
ClientLeft = 45
ClientTop = 330
ClientWidth = 9120
Icon = "frmModifyGuest.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 5715
ScaleWidth = 9120
ShowInTaskbar = 0 'False
Begin VB.CommandButton ExitB
Cancel = -1 'True
Caption = "关 闭(&C)"
Height = 450
Left = 7515
TabIndex = 16
Top = 1440
Width = 1380
End
Begin VB.CommandButton SaveRecord
Caption = "保 存(&S)"
Enabled = 0 'False
Height = 420
Left = 7515
TabIndex = 13
Top = 180
Width = 1380
End
Begin VB.CommandButton Command2
Caption = "修 改(&M)"
Height = 420
Left = 7515
TabIndex = 15
Top = 1020
Width = 1380
End
Begin VB.CommandButton CancelRecord
Caption = "取 消(&M)"
Enabled = 0 'False
Height = 420
Left = 7515
TabIndex = 14
Top = 600
Width = 1380
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
BackColor = &H00404000&
Height = 1410
Left = 4425
ScaleHeight = 1350
ScaleWidth = 2700
TabIndex = 25
Top = 180
Width = 2760
Begin VB.Label ScrollLab
BackStyle = 0 'Transparent
Caption = "第一步，选择客户单击； 第二步，单击修改按钮； 第三步，单击保存按钮。"
ForeColor = &H0000FFFF&
Height = 1275
Left = 270
TabIndex = 26
Top = 225
Width = 2235
End
End
Begin VB.TextBox txtFields
BackColor = &H00C0C0C0&
DataField = "公司电话"
DataSource = "Data1"
Enabled = 0 'False
ForeColor = &H00FF0000&
Height = 285
Index = 3
Left = 5490
MaxLength = 100
TabIndex = 4
Top = 3060
Width = 3375
End
Begin VB.TextBox txtFields
BackColor = &H00C0C0C0&
DataField = "公司传真"
DataSource = "Data1"
Enabled = 0 'False
ForeColor = &H00FF0000&
Height = 285
Index = 4
Left = 5490
MaxLength = 50
TabIndex = 5
Top = 3375
Width = 3375
End
Begin VB.TextBox txtFields
BackColor = &H00C0C0C0&
DataField = "公司邮件"
DataSource = "Data1"
Enabled = 0 'False
ForeColor = &H00FF0000&
Height = 285
Index = 5
Left = 5490
MaxLength = 80
TabIndex = 6
Top = 3690
Width = 3375
End
Begin VB.TextBox txtFields
BackColor = &H00C0C0C0&
DataField = "公司网址"
DataSource = "Data1"
Enabled = 0 'False
ForeColor = &H00FF0000&
Height = 285
Index = 6
Left = 5490
MaxLength = 100
TabIndex = 7
Top = 4020
Width = 3375
End
Begin VB.TextBox txtFields
BackColor = &H00C0C0C0&
DataField = "客户姓名"
DataSource = "Data1"
Enabled = 0 'False
ForeColor = &H00FF0000&
Height = 285
Index = 0
Left = 5475
MaxLength = 18
TabIndex = 1
Top = 1920
Width = 1710
End
Begin VB.TextBox txtFields
BackColor = &H00C0C0C0&
DataField = "公司名称"
DataSource = "Data1"
Enabled = 0 'False
ForeColor = &H00FF0000&
Height = 285
Index = 1
Left = 5475
MaxLength = 100
TabIndex = 2
Top = 2415
Width = 3375
End
Begin VB.TextBox txtFields
BackColor = &H00C0C0C0&
DataField = "公司地址"
DataSource = "Data1"
Enabled = 0 'False
ForeColor = &H00FF0000&
Height = 285
Index = 2
Left = 5475
MaxLength = 100
TabIndex = 3
Top = 2730
Width = 3375
End
Begin VB.TextBox txtFields
BackColor = &H00C0C0C0&
DataField = "客户类型"
DataSource = "Data1"
Enabled = 0 'False
ForeColor = &H00FF0000&
Height = 285
Index = 7
Left = 5490
Locked = -1 'True
MaxLength = 50
TabIndex = 8
ToolTipText = "此项不能修改"
Top = 4350
Width = 3375
End
Begin VB.TextBox txtFields
BackColor = &H00C0C0C0&
DataField = "邮政编码"
DataSource = "Data1"
Enabled = 0 'False
ForeColor = &H00FF0000&
Height = 285
Index = 8
Left = 5490
MaxLength = 10
TabIndex = 10
Top = 4665
Width = 3375
End
Begin VB.TextBox txtFields
BackColor = &H00C0C0C0&
DataField = "所在城市"
DataSource = "Data1"
Enabled = 0 'False
ForeColor = &H00FF0000&
Height = 285
Index = 9
Left = 5490
MaxLength = 50
TabIndex = 12
Top = 4995
Width = 3375
End
Begin ComctlLib.TreeView TreeView1
Height = 5400
Left = 135
TabIndex = 0
Top = 165
Width = 3915
_ExtentX = 6906
_ExtentY = 9525
_Version = 327682
LabelEdit = 1
LineStyle = 1
Style = 7
ImageList = "ImageList"
Appearance = 1
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "公司电话:"
ForeColor = &H00808000&
Height = 180
Index = 3
Left = 4455
TabIndex = 24
Top = 3120
Width = 810
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "公司传真:"
ForeColor = &H00808000&
Height = 180
Index = 4
Left = 4455
TabIndex = 23
Top = 3435
Width = 810
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "公司邮件:"
ForeColor = &H00808000&
Height = 180
Index = 5
Left = 4455
TabIndex = 22
Top = 3765
Width = 810
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "公司网址:"
ForeColor = &H00808000&
Height = 180
Index = 6
Left = 4455
TabIndex = 21
Top = 4080
Width = 810
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "客户姓名:"
ForeColor = &H000000C0&
Height = 180
Index = 0
Left = 4455
TabIndex = 20
Top = 1965
Width = 810
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "公司名称:"
ForeColor = &H00808000&
Height = 180
Index = 1
Left = 4455
TabIndex = 19
Top = 2475
Width = 810
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "公司地址:"
ForeColor = &H00808000&
Height = 180
Index = 2
Left = 4455
TabIndex = 18
Top = 2805
Width = 810
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "客户类型:"
ForeColor = &H00808000&
Height = 180
Index = 7
Left = 4470
TabIndex = 17
Top = 4410
Width = 810
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "邮政编码:"
ForeColor = &H00808000&
Height = 180
Index = 8
Left = 4470
TabIndex = 11
Top = 4740
Width = 810
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "所在城市:"
ForeColor = &H00808000&
Height = 180
Index = 9
Left = 4470
TabIndex = 9
Top = 5055
Width = 810
End
Begin ComctlLib.ImageList ImageList
Left = -600
Top = 4305
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
MaskColor = 12632256
_Version = 327682
End
End
Attribute VB_Name = "frmModifyGuest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim GuestNo As String
Dim TempArray(9) As String
Dim EventFlg As String
Dim NoEvent As String
Dim DB As Database, Ef As Recordset, FG As Recordset, TempStr As String, IntIndex As Single, x As Single
Private Sub CancelRecord_Click()
'修改操作
TreeView1.Enabled = True
ExitB.Enabled = True
SaveRecord.Enabled = False
CancelRecord.Enabled = False
Command2.Enabled = True
For x = 0 To 9
txtFields(x).Text = TempArray(x)
txtFields(x).Enabled = False
Next
End Sub
Private Sub Command2_Click()
If txtFields(0) = "" Then Exit Sub
'修改操作
TreeView1.Enabled = False
SaveRecord.Enabled = True
CancelRecord.Enabled = True
Command2.Enabled = False
ExitB.Enabled = False
For x = 0 To 9
TempArray(x) = txtFields(x).Text
txtFields(x).Enabled = True
Next
txtFields(0).SetFocus
End Sub
Private Sub ExitB_Click()
Unload Me
End Sub
Private Sub Form_Load()
frmModifyGuest.Left = (frmMain.Width - frmModifyGuest.Width) / 2
frmModifyGuest.Top = (frmMain.Height - frmModifyGuest.Height) / 2 - 400
On Error GoTo NOFILE
ImageList.ListImages.Add 1, "Top", LoadPicture(Browser + "TOP.ICO")
ImageList.ListImages.Add 2, "Open", LoadPicture(Browser + "OPEN.ICO")
ImageList.ListImages.Add 3, "Select", LoadPicture(Browser + "SELECT.ICO")
ImageList.ListImages.Add 4, "HEAD", LoadPicture(Browser + "HEAD.ICO")
ImageList.ListImages.Add 5, "Boot", LoadPicture(Browser + "BOOT.ICO")
Dim NodeYsl As Node
TreeView1.Sorted = True
Set NodeYsl = TreeView1.Nodes.Add()
NodeYsl.Text = "文件目录树"
NodeYsl.Tag = "HEAD"
NodeYsl.Image = "HEAD"
TreeView1.LabelEdit = tvwManual
Set DB = OpenDatabase(Browser + "data\file.MDB", False, False, ConStr)
Set Ef = DB.OpenRecordset("Catalog", dbOpenDynaset)
Do Until Ef.EOF
Set NodeYsl = TreeView1.Nodes.Add(1, tvwChild)
NodeYsl.Text = Ef!Name
NodeYsl.Key = Ef!Name
NodeYsl.Tag = "Type"
NodeYsl.Image = "Top"
IntIndex = NodeYsl.Index
TempStr = "文件类型='" & Ef!Name & "'"
Set FG = DB.OpenRecordset("Select * From Main Where " & TempStr, dbOpenDynaset)
Do Until FG.EOF
Set NodeYsl = TreeView1.Nodes.Add(IntIndex, tvwChild)
NodeYsl.Text = FG!文件姓名
NodeYsl.Key = FG!文件姓名
NodeYsl.Tag = "Guest Name"
NodeYsl.Image = "Select"
FG.MoveNext
Loop
NodeYsl.Sorted = True
Ef.MoveNext
Loop
DB.Close
TreeView1.Nodes(1).Expanded = True
Exit Sub
NOFILE:
MsgBox "系统文件没有找到,请重新安装系统!", vbOKOnly + 64, "文件没找到"
End Sub
Private Sub SaveRecord_Click()
If Trim(txtFields(0).Text) = "" Then
MsgBox "文件姓名不能为空,且不能重复!", vbOKOnly + 64, "文件姓名为空!"
txtFields(0).SetFocus
Exit Sub
End If
'Save Record
frmModifyGuest.MousePointer = 11
Set DB = OpenDatabase(Browser + "data\file.MDB", False, False, ConStr)
TempStr = "Update Main set 文件姓名='" & Trim(txtFields(0)) & "', " _
& "公司名称='" & Trim(txtFields(1)) & "', 公司地址='" & Trim(txtFields(2)) & "', " _
& "公司电话='" & Trim(txtFields(3)) & "', 公司传真='" & Trim(txtFields(4)) & "', " _
& "公司邮件='" & Trim(txtFields(5)) & "', 公司网址='" & Trim(txtFields(6)) & "', " _
& "邮政编码='" & Trim(txtFields(8)) & "', " _
& "所在城市='" & Trim(txtFields(9)) & "' Where 文件姓名='" & GuestNo & "'"
DB.Execute TempStr
DB.Close
GuestNo = txtFields(0).Text
TreeView1.SelectedItem.Text = GuestNo
TreeView1.Enabled = True
ExitB.Enabled = True
SaveRecord.Enabled = False
CancelRecord.Enabled = False
Command2.Enabled = True
frmModifyGuest.MousePointer = 0
End Sub
Private Sub TreeView1_Collapse(ByVal Node As ComctlLib.Node)
If Node.Tag = "HEAD" Then
Node.Image = "HEAD"
End If
If Node.Tag = "Type" Then
Node.Image = "Top"
End If
End Sub
Private Sub TreeView1_Expand(ByVal Node As ComctlLib.Node)
If Node.Tag = "HEAD" Then
Node.Image = "Boot"
End If
If Node.Tag = "Type" Then
Node.Image = "Open"
End If
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As ComctlLib.Node)
If Node.Tag = "HEAD" Or Node.Tag = "Type" Then
If txtFields(0).Text <> "" Then
NoEvent = Node.Text
If EventFlg = NoEvent Then Exit Sub
For x = 0 To 9
txtFields(x).Text = ""
Next
NoEvent = Node.Text
EventFlg = ""
Exit Sub
End If
NoEvent = Node.Text
EventFlg = ""
Exit Sub
End If
NoEvent = Node.Text
If EventFlg = NoEvent Then Exit Sub
TreeView1.MousePointer = 11
GuestNo = Node.Text
Set DB = OpenDatabase(Browser + "data\file.MDB", False, False, ConStr)
Set Ef = DB.OpenRecordset("Detail", dbOpenDynaset)
TempStr = "文件姓名='" & GuestNo & "'"
Ef.FindFirst TempStr
If Ef.NoMatch Then
TreeView1.MousePointer = 0
DB.Close
Exit Sub
Else
For x = 0 To 9
If Not IsNull(Ef.Fields(x).Value) Then
txtFields(x).Text = Ef.Fields(x).Value
End If
Next
DB.Close
End If
TreeView1.MousePointer = 0
NoEvent = Node.Text
EventFlg = NoEvent
End Sub
Private Sub txtFields_GotFocus(Index As Integer)
txtFields(Index).BackColor = &HFFFFFF
txtFields(Index).ForeColor = &H0
txtFields(Index).SelStart = 0
txtFields(Index).SelLength = Len(Trim(txtFields(Index).Text))
End Sub
Private Sub txtFields_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = 38 Then
If Index > 0 Then
txtFields(Index - 1).SetFocus
End If
End If
If KeyCode = 40 Then
If Index < 9 Then
txtFields(Index + 1).SetFocus
End If
End If
End Sub
Private Sub txtFields_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
End If
End Sub
Private Sub txtFields_LostFocus(Index As Integer)
txtFields(Index).BackColor = &HC0C0C0
txtFields(Index).ForeColor = &HFF0000
If InStr(1, txtFields(Index).Text, "'", vbTextCompare) Then
MsgBox "该项目之中有特殊字符" + "<'>,请删除。", vbOKOnly + 48, "提示："
txtFields(Index).SetFocus
Exit Sub
End If
'较对有无重复的编号
If Index = 0 Then
If Trim(txtFields(0).Text) = GuestNo Then Exit Sub
Dim DB As Database, Ef As Recordset, TempStr As String
Set DB = OpenDatabase(Browser + "data\file.MDB", False, False, ConStr)
Set Ef = DB.OpenRecordset("Detail", dbOpenDynaset)
TempStr = "文件姓名='" & txtFields(0).Text & "'"
Ef.FindFirst TempStr
If Not Ef.NoMatch Then
MsgBox "重复的文件姓名,请修改!", vbOKOnly + 48, "警告!"
DB.Close
txtFields(0).Text = ""
txtFields(0).SetFocus
Exit Sub
Else
DB.Close
End If
End If
End Sub