frmhwbm.frm

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

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_RowColChange(Index As Integer)
On Error GoTo Errorhandle

    Select Case Index
        Case FlexHwBm
            If Flex(Index).Row <> Flex(Index).Rows - 1 Then
                Set OHwBm = OHwBms(CStr(Flex(FlexHwBm).RowData(Flex(FlexHwBm).Row)))
                SetValueToControl "HwBm"
            Else
                Set OHwBm = Nothing
                Clearcontrol "HwBm"
            End If
    End Select
    
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Form_Load()
On Error GoTo Errorhandle
   
   Flex(FlexHwBm).ColKey(1) = "HWBM_HWFLNO"
   Flex(FlexHwBm).ColKey(2) = "HWBMCODE"
   Flex(FlexHwBm).ColKey(3) = "HWBMMC"
   Flex(FlexHwBm).ColKey(4) = "HWBMEMC"
   Flex(FlexHwBm).ColKey(5) = "HWBMSIZE"
   Flex(FlexHwBm).ColKey(6) = "HWBM_HWDWNO"
   Flex(FlexHwBm).ColKey(7) = "HWBMISSTOP"
   
   gPublicCommon.PublicFunction.LoadFormSet Me, Tlbaction(TlbHwBm), Img(ImgHwBm), SBar(SBarHwBm)
   gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "HwBm", "CbxHwBm_HwFlno", "CHKHWBMISSTOP"
   gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "HwBmReq", "CBXQRYHwBm_HwFlNo", "CMDQUERY"
   
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Frame(FrameHwbm), Flex(FlexHwBm)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "ADD", Frame(FrameHwbm), Flex(FlexHwBm)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "CHG", Frame(FrameHwbm), Flex(FlexHwBm)
   gPublicCommon.PublicFunction.EnableControl Me, ""
   
   gPublicFunction.FillComboWithSql Me, Combo(CbxHwBm_HwFlCode), "SELECT HWFLCODE,HWFLNO FROM HWFLREC ORDER BY HWFLCODE", "HWFLNO"
   gPublicFunction.FillComboWithSql Me, Combo(ReqCbxHwBm_HwFlCode), "SELECT HWFLCODE,HWFLNO FROM HWFLREC ORDER BY HWFLCODE", "HWFLNO"
   gPublicFunction.FillComboWithSql Me, Combo(CbxHwBm_HwDwCode), "SELECT HWDWCODE,HWDWMC,HWDWNO FROM HWDWREC ORDER BY HWDWCODE", "HWDWNO"
   
   Combo(ReqCbxHwBm_HwFlCode).Text = ""

   Set OHwBms = New HwBms

Exit Sub
Errorhandle:
    MsgBox Err.Description
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
   Dim mButton As Button
On Error GoTo Errorhandle

   Set mButton = gPublicFunction.GetToolBarButton(Me, KeyCode)
   
   If Not mButton Is Nothing Then
      Tlbaction_ButtonClick TlbHwBm, mButton
   End If
  
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Public Function GetWhereStr() As String
   Dim mWhereStr As String
On Error GoTo Errorhandle

   mWhereStr = ""
   
   If Trim(Combo(ReqCbxHwBm_HwFlCode).Text) <> "" Then
      mWhereStr = mWhereStr & " AND HWFLCODE LIKE '" & CStr(Combo(ReqCbxHwBm_HwFlCode).Text) & "%'"
   End If
   
   If Trim(Text(ReqTxtHwBmCode).Text) <> "" Then
      mWhereStr = mWhereStr & " AND HWBMCODE LIKE '" & Trim(Text(ReqTxtHwBmCode).Text) & "%'"
   End If
   
   If Trim(Text(ReqTxtHwBmMc).Text) <> "" Then
      mWhereStr = mWhereStr & " AND HWBMMC LIKE '%" & Trim(Text(ReqTxtHwBmMc).Text) & "%'"
   End If
   
   If mWhereStr <> "" Then
      mWhereStr = Mid(mWhereStr, 5)
   End If
   
   GetWhereStr = mWhereStr
   

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

Private Sub LoadDataIntoGrid()
    Dim ItemStr As String
    Dim mHwBm As HwBm
On Error GoTo Errorhandle

   OHwBms.FillbyDb GetWhereStr
   
   Flex(FlexHwBm).Rows = 1
   Flex(FlexHwBm).AddItem ""
   
   For Each mHwBm In OHwBms
      ItemStr = vbTab & mHwBm.HwBm_HwFlMc & vbTab & mHwBm.HwBmCode & vbTab & mHwBm.HwBmMc & vbTab & mHwBm.HwBmEMc
      ItemStr = ItemStr & vbTab & mHwBm.HwBmSize & vbTab & mHwBm.HwBm_HwDwCode & vbTab & IIf(mHwBm.HwBmIsStop = 1, "√", "")
      Flex(FlexHwBm).AddItem ItemStr, Flex(FlexHwBm).Rows - 1
      Flex(FlexHwBm).RowData(Flex(FlexHwBm).Rows - 2) = mHwBm.HwBm_Key
   Next
   
   If Flex(FlexHwBm).Rows > 2 Then
      Flex(FlexHwBm).Row = 1
      Set OHwBm = OHwBms(CStr(Flex(FlexHwBm).RowData(1)))
      SetValueToControl "HwBm"
   Else
      Set OHwBm = Nothing
      Clearcontrol "HwBm"
   End If
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Clearcontrol(ControlName)
On Error GoTo Errorhandle

   Combo(CbxHwBm_HwFlCode).Text = ""
   Text(TxtHwBmCode).Text = ""
   Text(TxtHwBmMc).Text = ""
   Text(TxtHwBmEMc).Text = ""
   Text(TxtHwBmSize).Text = ""
   Combo(CbxHwBm_HwDwCode).Text = ""
   Check(ChkHwBmIsStop).Value = vbUnchecked

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

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

   Set OHwBm = New HwBm
   Clearcontrol "HwBm"
   Combo(CbxHwBm_HwFlCode).SetFocus
   Flex(FlexHwBm).Enabled = False
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbHwBm), RecordName

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

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

   Combo(CbxHwBm_HwFlCode).SetFocus
   Flex(FlexHwBm).Enabled = False
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbHwBm), RecordName
    
Exit Sub
Errorhandle:
    Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbHwBm), RecordName
   If OHwBm.HwBm_id = -1 Then
      If Flex(FlexHwBm).Rows > 2 Then
         Set OHwBm = OHwBms(CStr(Flex(FlexHwBm).RowData(1)))
         Flex(FlexHwBm).Row = 1
         SetValueToControl "HwBm"
      End If
   Else
      SetValueToControl "HwBm"
   End If
   
   Flex(FlexHwBm).Enabled = True
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Delrecord(RecordName As String)
On Error GoTo Errorhandle
        
   If OHwBms Is Nothing Then
       Exit Sub
   End If
   
   If OHwBm Is Nothing Then
       Exit Sub
   End If
   
   If Flex(FlexHwBm).Rows <= 2 Then
       Exit Sub
   End If

    
   If MsgBox("您真的要删除吗？", vbYesNo) = vbYes Then
      OHwBms.Remove CStr(OHwBm.HwBm_Key)
      gPublicFunction.RemoveFlexItem Flex(FlexHwBm).Row, Flex(FlexHwBm)
      If Flex(FlexHwBm).Rows = 2 Then
         Set OHwBm = Nothing
         Clearcontrol "HwBm"
      Else
         Set OHwBm = OHwBms(CStr(Flex(FlexHwBm).RowData(Flex(FlexHwBm).Row)))
         SetValueToControl "HwBm"
      End If
   End If

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

Private Sub SaveRecord(RecordName As String)
On Error GoTo Errorhandle
   
   SetValueToObject RecordName
    
   If OHwBm.HwBm_id = -1 Then
      OHwBm.DbSave
      OHwBms.Add OHwBm
      ChgGrid "add_HwBm"
   Else
      OHwBm.DbSave
      ChgGrid "chg_HwBm"
   End If
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbHwBm), RecordName
   
   Flex(FlexHwBm).Enabled = True
    
Exit Sub
Errorhandle:
    Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub ChgGrid(RecordName As String)
    Dim ItemStr As String
On Error GoTo Errorhandle


   If UCase(Left(RecordName, 3)) = "ADD" Then
      ItemStr = vbTab & OHwBm.HwBm_HwFlMc & vbTab & OHwBm.HwBmCode & vbTab & OHwBm.HwBmMc & vbTab & OHwBm.HwBmEMc
      ItemStr = ItemStr & vbTab & OHwBm.HwBmSize & vbTab & OHwBm.HwBm_HwDwCode & vbTab & IIf(OHwBm.HwBmIsStop = 1, "√", "")
      
      Flex(FlexHwBm).AddItem ItemStr, Flex(FlexHwBm).Rows - 1
      Flex(FlexHwBm).RowData(Flex(FlexHwBm).Rows - 2) = OHwBm.HwBm_Key
      Flex(FlexHwBm).Row = Flex(FlexHwBm).Rows - 2
   Else
      Flex(FlexHwBm).TextMatrix(Flex(FlexHwBm).Row, Flex(FlexHwBm).ColIndex("HwBm_HwFlNo")) = OHwBm.HwBm_HwFlMc
      Flex(FlexHwBm).TextMatrix(Flex(FlexHwBm).Row, Flex(FlexHwBm).ColIndex("HwBmCODE")) = OHwBm.HwBmCode
      Flex(FlexHwBm).TextMatrix(Flex(FlexHwBm).Row, Flex(FlexHwBm).ColIndex("HwBmMC")) = OHwBm.HwBmMc
      Flex(FlexHwBm).TextMatrix(Flex(FlexHwBm).Row, Flex(FlexHwBm).ColIndex("HwBmEMc")) = OHwBm.HwBmEMc
      Flex(FlexHwBm).TextMatrix(Flex(FlexHwBm).Row, Flex(FlexHwBm).ColIndex("HwBmSize")) = OHwBm.HwBmSize
      Flex(FlexHwBm).TextMatrix(Flex(FlexHwBm).Row, Flex(FlexHwBm).ColIndex("HwBm_HwDwNo")) = OHwBm.HwBm_HwDwCode
      Flex(FlexHwBm).TextMatrix(Flex(FlexHwBm).Row, Flex(FlexHwBm).ColIndex("HwBmISSTOP")) = IIf(OHwBm.HwBmIsStop = 1, "√", "")
   End If

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

Private Sub SetValueToObject(ObjectName As String)
On Error GoTo Errorhandle


   OHwBm.HwBm_HwFlCode = Trim(Combo(CbxHwBm_HwFlCode).Text)
   OHwBm.HwBmCode = Trim(Text(TxtHwBmCode).Text)
   OHwBm.HwBmMc = Trim(Text(TxtHwBmMc).Text)
   OHwBm.HwBmEMc = Trim(Text(TxtHwBmEMc).Text)
   OHwBm.HwBmSize = Trim(Text(TxtHwBmSize).Text)
   OHwBm.HwBm_HwDwCode = Trim(Combo(CbxHwBm_HwDwCode).Text)
   If Check(ChkHwBmIsStop).Value = vbChecked Then
      OHwBm.HwBmIsStop = 1
   Else
      OHwBm.HwBmIsStop = 0
   End If
    
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Form_Resize()
On Error GoTo Errorhandle
   
   gPublicFunction.ResizeForm Me
   
Exit Sub
Errorhandle:
    MsgBox Err.Description
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Errorhandle

   Set OHwBm = Nothing
   Set OHwBms = Nothing
   
   gPublicCommon.PublicFunction.SaveFormSet Me
    
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Text_GotFocus(Index As Integer)
On Error GoTo Errorhandle

    
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Text_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
On Error GoTo Errorhandle

gPublicFunction.FormKeyDown Me, KeyCode, Shift, Text(Index)

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Text_KeyPress(Index As Integer, KeyAscii As Integer)
On Error GoTo Errorhandle


Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub SetValueToControl(ObjectName As String)
On Error GoTo Errorhandle

   Combo(CbxHwBm_HwFlCode).ListIndex = gPublicCommon.PublicFunction.GetComboListIndex(Combo(CbxHwBm_HwFlCode), OHwBm.HwBm_HwFlNo, 2)
   Text(TxtHwBmCode).Text = OHwBm.HwBmCode
   Text(TxtHwBmMc).Text = OHwBm.HwBmMc
   Text(TxtHwBmEMc).Text = OHwBm.HwBmEMc
   Text(TxtHwBmSize).Text = OHwBm.HwBmSize
   Combo(CbxHwBm_HwDwCode).ListIndex = gPublicCommon.PublicFunction.GetComboListIndex(Combo(CbxHwBm_HwDwCode), OHwBm.HwBm_HwDwNo, 2)
   
   If OHwBm.HwBmIsStop = 1 Then
      Check(ChkHwBmIsStop).Value = vbChecked
   Else
      Check(ChkHwBmIsStop).Value = vbUnchecked
   End If

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

Private Sub Text_LostFocus(Index As Integer)
On Error GoTo Errorhandle

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error GoTo Errorhandle
    
    Exit Sub
Errorhandle:
    MsgBox Err.Description
End Sub

Private Sub Tlbaction_ButtonClick(Index As Integer, ByVal Button As MSComctlLib.Button)
    Dim Action, RecordName As String
On Error GoTo Errorhandle

   Action = (Mid(Button.Key, 1, 3))
   RecordName = Button.Key
    
   Select Case Action
   Case "ADD"
         AddRecord RecordName
   Case "CHG"
         ChgRecord RecordName
   Case "CAN"
         CancelRecord RecordName
   Case "SAV"
         SaveRecord RecordName
   Case "DEL"
         Delrecord RecordName
   Case "EXI"
         Unload Me
   Case "FIN"
        
   Case Else
            
    End Select

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub