frmcgshdap.frm
来自「制造业产供销与往来系统源码,包括进销存及全部控件!」· FRM 代码 · 共 1,504 行 · 第 1/4 页
FRM
1,504 行
Const TxtCgShdAphDocno = 0
Const TxtCgShdAphDat = 6
Const TxtCgShdAph_CwqjCode = 5
Const CBxCgShdAph_KhCode = 0
Const CBxCgShdAph_CwBzCode = 2
Const TxtTotalQty = 1
Const TxtTotalAmt = 2
Const TxtTotalQAmt = 3
Const TxtTotalTAmt = 4
Dim mCurColOldValue As String
Dim oCgShdAph As CgShdAph
Dim oCgShdAp As CgShdAp
Public Sub LetDocno(vDocno As String)
On Error GoTo Errorhandle
Text(TxtCgShdAphDocno).Text = vDocno
Text_LostFocus TxtCgShdAphDocno
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(TlbCgShdAp).Tag = "" Then
Exit Sub
End If
Select Case Index
Case CBxCgShdAph_KhCode
If Trim(Combo(CBxCgShdAph_KhCode).Text) <> "" Then
oCgShdAph.CgShdAph_KhCode = Combo(CBxCgShdAph_KhCode).Text
Combo(CBxCgShdAph_CwBzCode).Text = oCgShdAph.CgShdAph_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(TlbCgShdAp).Tag = "" Then
Cancel = True
End If
If oCgShdAph Is Nothing Then
Cancel = True
End If
mCurColOldValue = Trim(Flex(FlexCgShdAp).TextMatrix(Flex(FlexCgShdAp).Row, Flex(FlexCgShdAp).Col))
Select Case Flex(FlexCgShdAp).ColKey(Col)
Case "HWBMCODE"
Case "HWCKMC", "CGSHDAP_HWDWCONV", "CGSHDAPQTY", "CGSHDAPPRICE", "CGSHDAPAMT", "CGSHDAPQAMT", "CGSHDAPTAMT", "CGSHDAPBZ"
If oCgShdAp Is Nothing Then
Cancel = True
End If
Case "HWDWCODE"
If oCgShdAp Is Nothing Then
Cancel = True
End If
Case "CWSMCODE"
If oCgShdAp 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(TxtCgShdAphDocno).SetFocus
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
On Error GoTo Errorhandle
Flex(FlexCgShdAp).Editable = flexEDKbdMouse
Flex(FlexCgShdAp).ColKey(1) = "CGPODHDOCNO"
Flex(FlexCgShdAp).ColKey(2) = "HWBMCODE"
Flex(FlexCgShdAp).ColKey(3) = "HWBMMC"
Flex(FlexCgShdAp).ColKey(4) = "HWDWCODE"
Flex(FlexCgShdAp).ColKey(5) = "CGSHDAP_HWDWCONV"
Flex(FlexCgShdAp).ColKey(6) = "HWCKMC"
Flex(FlexCgShdAp).ColKey(7) = "CGSHDAPQTY"
Flex(FlexCgShdAp).ColKey(8) = "CGSHDAPPRICE"
Flex(FlexCgShdAp).ColKey(9) = "CGSHDAPAMT"
Flex(FlexCgShdAp).ColKey(10) = "CGSHDAPQAMT"
Flex(FlexCgShdAp).ColKey(11) = "CGSHDAPTAMT"
Flex(FlexCgShdAp).ColKey(12) = "CWSMCODE"
Flex(FlexCgShdAp).ColKey(13) = "CGSHDAPBZ"
gPublicFunction.LoadFormSet Me, Tlbaction(TlbCgShdAp), Img(ImgCgShdAp), SBar(SbarCgShdAp)
gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "CgShdAp", "TXTCgShdApHDOCNO", "CBXCWBZCODE"
gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Flex(FlexCgShdAp), Text(TxtCgShdAphDocno)
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(CBxCgShdAph_KhCode), "SELECT KHCODE,KHNO FROM KHREC WHERE KHTYPE=2 ORDER BY KHCODE", "KHNO", 0
gPublicFunction.FillComboWithSql Me, Combo(CBxCgShdAph_CwBzCode), "SELECT CwBzCODE,CwBzNO FROM CwBzREC ORDER BY CwBzCODE", "CwBzNO", 0
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub LoadDataIntoGrid()
Dim ItemStr As String
Dim mCgShdAph As CgShdAph
Dim mCgShdAp As CgShdAp
On Error GoTo Errorhandle
Flex(FlexCgShdAp).Rows = 1
Flex(FlexCgShdAp).AddItem ""
oCgShdAph.CgShdAps.FillbyDb oCgShdAph
For Each mCgShdAp In oCgShdAph.CgShdAps
ItemStr = vbTab & mCgShdAp.CgShdAp_CgPodDocno & vbTab & mCgShdAp.CgShdAp_HwBmCode & vbTab & mCgShdAp.CgShdAp_HwBmMc
ItemStr = ItemStr & vbTab & mCgShdAp.CgShdAp_HwDwCode & vbTab & mCgShdAp.CgShdAp_HwDwConv & vbTab & mCgShdAp.CgShdAp_HwCkMc
ItemStr = ItemStr & vbTab & mCgShdAp.CgShdApQty & vbTab & mCgShdAp.CgShdApPrice & vbTab & mCgShdAp.CgShdApAmt & vbTab & mCgShdAp.CgShdApQAmt & vbTab & mCgShdAp.CgShdApTAmt & vbTab & mCgShdAp.CgShdAp_CwSmCode & vbTab & mCgShdAp.CgShdApBz
Flex(FlexCgShdAp).AddItem ItemStr, Flex(FlexCgShdAp).Rows - 1
Flex(FlexCgShdAp).RowData(Flex(FlexCgShdAp).Rows - 2) = mCgShdAp.CgShdApKey
Next
If Flex(FlexCgShdAp).Rows > 2 Then
Flex(FlexCgShdAp).Row = 1
Set oCgShdAp = oCgShdAph.CgShdAps(CStr(Flex(FlexCgShdAp).RowData(1)))
Else
Set oCgShdAp = Nothing
End If
gPublicFunction.SumFlexQtyAmt Flex(FlexCgShdAp), "CGSHDAPQTY,CGSHDAPAMT,CGSHDAPQAMT,CGSHDAPTAMT", Text(TxtTotalQty), Text(TxtTotalAmt), Text(TxtTotalQAmt), Text(TxtTotalTAmt)
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub AddRecord(RecordName As String)
On Error GoTo Errorhandle
Set oCgShdAph = New CgShdAph
Set oCgShdAp = Nothing
Clearcontrol
Text(TxtCgShdAphDocno).SetFocus
If Text(TxtCgShdAphDat).Text = "" Then
Text(TxtCgShdAphDat).Text = gPublicCommon.PublicSysDatas("SYSTEMDATE").SysDataValue
End If
oCgShdAph.CgShdAphDat = Trim(Text(TxtCgShdAphDat).Text)
Text(TxtCgShdAph_CwqjCode).Text = oCgShdAph.CgShdAph_CwQjCode
gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbCgShdAp), RecordName
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub ChgRecord(RecordName As String)
On Error GoTo Errorhandle
If oCgShdAph Is Nothing Then
Exit Sub
End If
Text(TxtCgShdAphDocno).SetFocus
gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbCgShdAp), RecordName
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub CancelRecord(RecordName As String)
On Error GoTo Errorhandle
If oCgShdAph.CgShdAphId = -1 Then
Clearcontrol
Set oCgShdAp = Nothing
Set oCgShdAph = Nothing
Else
oCgShdAph.Requery oCgShdAph.CgShdAphDocno
SetValueToControl
End If
gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbCgShdAp), RecordName
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub Clearcontrol()
On Error GoTo Errorhandle
Text(TxtCgShdAphDocno).Text = ""
Text(TxtCgShdAph_CwqjCode).Text = ""
Combo(CBxCgShdAph_KhCode).Text = ""
Combo(CBxCgShdAph_CwBzCode).Text = ""
Text(TxtTotalQty).Text = ""
Text(TxtTotalAmt).Text = ""
Text(TxtTotalQAmt).Text = ""
Text(TxtTotalTAmt).Text = ""
Flex(FlexCgShdAp).Rows = 1
Flex(FlexCgShdAp).AddItem ""
Text(TxtCgShdAphDocno).SetFocus
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub SaveRecord(RecordName As String)
On Error GoTo Errorhandle
SetValueToObject
oCgShdAph.Save
gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbCgShdAp), RecordName
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub SetValueToObject()
Dim mCgShdAp As CgShdAp
Dim I As Integer
On Error GoTo Errorhandle
oCgShdAph.CgShdAphType = 1
oCgShdAph.CgShdAphDocno = Trim(Text(TxtCgShdAphDocno).Text)
oCgShdAph.CgShdAphDat = gPublicFunction.ConvDateToString(Text(TxtCgShdAphDat).Text)
oCgShdAph.CgShdAph_CwQjCode = Trim(Text(TxtCgShdAph_CwqjCode).Text)
oCgShdAph.CgShdAph_KhCode = Trim(Combo(CBxCgShdAph_KhCode).Text)
oCgShdAph.CgShdAph_CwBzCode = Trim(Combo(CBxCgShdAph_CwBzCode).Text)
oCgShdAph.CgShdAphForm = UCase(Me.Name)
For I = 1 To Flex(FlexCgShdAp).Rows - 2
Set mCgShdAp = oCgShdAph.CgShdAps(CStr(Flex(FlexCgShdAp).RowData(I)))
mCgShdAp.CgShdAp_HwBmCode = Trim(Flex(FlexCgShdAp).TextMatrix(I, Flex(FlexCgShdAp).ColIndex("HWBMCODE")))
mCgShdAp.CgShdAp_HwDwCode = Trim(Flex(FlexCgShdAp).TextMatrix(I, Flex(FlexCgShdAp).ColIndex("HWDWCODE")))
mCgShdAp.CgShdAp_HwDwConv = Val(Flex(FlexCgShdAp).TextMatrix(I, Flex(FlexCgShdAp).ColIndex("CGSHDAP_HWDWCONV")))
mCgShdAp.CgShdAp_HwCkMc = Trim(Flex(FlexCgShdAp).TextMatrix(I, Flex(FlexCgShdAp).ColIndex("HWCKMC")))
mCgShdAp.CgShdApQty = Val(Flex(FlexCgShdAp).TextMatrix(I, Flex(FlexCgShdAp).ColIndex("CGSHDAPQTY")))
mCgShdAp.CgShdApPrice = Val(Flex(FlexCgShdAp).TextMatrix(I, Flex(FlexCgShdAp).ColIndex("CGSHDAPPRICE")))
mCgShdAp.CgShdApAmt = Val(Flex(FlexCgShdAp).TextMatrix(I, Flex(FlexCgShdAp).ColIndex("CGSHDAPAMT")))
mCgShdAp.CgShdApQAmt = Val(Flex(FlexCgShdAp).TextMatrix(I, Flex(FlexCgShdAp).ColIndex("CGSHDAPQAMT")))
mCgShdAp.CgShdApTAmt = Val(Flex(FlexCgShdAp).TextMatrix(I, Flex(FlexCgShdAp).ColIndex("CGSHDAPTAMT")))
mCgShdAp.CgShdAp_CwSmCode = Trim(Flex(FlexCgShdAp).TextMatrix(I, Flex(FlexCgShdAp).ColIndex("CWSMCODE")))
mCgShdAp.CgShdApBz = Trim(Flex(FlexCgShdAp).TextMatrix(I, Flex(FlexCgShdAp).ColIndex("CGSHDAPBZ")))
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 oCgShdAph Is Nothing Then
Err.Raise vbObjectError + 1, , "无单据,不能进行删除!"
Exit Sub
End If
If MsgBox("您真的要删除当前整张单据吗?", vbYesNo + vbQuestion) = vbYes Then
oCgShdAph.Del
Set oCgShdAp = Nothing
Set oCgShdAph = Nothing
Clearcontrol
End If
Case "DEF"
If Flex(FlexCgShdAp).Row = Flex(FlexCgShdAp).Rows - 1 Then
Exit Sub
End If
If MsgBox("您真的要删除单据当前行吗?", vbYesNo + vbQuestion) = vbYes Then
oCgShdAph.CgShdAps.Remove CStr(oCgShdAp.CgShdApKey)
Flex(FlexCgShdAp).RemoveItem Flex(FlexCgShdAp).Row
If Flex(FlexCgShdAp).Rows = 2 Then
Set oCgShdAp = Nothing
Set oCgShdAph = Nothing
Clearcontrol
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?