📄 frmhwdbd.frm
字号:
Private Sub Clearcontrol()
On Error GoTo Errorhandle
Text(TxtHwDbdhDocno).Text = ""
Text(TxtHwDbdh_CwqjCode).Text = ""
Combo(CBxHwDbdh_HwDbRcCode).Text = ""
Text(TxtTotalQty).Text = ""
Text(TxtTotalAmt).Text = ""
Flex(FlexHwDbd).Rows = 1
Flex(FlexHwDbd).AddItem ""
Text(TxtHwDbdhDocno).SetFocus
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub SaveRecord(RecordName As String)
On Error GoTo Errorhandle
SetValueToObject
oHwDbdh.Save
gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbHwDbd), RecordName
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub SetValueToObject()
Dim mHwDbd As Hwdbd
Dim I As Integer
On Error GoTo Errorhandle
oHwDbdh.HwdbdhDocno = Trim(Text(TxtHwDbdhDocno).Text)
oHwDbdh.HwdbdhDat = gPublicFunction.ConvDateToString(Text(TxtHwDbdhDat).Text)
oHwDbdh.Hwdbdh_CwQjCode = Trim(Text(TxtHwDbdh_CwqjCode).Text)
oHwDbdh.Hwdbdh_HwDbRcCode = Trim(Combo(CBxHwDbdh_HwDbRcCode).Text)
oHwDbdh.HwdbdhForm = UCase(Me.Name)
For I = 1 To Flex(FlexHwDbd).Rows - 2
Set mHwDbd = oHwDbdh.Hwdbds(CStr(Flex(FlexHwDbd).RowData(I)))
mHwDbd.Hwdbd_HwBmCode = Trim(Flex(FlexHwDbd).TextMatrix(I, Flex(FlexHwDbd).ColIndex("HWBMCODE")))
mHwDbd.Hwdbd_HwDwCode = Trim(Flex(FlexHwDbd).TextMatrix(I, Flex(FlexHwDbd).ColIndex("HWDWCODE")))
mHwDbd.Hwdbd_HwDwConv = Val(Flex(FlexHwDbd).TextMatrix(I, Flex(FlexHwDbd).ColIndex("HwDbd_HWDWCONV")))
mHwDbd.Hwdbd_FromHwCkMc = Trim(Flex(FlexHwDbd).TextMatrix(I, Flex(FlexHwDbd).ColIndex("HWDBD_FROMHWCKMC|HWCKMC")))
mHwDbd.Hwdbd_ToHwCkMc = Trim(Flex(FlexHwDbd).TextMatrix(I, Flex(FlexHwDbd).ColIndex("HWDBD_TOHWCKMC|HWCKMC")))
mHwDbd.HwdbdQty = Val(Flex(FlexHwDbd).TextMatrix(I, Flex(FlexHwDbd).ColIndex("HwDbdQTY")))
mHwDbd.HwdbdPrice = Val(Flex(FlexHwDbd).TextMatrix(I, Flex(FlexHwDbd).ColIndex("HwDbdPRICE")))
mHwDbd.HwdbdAmt = Val(Flex(FlexHwDbd).TextMatrix(I, Flex(FlexHwDbd).ColIndex("HwDbdAMT")))
mHwDbd.HwdbdBz = Trim(Flex(FlexHwDbd).TextMatrix(I, Flex(FlexHwDbd).ColIndex("HwDbdBZ")))
Next
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub DelRecord(RecordName As String)
On Error GoTo Errorhandle
Select Case UCase(RecordName)
Case "DEL"
If oHwDbdh Is Nothing Then
Err.Raise vbObjectError + 1, , "无单据,不能进行删除!"
Exit Sub
End If
If MsgBox("您真的要删除当前整张单据吗?", vbYesNo + vbQuestion) = vbYes Then
oHwDbdh.Del
Set oHwDbd = Nothing
Set oHwDbdh = Nothing
Clearcontrol
End If
Case "DEF"
If Flex(FlexHwDbd).Row = Flex(FlexHwDbd).Rows - 1 Then
Exit Sub
End If
If MsgBox("您真的要删除单据当前行吗?", vbYesNo + vbQuestion) = vbYes Then
oHwDbdh.Hwdbds.Remove CStr(oHwDbd.HwdbdKey)
Flex(FlexHwDbd).RemoveItem Flex(FlexHwDbd).Row
If Flex(FlexHwDbd).Rows = 2 Then
Set oHwDbd = Nothing
Set oHwDbdh = Nothing
Clearcontrol
gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbHwDbd), "CAN"
Else
If Flex(FlexHwDbd).Row = Flex(FlexHwDbd).Rows - 1 Then
Flex(FlexHwDbd).Row = Flex(FlexHwDbd).Row - 1
End If
Set oHwDbd = oHwDbdh.Hwdbds(CStr(Flex(FlexHwDbd).RowData(Flex(FlexHwDbd).Row)))
End If
End If
End Select
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub Flex_RowColChange(Index As Integer)
On Error GoTo Errorhandle
Select Case Index
Case FlexHwDbd
If Flex(FlexHwDbd).Row <> Flex(FlexHwDbd).Rows - 1 Then
Set oHwDbd = oHwDbdh.Hwdbds(CStr(Flex(FlexHwDbd).RowData(Flex(FlexHwDbd).Row)))
Else
Set oHwDbd = Nothing
End If
End Select
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub SetValueToControl()
On Error GoTo Errorhandle
Text(TxtHwDbdhDocno).Text = oHwDbdh.HwdbdhDocno
Text(TxtHwDbdhDat).Text = gPublicFunction.ConvStringToDate(oHwDbdh.HwdbdhDat)
Text(TxtHwDbdh_CwqjCode).Text = oHwDbdh.Hwdbdh_CwQjCode
Combo(CBxHwDbdh_HwDbRcCode).Text = oHwDbdh.Hwdbdh_HwDbRcCode
LoadDataIntoGrid
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Errorhandle
Set oHwDbdhs = Nothing
Set oHwDbdh = Nothing
Set oHwDbd = Nothing
gPublicFunction.SaveFormSet Me
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub muEdit_Click(Index As Integer)
On Error GoTo Errorhandle
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Text_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
On Error GoTo Errorhandle
gPublicFunction.FormKeyDown Me, KeyCode, Shift, Text(Index)
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Text_KeyPress(Index As Integer, KeyAscii As Integer)
On Error GoTo Errorhandle
gPublicFunction.InputCheck Me, Text(Index), KeyAscii
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(TlbHwDbd).Tag = "" Then
Exit Sub
End If
mCurRow = Flex(FlexHwDbd).Row
mCurCol = Flex(FlexHwDbd).Col
Select Case Flex(FlexHwDbd).ColKey(Flex(FlexHwDbd).Col)
Case "HWBMCODE"
If oHwDbd Is Nothing Then
AddNewRecord
Else
oHwDbd.Hwdbd_HwBmCode = Trim(Flex(FlexHwDbd).TextMatrix(mCurRow, mCurCol))
Flex(FlexHwDbd).TextMatrix(mCurRow, Flex(FlexHwDbd).ColIndex("HWBMMC")) = oHwDbd.Hwdbd_HwBmMc
Flex(FlexHwDbd).TextMatrix(mCurRow, Flex(FlexHwDbd).ColIndex("HWDWCODE")) = oHwDbd.Hwdbd_HwDwCode
Flex(FlexHwDbd).TextMatrix(mCurRow, Flex(FlexHwDbd).ColIndex("HWDBD_HWDWCONV")) = oHwDbd.Hwdbd_HwDwConv
End If
Case "HWDWCODE"
If Not oHwDbd Is Nothing Then
oHwDbd.Hwdbd_HwDwCode = Trim(Flex(FlexHwDbd).TextMatrix(mCurRow, mCurCol))
End If
Case "HWDBD_HWDWCONV"
If Not oHwDbd Is Nothing Then
oHwDbd.Hwdbd_HwDwConv = Val(Flex(FlexHwDbd).TextMatrix(mCurRow, mCurCol))
End If
Case "HWDBD_FROMHWCKMC|HWCKMC"
If Not oHwDbd Is Nothing Then
oHwDbd.Hwdbd_FromHwCkMc = Trim(Flex(FlexHwDbd).TextMatrix(mCurRow, mCurCol))
End If
Case "HWDBD_TOHWCKMC|HWCKMC"
If Not oHwDbd Is Nothing Then
oHwDbd.Hwdbd_ToHwCkMc = Trim(Flex(FlexHwDbd).TextMatrix(mCurRow, mCurCol))
End If
Case "HWDBDQTY"
If Not oHwDbd Is Nothing Then
oHwDbd.HwdbdQty = Val(Flex(FlexHwDbd).TextMatrix(Flex(FlexHwDbd).Row, mCurCol))
Flex(FlexHwDbd).TextMatrix(Flex(FlexHwDbd).Row, Flex(FlexHwDbd).ColIndex("HwDbdAMT")) = oHwDbd.HwdbdAmt
End If
Case "HWDBDPRICE"
If Not oHwDbd Is Nothing Then
oHwDbd.HwdbdPrice = Val(Flex(FlexHwDbd).TextMatrix(Flex(FlexHwDbd).Row, mCurCol))
Flex(FlexHwDbd).TextMatrix(Flex(FlexHwDbd).Row, Flex(FlexHwDbd).ColIndex("HwDbdAMT")) = oHwDbd.HwdbdAmt
End If
Case "HWDBDAMT"
If Not oHwDbd Is Nothing Then
oHwDbd.HwdbdAmt = Val(Flex(FlexHwDbd).TextMatrix(Flex(FlexHwDbd).Row, mCurCol))
End If
Case "HWDBDBZ"
If Not oHwDbd Is Nothing Then
oHwDbd.HwdbdBz = Trim(Flex(FlexHwDbd).TextMatrix(Flex(FlexHwDbd).Row, mCurCol))
End If
End Select
If UCase(Flex(FlexHwDbd).ColKey(Flex(FlexHwDbd).Col)) = "HWDBDQTY" Or UCase(Flex(FlexHwDbd).ColKey(Flex(FlexHwDbd).Col)) = "HWDBDPRICE" Or UCase(Flex(FlexHwDbd).ColKey(Flex(FlexHwDbd).Col)) = "HWDBDAMT" Then
gPublicFunction.SumFlexQtyAmt Flex(FlexHwDbd), "HWDBDQTY,HWDBDAMT", Text(TxtTotalQty), Text(TxtTotalAmt)
End If
Exit Sub
Errorhandle:
Flex(FlexHwDbd).TextMatrix(mCurRow, mCurCol) = mCurColOldValue
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub AddNewRecord()
Dim mCurRow As Integer
On Error GoTo Errorhandle
mCurRow = Flex(FlexHwDbd).Row
If Trim(Flex(FlexHwDbd).TextMatrix(mCurRow, Flex(FlexHwDbd).Col)) <> "" Then
Set oHwDbd = New Hwdbd
Set oHwDbd.Hwdbdh = oHwDbdh
oHwDbd.Hwdbd_HwBmCode = Trim(Flex(FlexHwDbd).TextMatrix(mCurRow, Flex(FlexHwDbd).Col))
Flex(FlexHwDbd).TextMatrix(mCurRow, Flex(FlexHwDbd).ColIndex("HWBMMC")) = oHwDbd.Hwdbd_HwBmMc
Flex(FlexHwDbd).TextMatrix(mCurRow, Flex(FlexHwDbd).ColIndex("HWDWCODE")) = oHwDbd.Hwdbd_HwDwCode
Flex(FlexHwDbd).TextMatrix(mCurRow, Flex(FlexHwDbd).ColIndex("HWDBD_HWDWCONV")) = oHwDbd.Hwdbd_HwDwConv
oHwDbdh.Hwdbds.Add oHwDbd, 0
Flex(FlexHwDbd).RowData(Flex(FlexHwDbd).Rows - 1) = oHwDbd.HwdbdKey
Flex(FlexHwDbd).AddItem ""
End If
Exit Sub
Errorhandle:
Set oHwDbd = Nothing
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub Form_Resize()
On Error GoTo Errorhandle
gPublicFunction.ResizeForm Me
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Text_LostFocus(Index As Integer)
On Error GoTo Errorhandle
Select Case Index
Case TxtHwDbdhDat
If Tlbaction(TlbHwDbd).Tag <> "" And Trim(Text(TxtHwDbdhDat).Text) <> "" Then
Text(TxtHwDbdhDat).Text = gPublicFunction.SetDateFormat(Text(TxtHwDbdhDat).Text)
oHwDbdh.HwdbdhDat = gPublicFunction.ConvDateToString(Text(TxtHwDbdhDat).Text)
Text(TxtHwDbdh_CwqjCode).Text = oHwDbdh.Hwdbdh_CwQjCode
End If
Case TxtHwDbdhDocno
If Tlbaction(TlbHwDbd).Tag = "" Then
If Trim(Text(Index).Text) = "" Then
Exit Sub
End If
If Not oHwDbdh Is Nothing Then
If oHwDbdh.HwdbdhDocno = Text(TxtHwDbdhDocno).Text Then
Exit Sub
End If
End If
Set oHwDbdh = New Hwdbdh
If oHwDbdh.Requery(Text(TxtHwDbdhDocno).Text) = 1 Then
SetValueToControl
Else
Set oHwDbdh = Nothing
Dim vHwDbddocno As String
vHwDbddocno = Text(TxtHwDbdhDocno).Text
AddRecord "ADD"
Text(TxtHwDbdhDocno).Text = vHwDbddocno
End If
End If
End Select
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(FlexHwDbd).EditText) <> "" Then
Flex(FlexHwDbd).TextMatrix(Flex(FlexHwDbd).Row, Flex(FlexHwDbd).Col) = Trim(Flex(FlexHwDbd).EditText)
End If
Select Case Action
Case "ADD"
AddRecord RecordName
Case "CHG"
ChgRecord RecordName
Case "CAN"
CancelRecord RecordName
Case "SAV"
SaveRecord RecordName
Case "DEL", "DEF"
DelRecord RecordName
Case "EXI"
Unload Me
Case "FIN"
ShowBmQuery
Case Else
End Select
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 TlbHwDbd, mButton
End If
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub ShowBmQuery()
Dim mCodeType As String
Dim mQueryValue As String
On Error GoTo Errorhandle
If Tlbaction(TlbHwDbd).Tag = "" Then
Exit Sub
End If
If Me.ActiveControl Is Nothing Then
Exit Sub
End If
If Me.ActiveControl Is Flex(FlexHwDbd) Then
Select Case UCase(Flex(FlexHwDbd).ColKey(Flex(FlexHwDbd).Col))
Case "HWBMCODE", "HWDWCODE", "HWDBD_FROMHWCKMC|HWCKMC", "HWDBD_TOHWCKMC|HWCKMC"
mCodeType = UCase(Flex(FlexHwDbd).ColKey(Flex(FlexHwDbd).Col))
End Select
If mCodeType <> "" Then
mQueryValue = gPublicFunction.GetBmQueryValue(Me, mCodeType)
If mQueryValue <> "" Then
Flex(FlexHwDbd).TextMatrix(Flex(FlexHwDbd).Row, Flex(FlexHwDbd).Col) = mQueryValue
Flex(FlexHwDbd).EditCell
SetControlToFlex
End If
End If
Else
Select Case Mid(UCase(Me.ActiveControl.Tag), 4)
Case "CWQJCODE", "HWDBRCCODE"
mCodeType = Mid(UCase(Me.ActiveControl.Tag), 4)
End Select
If mCodeType <> "" Then
mQueryValue = gPublicFunction.GetBmQueryValue(Me, mCodeType)
If mQueryValue <> "" Then
Me.ActiveControl.Text = mQueryValue
End If
End If
End If
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -