frmhwpdd.frm

制造业产供销与往来系统源码,包括进销存及全部控件！

Const TlbHwPdd = 0
Const ImgHwPdd = 0
Const SbarHwPdd = 0

Const FrmHwPddh = 0

Const FlexHwPddh = 1
Const FlexHwPdd = 0

Const TxtHwPddhDocno = 0
Const TxtHwPddhDat = 6
Const TxtHwPddh_CwqjCode = 5

Const CBxHwPddh_HwPdRcCode = 0
Const CBxHwPddh_HwCkMc = 1

Const TxtTotalZQty = 3
Const TxtTotalPQty = 1
Const TxtTotalAmt = 2

Dim mCurColOldValue As String

Dim oHwPddhs As HwPddhs
Dim oHwPddh As HwPddh
Dim oHwPdd As HwPdd

Public Sub LetDocno(vDocno As String)
On Error GoTo Errorhandle

   Text(TxtHwPddhDocno).Text = vDocno
   Text_LostFocus TxtHwPddhDocno

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(TlbHwPdd).Tag = "" Then
      Exit Sub
   End If

   Select Case Index
   Case CBxHwPddh_HwCkMc
         oHwPddh.HwPddh_HwCkMc = Trim(Combo(CBxHwPddh_HwCkMc).Text)
   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(TlbHwPdd).Tag = "" Then
      Cancel = True
   End If
   
   If oHwPddh Is Nothing Then
      Cancel = True
   End If

   mCurColOldValue = Trim(Flex(FlexHwPdd).TextMatrix(Flex(FlexHwPdd).Row, Flex(FlexHwPdd).Col))

   Select Case Flex(FlexHwPdd).ColKey(Col)
   Case "HWBMCODE"
         
   Case "HWPDD_HWDWCONV", "HWPDDPQTY", "HWPDDPRICE", "HWPDDAMT", "HWPDDBZ"
         If oHwPdd Is Nothing Then
            Cancel = True
         End If
         
   Case "HWDWCODE"
         If oHwPdd 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(TxtHwPddhDocno).SetFocus
  
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Form_Load()
On Error GoTo Errorhandle
  
   Flex(FlexHwPdd).Editable = flexEDKbdMouse
   
   Flex(FlexHwPdd).ColKey(1) = "HWBMCODE"
   Flex(FlexHwPdd).ColKey(2) = "HWBMMC"
   Flex(FlexHwPdd).ColKey(3) = "HWDWCODE"
   Flex(FlexHwPdd).ColKey(4) = "HWPDD_HWDWCONV"
   Flex(FlexHwPdd).ColKey(5) = "HWPDDZQTY"
   Flex(FlexHwPdd).ColKey(6) = "HWPDDPQTY"
   Flex(FlexHwPdd).ColKey(7) = "HWPDDPRICE"
   Flex(FlexHwPdd).ColKey(8) = "HWPDDAMT"
   Flex(FlexHwPdd).ColKey(9) = "HWPDDBZ"
      
   gPublicFunction.LoadFormSet Me, Tlbaction(TlbHwPdd), Img(ImgHwPdd), SBar(SbarHwPdd)
   gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "HwPdd", "TXTHwPddHDOCNO", "CBXHWCKMC"
   
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Flex(FlexHwPdd), Text(TxtHwPddhDocno)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "ADD", Text(TxtTotalZQty), Text(TxtTotalPQty), Text(TxtTotalAmt)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "CHG", Text(TxtTotalZQty), Text(TxtTotalPQty), Text(TxtTotalAmt)
   
   gPublicCommon.PublicFunction.EnableControl Me, ""
   
   gPublicFunction.FillComboWithSql Me, Combo(CBxHwPddh_HwPdRcCode), "SELECT HwPdRcCODE,HwPdRcNO FROM HwPdRcREC ORDER BY HwPdRcCODE", "HwPdRcNO", 0
   gPublicFunction.FillComboWithSql Me, Combo(CBxHwPddh_HwCkMc), "SELECT HwCkMc,HwCkNo FROM HwCkREC ORDER BY HwCkMc", "HwCkNO", 0
  
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub LoadDataIntoGrid()
   Dim ItemStr As String
   Dim mHwPddh As HwPddh
   Dim mHwPdd As HwPdd
On Error GoTo Errorhandle
   
   Flex(FlexHwPdd).Rows = 1
   Flex(FlexHwPdd).AddItem ""
   
   oHwPddh.HwPdds.FillbyDb oHwPddh
   
   For Each mHwPdd In oHwPddh.HwPdds
      ItemStr = vbTab & mHwPdd.HwPdd_HwBmCode & vbTab & mHwPdd.HwPdd_HwBmMc
      ItemStr = ItemStr & vbTab & mHwPdd.HwPdd_HwDwCode & vbTab & mHwPdd.HwPdd_HwDwConv
      ItemStr = ItemStr & vbTab & mHwPdd.HwPddZQty & vbTab & mHwPdd.HwPddPQty & vbTab & mHwPdd.HwPddPrice & vbTab & mHwPdd.HwPddAmt & vbTab & mHwPdd.HwPddBz
      Flex(FlexHwPdd).AddItem ItemStr, Flex(FlexHwPdd).Rows - 1
      Flex(FlexHwPdd).RowData(Flex(FlexHwPdd).Rows - 2) = mHwPdd.HwPddKey
   Next
   If Flex(FlexHwPdd).Rows > 2 Then
      Flex(FlexHwPdd).Row = 1
      Set oHwPdd = oHwPddh.HwPdds(CStr(Flex(FlexHwPdd).RowData(1)))
   Else
      Set oHwPdd = Nothing
   End If
   
   gPublicFunction.SumFlexQtyAmt Flex(FlexHwPdd), "HWPDDZQTY,HWPDDPQTY,HWPDDAMT", Text(TxtTotalZQty), Text(TxtTotalPQty), Text(TxtTotalAmt)

Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub AddRecord(RecordName As String)
On Error GoTo Errorhandle

   Set oHwPddh = New HwPddh
   Set oHwPdd = Nothing
   Clearcontrol
   Text(TxtHwPddhDocno).SetFocus
   
   If Text(TxtHwPddhDat).Text = "" Then
      Text(TxtHwPddhDat).Text = gPublicCommon.PublicSysDatas("SYSTEMDATE").SysDataValue
   End If
   
   oHwPddh.HwPddhDat = Trim(Text(TxtHwPddhDat).Text)
   Text(TxtHwPddh_CwqjCode).Text = oHwPddh.HwPddh_CwQjCode
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbHwPdd), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub ChgRecord(RecordName As String)
On Error GoTo Errorhandle
    
   If oHwPddh Is Nothing Then
      Exit Sub
   End If

   Text(TxtHwPddhDocno).SetFocus
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbHwPdd), RecordName
    
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub CancelRecord(RecordName As String)
On Error GoTo Errorhandle

   If oHwPddh.HwPddhId = -1 Then
      Clearcontrol
      Set oHwPdd = Nothing
      Set oHwPddh = Nothing
   Else
      oHwPddh.Requery oHwPddh.HwPddhDocno
      SetValueToControl
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbHwPdd), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub


Private Sub Clearcontrol()
On Error GoTo Errorhandle

   Text(TxtHwPddhDocno).Text = ""
   Text(TxtHwPddh_CwqjCode).Text = ""
   Combo(CBxHwPddh_HwPdRcCode).Text = ""
   Combo(CBxHwPddh_HwCkMc).Text = ""
   
   Text(TxtTotalZQty).Text = ""
   Text(TxtTotalPQty).Text = ""
   Text(TxtTotalAmt).Text = ""
   
   Flex(FlexHwPdd).Rows = 1
   Flex(FlexHwPdd).AddItem ""
   
   Text(TxtHwPddhDocno).SetFocus
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SaveRecord(RecordName As String)
On Error GoTo Errorhandle
   
   SetValueToObject
   oHwPddh.Save
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbHwPdd), RecordName

Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SetValueToObject()
   Dim mHwPdd As HwPdd
   Dim I As Integer
On Error GoTo Errorhandle

   oHwPddh.HwPddhDocno = Trim(Text(TxtHwPddhDocno).Text)
   oHwPddh.HwPddhDat = gPublicFunction.ConvDateToString(Text(TxtHwPddhDat).Text)
   oHwPddh.HwPddh_CwQjCode = Trim(Text(TxtHwPddh_CwqjCode).Text)
   oHwPddh.HwPddh_HwPdRcCode = Trim(Combo(CBxHwPddh_HwPdRcCode).Text)
   oHwPddh.HwPddh_HwCkMc = Trim(Combo(CBxHwPddh_HwCkMc).Text)
   oHwPddh.HwPddhForm = UCase(Me.Name)
   
   For I = 1 To Flex(FlexHwPdd).Rows - 2
      Set mHwPdd = oHwPddh.HwPdds(CStr(Flex(FlexHwPdd).RowData(I)))
      mHwPdd.HwPdd_HwBmCode = Trim(Flex(FlexHwPdd).TextMatrix(I, Flex(FlexHwPdd).ColIndex("HWBMCODE")))
      mHwPdd.HwPdd_HwDwCode = Trim(Flex(FlexHwPdd).TextMatrix(I, Flex(FlexHwPdd).ColIndex("HWDWCODE")))
      mHwPdd.HwPdd_HwDwConv = Val(Flex(FlexHwPdd).TextMatrix(I, Flex(FlexHwPdd).ColIndex("HWPDD_HWDWCONV")))
      mHwPdd.HwPddPQty = Val(Flex(FlexHwPdd).TextMatrix(I, Flex(FlexHwPdd).ColIndex("HWPDDPQTY")))
      mHwPdd.HwPddPrice = Val(Flex(FlexHwPdd).TextMatrix(I, Flex(FlexHwPdd).ColIndex("HWPDDPRICE")))
      mHwPdd.HwPddAmt = Val(Flex(FlexHwPdd).TextMatrix(I, Flex(FlexHwPdd).ColIndex("HWPDDAMT")))
      mHwPdd.HwPddBz = Trim(Flex(FlexHwPdd).TextMatrix(I, Flex(FlexHwPdd).ColIndex("HWPDDBZ")))
   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 oHwPddh Is Nothing Then
            Err.Raise vbObjectError + 1, , "无单据，不能进行删除！"
            Exit Sub
         End If
      
         If MsgBox("您真的要删除当前整张单据吗？", vbYesNo + vbQuestion) = vbYes Then
            oHwPddh.Del
            Set oHwPdd = Nothing
            Set oHwPddh = Nothing
            Clearcontrol
         End If
   
   Case "DEF"