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 + -
显示快捷键?