📄 frmhwdw.frm
字号:
Dim OHwDw As HwDw
Dim OHwDws As HwDws
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(FlexHwDw).TextMatrix(Flex(FlexHwDw).Row, Flex(FlexHwDw).Col))
If Tlbaction(TlbHwDw).Tag = "" Then
Cancel = True
End If
If Tlbaction(TlbHwDw).Tag <> "" Then
Select Case Flex(FlexHwDw).ColKey(Col)
Case "HWDWCODE"
Case "HWDWMC"
If OHwDw Is Nothing Then
Cancel = True
End If
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(TlbHwDw).Tag = "" Then
Exit Sub
End If
If OHwDw Is Nothing Then
Exit Sub
End If
Select Case Index
Case FlexHwDw
If Flex(Index).Col = Flex(Index).ColIndex("HWDWISSTOP") Then
If Flex(Index).TextMatrix(Flex(Index).Row, Flex(FlexHwDw).Col) = "" Then
Flex(Index).TextMatrix(Flex(Index).Row, Flex(FlexHwDw).Col) = "√"
Else
Flex(Index).TextMatrix(Flex(Index).Row, Flex(FlexHwDw).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 FlexHwDw
If Flex(Index).Rows > 2 And Flex(FlexHwDw).Row <> Flex(FlexHwDw).Rows - 1 Then
Set OHwDw = OHwDws(CStr(Flex(FlexHwDw).RowData(Flex(FlexHwDw).Row)))
Else
Set OHwDw = 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(TlbHwDw).Tag = "" Then
Exit Sub
End If
mCurRow = Flex(FlexHwDw).Row
mCurCol = Flex(FlexHwDw).Col
Select Case Flex(FlexHwDw).ColKey(Flex(FlexHwDw).Col)
Case "HWDWCODE"
If OHwDw Is Nothing Then
AddNewRecord
Else
OHwDw.HwDwCode = Trim(Flex(FlexHwDw).TextMatrix(mCurRow, mCurCol))
End If
Case "HWDWMC"
If Not OHwDw Is Nothing Then
OHwDw.HwDwMc = Trim(Flex(FlexHwDw).TextMatrix(mCurRow, mCurCol))
End If
End Select
Exit Sub
Errorhandle:
Flex(FlexHwDw).TextMatrix(mCurRow, mCurCol) = mCurColOldValue
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub AddNewRecord()
On Error GoTo Errorhandle
If Trim(Flex(FlexHwDw).TextMatrix(Flex(FlexHwDw).Row, Flex(FlexHwDw).Col)) <> "" Then
Set OHwDw = New HwDw
OHwDw.HwDwCode = Trim(Flex(FlexHwDw).TextMatrix(Flex(FlexHwDw).Row, Flex(FlexHwDw).Col))
OHwDws.Add OHwDw
Flex(FlexHwDw).RowData(Flex(FlexHwDw).Rows - 1) = OHwDw.HwDw_Key
Flex(FlexHwDw).AddItem ""
End If
Exit Sub
Errorhandle:
Set OHwDw = Nothing
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub Form_Load()
On Error GoTo Errorhandle
Flex(FlexHwDw).Editable = flexEDKbdMouse
Flex(FlexHwDw).ColKey(1) = "HWDWCODE"
Flex(FlexHwDw).ColKey(2) = "HWDWMC"
Flex(FlexHwDw).ColKey(3) = "HWDWISSTOP"
gPublicCommon.PublicFunction.LoadFormSet Me, Tlbaction(TlbHwDw), Img(ImgHwDw), SBar(SBarHwDw)
gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Flex(FlexHwDw)
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 TlbHwDw, mButton
End If
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub LoadDataIntoGrid()
Dim ItemStr As String
Dim m_HwDw As HwDw
On Error GoTo Errorhandle
Flex(FlexHwDw).Rows = 1
Flex(FlexHwDw).AddItem ""
Set OHwDws = New HwDws
OHwDws.FillbyDb
For Each m_HwDw In OHwDws
ItemStr = vbTab & m_HwDw.HwDwCode & vbTab & m_HwDw.HwDwMc & vbTab & IIf(m_HwDw.HwDwIsStop = 1, "√", "")
Flex(FlexHwDw).AddItem ItemStr, Flex(FlexHwDw).Rows - 1
Flex(FlexHwDw).RowData(Flex(FlexHwDw).Rows - 2) = m_HwDw.HwDw_Key
Next
If Flex(FlexHwDw).Rows > 2 Then
Flex(FlexHwDw).Row = 1
Set OHwDw = OHwDws(CStr(Flex(FlexHwDw).RowData(1)))
Else
Set OHwDw = 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(FlexHwDw).Row = Flex(FlexHwDw).Rows - 1
Flex(FlexHwDw).Col = Flex(FlexHwDw).ColIndex("HWDWCODE")
gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbHwDw), RecordName
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub CancelRecord(RecordName As String)
On Error GoTo Errorhandle
If Tlbaction(TlbHwDw).Tag <> "" Then
gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbHwDw), 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 OHwDws Is Nothing Then
Exit Sub
End If
If OHwDw Is Nothing Then
Exit Sub
End If
If Flex(FlexHwDw).Rows <= 2 Then
Exit Sub
End If
If MsgBox("您真的要删除吗?", vbYesNo) = vbYes Then
OHwDws.Remove CStr(OHwDw.HwDw_Key)
gPublicFunction.RemoveFlexItem Flex(FlexHwDw).Row, Flex(FlexHwDw)
If Flex(FlexHwDw).Rows = 2 Then
Set OHwDw = Nothing
Else
Set OHwDw = OHwDws(CStr(Flex(FlexHwDw).RowData(Flex(FlexHwDw).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
OHwDws.DbSave
gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbHwDw), 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(FlexHwDw).Rows - 2
Set OHwDw = OHwDws.Item(CStr(Flex(FlexHwDw).RowData(I)))
OHwDw.HwDwCode = Trim(Flex(FlexHwDw).TextMatrix(I, Flex(FlexHwDw).ColIndex("HWDWCODE")))
OHwDw.HwDwMc = Trim(Flex(FlexHwDw).TextMatrix(I, Flex(FlexHwDw).ColIndex("HWDWMC")))
OHwDw.HwDwIsStop = IIf(Trim(Flex(FlexHwDw).TextMatrix(I, Flex(FlexHwDw).ColIndex("HWDWISSTOP"))) <> "", 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 OHwDw = Nothing
Set OHwDws = 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(FlexHwDw).EditText) <> "" Then
Flex(FlexHwDw).TextMatrix(Flex(FlexHwDw).Row, Flex(FlexHwDw).Col) = Trim(Flex(FlexHwDw).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 + -