frmcgshd.frm

来自「制造业产供销与往来系统源码,包括进销存及全部控件！」· FRM 代码 · 共 1,512 行 · 第 1/4 页

FRM
1,512 行
字号
1234
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()
   Dim ItemStr As String
   Dim mCgShdh As Cgshdh
   Dim mCgShd As CgShd
On Error GoTo Errorhandle
   
   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)


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 = 1
   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
      
         If MsgBox("您真的要删除单据当前行吗？", vbYesNo + vbQuestion) = vbYes Then
            oCgShdh.CgShds.Remove CStr(oCgShd.CgShdKey)
            Flex(FlexCgShd).RemoveItem Flex(FlexCgShd).Row
            If Flex(FlexCgShd).Rows = 2 Then
               Set oCgShd = Nothing
               Set oCgShdh = Nothing
               Clearcontrol
               gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbCgshd), "CAN"
            Else
               If Flex(FlexCgShd).Row = Flex(FlexCgShd).Rows - 1 Then
                  Flex(FlexCgShd).Row = Flex(FlexCgShd).Row - 1
               End If
               Set oCgShd = oCgShdh.CgShds(CStr(Flex(FlexCgShd).RowData(Flex(FlexCgShd).Row)))
1234

frmcgshd.frm - 源码说明

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

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

⌨️ 快捷键说明

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