frmcgthd.frm
来自「制造业产供销与往来系统源码,包括进销存及全部控件!」· FRM 代码 · 共 1,497 行 · 第 1/4 页
FRM
1,497 行
Const FlexCgShd = 0
Const TxtCgShdhDocno = 0
Const TxtCgShdhDat = 6
Const TxtCgShdh_CwqjCode = 5
Const CBxCgShdh_KhCode = 0
Const CBxCgShdh_CwBzCode = 2
Const TxtTotalQty = 1
Const TxtTotalAmt = 2
Const TxtTotalQAmt = 3
Const TxtTotalTAmt = 4
Dim mCurColOldValue As String
Dim oCgShdhs As CgShdhs
Dim oCgShdh As Cgshdh
Dim oCgShd As CgShd
Public Sub LetDocno(vDocno As String)
On Error GoTo Errorhandle
Text(TxtCgShdhDocno).Text = vDocno
Text_LostFocus TxtCgShdhDocno
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub Combo_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
On Error GoTo Errorhandle
gPublicFunction.FormKeyDown Me, KeyCode, Shift, Combo(Index)
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Combo_LostFocus(Index As Integer)
On Error GoTo Errorhandle
If Tlbaction(TlbCgshd).Tag = "" Then
Exit Sub
End If
Select Case Index
Case CBxCgShdh_KhCode
If Trim(Combo(CBxCgShdh_KhCode).Text) <> "" Then
oCgShdh.CgShdh_KhCode = Combo(CBxCgShdh_KhCode).Text
Combo(CBxCgShdh_CwBzCode).Text = oCgShdh.CgShdh_CwBzCode
End If
End Select
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
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
If Tlbaction(TlbCgshd).Tag = "" Then
Cancel = True
End If
If oCgShdh Is Nothing Then
Cancel = True
End If
mCurColOldValue = Trim(Flex(FlexCgShd).TextMatrix(Flex(FlexCgShd).Row, Flex(FlexCgShd).Col))
Select Case Flex(FlexCgShd).ColKey(Col)
Case "HWBMCODE"
Case "HWCKMC", "CGSHD_HWDWCONV", "CGSHDQTY", "CGSHDPRICE", "CGSHDAMT", "CGSHDQAMT", "CGSHDTAMT", "CGSHDBZ"
If oCgShd Is Nothing Then
Cancel = True
End If
Case "HWDWCODE"
If oCgShd Is Nothing Then
Cancel = True
End If
Case "CWSMCODE"
If oCgShd Is Nothing Then
Cancel = True
End If
Case Else
Cancel = True
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 Form_Activate()
On Error GoTo Errorhandle
Text(TxtCgShdhDocno).SetFocus
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
On Error GoTo Errorhandle
Flex(FlexCgShd).Editable = flexEDKbdMouse
Flex(FlexCgShd).ColKey(1) = "CGPODHDOCNO"
Flex(FlexCgShd).ColKey(2) = "HWBMCODE"
Flex(FlexCgShd).ColKey(3) = "HWBMMC"
Flex(FlexCgShd).ColKey(4) = "HWDWCODE"
Flex(FlexCgShd).ColKey(5) = "CGSHD_HWDWCONV"
Flex(FlexCgShd).ColKey(6) = "HWCKMC"
Flex(FlexCgShd).ColKey(7) = "CGSHDQTY"
Flex(FlexCgShd).ColKey(8) = "CGSHDPRICE"
Flex(FlexCgShd).ColKey(9) = "CGSHDAMT"
Flex(FlexCgShd).ColKey(10) = "CGSHDQAMT"
Flex(FlexCgShd).ColKey(11) = "CGSHDTAMT"
Flex(FlexCgShd).ColKey(12) = "CWSMCODE"
Flex(FlexCgShd).ColKey(13) = "CGSHDBZ"
gPublicFunction.LoadFormSet Me, Tlbaction(TlbCgshd), Img(ImgCgshd), SBar(SbarCgshd)
gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "Cgshd", "TXTCGSHDHDOCNO", "CBXCWBZCODE"
gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Flex(FlexCgShd), Text(TxtCgShdhDocno)
gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "ADD", Text(TxtTotalQty), Text(TxtTotalAmt), Text(TxtTotalQAmt), Text(TxtTotalTAmt)
gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "CHG", Text(TxtTotalQty), Text(TxtTotalAmt), Text(TxtTotalQAmt), Text(TxtTotalTAmt)
gPublicCommon.PublicFunction.EnableControl Me, ""
gPublicFunction.FillComboWithSql Me, Combo(CBxCgShdh_KhCode), "SELECT KHCODE,KHNO FROM KHREC WHERE KHTYPE=2 ORDER BY KHCODE", "KHNO", 0
gPublicFunction.FillComboWithSql Me, Combo(CBxCgShdh_CwBzCode), "SELECT CwBzCODE,CwBzNO FROM CwBzREC ORDER BY CwBzCODE", "CwBzNO", 0
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub LoadDataIntoGrid(Index As String)
Dim ItemStr As String
Dim mCgShdh As Cgshdh
Dim mCgShd As CgShd
On Error GoTo Errorhandle
Select Case UCase(Index)
Case "CGSHD"
Flex(FlexCgShd).Rows = 1
Flex(FlexCgShd).AddItem ""
oCgShdh.CgShds.FillbyDb oCgShdh
For Each mCgShd In oCgShdh.CgShds
ItemStr = vbTab & mCgShd.CgShd_CgPodDocno & vbTab & mCgShd.CgShd_HwBmCode & vbTab & mCgShd.CgShd_HwBmMc
ItemStr = ItemStr & vbTab & mCgShd.CgShd_HwDwCode & vbTab & mCgShd.CgShd_HwDwConv & vbTab & mCgShd.CgShd_HwCkMc
ItemStr = ItemStr & vbTab & mCgShd.CgShdQty & vbTab & mCgShd.CgShdPrice & vbTab & mCgShd.CgShdAmt & vbTab & mCgShd.CgShdQAmt & vbTab & mCgShd.CgShdTAmt & vbTab & mCgShd.CgShd_CwSmCode & vbTab & mCgShd.CgShdBz
Flex(FlexCgShd).AddItem ItemStr, Flex(FlexCgShd).Rows - 1
Flex(FlexCgShd).RowData(Flex(FlexCgShd).Rows - 2) = mCgShd.CgShdKey
Next
If Flex(FlexCgShd).Rows > 2 Then
Flex(FlexCgShd).Row = 1
Set oCgShd = oCgShdh.CgShds(CStr(Flex(FlexCgShd).RowData(1)))
Else
Set oCgShd = Nothing
End If
gPublicFunction.SumFlexQtyAmt Flex(FlexCgShd), "CGSHDQTY,CGSHDAMT,CGSHDQAMT,CGSHDTAMT", Text(TxtTotalQty), Text(TxtTotalAmt), Text(TxtTotalQAmt), Text(TxtTotalTAmt)
End Select
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub AddRecord(RecordName As String)
On Error GoTo Errorhandle
Set oCgShdh = New Cgshdh
Set oCgShd = Nothing
Clearcontrol
Text(TxtCgShdhDocno).SetFocus
If Text(TxtCgShdhDat).Text = "" Then
Text(TxtCgShdhDat).Text = gPublicCommon.PublicSysDatas("SYSTEMDATE").SysDataValue
End If
oCgShdh.CgShdhDat = Trim(Text(TxtCgShdhDat).Text)
Text(TxtCgShdh_CwqjCode).Text = oCgShdh.CgShdh_CwQjCode
gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbCgshd), RecordName
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub ChgRecord(RecordName As String)
On Error GoTo Errorhandle
If oCgShdh Is Nothing Then
Exit Sub
End If
Text(TxtCgShdhDocno).SetFocus
gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbCgshd), RecordName
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub CancelRecord(RecordName As String)
On Error GoTo Errorhandle
If oCgShdh.CgShdhId = -1 Then
Clearcontrol
Set oCgShd = Nothing
Set oCgShdh = Nothing
Else
oCgShdh.Requery oCgShdh.CgShdhDocno
SetValueToControl
End If
gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbCgshd), RecordName
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub Clearcontrol()
On Error GoTo Errorhandle
Text(TxtCgShdhDocno).Text = ""
Text(TxtCgShdh_CwqjCode).Text = ""
Combo(CBxCgShdh_KhCode).Text = ""
Combo(CBxCgShdh_CwBzCode).Text = ""
Text(TxtTotalQty).Text = ""
Text(TxtTotalAmt).Text = ""
Text(TxtTotalQAmt).Text = ""
Text(TxtTotalTAmt).Text = ""
Flex(FlexCgShd).Rows = 1
Flex(FlexCgShd).AddItem ""
Text(TxtCgShdhDocno).SetFocus
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub SaveRecord(RecordName As String)
On Error GoTo Errorhandle
SetValueToObject
oCgShdh.Save
gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbCgshd), RecordName
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub SetValueToObject()
Dim mCgShd As CgShd
Dim I As Integer
On Error GoTo Errorhandle
oCgShdh.CgShdhType = 2
oCgShdh.CgShdhDocno = Trim(Text(TxtCgShdhDocno).Text)
oCgShdh.CgShdhDat = gPublicFunction.ConvDateToString(Text(TxtCgShdhDat).Text)
oCgShdh.CgShdh_CwQjCode = Trim(Text(TxtCgShdh_CwqjCode).Text)
oCgShdh.CgShdh_KhCode = Trim(Combo(CBxCgShdh_KhCode).Text)
oCgShdh.CgShdh_CwBzCode = Trim(Combo(CBxCgShdh_CwBzCode).Text)
oCgShdh.CgShdhForm = UCase(Me.Name)
For I = 1 To Flex(FlexCgShd).Rows - 2
Set mCgShd = oCgShdh.CgShds(CStr(Flex(FlexCgShd).RowData(I)))
mCgShd.CgShd_HwBmCode = Trim(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("HWBMCODE")))
mCgShd.CgShd_HwDwCode = Trim(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("HWDWCODE")))
mCgShd.CgShd_HwDwConv = Val(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("CGSHD_HWDWCONV")))
mCgShd.CgShd_HwCkMc = Trim(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("HWCKMC")))
mCgShd.CgShdQty = Val(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("CGSHDQTY")))
mCgShd.CgShdPrice = Val(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("CGSHDPRICE")))
mCgShd.CgShdAmt = Val(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("CGSHDAMT")))
mCgShd.CgShdQAmt = Val(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("CGSHDQAMT")))
mCgShd.CgShdTAmt = Val(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("CGSHDTAMT")))
mCgShd.CgShd_CwSmCode = Trim(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("CWSMCODE")))
mCgShd.CgShdBz = Trim(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("CGSHDBZ")))
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 oCgShdh Is Nothing Then
Err.Raise vbObjectError + 1, , "无单据,不能进行删除!"
Exit Sub
End If
If MsgBox("您真的要删除当前整张单据吗?", vbYesNo + vbQuestion) = vbYes Then
oCgShdh.Del
Set oCgShd = Nothing
Set oCgShdh = Nothing
Clearcontrol
End If
Case "DEF"
If Flex(FlexCgShd).Row = Flex(FlexCgShd).Rows - 1 Then
Exit Sub
End If
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?