📄 frmclient.frm
字号:
TabIndex = 36
Top = 1992
Width = 720
End
End
Begin VB.Frame frabaseInfo
Caption = "必填信息"
Height = 2775
Left = -74760
TabIndex = 31
Top = 600
Width = 3375
Begin VB.ComboBox cboSex
Height = 300
ItemData = "frmClient.frx":0091
Left = 960
List = "frmClient.frx":009B
Style = 2 'Dropdown List
TabIndex = 5
Top = 780
Width = 2055
End
Begin VB.ComboBox cboClientType
Height = 300
ItemData = "frmClient.frx":00A7
Left = 960
List = "frmClient.frx":00A9
Style = 2 'Dropdown List
TabIndex = 6
Top = 1260
Width = 2055
End
Begin VB.TextBox txtEmail
Height = 300
Left = 960
TabIndex = 8
Text = "txtEmail"
Top = 2220
Width = 2055
End
Begin VB.TextBox txtMobile
Height = 300
Left = 960
TabIndex = 7
Text = "txtMobile"
Top = 1740
Width = 2055
End
Begin VB.TextBox txtName
Height = 300
Left = 960
TabIndex = 4
Text = "txtName"
Top = 300
Width = 2055
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "客户类型"
Height = 180
Left = 120
TabIndex = 42
Top = 1320
Width = 720
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "E-Mail"
Height = 180
Left = 120
TabIndex = 40
Top = 2280
Width = 540
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "性别"
Height = 180
Left = 120
TabIndex = 34
Top = 840
Width = 360
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "手机"
Height = 180
Left = 120
TabIndex = 33
Top = 1800
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "姓名"
Height = 180
Left = 120
TabIndex = 32
Top = 360
Width = 360
End
End
Begin MSComCtl2.DTPicker dtpBirthday
Height = 300
Left = -74280
TabIndex = 15
Top = 3660
Width = 1335
_ExtentX = 2355
_ExtentY = 529
_Version = 393216
Format = 25493505
CurrentDate = 38220
End
Begin VB.Label Label16
AutoSize = -1 'True
Caption = "个人网站"
Height = 180
Left = 480
TabIndex = 55
Top = 1680
Width = 720
End
Begin VB.Label Label13
AutoSize = -1 'True
Caption = "年龄"
Height = 180
Left = -72720
TabIndex = 49
Top = 3720
Width = 360
End
Begin VB.Label Label12
AutoSize = -1 'True
Caption = "生日"
Height = 180
Left = -74760
TabIndex = 48
Top = 3720
Width = 360
End
End
Begin VB.CommandButton CancelButton
Caption = "取消"
Height = 375
Left = 6000
TabIndex = 1
Top = 4560
Width = 1215
End
Begin VB.CommandButton OKButton
Caption = "确定"
Height = 375
Left = 4560
TabIndex = 0
Top = 4560
Width = 1215
End
End
Attribute VB_Name = "frmClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private OK As Boolean
Private mvarViewType As gxcViewType
Private objClient As cClient
Private TypeId As Long
Private mvarBirthdayWarn As Boolean
Public Property Get ViewType() As gxcViewType
ViewType = mvarViewType
End Property
Public Property Get ShowBirthdayWarn() As Boolean
ShowBirthdayWarn = mvarBirthdayWarn
End Property
Private Sub CancelButton_Click()
OK = False
Me.Hide
End Sub
Private Sub cmdAdd_Click()
Dim objCoop As CCooperate
If frmAddCoop.RetriveCoop(objCoop, vtadd, objClient.ID) = False Then Exit Sub
If objCoop.AddNew = AddNewOK Then
AddCooperateToLvw objCoop, lvListView, False
Else
MsgBox "错误"
End If
End Sub
Private Sub cmdCoopInfo_Click()
Dim objCoop As CCooperate
If GetCoopFromControl(lvListView, objCoop) = False Then Exit Sub
If frmAddCoop.RetriveCoop(objCoop, vtInfo, objClient.ID) = False Then Exit Sub
If frmAddCoop.ViewType = vtModify Then
If objCoop.Update = UpdateOK Then
AddCooperateToLvw objCoop, lvListView, True
Else
MsgBox "错误"
End If
End If
End Sub
Private Sub cmdDel_Click()
If MsgBox("要删除合作？", vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
Dim objCoop As CCooperate
If GetCoopFromControl(lvListView, objCoop) = False Then Exit Sub
If objCoop.Delete = DeleteOK Then
lvListView.ListItems.Remove (lvListView.SelectedItem.Index)
Else
MsgBox "错误"
End If
End Sub
Private Sub cmdModify_Click()
Dim objCoop As CCooperate
If GetCoopFromControl(lvListView, objCoop) = False Then Exit Sub
If frmAddCoop.RetriveCoop(objCoop, vtModify, objClient.ID) = False Then Exit Sub
If objCoop.Update = UpdateOK Then
AddCooperateToLvw objCoop, lvListView, True
Else
MsgBox "错误"
End If
End Sub
Private Sub cmdModifyInfo_Click()
mvarViewType = vtModify
SetStatus
End Sub
Private Sub dtpBirthday_Change()
txtAge.Text = Year(Date) - dtpBirthday.Year
End Sub
Private Sub lvListView_DblClick()
cmdCoopInfo_Click
End Sub
Private Sub OKButton_Click()
If mvarViewType = vtInfo Then
Me.Hide
Exit Sub
End If
If CheckValid() = False Then
Exit Sub
End If
OK = True
If mvarViewType = vtadd Then Set objClient = New cClient
SaveValue
Me.Hide
End Sub
Private Sub SetStatus()
Dim ctl As Control
Dim intBorderStyle As Integer
Dim lngbkColor As Long
Dim boolLocked As Boolean
intBorderStyle = 1
lngbkColor = &H80000009
boolLocked = False
OKButton.Visible = True
CancelButton.Caption = "取消"
cmdModifyInfo.Visible = False
SetDefaultValue
Select Case mvarViewType
Case vtadd
cmdModify.Enabled = False
cmdAdd.Enabled = False
cmdDel.Enabled = False
cmdCoopInfo.Enabled = False
OKButton.Caption = "确定"
Me.Caption = "添加客户"
Case vtModify
OKButton.Caption = "保存"
Me.Caption = "修改客户信息"
Case vtInfo
intBorderStyle = 0
lngbkColor = &H8000000F
boolLocked = True
cmdModifyInfo.Visible = True
OKButton.Visible = False
CancelButton.Caption = "关闭"
Me.Caption = "查看客户信息"
Case Else
End Select
For Each ctl In Controls
If (TypeOf ctl Is TextBox) Then
ctl.BorderStyle = intBorderStyle
ctl.BackColor = lngbkColor
ctl.Locked = boolLocked
ElseIf (TypeOf ctl Is ComboBox) Or _
(TypeOf ctl Is DTPicker) Or _
(TypeOf ctl Is CheckBox) Or _
(TypeOf ctl Is Slider) Then
ctl.Enabled = Not boolLocked
End If
Next
End Sub
Public Function RetriveClient(ByRef oClient As cClient, _
ByVal eViewType As gxcViewType, _
Optional nTypeID As Long = -1) As Boolean
Set objClient = oClient
If nTypeID = -1 And (Not oClient Is Nothing) Then
TypeId = oClient.TypeId
Else
TypeId = nTypeID
End If
mvarViewType = eViewType
SetStatus
OK = False
Me.Show vbModal
If OK = False Then Exit Function
Set oClient = objClient
RetriveClient = True
Unload Me
End Function
Private Sub SetDefaultValue()
Dim ctl As Control
Dim i As Integer
AllClientsTypeToCombo cboClientType
For i = 0 To cboClientType.ListCount - 1
If cboClientType.ItemData(i) = TypeId Then
cboClientType.ListIndex = i
Exit For
End If
Next i
If objClient Is Nothing Then
For Each ctl In Controls
If TypeOf ctl Is TextBox Then
ctl.Text = ""
End If
Next
Else
With objClient
txtName.Text = .Name
cboSex.ListIndex = IIf(.Sex = Male, 0, 1)
txtMobile.Text = .Mobile
txtEmail.Text = .Email
txtName.Text = .Name
txtAge.Text = .Age
cboSex.ListIndex = IIf(.Sex = Male, 0, 1)
txtMobile.Text = .Mobile
txtEmail.Text = .Email
txtOfficePhone.Text = .OfficePhone
txtHomePhone.Text = .HomePhone
txtFax.Text = .Fax
txtHomeAdr.Text = .HomeAdr
txtMailAdr.Text = .MailAdr
txtZipCode.Text = .ZipCode
dtpBirthday.Value = .Birthday
chkBirthdayWarn.Value = IIf(.BirthdayWarn, 1, 0)
txtWork.Text = .Work
txtPosition.Text = .Position
txtCompany.Text = .Company
txtCompanySite.Text = .CompanySite
txtSelfSite.Text = .SelfSite
txtLikes.Text = .Likes
txtHate.Text = .Hate
txtRemark.Text = .Remark
sldImportance.Value = .Importance
sldFriendly.Value = .Friendly
sldSatisfaction.Value = .Satisfaction
ListAllCooperates lvListView, .ID
End With
End If
End Sub
Private Function CheckValid() As Boolean
If txtName.Text = "" Or _
cboSex.Text = "" Or _
cboClientType.Text = "" Or _
txtMobile.Text = "" Or _
txtEmail.Text = "" Then
MsgBox "请填写表格中的必填信息", vbOKOnly + vbExclamation
CheckValid = False
Else
CheckValid = True
End If
End Function
Private Sub SaveValue()
With objClient
.Name = Trim(txtName.Text)
.Age = Val(txtAge.Text)
.Sex = IIf(cboSex.ListIndex = 0, Male, Female)
.TypeId = cboClientType.ItemData(cboClientType.ListIndex)
.Mobile = Trim(txtMobile.Text)
.Email = Trim(txtEmail.Text)
.OfficePhone = Trim(txtOfficePhone.Text)
.HomePhone = Trim(txtHomePhone.Text)
.Fax = Trim(txtFax.Text)
.HomeAdr = Trim(txtHomeAdr.Text)
.MailAdr = Trim(txtMailAdr.Text)
.ZipCode = Trim(txtZipCode.Text)
.Birthday = dtpBirthday.Value
.BirthdayWarn = chkBirthdayWarn.Value
.Work = Trim(txtWork.Text)
.Position = Trim(txtPosition.Text)
.Company = Trim(txtCompany.Text)
.CompanySite = Trim(txtCompanySite.Text)
.SelfSite = Trim(txtSelfSite.Text)
.Likes = Trim(txtLikes.Text)
.Hate = Trim(txtHate.Text)
.Remark = Trim(txtRemark.Text)
.Importance = sldImportance.Value
.Friendly = sldFriendly.Value
.Satisfaction = sldSatisfaction.Value
End With
mvarBirthdayWarn = IIf(chkBirthdayWarn.Value = 0, False, True)
End Sub
Private Sub txtAge_Change()
dtpBirthday.Year = Year(Date) - Val(txtAge.Text)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -