📄 frmkh.frm
字号:
Top = 5640
Width = 855
End
Begin VB.CommandButton Command1
Caption = "搜 索"
Height = 330
Left = 3600
TabIndex = 10
Top = 5640
Width = 975
End
Begin VB.TextBox txtSS
Appearance = 0 'Flat
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1080
TabIndex = 9
Top = 5640
Width = 2415
End
Begin MSComctlLib.ImageList ImageList1
Left = 4680
Top = 1680
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 4
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmKH.frx":030A
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmKH.frx":0624
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmKH.frx":0A76
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmKH.frx":0BD0
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 360
Left = 0
TabIndex = 0
Top = 0
Width = 9840
_ExtentX = 17357
_ExtentY = 635
ButtonWidth = 1349
ButtonHeight = 582
Style = 1
TextAlignment = 1
ImageList = "ImageList1"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 5
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "增加"
Key = "Add"
ImageIndex = 3
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "删除"
Key = "Del"
ImageIndex = 4
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "修改"
Key = "Modify"
ImageIndex = 2
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
ImageIndex = 1
Style = 4
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "退出"
Key = "Exit"
ImageIndex = 1
EndProperty
EndProperty
BorderStyle = 1
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "客户名称："
Height = 180
Left = 120
TabIndex = 11
Top = 5715
Width = 900
End
End
Attribute VB_Name = "FrmKH"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Rst As ADODB.Recordset
Dim FindFlag As Integer
Private Sub cmdOK_Click()
On Error GoTo HandleErrors:
Rst.Fields(0) = TxtKHID.Text
Rst.Fields(1) = TxtKHMC.Text
Rst.Fields(2) = TxtDZ.Text
Rst.Fields(3) = TxtGSSZD.Text
Rst.Fields(4) = TxtMB.Text
Rst.Fields(5) = TxtLXR.Text
Rst.Fields(6) = TxtDH.Text
Rst.Update
Call ReSet
Call FillGrid
Call Txtclear
Frame1.Visible = False
Toolbar1.Enabled = True
Grid.Enabled = True
Exit Sub
HandleErrors:
MsgBox Err.Description, vbOKOnly + vbCritical
End Sub
Private Sub CmdReturn_Click()
On Error GoTo HandleErrors:
Rst.CancelUpdate
Call Txtclear
Frame1.Visible = False
Toolbar1.Enabled = True
Grid.Enabled = True
Rst.Close
Exit Sub
HandleErrors:
MsgBox Err.Description, vbOKOnly + vbCritical
End Sub
Private Sub Command1_Click()
FindFlag = 2
Call FillGrid
End Sub
Private Sub Command2_Click()
Call ReSet
Call FillGrid
End Sub
Private Sub Form_Load()
Dim I As Integer
Frame1.Visible = False
FindFlag = 0
Call ReSet
Call FillGrid
Call Txtclear
End Sub
Sub ReSet()
Grid.Clear
Grid.Rows = 1
Grid.FormatString = "编码|^ 客 户 名 称 |^ 地 址 |^ 所 在 地 |^ M.B. |^ 联 系 人 |^ 联 系 电 话"
End Sub
Sub FillGrid()
On Error GoTo HandleErrors:
Set Rst = New ADODB.Recordset
If FindFlag = 2 Then
If txtSS <> "" Then
SQL = "select * from KH where khmc like '%" & Trim(txtSS.Text) & "%'"
Rst.Open SQL, db, 1, 3
If Rst.EOF Then
MsgBox "无此客户，请重新搜索！", vbOKOnly + vbInformation, "提示"
txtSS.Text = ""
txtSS.SetFocus
FindFlag = 0
Exit Sub
Else
Call ReSet
End If
Else
Exit Sub
End If
ElseIf FindFlag = 0 Then
SQL = "select * from KH"
Rst.Open SQL, db, 1, 3
If Rst.EOF Then Exit Sub
End If
For I = 1 To Rst.RecordCount
Grid.Rows = Grid.Rows + 1
Grid.TextMatrix(Grid.Rows - 1, 0) = Rst.Fields(0)
Grid.TextMatrix(Grid.Rows - 1, 1) = Rst.Fields(1)
Grid.TextMatrix(Grid.Rows - 1, 2) = Rst.Fields(2)
Grid.TextMatrix(Grid.Rows - 1, 3) = Rst.Fields(3)
Grid.TextMatrix(Grid.Rows - 1, 4) = Rst.Fields(4)
Grid.TextMatrix(Grid.Rows - 1, 5) = Rst.Fields(5)
Grid.TextMatrix(Grid.Rows - 1, 6) = Rst.Fields(6)
Rst.MoveNext
Next
Rst.Close
Set Rst = Nothing
Exit Sub
HandleErrors:
MsgBox Err.Description
End Sub
Private Sub Grid_DblClick()
If KHFlag = 2 Then
FrmSELL.TxtSHR.Caption = Grid.TextMatrix(Grid.RowSel, 1)
Unload Me
End If
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case Is = "Add"
Call DataAdd
Case Is = "Del"
Call DataDel
Case Is = "Modify"
Call DataModify
Case Is = "Exit"
Unload Me
End Select
End Sub
Sub DataAdd()
Dim LastKHID As Integer
Frame1.Visible = True
Toolbar1.Enabled = False
Grid.Enabled = False
Frame1.Caption = "添加客户"
On Error GoTo ErrHandle
Set Rst = New ADODB.Recordset
Rst.Open "select * from kh", db, 1, 3
If Rst.BOF Then
Rst.MoveFirst
ElseIf Rst.EOF Then
Rst.MoveLast
Else
Rst.MoveLast
End If
LastKHID = Rst.Fields(0).Value
Rst.AddNew
TxtKHID.Text = LastKHID + 1
TxtKHMC.SetFocus
Exit Sub
ErrHandle:
MsgBox Err.Description
End Sub
Sub DataModify()
Frame1.Visible = True
Toolbar1.Enabled = False
Grid.Enabled = False
Frame1.Caption = "客户资料修改"
On Error GoTo ErrHandle
Set Rst = New Recordset
SQL = "select * from kh where khmc='" & Trim(Grid.TextMatrix(Grid.RowSel, 1)) & "'"
Rst.Open SQL, db, 1, 3
If Rst.EOF Then Exit Sub
TxtKHID = Rst.Fields(0)
TxtKHMC = Rst.Fields(1)
TxtDZ = Rst.Fields(2)
TxtGSSZD = Rst.Fields(3)
TxtMB = Rst.Fields(4)
TxtLXR = Rst.Fields(5)
TxtDH = Rst.Fields(6)
Exit Sub
ErrHandle:
MsgBox Err.Description
End Sub
Sub DataDel()
On Error GoTo HandleErrors:
Set Rst = New Recordset
SQL = "delete * from kh where khmc='" & Trim(Grid.TextMatrix(Grid.RowSel, 1)) & "'"
If MsgBox("请确认要删除此客户资料？", vbOKCancel + 48, "警告") = vbOK Then
Rst.Open SQL, db, 1, 3
Call ReSet
Call FillGrid
End If
Exit Sub
HandleErrors:
MsgBox Err.Description, vbOKOnly + vbCritical
End Sub
Private Sub txtSS_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call Command1_Click
End If
End Sub
Sub Txtclear()
TxtKHID = ""
TxtKHMC = ""
TxtDZ = ""
TxtGSSZD = ""
TxtMB = ""
TxtLXR = ""
TxtDH = ""
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -