frmscd.frm

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

         Index           =   0
      End
   End
   Begin VB.Menu mView 
      Caption         =   "查看(&V)"
      Begin VB.Menu muView 
         Caption         =   ""
         Index           =   0
      End
   End
   Begin VB.Menu mHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu muHelp 
         Caption         =   ""
         Index           =   0
      End
   End
End
Attribute VB_Name = "frmScd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const TlbScd = 0
Const ImgScd = 0
Const SbarScd = 0

Const FrmScd = 0

Const FlexScdm = 0

Const TxtScdDocno = 0
Const TxtScdDat = 6
Const TxtScd_HwBmCode = 5
Const TxtScd_HwDwConv = 3
Const TxtScdQty = 4
Const TxtScdBDat = 7
Const TxtScdWDat = 8
Const TxtScdBz = 9

Const CBxScd_PsBmCode = 0
Const CBxScd_HwDwCode = 1

Const TxtScd_HwbmMc = 10
Const TxtScdWQty = 11

Const TxtTotalQty = 1
Const TxtTotalFQty = 2

Dim mCurColOldValue As String

Dim oScd As Scd
Dim oScdms As Scdms
Dim oScdm As Scdm

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

   Text(TxtScdDocno).Text = vDocno
   Text_LostFocus TxtScdDocno

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 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(TlbScd).Tag = "" Then
      Cancel = True
   End If
   
   If oScd Is Nothing Then
      Cancel = True
   End If

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

   Select Case Flex(FlexScdm).ColKey(Col)
   Case "HWBMCODE"
         
   Case "SCDM_HWDWCONV", "SCDMDWQTY", "SCDMDWSHL", "SCDMQTY", "SCDMBZ"
         If oScdm Is Nothing Then
            Cancel = True
         End If
         
   Case "HWDWCODE"
         If oScdm 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(TxtScdDocno).SetFocus
  
Exit Sub
ErrorHandle:
   MsgBox Err.Description
End Sub

Private Sub Form_Load()
On Error GoTo ErrorHandle
  
   Flex(FlexScdm).Editable = flexEDKbdMouse
   
   Flex(FlexScdm).ColKey(1) = "HWBMCODE"
   Flex(FlexScdm).ColKey(2) = "HWBMMC"
   Flex(FlexScdm).ColKey(3) = "HWDWCODE"
   Flex(FlexScdm).ColKey(4) = "SCDM_HWDWCONV"
   Flex(FlexScdm).ColKey(5) = "SCDMDWQTY"
   Flex(FlexScdm).ColKey(6) = "SCDMDWSHL"
   Flex(FlexScdm).ColKey(7) = "SCDMQTY"
   Flex(FlexScdm).ColKey(8) = "SCDMFQTY"
   Flex(FlexScdm).ColKey(9) = "SCDMBZ"
      
   gPublicFunction.LoadFormSet Me, Tlbaction(TlbScd), Img(ImgScd), SBar(SbarScd)
   gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "SCD", "TXTSCDDOCNO", "TXTSCDBZ"
   
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Flex(FlexScdm), Text(TxtScdDocno)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "ADD", Text(TxtScd_HwbmMc), Text(TxtScdWQty), Text(TxtTotalQty), Text(TxtTotalFQty)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "CHG", Text(TxtScd_HwbmMc), Text(TxtScdWQty), Text(TxtTotalQty), Text(TxtTotalFQty)
   
   gPublicCommon.PublicFunction.EnableControl Me, ""
   
   gPublicFunction.FillComboWithSql Me, Combo(CBxScd_PsBmCode), "SELECT PsBmCODE,PsBmNO FROM PsBmREC ORDER BY PsBmCODE", "PsBmNO", 0
   gPublicFunction.FillComboWithSql Me, Combo(CBxScd_HwDwCode), "SELECT HwDwCODE,HwDwNO FROM HwDwREC ORDER BY HwDwCODE", "HwDwNO", 0
   
   Text(TxtScd_HwbmMc).BorderStyle = 0
   Text(TxtScdWQty).BorderStyle = 0
  
Exit Sub
ErrorHandle:
   MsgBox Err.Description
End Sub

Private Sub LoadDataIntoGrid()
   Dim Itemstr As String
   Dim mScdm As Scdm
On Error GoTo ErrorHandle
   
   Flex(FlexScdm).Rows = 1
   Flex(FlexScdm).AddItem ""
   
   oScd.Scdms.FillbyDb oScd
   
   For Each mScdm In oScd.Scdms
      Itemstr = vbTab & mScdm.Scdm_HwBmCode & vbTab & mScdm.Scdm_HwBmMc
      Itemstr = Itemstr & vbTab & mScdm.Scdm_HwDwCode & vbTab & mScdm.Scdm_HwDwConv & vbTab & mScdm.ScdmDwQty
      Itemstr = Itemstr & vbTab & mScdm.ScdmDwShl & vbTab & mScdm.ScdmQty & vbTab & mScdm.ScdmFQty & vbTab & mScdm.ScdmBz
      Flex(FlexScdm).AddItem Itemstr, Flex(FlexScdm).Rows - 1
      Flex(FlexScdm).RowData(Flex(FlexScdm).Rows - 2) = mScdm.ScdmKey
   Next
   
   If Flex(FlexScdm).Rows > 2 Then
      Flex(FlexScdm).Row = 1
      Set oScdm = oScd.Scdms(CStr(Flex(FlexScdm).RowData(1)))
   Else
      Set oScdm = Nothing
   End If
   
   gPublicFunction.SumFlexQtyAmt Flex(FlexScdm), "SCDMQTY,SCDMFQTY", Text(TxtTotalQty), Text(TxtTotalFQty)


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

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

   Set oScd = New Scd
   Set oScdm = Nothing
   Clearcontrol
   Text(TxtScdDocno).SetFocus
   
   If Text(TxtScdDat).Text = "" Then
      Text(TxtScdDat).Text = gPublicCommon.PublicSysDatas("SYSTEMDATE").SysDataValue
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbScd), RecordName
   
Exit Sub
ErrorHandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   Text(TxtScdDocno).SetFocus
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbScd), RecordName
    
Exit Sub
ErrorHandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   If oScd.ScdId = -1 Then
      Clearcontrol
      Set oScd = Nothing
      Set oScdm = Nothing
   Else
      oScd.Requery oScd.ScdDocno
      SetValueToControl
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbScd), RecordName
   
Exit Sub
ErrorHandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub


Private Sub Clearcontrol()
On Error GoTo ErrorHandle

   Text(TxtScdDocno).Text = ""
   Text(TxtScdDat).Text = ""
   Combo(CBxScd_PsBmCode).Text = ""
   
   Text(TxtScd_HwBmCode).Text = ""
   Text(TxtScd_HwbmMc).Text = ""
   Combo(CBxScd_HwDwCode).Text = ""
   Text(TxtScd_HwDwConv).Text = ""
   Text(TxtScdQty).Text = ""
   Text(TxtScdWQty).Text = ""
   Text(TxtScdBDat).Text = ""
   Text(TxtScdWDat).Text = ""
   Text(TxtScdBz).Text = ""
   
   Text(TxtTotalQty).Text = ""
   Text(TxtTotalFQty).Text = ""
   
   Flex(FlexScdm).Rows = 1
   Flex(FlexScdm).AddItem ""
   
   Text(TxtScdDocno).SetFocus
   
Exit Sub
ErrorHandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SaveRecord(RecordName As String)
On Error GoTo ErrorHandle
   
   SetValueToObject
   oScd.Save
   
   If oScd.Scdms.Count = 0 Then
      If MsgBox("是否据物料单生成工单材料表？", vbYesNo + vbQuestion) = vbYes Then
         oScd.GenScdm
         LoadDataIntoGrid
      End If
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbScd), RecordName

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

Private Sub SetValueToObject()
   Dim mScdm As Scdm
   Dim I As Integer
On Error GoTo ErrorHandle

   oScd.ScdType = 1
   oScd.ScdDocno = Trim(Text(TxtScdDocno).Text)
   oScd.ScdDat = Trim(gPublicFunction.ConvDateToString(Text(TxtScdDat).Text))
   oScd.Scd_PsBmCode = Trim(Combo(CBxScd_PsBmCode).Text)
   oScd.Scd_HwBmCode = Trim(Text(TxtScd_HwBmCode).Text)
   oScd.Scd_HwDwCode = Trim(Combo(CBxScd_HwDwCode).Text)
   oScd.Scd_HwDwConv = Val(Text(TxtScd_HwDwConv).Text)
   oScd.ScdQty = Val(Text(TxtScdQty).Text)
   oScd.ScdBDat = Trim(gPublicFunction.ConvDateToString((Text(TxtScdBDat).Text)))
   oScd.ScdwDat = Trim(gPublicFunction.ConvDateToString((Text(TxtScdWDat).Text)))
   oScd.ScdBz = Trim(Text(TxtScdBz).Text)
   oScd.ScdForm = UCase(Me.Name)
   
   For I = 1 To Flex(FlexScdm).Rows - 2
      Set mScdm = oScd.Scdms(CStr(Flex(FlexScdm).RowData(I)))
      mScdm.Scdm_HwBmCode = Trim(Flex(FlexScdm).TextMatrix(I, Flex(FlexScdm).ColIndex("HWBMCODE")))
      mScdm.Scdm_HwDwCode = Trim(Flex(FlexScdm).TextMatrix(I, Flex(FlexScdm).ColIndex("HWDWCODE")))
      mScdm.Scdm_HwDwConv = Val(Flex(FlexScdm).TextMatrix(I, Flex(FlexScdm).ColIndex("SCDM_HWDWCONV")))
      mScdm.ScdmDwQty = Val(Flex(FlexScdm).TextMatrix(I, Flex(FlexScdm).ColIndex("SCDMDWQTY")))
      mScdm.ScdmDwShl = Val(Flex(FlexScdm).TextMatrix(I, Flex(FlexScdm).ColIndex("SCDMDWSHL")))
      mScdm.ScdmQty = Val(Flex(FlexScdm).TextMatrix(I, Flex(FlexScdm).ColIndex("SCDMQTY")))
      mScdm.ScdmBz = Trim(Flex(FlexScdm).TextMatrix(I, Flex(FlexScdm).ColIndex("SCDMBZ")))
   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 oScd Is Nothing Then
            Err.Raise vbObjectError + 1, , "无单据，不能进行删除！"
            Exit Sub
         End If
      
         If MsgBox("您真的要删除当前整张单据吗？", vbYesNo + vbQuestion) = vbYes Then
            oScd.Del
            Set oScd = Nothing
            Set oScdm = Nothing
            Clearcontrol