frmcgthdap.frm

来自「制造业产供销与往来系统源码」· FRM 代码 · 共 1,515 行 · 第 1/4 页

FRM
1,515 行
字号
1234

Const TxtTotalQty = 1
Const TxtTotalAmt = 2
Const TxtTotalQAmt = 3
Const TxtTotalTAmt = 4

Dim mCurColOldValue As String

Dim oCgShdAphs As CgShdAphs
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 = 2
   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
               gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbCgShdAp), "CAN"
            Else
               If Flex(FlexCgShdAp).Row = Flex(FlexCgShdAp).Rows - 1 Then
                  Flex(FlexCgShdAp).Row = Flex(FlexCgShdAp).Row - 1
               End If
               Set oCgShdAp = oCgShdAph.CgShdAps(CStr(Flex(FlexCgShdAp).RowData(Flex(FlexCgShdAp).Row)))
            End If
         End If
1234

frmcgthdap.frm - 源码说明

本页面展示了「制造业产供销与往来系统源码」中的 frmcgthdap.frm 源码文件，采用 FRM 编程语言编写，共 1,515 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫开发者社区收录了大量与制造业相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?