📄 frmcard.frm
字号:
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 3
Left = -69240
MaxLength = 50
TabIndex = 5
Top = 1170
Width = 2115
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 2
Left = -73470
MaxLength = 50
TabIndex = 2
Top = 780
Width = 2985
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 1
Left = -71370
MaxLength = 100
TabIndex = 1
Top = 390
Width = 4245
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 0
Left = -73470
MaxLength = 10
TabIndex = 0
Top = 390
Width = 1245
End
Begin MSFlexGridLib.MSFlexGrid MSFlex1
Height = 5025
Left = -74880
TabIndex = 47
Top = 1260
Width = 9375
_ExtentX = 16536
_ExtentY = 8864
_Version = 393216
SelectionMode = 1
AllowUserResizing= 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "说明"
Height = 180
Index = 18
Left = -71580
TabIndex = 46
Top = 930
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "说明"
Height = 180
Index = 13
Left = -73890
TabIndex = 44
Top = 3180
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "姓名"
Height = 180
Index = 17
Left = -73920
TabIndex = 39
Top = 540
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "单位"
Height = 180
Index = 16
Left = -71580
TabIndex = 38
Top = 540
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "分类"
Height = 180
Index = 15
Left = -73920
TabIndex = 37
Top = 930
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "分类"
Height = 180
Index = 14
Left = -69660
TabIndex = 35
Top = 2790
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "职位"
Height = 180
Index = 12
Left = -73890
TabIndex = 34
Top = 2790
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "邮编"
Height = 180
Index = 11
Left = -69660
TabIndex = 33
Top = 2400
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "家庭地址"
Height = 180
Index = 10
Left = -74250
TabIndex = 32
Top = 2400
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "邮编"
Height = 180
Index = 9
Left = -69660
TabIndex = 31
Top = 2010
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "公司地址"
Height = 180
Index = 8
Left = -74250
TabIndex = 30
Top = 2010
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "网址"
Height = 180
Index = 7
Left = -69660
TabIndex = 29
Top = 1620
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "E-mail"
Height = 180
Index = 6
Left = -74070
TabIndex = 28
Top = 1620
Width = 540
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "传真"
Height = 180
Index = 5
Left = -69660
TabIndex = 27
Top = 840
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "手机"
Height = 180
Index = 4
Left = -73890
TabIndex = 26
Top = 1230
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "家庭电话"
Height = 180
Index = 3
Left = -70020
TabIndex = 25
Top = 1230
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "办公电话"
Height = 180
Index = 2
Left = -74250
TabIndex = 24
Top = 840
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "单位"
Height = 180
Index = 1
Left = -71790
TabIndex = 23
Top = 450
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "姓名"
Height = 180
Index = 0
Left = -73890
TabIndex = 22
Top = 450
Width = 360
End
End
End
Attribute VB_Name = "frmCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim I As Integer
Dim StrSql As String
Dim intCurrentRow As Integer
Dim intCurrentCol As Integer
Dim strAction As String
Dim intresult As Integer
Dim intRowClick As Integer
Const conActionNew = 0
Const conActionEdit = 1
Const conActionNormal = 2
Dim strEdit(1) As String
Dim intActionType As Integer
Dim oText As TextBox
Private Sub Cbo1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
SendKeys "{tab}"
End If
Select Case KeyCode
Case 27
If intActionType <> 2 Then
Cancel_Click
Else
Unload Me
End If
Case 113
If intActionType <> 2 Then CmdSave_Click
Case 45
If intActionType = 2 Then CmdIns_Click
End Select
End Sub
Private Sub CmdDel_Click()
Dim j As Integer
On Error GoTo ErrorHandle
If MSFlex.Rows = 2 And MSFlex.TextMatrix(1, 1) = "" And MSFlex.TextMatrix(1, 2) = "" Then
Exit Sub
End If
intresult = MsgBox("是否真要删除当前记录，请慎重操作！ ", vbYesNo + vbQuestion + vbDefaultButton2, "删除操作")
If intresult = vbYes Then
StrSql = "Delete from c002 Where f001 = '" & Trim(Text1(0)) & "' and f002='" & Trim(Text1(1)) & "'"
adoCon.Errors.Clear
On Error GoTo ErrorHandle
adoCon.Execute (StrSql)
On Error GoTo 0
If MSFlex.Rows = 2 Then
MSFlex.HighLight = flexHighlightNever
For Each oText In Me.Text1
oText.Text = ""
Next
I = 1
For j = 1 To MSFlex.Cols - 1
MSFlex.TextMatrix(I, j) = ""
Next
MSFlex_RowColChange
MSFlex.Enabled = False
Else
MSFlex.RemoveItem intCurrentRow
intCurrentRow = 0
MSFlex_RowColChange
intCurrentRow = MSFlex.Row
End If
End If
Exit Sub
ErrorHandle:
MsgBox "错误 # " & Str(Err.Number) & " 生成于 " & Err.Source & Chr(13) & Err.Description, vbCritical, "错误" & "DEL_CLICK", Err.HelpFile, Err.HelpContext
End Sub
Private Sub CmdExit_Click()
Unload Me
End Sub
Private Sub CmdIns_Click()
For Each oText In Me.Text1
oText.Text = ""
Next
Text1(0).SetFocus
MSFlex.Enabled = False
CmdSave.Enabled = True
CmdIns.Enabled = False
CmdModi.Enabled = False
CmdDel.Enabled = False
CmdQry.Enabled = False
intActionType = conActionNew
Cbo1 = "商业客户"
End Sub
Private Sub CmdModi_Click()
If MSFlex.Rows = 2 And MSFlex.TextMatrix(1, 1) = "" And MSFlex.TextMatrix(1, 2) = "" Then
Exit Sub
End If
strEdit(0) = Trim(Text1(0))
strEdit(1) = Trim(Text1(1))
MSFlex.Enabled = False
CmdSave.Enabled = True
Text1(0).SetFocus
intActionType = conActionEdit
End Sub
Private Sub CmdQry_Click()
Dim adoRes As New ADODB.Recordset
On Error GoTo ErrorHandle
If CmdQry.Caption = "查询" Then
CmdQry.Caption = "执行"
For Each oText In Me.Text1
oText.Text = ""
Cbo1 = ""
Next
Text1(0).SetFocus
Exit Sub
End If
If CmdQry.Caption = "执行" Then
CmdQry.Caption = "查询"
End If
StrSql = "select * from c002 where "
For I = 0 To 13
If Len(Trim(Text1(I))) > 0 And I < 9 Then
StrSql = StrSql & " f00" & I + 1 & " Like " & " '" & "%" & Trim(Text1(I)) & "%" & "'" & " and"
End If
If Len(Trim(Text1(I))) > 0 And I >= 9 Then
StrSql = StrSql & " f0" & I + 1 & " Like " & " '" & "%" & Trim(Text1(I)) & "%" & "'" & " and"
End If
Next
If Len(Trim(Cbo1)) > 0 Then
StrSql = StrSql & " f015 like " & "'" & "%" & Lov_list("c003", "f002", "f001", Cbo1) & "%" & "'" & " and"
End If
StrSql = Mid(StrSql, 1, Len(Trim(StrSql)) - 3) & " order by f001"
Me.MousePointer = vbHourglass
Set adoRes = adoCon.Execute(StrSql)
If adoRes.EOF Then
MsgBox "没有查询到记录，请重新输入条件！ ", vbOKOnly + vbInformation, "信息帮助"
Text1(0).SetFocus
MSFlex.Enabled = False
Me.MousePointer = flexDefault
Exit Sub
End If
FillGrid MSFlex, adoRes
MSFlex.Enabled = True
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -