frmcgthdap.frm
来自「制造业产供销与往来系统源码」· FRM 代码 · 共 1,515 行 · 第 1/4 页
FRM
1,515 行
gPublicFunction.SumFlexQtyAmt Flex(FlexCgShdAp), "CGSHDAPQTY,CGSHDAPAMT,CGSHDAPQAMT,CGSHDAPTAMT", Text(TxtTotalQty), Text(TxtTotalAmt), Text(TxtTotalQAmt), Text(TxtTotalTAmt)
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 FlexCgShdAph
If Flex(FlexCgShdAph).Rows > 1 Then
Set oCgShdAph = oCgShdAphs(CStr(Flex(FlexCgShdAph).RowData(Flex(FlexCgShdAph).Row)))
SetValueToControl
Else
Set oCgShdAph = Nothing
Clearcontrol
End If
Case FlexCgShdAp
If Flex(FlexCgShdAp).Row <> Flex(FlexCgShdAp).Rows - 1 Then
Set oCgShdAp = oCgShdAph.CgShdAps(CStr(Flex(FlexCgShdAp).RowData(Flex(FlexCgShdAp).Row)))
Else
Set oCgShdAp = Nothing
End If
End Select
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub SetValueToControl()
On Error GoTo Errorhandle
Text(TxtCgShdAphDocno).Text = oCgShdAph.CgShdAphDocno
Text(TxtCgShdAphDat).Text = gPublicFunction.ConvStringToDate(oCgShdAph.CgShdAphDat)
Text(TxtCgShdAph_CwqjCode).Text = oCgShdAph.CgShdAph_CwQjCode
Combo(CBxCgShdAph_KhCode).Text = oCgShdAph.Kh.KhCode
Combo(CBxCgShdAph_CwBzCode).Text = oCgShdAph.CwBz.CwBzCode
LoadDataIntoGrid
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Errorhandle
Set oCgShdAphs = Nothing
Set oCgShdAph = Nothing
Set oCgShdAp = Nothing
gPublicFunction.SaveFormSet Me
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub muEdit_Click(Index As Integer)
Dim mFrmCgShdApGen As frmCgShdApGen
On Error GoTo Errorhandle
Select Case muEdit(Index).Tag
Case "CGSHDAPGEN"
If Tlbaction(TlbCgShdAp).Tag <> "" Then
SetValueToObject
Set mFrmCgShdApGen = New frmCgShdApGen
Set mFrmCgShdApGen.CgShdAph = oCgShdAph
mFrmCgShdApGen.Show vbModal
Set mFrmCgShdApGen = Nothing
LoadDataIntoGrid
End If
End Select
Exit Sub
Errorhandle:
Set mFrmCgShdApGen = Nothing
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(TlbCgShdAp).Tag = "" Then
Exit Sub
End If
mCurRow = Flex(FlexCgShdAp).Row
mCurCol = Flex(FlexCgShdAp).Col
Select Case Flex(FlexCgShdAp).ColKey(Flex(FlexCgShdAp).Col)
Case "HWBMCODE"
If oCgShdAp Is Nothing Then
AddNewRecord
Else
oCgShdAp.CgShdAp_HwBmCode = Trim(Flex(FlexCgShdAp).TextMatrix(mCurRow, mCurCol))
Flex(FlexCgShdAp).TextMatrix(mCurRow, Flex(FlexCgShdAp).ColIndex("HWBMMC")) = oCgShdAp.CgShdAp_HwBmMc
Flex(FlexCgShdAp).TextMatrix(mCurRow, Flex(FlexCgShdAp).ColIndex("HWDWCODE")) = oCgShdAp.CgShdAp_HwDwCode
Flex(FlexCgShdAp).TextMatrix(mCurRow, Flex(FlexCgShdAp).ColIndex("CGSHDAP_HWDWCONV")) = oCgShdAp.CgShdAp_HwDwConv
End If
Case "HWDWCODE"
If Not oCgShdAp Is Nothing Then
oCgShdAp.CgShdAp_HwDwCode = Trim(Flex(FlexCgShdAp).TextMatrix(mCurRow, mCurCol))
End If
Case "CGSHDAP_HWDWCONV"
If Not oCgShdAp Is Nothing Then
oCgShdAp.CgShdAp_HwDwConv = Val(Flex(FlexCgShdAp).TextMatrix(mCurRow, mCurCol))
End If
Case "HWCKMC"
If Not oCgShdAp Is Nothing Then
oCgShdAp.CgShdAp_HwCkMc = Trim(Flex(FlexCgShdAp).TextMatrix(mCurRow, mCurCol))
End If
Case "CGSHDAPQTY"
If Not oCgShdAp Is Nothing Then
oCgShdAp.CgShdApQty = Val(Flex(FlexCgShdAp).TextMatrix(Flex(FlexCgShdAp).Row, mCurCol))
Flex(FlexCgShdAp).TextMatrix(Flex(FlexCgShdAp).Row, Flex(FlexCgShdAp).ColIndex("CGSHDAPAMT")) = oCgShdAp.CgShdApAmt
Flex(FlexCgShdAp).TextMatrix(Flex(FlexCgShdAp).Row, Flex(FlexCgShdAp).ColIndex("CGSHDAPTAMT")) = oCgShdAp.CgShdApTAmt
End If
Case "CGSHDAPPRICE"
If Not oCgShdAp Is Nothing Then
oCgShdAp.CgShdApPrice = Val(Flex(FlexCgShdAp).TextMatrix(Flex(FlexCgShdAp).Row, mCurCol))
Flex(FlexCgShdAp).TextMatrix(Flex(FlexCgShdAp).Row, Flex(FlexCgShdAp).ColIndex("CGSHDAPAMT")) = oCgShdAp.CgShdApAmt
Flex(FlexCgShdAp).TextMatrix(Flex(FlexCgShdAp).Row, Flex(FlexCgShdAp).ColIndex("CGSHDAPTAMT")) = oCgShdAp.CgShdApTAmt
End If
Case "CGSHDAPAMT"
If Not oCgShdAp Is Nothing Then
oCgShdAp.CgShdApAmt = Val(Flex(FlexCgShdAp).TextMatrix(Flex(FlexCgShdAp).Row, mCurCol))
Flex(FlexCgShdAp).TextMatrix(Flex(FlexCgShdAp).Row, Flex(FlexCgShdAp).ColIndex("CGSHDAPTAMT")) = oCgShdAp.CgShdApTAmt
End If
Case "CGSHDAPQAMT"
If Not oCgShdAp Is Nothing Then
oCgShdAp.CgShdApQAmt = Val(Flex(FlexCgShdAp).TextMatrix(Flex(FlexCgShdAp).Row, mCurCol))
Flex(FlexCgShdAp).TextMatrix(Flex(FlexCgShdAp).Row, Flex(FlexCgShdAp).ColIndex("CGSHDAPTAMT")) = oCgShdAp.CgShdApTAmt
End If
Case "CGSHDAPTAMT"
If Not oCgShdAp Is Nothing Then
oCgShdAp.CgShdApTAmt = Val(Flex(FlexCgShdAp).TextMatrix(Flex(FlexCgShdAp).Row, mCurCol))
End If
Case "CWSMCODE"
If Not oCgShdAp Is Nothing Then
oCgShdAp.CgShdAp_CwSmCode = Trim(Flex(FlexCgShdAp).TextMatrix(Flex(FlexCgShdAp).Row, mCurCol))
End If
Case "CGSHDAPBZ"
If Not oCgShdAp Is Nothing Then
oCgShdAp.CgShdApBz = Trim(Flex(FlexCgShdAp).TextMatrix(Flex(FlexCgShdAp).Row, mCurCol))
End If
End Select
If UCase(Flex(FlexCgShdAp).ColKey(Flex(FlexCgShdAp).Col)) = "CGSHDAPQTY" Or UCase(Flex(FlexCgShdAp).ColKey(Flex(FlexCgShdAp).Col)) = "CGSHDAPPRICE" Or UCase(Flex(FlexCgShdAp).ColKey(Flex(FlexCgShdAp).Col)) = "CGSHDAPAMT" Or UCase(Flex(FlexCgShdAp).ColKey(Flex(FlexCgShdAp).Col)) = "CGSHDAPQAMT" Or UCase(Flex(FlexCgShdAp).ColKey(Flex(FlexCgShdAp).Col)) = "CGSHDAPTAMT" Then
gPublicFunction.SumFlexQtyAmt Flex(FlexCgShdAp), "CGSHDAPQTY,CGSHDAPAMT,CGSHDAPQAMT,CGSHDAPTAMT", Text(TxtTotalQty), Text(TxtTotalAmt), Text(TxtTotalQAmt), Text(TxtTotalTAmt)
End If
Exit Sub
Errorhandle:
Flex(FlexCgShdAp).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(FlexCgShdAp).Row
If Trim(Flex(FlexCgShdAp).TextMatrix(mCurRow, Flex(FlexCgShdAp).Col)) <> "" Then
Set oCgShdAp = New CgShdAp
Set oCgShdAp.CgShdAph = oCgShdAph
oCgShdAp.CgShdAp_HwBmCode = Trim(Flex(FlexCgShdAp).TextMatrix(mCurRow, Flex(FlexCgShdAp).Col))
Flex(FlexCgShdAp).TextMatrix(mCurRow, Flex(FlexCgShdAp).ColIndex("HWBMMC")) = oCgShdAp.CgShdAp_HwBmMc
Flex(FlexCgShdAp).TextMatrix(mCurRow, Flex(FlexCgShdAp).ColIndex("HWDWCODE")) = oCgShdAp.CgShdAp_HwDwCode
Flex(FlexCgShdAp).TextMatrix(mCurRow, Flex(FlexCgShdAp).ColIndex("CGSHDAP_HWDWCONV")) = oCgShdAp.CgShdAp_HwDwConv
Flex(FlexCgShdAp).TextMatrix(mCurRow, Flex(FlexCgShdAp).ColIndex("CWSMCODE")) = oCgShdAph.Kh.Kh_CwSmCode
oCgShdAph.CgShdAps.Add oCgShdAp, 0
Flex(FlexCgShdAp).RowData(Flex(FlexCgShdAp).Rows - 1) = oCgShdAp.CgShdApKey
Flex(FlexCgShdAp).AddItem ""
End If
Exit Sub
Errorhandle:
Set oCgShdAp = 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 TxtCgShdAphDat
If Tlbaction(TlbCgShdAp).Tag <> "" And Trim(Text(TxtCgShdAphDat).Text) <> "" Then
Text(TxtCgShdAphDat).Text = gPublicFunction.SetDateFormat(Text(TxtCgShdAphDat).Text)
oCgShdAph.CgShdAphDat = gPublicFunction.ConvDateToString(Text(TxtCgShdAphDat).Text)
Text(TxtCgShdAph_CwqjCode).Text = oCgShdAph.CgShdAph_CwQjCode
End If
Case TxtCgShdAphDocno
If Tlbaction(TlbCgShdAp).Tag = "" Then
If Trim(Text(Index).Text) = "" Then
Exit Sub
End If
If Not oCgShdAph Is Nothing Then
If oCgShdAph.CgShdAphDocno = Text(TxtCgShdAphDocno).Text Then
Exit Sub
End If
End If
Set oCgShdAph = New CgShdAph
If oCgShdAph.Requery(Text(TxtCgShdAphDocno).Text) = 1 Then
SetValueToControl
Else
Set oCgShdAph = Nothing
Dim vCgShdApdocno As String
vCgShdApdocno = Text(TxtCgShdAphDocno).Text
AddRecord "ADD"
Text(TxtCgShdAphDocno).Text = vCgShdApdocno
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(FlexCgShdAp).EditText) <> "" Then
Flex(FlexCgShdAp).TextMatrix(Flex(FlexCgShdAp).Row, Flex(FlexCgShdAp).Col) = Trim(Flex(FlexCgShdAp).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 TlbCgShdAp, 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(TlbCgShdAp).Tag = "" Then
Exit Sub
End If
If Me.ActiveControl Is Nothing Then
Exit Sub
End If
If Me.ActiveControl Is Flex(FlexCgShdAp) Then
Select Case UCase(Flex(FlexCgShdAp).ColKey(Flex(FlexCgShdAp).Col))
Case "HWBMCODE", "HWDWCODE", "HWCKMC", "CWSMCODE"
mCodeType = UCase(Flex(FlexCgShdAp).ColKey(Flex(FlexCgShdAp).Col))
End Select
If mCodeType <> "" Then
mQueryValue = gPublicFunction.GetBmQueryValue(Me, mCodeType)
If mQueryValue <> "" Then
Flex(FlexCgShdAp).TextMatrix(Flex(FlexCgShdAp).Row, Flex(FlexCgShdAp).Col) = mQueryValue
Flex(FlexCgShdAp).EditCell
SetControlToFlex
End If
End If
Else
Select Case Mid(UCase(Me.ActiveControl.Tag), 4)
Case "CWQJCODE", "GYSCODE|KHCODE", "CWBZCODE"
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 + =
减小字号Ctrl + -
显示快捷键?