📄 frmaddcoop.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmAddCoop
BorderStyle = 3 'Fixed Dialog
Caption = "添加合作信息"
ClientHeight = 3570
ClientLeft = 2760
ClientTop = 3750
ClientWidth = 6165
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3570
ScaleWidth = 6165
ShowInTaskbar = 0 'False
Begin VB.CommandButton cmdModify
Caption = "修改"
Height = 375
Left = 360
TabIndex = 9
Top = 3000
Width = 1215
End
Begin VB.Frame fraCoop
Caption = "合作信息 "
Height = 2535
Left = 360
TabIndex = 2
Top = 240
Width = 5295
Begin MSComctlLib.Slider sldCoop
Height = 255
Left = 1200
TabIndex = 7
Top = 840
Width = 3015
_ExtentX = 5318
_ExtentY = 450
_Version = 393216
Max = 255
SelStart = 50
TickStyle = 3
Value = 50
End
Begin VB.TextBox txtCoopMsg
BackColor = &H80000009&
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 975
Left = 1320
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 3
Top = 1320
Width = 3735
End
Begin MSComCtl2.DTPicker dtpCoopDate
Height = 375
Left = 1320
TabIndex = 4
Top = 360
Width = 3015
_ExtentX = 5318
_ExtentY = 661
_Version = 393216
CalendarTitleBackColor= -2147483635
Format = 25559041
CurrentDate = 38219
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "满意度"
Height = 180
Left = 120
TabIndex = 8
Top = 840
Width = 540
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "合作内容"
Height = 180
Left = 120
TabIndex = 6
Top = 1320
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "合作时间"
Height = 180
Left = 120
TabIndex = 5
Top = 360
Width = 720
End
End
Begin VB.CommandButton CancelButton
Caption = "取消"
Height = 375
Left = 4440
TabIndex = 1
Top = 3000
Width = 1215
End
Begin VB.CommandButton OKButton
Caption = "确定"
Height = 375
Left = 3000
TabIndex = 0
Top = 3000
Width = 1215
End
End
Attribute VB_Name = "frmAddCoop"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private OK As Boolean
Private objCoop As CCooperate
Private mvarViewType As gxcViewType
Private ClientId As Long
Public Property Get ViewType() As gxcViewType
ViewType = mvarViewType
End Property
Private Sub CancelButton_Click()
OK = False
Me.Hide
End Sub
Private Sub cmdModify_Click()
mvarViewType = vtModify
SetStatus
End Sub
Private Sub OKButton_Click()
OK = True
Call CheckValid
If mvarViewType = vtadd Then Set objCoop = New CCooperate
SaveValue
Me.Hide
End Sub
Private Sub SetStatus()
txtCoopMsg.Appearance = 1
txtCoopMsg.BackColor = &H80000009
txtCoopMsg.Locked = False
cmdModify.Visible = False
dtpCoopDate.Enabled = True
sldCoop.Enabled = True
SetDefaultValue
Select Case mvarViewType
Case vtadd
CancelButton.Visible = True
OKButton.Caption = "确定"
Me.Caption = "添加合作信息"
Case vtModify
CancelButton.Visible = True
OKButton.Caption = "保存"
Me.Caption = "修改合作信息"
Case vtInfo
cmdModify.Visible = True
CancelButton.Visible = False
OKButton.Caption = "关闭"
Me.Caption = "查看合作信息"
txtCoopMsg.Appearance = 0
txtCoopMsg.BackColor = &H8000000F
txtCoopMsg.Locked = True
dtpCoopDate.Enabled = False
sldCoop.Enabled = False
Case Else
End Select
End Sub
Public Function RetriveCoop(ByRef oCoop As CCooperate, _
ByVal eViewType As gxcViewType, _
ByVal nClientId As Long) As Boolean
Set objCoop = oCoop
mvarViewType = eViewType
If nClientId <> -1 Then
ClientId = nClientId
Else
ClientId = oCoop.ClientId
End If
SetStatus
OK = False
Me.Show vbModal
If OK = False Then Exit Function
Set oCoop = objCoop
RetriveCoop = True
Unload Me
End Function
Private Sub SetDefaultValue()
Dim ctl As Control
Dim i As Integer
If objCoop Is Nothing Then
For Each ctl In Controls
If TypeOf ctl Is TextBox Then
ctl.Text = ""
End If
Next
Else
With objCoop
txtCoopMsg.Text = .Remark
dtpCoopDate.Value = .CooperateDate
sldCoop.Value = .Satisfaction
End With
End If
End Sub
Private Function CheckValid() As Boolean
If txtCoopMsg.Text = "" Then
MsgBox "请填写合作信息", vbOKOnly + vbExclamation
CheckValid = False
Else
CheckValid = True
End If
End Function
Private Sub SaveValue()
With objCoop
.ClientId = ClientId
.CooperateDate = dtpCoopDate.Value
.Satisfaction = sldCoop.Value
.Remark = Trim(txtCoopMsg.Text)
End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -