frmbuyer.frm

来自「制造业产供销与往来系统源码」· FRM 代码 · 共 802 行 · 第 1/2 页

            Key             =   ""
         EndProperty
         BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmBuyer.frx":2A68
            Key             =   ""
         EndProperty
         BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmBuyer.frx":2B7A
            Key             =   ""
         EndProperty
         BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmBuyer.frx":2C8C
            Key             =   ""
         EndProperty
         BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmBuyer.frx":2D9E
            Key             =   ""
         EndProperty
         BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmBuyer.frx":2EB0
            Key             =   ""
         EndProperty
         BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmBuyer.frx":31CA
            Key             =   ""
         EndProperty
         BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmBuyer.frx":32DC
            Key             =   ""
         EndProperty
         BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmBuyer.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 = "frmBuyer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const TlbBuyer = 0
Const ImgBuyer = 0
Const SbarBuyer = 0

Const FlexBuyer = 0

Const TxtBuyerCode = 0
Const TxtBuyerMc = 1

Const ChkBuyerIsStop = 0

Dim OBuyer As Buyer
Dim OBuyers As Buyers

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(FlexBuyer).ColKey(1) = "BUYERCODE"
   Flex(FlexBuyer).ColKey(2) = "BUYERMC"
    
   gPublicFunction.LoadFormSet Me, Tlbaction(TlbBuyer), Img(ImgBuyer), SBar(SbarBuyer)
   
   gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "Buyer", "TXTBUYERCODE", "CHKBUYERISSTOP"
   
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Flex(FlexBuyer)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "ADD", Flex(FlexBuyer)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "CHG", Flex(FlexBuyer)
   
   gPublicCommon.PublicFunction.EnableControl Me, ""
   
   LoadDataIntoGrid
   
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub LoadDataIntoGrid()
   Dim ItemStr As String
   Dim mBuyer As Buyer
On Error GoTo Errorhandle

   Flex(FlexBuyer).Rows = 1
   
   Set OBuyers = New Buyers
   OBuyers.FillbyDb
      
   For Each mBuyer In OBuyers
      ItemStr = vbTab & mBuyer.BuyerCode & vbTab & mBuyer.BuyerMc
      Flex(FlexBuyer).AddItem ItemStr
      Flex(FlexBuyer).RowData(Flex(FlexBuyer).Rows - 1) = mBuyer.BuyerKey
   Next
   If Flex(FlexBuyer).Rows > 1 Then
      Flex(FlexBuyer).Row = 1
      Set OBuyer = OBuyers(CStr(Flex(FlexBuyer).RowData(1)))
      SetValueToControl
   Else
      Set OBuyer = 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 OBuyer = New Buyer
   Clearcontrol
   Text(TxtBuyerCode).SetFocus
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbBuyer), RecordName
   
Exit Sub
Errorhandle:
   Set OBuyer = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

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

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

Private Sub Clearcontrol()
On Error GoTo Errorhandle

   Text(TxtBuyerCode).Text = ""
   Text(TxtBuyerMc).Text = ""
   Check(ChkBuyerIsStop).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 OBuyer.BuyerId = -1 Then
      OBuyers.Add OBuyer
      ChgGrid "ADD"
   Else
      OBuyer.Save
      ChgGrid "CHG"
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbBuyer), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SetValueToObject()
On Error GoTo Errorhandle

   OBuyer.BuyerCode = Trim(Text(TxtBuyerCode).Text)
   OBuyer.BuyerMc = Trim(Text(TxtBuyerMc).Text)
   OBuyer.BuyerIsStop = Check(ChkBuyerIsStop)
   
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 & OBuyer.BuyerCode & vbTab & OBuyer.BuyerMc
      Flex(FlexBuyer).AddItem ItemStr
      Flex(FlexBuyer).RowData(Flex(FlexBuyer).Rows - 1) = OBuyer.BuyerKey
      Flex(FlexBuyer).Row = Flex(FlexBuyer).Rows - 1
   Else
      Flex(FlexBuyer).TextMatrix(Flex(FlexBuyer).Row, 1) = Text(TxtBuyerCode).Text
      Flex(FlexBuyer).TextMatrix(Flex(FlexBuyer).Row, 2) = Text(TxtBuyerMc).Text
   End If

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

Private Sub Delrecord()
On Error GoTo Errorhandle

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

   If MsgBox("您真的要删除吗？", vbYesNo) = vbYes Then
      OBuyers.Remove CStr(OBuyer.BuyerKey)
      Flex(FlexBuyer).RemoveItem Flex(FlexBuyer).Row
      If Flex(FlexBuyer).Rows = 1 Then
         Set OBuyer = Nothing
         Clearcontrol
      Else
         Set OBuyer = OBuyers(CStr(Flex(FlexBuyer).RowData(Flex(FlexBuyer).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(FlexBuyer).Rows > 1 Then
      Set OBuyer = OBuyers(CStr(Flex(FlexBuyer).RowData(Flex(FlexBuyer).Row)))
      SetValueToControl
   Else
      Set OBuyer = Nothing
      Clearcontrol
   End If
   
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub SetValueToControl()
On Error GoTo Errorhandle

   Text(TxtBuyerCode).Text = OBuyer.BuyerCode
   Text(TxtBuyerMc).Text = OBuyer.BuyerMc
   Check(ChkBuyerIsStop).Value = OBuyer.BuyerIsStop
   
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 OBuyer = Nothing
   Set OBuyers = 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 TlbBuyer, 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