frmsaler.frm

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

            Key             =   ""
         EndProperty
         BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmSaler.frx":2A68
            Key             =   ""
         EndProperty
         BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmSaler.frx":2B7A
            Key             =   ""
         EndProperty
         BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmSaler.frx":2C8C
            Key             =   ""
         EndProperty
         BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmSaler.frx":2D9E
            Key             =   ""
         EndProperty
         BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmSaler.frx":2EB0
            Key             =   ""
         EndProperty
         BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmSaler.frx":31CA
            Key             =   ""
         EndProperty
         BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmSaler.frx":32DC
            Key             =   ""
         EndProperty
         BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmSaler.frx":33F0
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.Menu mFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu muFile 
         Caption         =   ""
         Index           =   0
      End
   End
   Begin VB.Menu mEdit 
      Caption         =   "编辑(&E)"
      Begin VB.Menu muEdit 
         Caption         =   ""
         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 = "frmSaler"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const TlbSaler = 0
Const ImgSaler = 0
Const SbarSaler = 0

Const FlexSaler = 0

Const TxtSalerCode = 0
Const TxtSalerMc = 1

Const ChkSalerIsStop = 0

Dim OSaler As Saler
Dim OSalers As Salers

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

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

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Form_Load()
On Error GoTo Errorhandle

   Flex(FlexSaler).ColKey(1) = "SALERCODE"
   Flex(FlexSaler).ColKey(2) = "SALERMC"
    
   gPublicFunction.LoadFormSet Me, Tlbaction(TlbSaler), Img(ImgSaler), SBar(SbarSaler)
   
   gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "Saler", "TXTSalerCODE", "CHKSalerISSTOP"
   
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Flex(FlexSaler)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "ADD", Flex(FlexSaler)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "CHG", Flex(FlexSaler)
   
   gPublicCommon.PublicFunction.EnableControl Me, ""
   
   LoadDataIntoGrid
   
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub LoadDataIntoGrid()
   Dim ItemStr As String
   Dim mSaler As Saler
On Error GoTo Errorhandle

   Flex(FlexSaler).Rows = 1
   
   Set OSalers = New Salers
   OSalers.FillbyDb
      
   For Each mSaler In OSalers
      ItemStr = vbTab & mSaler.SalerCode & vbTab & mSaler.SalerMc
      Flex(FlexSaler).AddItem ItemStr
      Flex(FlexSaler).RowData(Flex(FlexSaler).Rows - 1) = mSaler.SalerKey
   Next
   If Flex(FlexSaler).Rows > 1 Then
      Flex(FlexSaler).Row = 1
      Set OSaler = OSalers(CStr(Flex(FlexSaler).RowData(1)))
      SetValueToControl
   Else
      Set OSaler = Nothing
      Clearcontrol
   End If

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

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

   Set OSaler = New Saler
   Clearcontrol
   Text(TxtSalerCode).SetFocus
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbSaler), RecordName
   
Exit Sub
Errorhandle:
   Set OSaler = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub ChgRecord(RecordName As String)
On Error GoTo Errorhandle
    
   If OSaler Is Nothing Then
      Exit Sub
   End If
   
   Text(TxtSalerCode).SetFocus
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbSaler), RecordName
    
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   If Flex(FlexSaler).Rows = 1 Then
      Set OSaler = Nothing
      Clearcontrol
   Else
      Set OSaler = OSalers(CStr(Flex(FlexSaler).RowData(Flex(FlexSaler).Row)))
      SetValueToControl
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbSaler), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Clearcontrol()
On Error GoTo Errorhandle

   Text(TxtSalerCode).Text = ""
   Text(TxtSalerMc).Text = ""
   Check(ChkSalerIsStop).Value = vbUnchecked
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SaveRecord(RecordName As String)
On Error GoTo Errorhandle
    
   SetValueToObject

   If OSaler.SalerId = -1 Then
      OSalers.Add OSaler
      ChgGrid "ADD"
   Else
      OSaler.Save
      ChgGrid "CHG"
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbSaler), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SetValueToObject()
On Error GoTo Errorhandle

   OSaler.SalerCode = Trim(Text(TxtSalerCode).Text)
   OSaler.SalerMc = Trim(Text(TxtSalerMc).Text)
   OSaler.SalerIsStop = Check(ChkSalerIsStop)
   
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 RecordName = "ADD" Then
      ItemStr = vbTab & OSaler.SalerCode & vbTab & OSaler.SalerMc
      Flex(FlexSaler).AddItem ItemStr
      Flex(FlexSaler).RowData(Flex(FlexSaler).Rows - 1) = OSaler.SalerKey
      Flex(FlexSaler).Row = Flex(FlexSaler).Rows - 1
   Else
      Flex(FlexSaler).TextMatrix(Flex(FlexSaler).Row, Flex(FlexSaler).ColIndex("SALERCODE")) = Text(TxtSalerCode).Text
      Flex(FlexSaler).TextMatrix(Flex(FlexSaler).Row, Flex(FlexSaler).ColIndex("SALERMC")) = Text(TxtSalerMc).Text
   End If

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

Private Sub Delrecord()
On Error GoTo Errorhandle

   If Flex(FlexSaler).Rows = 1 Then
      Exit Sub
   End If

   If MsgBox("您真的要删除吗？", vbYesNo + vbQuestion) = vbYes Then
      OSalers.Remove CStr(OSaler.SalerKey)
      Flex(FlexSaler).RemoveItem Flex(FlexSaler).Row
      If Flex(FlexSaler).Rows = 1 Then
         Set OSaler = Nothing
         Clearcontrol
      Else
         Set OSaler = OSalers(CStr(Flex(FlexSaler).RowData(Flex(FlexSaler).Row)))
         SetValueToControl
      End If
   End If
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   If Flex(FlexSaler).Rows > 1 Then
      Set OSaler = OSalers(CStr(Flex(FlexSaler).RowData(Flex(FlexSaler).Row)))
      SetValueToControl
   Else
      Set OSaler = Nothing
      Clearcontrol
   End If
   
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub SetValueToControl()
On Error GoTo Errorhandle

   Text(TxtSalerCode).Text = OSaler.SalerCode
   Text(TxtSalerMc).Text = OSaler.SalerMc
   Check(ChkSalerIsStop).Value = OSaler.SalerIsStop
   
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 OSaler = Nothing
   Set OSalers = Nothing
   
   gPublicFunction.SaveFormSet Me
    
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

   gPublicFunction.InputCheck Me, Text(Index), KeyAscii

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 TlbSaler, mButton
   End If
  
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", "DEF"
            Delrecord
       Case "EXI"
            Unload Me
       Case "FIN"

       Case Else
           
   End Select

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub