frmxsfhd.frm

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

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(TlbXsFhd).Tag = "" Then
      Exit Sub
   End If
   
   Select Case Index
   Case CBxXsFhdh_KhCode
         If Trim(Combo(CBxXsFhdh_KhCode).Text) <> "" Then
            oXsFhdh.XsFhdh_KhCode = Combo(CBxXsFhdh_KhCode).Text
            Combo(CBxXsFhdh_CwBzCode).Text = oXsFhdh.XsFhdh_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(TlbXsFhd).Tag = "" Then
      Cancel = True
   End If
   
   If oXsFhdh Is Nothing Then
      Cancel = True
   End If

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

   Select Case Flex(FlexXsFhd).ColKey(Col)
   Case "HWBMCODE"
         
   Case "HWCKMC", "XSFHD_HWDWCONV", "XSFHDQTY", "XSFHDPRICE", "XSFHDAMT", "XSFHDBZ"
         If oXsFhd Is Nothing Then
            Cancel = True
         End If
         
   Case "XSFHD_HWDMCODE"
         If oXsFhd Is Nothing Then
            Cancel = True
         End If
         
   Case "CWSMCODE"
         If oXsFhd 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(TxtXsFhdhDocno).SetFocus
  
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Form_Load()
On Error GoTo Errorhandle
  
   Flex(FlexXsFhd).Editable = flexEDKbdMouse
   
   Flex(FlexXsFhd).ColKey(1) = "XSSODHDOCNO"
   Flex(FlexXsFhd).ColKey(2) = "HWBMCODE"
   Flex(FlexXsFhd).ColKey(3) = "HWBMMC"
   Flex(FlexXsFhd).ColKey(4) = "HWDWCODE"
   Flex(FlexXsFhd).ColKey(5) = "XSFHD_HWDWCONV"
   Flex(FlexXsFhd).ColKey(6) = "HWCKMC"
   Flex(FlexXsFhd).ColKey(7) = "XSFHDQTY"
   Flex(FlexXsFhd).ColKey(8) = "XSFHDPRICE"
   Flex(FlexXsFhd).ColKey(9) = "XSFHDAMT"
   Flex(FlexXsFhd).ColKey(10) = "CWSMCODE"
   Flex(FlexXsFhd).ColKey(11) = "XsFhDBZ"
      
   gPublicFunction.LoadFormSet Me, Tlbaction(TlbXsFhd), Img(ImgXsFhd), SBar(SbarXsFhd)
   gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "XsFhd", "TXTXsFhDHDOCNO", "CBXCWBZCODE"
   
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Flex(FlexXsFhd), Text(TxtXsFhdhDocno)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "ADD", Text(TxtTotalQty), Text(TxtTotalAmt)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "CHG", Text(TxtTotalQty), Text(TxtTotalAmt)
   
   gPublicCommon.PublicFunction.EnableControl Me, ""
   
   gPublicFunction.FillComboWithSql Me, Combo(CBxXsFhdh_KhCode), "SELECT KHCODE,KHNO FROM KHREC WHERE KHTYPE=1 ORDER BY KHCODE", "KHNO", 0
   gPublicFunction.FillComboWithSql Me, Combo(CBxXsFhdh_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 mXsFhdh As XsFhdh
   Dim mXsFhd As XsFhd
On Error GoTo Errorhandle
   
   Flex(FlexXsFhd).Rows = 1
   Flex(FlexXsFhd).AddItem ""
   
   oXsFhdh.XsFhds.FillbyDb oXsFhdh
   
   For Each mXsFhd In oXsFhdh.XsFhds
      ItemStr = vbTab & mXsFhd.XsFhd_XsSodDocno & vbTab & mXsFhd.XsFhd_HwBmCode & vbTab & mXsFhd.XsFhd_HwBmMc
      ItemStr = ItemStr & vbTab & mXsFhd.XsFhd_HwDwCode & vbTab & mXsFhd.XsFhd_HwDwConv & vbTab & mXsFhd.XsFhd_HwCkMc
      ItemStr = ItemStr & vbTab & mXsFhd.XsFhdQty & vbTab & mXsFhd.XsFhdPrice & vbTab & mXsFhd.XsFhdAmt & vbTab & mXsFhd.XsFhd_CwSmCode & vbTab & mXsFhd.XsFhdBz
      Flex(FlexXsFhd).AddItem ItemStr, Flex(FlexXsFhd).Rows - 1
      Flex(FlexXsFhd).RowData(Flex(FlexXsFhd).Rows - 2) = mXsFhd.XsFhdKey
   Next
   If Flex(FlexXsFhd).Rows > 2 Then
      Flex(FlexXsFhd).Row = 1
      Set oXsFhd = oXsFhdh.XsFhds(CStr(Flex(FlexXsFhd).RowData(1)))
   Else
      Set oXsFhd = Nothing
   End If
   
   gPublicFunction.SumFlexQtyAmt Flex(FlexXsFhd), "XsFhDQTY,XsFhDAMT", Text(TxtTotalQty), Text(TxtTotalAmt)


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

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

   Set oXsFhdh = New XsFhdh
   Set oXsFhd = Nothing
   Clearcontrol
   Text(TxtXsFhdhDocno).SetFocus
   
   If Text(TxtXsFhdhDat).Text = "" Then
      Text(TxtXsFhdhDat).Text = gPublicCommon.PublicSysDatas("SYSTEMDATE").SysDataValue
   End If
   
   oXsFhdh.XsFhdhDat = Trim(Text(TxtXsFhdhDat).Text)
   Text(TxtXsFhdh_CwqjCode).Text = oXsFhdh.XsFhdh_CwQjCode
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbXsFhd), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

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

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

   If oXsFhdh.XsFhdhId = -1 Then
      Clearcontrol
      Set oXsFhd = Nothing
      Set oXsFhdh = Nothing
   Else
      oXsFhdh.Requery oXsFhdh.XsFhdhDocno
      SetValueToControl
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbXsFhd), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub


Private Sub Clearcontrol()
On Error GoTo Errorhandle

   Text(TxtXsFhdhDocno).Text = ""
   Text(TxtXsFhdh_CwqjCode).Text = ""
   Combo(CBxXsFhdh_KhCode).Text = ""
   Combo(CBxXsFhdh_CwBzCode).Text = ""
   
   Text(TxtTotalQty).Text = ""
   
   Flex(FlexXsFhd).Rows = 1
   Flex(FlexXsFhd).AddItem ""
   
   Text(TxtXsFhdhDocno).SetFocus
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

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

Private Sub SetValueToObject()
   Dim mXsFhd As XsFhd
   Dim I As Integer
On Error GoTo Errorhandle

   oXsFhdh.XsFhdhType = 1
   oXsFhdh.XsFhdhDocno = Trim(Text(TxtXsFhdhDocno).Text)
   oXsFhdh.XsFhdhDat = gPublicFunction.ConvDateToString(Text(TxtXsFhdhDat).Text)
   oXsFhdh.XsFhdh_CwQjCode = Trim(Text(TxtXsFhdh_CwqjCode).Text)
   oXsFhdh.XsFhdh_KhCode = Trim(Combo(CBxXsFhdh_KhCode).Text)
   oXsFhdh.XsFhdh_CwBzCode = Trim(Combo(CBxXsFhdh_CwBzCode).Text)
   oXsFhdh.XsFhdhForm = UCase(Me.Name)
   
   For I = 1 To Flex(FlexXsFhd).Rows - 2
      Set mXsFhd = oXsFhdh.XsFhds(CStr(Flex(FlexXsFhd).RowData(I)))
      mXsFhd.XsFhd_HwBmCode = Trim(Flex(FlexXsFhd).TextMatrix(I, Flex(FlexXsFhd).ColIndex("HWBMCODE")))
      mXsFhd.XsFhd_HwDwCode = Trim(Flex(FlexXsFhd).TextMatrix(I, Flex(FlexXsFhd).ColIndex("HWDWCODE")))
      mXsFhd.XsFhd_HwDwConv = Val(Flex(FlexXsFhd).TextMatrix(I, Flex(FlexXsFhd).ColIndex("XSFHD_HWDWCONV")))
      mXsFhd.XsFhd_HwCkMc = Trim(Flex(FlexXsFhd).TextMatrix(I, Flex(FlexXsFhd).ColIndex("HWCKMC")))
      mXsFhd.XsFhdQty = Val(Flex(FlexXsFhd).TextMatrix(I, Flex(FlexXsFhd).ColIndex("XSFHDQTY")))
      mXsFhd.XsFhdPrice = Val(Flex(FlexXsFhd).TextMatrix(I, Flex(FlexXsFhd).ColIndex("XSFHDPRICE")))
      mXsFhd.XsFhdAmt = Val(Flex(FlexXsFhd).TextMatrix(I, Flex(FlexXsFhd).ColIndex("XSFHDAMT")))
      mXsFhd.XsFhd_CwSmCode = Trim(Flex(FlexXsFhd).TextMatrix(I, Flex(FlexXsFhd).ColIndex("CWSMCODE")))
      mXsFhd.XsFhdBz = Trim(Flex(FlexXsFhd).TextMatrix(I, Flex(FlexXsFhd).ColIndex("XSFHDBZ")))
   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 oXsFhdh Is Nothing Then
            Err.Raise vbObjectError + 1, , "无单据，不能进行删除！"
            Exit Sub
         End If
      
         If MsgBox("您真的要删除当前整张单据吗？", vbYesNo + vbQuestion) = vbYes Then
            oXsFhdh.Del
            Set oXsFhd = Nothing
            Set oXsFhdh = Nothing
            Clearcontrol
         End If
   
   Case "DEF"
   
         If Flex(FlexXsFhd).Row = Flex(FlexXsFhd).Rows - 1 Then
            Exit Sub
         End If
      
         If MsgBox("您真的要删除单据当前行吗？", vbYesNo + vbQuestion) = vbYes Then
            oXsFhdh.XsFhds.Remove CStr(oXsFhd.XsFhdKey)
            Flex(FlexXsFhd).RemoveItem Flex(FlexXsFhd).Row
            If Flex(FlexXsFhd).Rows = 2 Then
               Set oXsFhd = Nothing
               Set oXsFhdh = Nothing
               Clearcontrol
               gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbXsFhd), "CAN"
            Else
               If Flex(FlexXsFhd).Row = Flex(FlexXsFhd).Rows - 1 Then
                  Flex(FlexXsFhd).Row = Flex(FlexXsFhd).Row - 1
               End If
               Set oXsFhd = oXsFhdh.XsFhds(CStr(Flex(FlexXsFhd).RowData(Flex(FlexXsFhd).Row)))
            End If
         End If
      
   End Select
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Flex_RowColChange(Index As Integer)