📄 frmcwzh.frm
字号:
Const ImgCwZh = 0
Const SBarCwZh = 0
Const FlexCwZh = 0
Const txtCwZhYear = 0
Dim mCurColOldValue As String
Dim mOldCwZhYear As String
Dim OCwZh As CwZh
Dim OCwZhs As CwZhs
Private Sub Flex_AfterEdit(Index As Integer, ByVal Row As Long, ByVal Col As Long)
On Error GoTo Errorhandle
SetControlToFlex
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Flex_BeforeEdit(Index As Integer, ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
On Error GoTo Errorhandle
mCurColOldValue = Trim(Flex(FlexCwZh).TextMatrix(Flex(FlexCwZh).Row, Flex(FlexCwZh).Col))
If Tlbaction(TlbCwZh).Tag = "" Then
Cancel = True
End If
If Tlbaction(TlbCwZh).Tag <> "" Then
Select Case Flex(FlexCwZh).ColKey(Col)
Case "CWZHMC"
End Select
End If
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Flex_Click(Index As Integer)
On Error GoTo Errorhandle
If Tlbaction(TlbCwZh).Tag = "" Then
Exit Sub
End If
If OCwZh Is Nothing Then
Exit Sub
End If
Select Case Index
Case FlexCwZh
If Flex(Index).Col = Flex(Index).ColIndex("CWZHISSTOP") Then
If Flex(Index).TextMatrix(Flex(Index).Row, Flex(FlexCwZh).Col) = "" Then
Flex(Index).TextMatrix(Flex(Index).Row, Flex(FlexCwZh).Col) = "√"
Else
Flex(Index).TextMatrix(Flex(Index).Row, Flex(FlexCwZh).Col) = ""
End If
End If
End Select
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Flex_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
On Error GoTo Errorhandle
gPublicFunction.FlexKeyDown Flex(Index), KeyCode
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Flex_KeyDownEdit(Index As Integer, ByVal Row As Long, ByVal Col As Long, KeyCode As Integer, ByVal Shift As Integer)
On Error GoTo Errorhandle
gPublicFunction.FlexKeyDown Flex(Index), KeyCode
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Flex_KeyPressEdit(Index As Integer, ByVal Row As Long, ByVal Col As Long, KeyAscii As Integer)
On Error GoTo Errorhandle
gPublicFunction.FlexInputCheck Me, Flex(Index), KeyAscii
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Flex_RowColChange(Index As Integer)
On Error GoTo Errorhandle
Select Case Index
Case FlexCwZh
If Flex(Index).Rows > 2 And Flex(FlexCwZh).Row <> Flex(FlexCwZh).Rows - 1 Then
Set OCwZh = OCwZhs(CStr(Flex(FlexCwZh).RowData(Flex(FlexCwZh).Row)))
Else
Set OCwZh = Nothing
End If
End Select
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub SetControlToFlex()
Dim mCurCol As Integer
Dim mCurRow As Integer
On Error GoTo Errorhandle
If Tlbaction(TlbCwZh).Tag = "" Then
Exit Sub
End If
mCurRow = Flex(FlexCwZh).Row
mCurCol = Flex(FlexCwZh).Col
Select Case Flex(FlexCwZh).ColKey(Flex(FlexCwZh).Col)
Case "CWZHMC"
If OCwZh Is Nothing Then
AddNewRecord
Else
OCwZh.CwZhMc = Trim(Flex(FlexCwZh).TextMatrix(mCurRow, mCurCol))
End If
End Select
Exit Sub
Errorhandle:
Flex(FlexCwZh).TextMatrix(mCurRow, mCurCol) = mCurColOldValue
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub AddNewRecord()
On Error GoTo Errorhandle
If Trim(Flex(FlexCwZh).TextMatrix(Flex(FlexCwZh).Row, Flex(FlexCwZh).Col)) <> "" Then
Set OCwZh = New CwZh
OCwZh.CwZhMc = Trim(Flex(FlexCwZh).TextMatrix(Flex(FlexCwZh).Row, Flex(FlexCwZh).Col))
OCwZhs.Add OCwZh
Flex(FlexCwZh).RowData(Flex(FlexCwZh).Rows - 1) = OCwZh.CwZh_Key
Flex(FlexCwZh).AddItem ""
End If
Exit Sub
Errorhandle:
Set OCwZh = Nothing
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub Form_Load()
On Error GoTo Errorhandle
Flex(FlexCwZh).Editable = flexEDKbdMouse
Flex(FlexCwZh).ColKey(1) = "CWZHMC"
Flex(FlexCwZh).ColKey(2) = "CWZHISSTOP"
gPublicFunction.LoadFormSet Me, Tlbaction(TlbCwZh), Img(ImgCwZh), SBar(SBarCwZh)
gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Flex(FlexCwZh)
gPublicCommon.PublicFunction.EnableControl Me, ""
LoadDataIntoGrid
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim mButton As Button
On Error GoTo Errorhandle
Set mButton = gPublicFunction.GetToolBarButton(Me, KeyCode)
If Not mButton Is Nothing Then
Tlbaction_ButtonClick TlbCwZh, mButton
End If
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub LoadDataIntoGrid()
Dim ItemStr As String
Dim m_CwZh As CwZh
On Error GoTo Errorhandle
Flex(FlexCwZh).Rows = 1
Flex(FlexCwZh).AddItem ""
Set OCwZhs = New CwZhs
OCwZhs.FillbyDb
For Each m_CwZh In OCwZhs
ItemStr = vbTab & m_CwZh.CwZhMc & vbTab & IIf(m_CwZh.CwZhIsStop = 1, "√", "")
Flex(FlexCwZh).AddItem ItemStr, Flex(FlexCwZh).Rows - 1
Flex(FlexCwZh).RowData(Flex(FlexCwZh).Rows - 2) = m_CwZh.CwZh_Key
Next
If Flex(FlexCwZh).Rows > 2 Then
Flex(FlexCwZh).Row = 1
Set OCwZh = OCwZhs(CStr(Flex(FlexCwZh).RowData(1)))
Else
Set OCwZh = Nothing
End If
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub AddRecord(RecordName As String)
On Error GoTo Errorhandle
Flex(FlexCwZh).Row = Flex(FlexCwZh).Rows - 1
Flex(FlexCwZh).Col = Flex(FlexCwZh).ColIndex("CWZHMC")
gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbCwZh), RecordName
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub CancelRecord(RecordName As String)
On Error GoTo Errorhandle
If Tlbaction(TlbCwZh).Tag <> "" Then
gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbCwZh), RecordName
LoadDataIntoGrid
End If
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub Delrecord(RecordName As String)
On Error GoTo Errorhandle
If OCwZhs Is Nothing Then
Exit Sub
End If
If OCwZh Is Nothing Then
Exit Sub
End If
If Flex(FlexCwZh).Rows <= 2 Then
Exit Sub
End If
If MsgBox("您真的要删除吗?", vbYesNo) = vbYes Then
OCwZhs.Remove CStr(OCwZh.CwZh_Key)
gPublicFunction.RemoveFlexItem Flex(FlexCwZh).Row, Flex(FlexCwZh)
If Flex(FlexCwZh).Rows = 2 Then
Set OCwZh = Nothing
Else
Set OCwZh = OCwZhs(CStr(Flex(FlexCwZh).RowData(Flex(FlexCwZh).Row)))
End If
End If
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub SaveRecord(RecordName As String)
On Error GoTo Errorhandle
SetValueToObject RecordName
OCwZhs.DbSave
gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbCwZh), RecordName
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub SetValueToObject(ObjectName As String)
Dim I As Integer
On Error GoTo Errorhandle
For I = 1 To Flex(FlexCwZh).Rows - 2
Set OCwZh = OCwZhs.Item(CStr(Flex(FlexCwZh).RowData(I)))
OCwZh.CwZhMc = Trim(Flex(FlexCwZh).TextMatrix(I, Flex(FlexCwZh).ColIndex("CWZHMC")))
OCwZh.CwZhIsStop = IIf(Trim(Flex(FlexCwZh).TextMatrix(I, Flex(FlexCwZh).ColIndex("CWZHISSTOP"))) <> "", 1, 0)
Next
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Errorhandle
Set OCwZh = Nothing
Set OCwZhs = Nothing
gPublicCommon.PublicFunction.SaveFormSet Me
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Tlbaction_ButtonClick(Index As Integer, ByVal Button As MSComctlLib.Button)
Dim Action, RecordName As String
On Error GoTo Errorhandle
Action = (Mid(Button.Key, 1, 3))
RecordName = Button.Key
If Trim(Flex(FlexCwZh).EditText) <> "" Then
Flex(FlexCwZh).TextMatrix(Flex(FlexCwZh).Row, Flex(FlexCwZh).Col) = Trim(Flex(FlexCwZh).EditText)
End If
Select Case Action
Case "EDI"
AddRecord RecordName
Case "CAN"
CancelRecord RecordName
Case "SAV"
SaveRecord RecordName
Case "DEF"
Delrecord RecordName
Case "EXI"
Unload Me
End Select
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Form_Resize()
On Error GoTo Errorhandle
gPublicCommon.PublicFunction.ResizeForm Me
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -