frmhwbfrc.frm

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

Dim OHwBfRc As HwBfRc
Dim OHwBfRcs As HwBfRcs

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
   
   mCurColOldValue = Trim(Flex(FlexHwBfRc).TextMatrix(Flex(FlexHwBfRc).Row, Flex(FlexHwBfRc).Col))

   If Tlbaction(TlbHwBfRc).Tag = "" Then
      Cancel = True
   End If

   If Tlbaction(TlbHwBfRc).Tag <> "" Then
      Select Case Flex(FlexHwBfRc).ColKey(Col)
      Case "HWBFRCCODE"
            
      Case "HWBFRCMC"
            If OHwBfRc Is Nothing Then
               Cancel = True
            End If
            
      End Select
            
   End If
   

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

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

   If Tlbaction(TlbHwBfRc).Tag = "" Then
      Exit Sub
   End If
   
   If OHwBfRc Is Nothing Then
      Exit Sub
   End If

   Select Case Index
   Case FlexHwBfRc
         If Flex(Index).Col = Flex(Index).ColIndex("HWBFRCISSTOP") Then
            If Flex(Index).TextMatrix(Flex(Index).Row, Flex(FlexHwBfRc).Col) = "" Then
               Flex(Index).TextMatrix(Flex(Index).Row, Flex(FlexHwBfRc).Col) = "√"
            Else
               Flex(Index).TextMatrix(Flex(Index).Row, Flex(FlexHwBfRc).Col) = ""
            End If
         End If
   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_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 Flex_KeyDownEdit(Index As Integer, ByVal Row As Long, ByVal Col As Long, KeyCode As Integer, ByVal Shift As Integer)
On Error GoTo Errorhandle

   If Tlbaction(TlbHwBfRc).Tag = "" Then
      Exit Sub
   End If
   
   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 FlexHwBfRc
            If Flex(Index).Rows > 2 And Flex(FlexHwBfRc).Row <> Flex(FlexHwBfRc).Rows - 1 Then
                Set OHwBfRc = OHwBfRcs(CStr(Flex(FlexHwBfRc).RowData(Flex(FlexHwBfRc).Row)))
            Else
                Set OHwBfRc = Nothing
            End If
    End Select
    
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub SetControlToFlex()
   Dim mCurCol As Integer
   Dim mCurRow As Integer
On Error GoTo Errorhandle

   If Tlbaction(TlbHwBfRc).Tag = "" Then
      Exit Sub
   End If
   
   mCurRow = Flex(FlexHwBfRc).Row
   mCurCol = Flex(FlexHwBfRc).Col
   
   Select Case Flex(FlexHwBfRc).ColKey(Flex(FlexHwBfRc).Col)
   Case "HWBFRCCODE"
         If OHwBfRc Is Nothing Then
            AddNewRecord
         Else
            OHwBfRc.HwBfRcCode = Trim(Flex(FlexHwBfRc).TextMatrix(mCurRow, mCurCol))
         End If
   
   Case "HWBFRCMC"
         If Not OHwBfRc Is Nothing Then
            OHwBfRc.HwBfRcMc = Trim(Flex(FlexHwBfRc).TextMatrix(mCurRow, mCurCol))
         End If
   
   End Select


Exit Sub
Errorhandle:
   Flex(FlexHwBfRc).TextMatrix(mCurRow, mCurCol) = mCurColOldValue
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub AddNewRecord()
On Error GoTo Errorhandle

   If Trim(Flex(FlexHwBfRc).TextMatrix(Flex(FlexHwBfRc).Row, Flex(FlexHwBfRc).Col)) <> "" Then
      Set OHwBfRc = New HwBfRc
      OHwBfRc.HwBfRcCode = Trim(Flex(FlexHwBfRc).TextMatrix(Flex(FlexHwBfRc).Row, Flex(FlexHwBfRc).Col))
      OHwBfRcs.Add OHwBfRc
      Flex(FlexHwBfRc).RowData(Flex(FlexHwBfRc).Rows - 1) = OHwBfRc.HwBfRc_Key
      Flex(FlexHwBfRc).AddItem ""
   End If

Exit Sub
Errorhandle:
   Set OHwBfRc = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Form_Load()
On Error GoTo Errorhandle
   
   Flex(FlexHwBfRc).Editable = flexEDKbdMouse
   
   Flex(FlexHwBfRc).ColKey(1) = "HWBFRCCODE"
   Flex(FlexHwBfRc).ColKey(2) = "HWBFRCMC"
   Flex(FlexHwBfRc).ColKey(3) = "HWBFRCISSTOP"
   
   gPublicFunction.LoadFormSet Me, Tlbaction(TlbHwBfRc), Img(ImgHwBfRc), SBar(SBarHwBfRc)
   
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Flex(FlexHwBfRc)
   gPublicCommon.PublicFunction.EnableControl Me, ""
   
   LoadDataIntoGrid
   
   
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 TlbHwBfRc, mButton
   End If
  
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub LoadDataIntoGrid()
    Dim ItemStr As String
    Dim m_HwBfRc As HwBfRc
On Error GoTo Errorhandle
    
    Flex(FlexHwBfRc).Rows = 1
    Flex(FlexHwBfRc).AddItem ""
   
    Set OHwBfRcs = New HwBfRcs
    OHwBfRcs.FillbyDb
    
    For Each m_HwBfRc In OHwBfRcs
       ItemStr = vbTab & m_HwBfRc.HwBfRcCode & vbTab & m_HwBfRc.HwBfRcMc & vbTab & IIf(m_HwBfRc.HwBfRcIsStop = 1, "√", "")
       Flex(FlexHwBfRc).AddItem ItemStr, Flex(FlexHwBfRc).Rows - 1
       Flex(FlexHwBfRc).RowData(Flex(FlexHwBfRc).Rows - 2) = m_HwBfRc.HwBfRc_Key
    Next
    
    If Flex(FlexHwBfRc).Rows > 2 Then
      Flex(FlexHwBfRc).Row = 1
      Set OHwBfRc = OHwBfRcs(CStr(Flex(FlexHwBfRc).RowData(1)))
    Else
      Set OHwBfRc = Nothing
    End If
    
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub AddRecord(RecordName As String)
On Error GoTo Errorhandle
   
   Flex(FlexHwBfRc).Row = Flex(FlexHwBfRc).Rows - 1
   Flex(FlexHwBfRc).Col = Flex(FlexHwBfRc).ColIndex("HWBFRCCODE")
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbHwBfRc), RecordName
    
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   If Tlbaction(TlbHwBfRc).Tag <> "" Then
      gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbHwBfRc), RecordName
      LoadDataIntoGrid
   End If
    
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   If OHwBfRcs Is Nothing Then
       Exit Sub
   End If
   
   If OHwBfRc Is Nothing Then
       Exit Sub
   End If
   
   If Flex(FlexHwBfRc).Rows <= 2 Then
       Exit Sub
   End If
    
   If MsgBox("您真的要删除吗？", vbYesNo) = vbYes Then
      OHwBfRcs.Remove CStr(OHwBfRc.HwBfRc_Key)
      gPublicFunction.RemoveFlexItem Flex(FlexHwBfRc).Row, Flex(FlexHwBfRc)
      If Flex(FlexHwBfRc).Rows = 2 Then
          Set OHwBfRc = Nothing
      Else
          Set OHwBfRc = OHwBfRcs(CStr(Flex(FlexHwBfRc).RowData(Flex(FlexHwBfRc).Row)))
      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
   OHwBfRcs.DbSave
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbHwBfRc), RecordName
    
Exit Sub
Errorhandle:
    Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   For I = 1 To Flex(FlexHwBfRc).Rows - 2
      Set OHwBfRc = OHwBfRcs.Item(CStr(Flex(FlexHwBfRc).RowData(I)))
      OHwBfRc.HwBfRcCode = Trim(Flex(FlexHwBfRc).TextMatrix(I, Flex(FlexHwBfRc).ColIndex("HWBFRCCODE")))
      OHwBfRc.HwBfRcMc = Trim(Flex(FlexHwBfRc).TextMatrix(I, Flex(FlexHwBfRc).ColIndex("HWBFRCMC")))
      OHwBfRc.HwBfRcIsStop = IIf(Trim(Flex(FlexHwBfRc).TextMatrix(I, Flex(FlexHwBfRc).ColIndex("HWBFRCISSTOP"))) <> "", 1, 0)
   Next
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   Set OHwBfRc = Nothing
   Set OHwBfRcs = Nothing
   
   gPublicCommon.PublicFunction.SaveFormSet Me
    
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
   
   If Trim(Flex(FlexHwBfRc).EditText) <> "" Then
      Flex(FlexHwBfRc).TextMatrix(Flex(FlexHwBfRc).Row, Flex(FlexHwBfRc).Col) = Trim(Flex(FlexHwBfRc).EditText)
   End If
       
   Select Case Action
   Case "EDI"
        AddRecord RecordName
   Case "CAN"
        CancelRecord RecordName
   Case "SAV"
        SaveRecord RecordName
   Case "DEF"
        Delrecord RecordName
   Case "EXI"
        Unload Me
   End Select
    
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

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