frm_outstemperspecbill_addart.frm

一个公司的客户财产管理系统vb源码

      Width           =   15240
      _ExtentX        =   26882
      _ExtentY        =   661
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   8
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   6
            Object.Width           =   2823
            MinWidth        =   2823
            Picture         =   "Frm_OutStemperSpecBill_AddArt.frx":2B40
            TextSave        =   "2006-5-29"
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   5
            Object.Width           =   1764
            MinWidth        =   1764
            TextSave        =   "18:17"
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   3528
            MinWidth        =   3528
            Text            =   "操作员："
            TextSave        =   "操作员："
         EndProperty
         BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   2
            Object.Width           =   1411
            MinWidth        =   1411
            TextSave        =   "NUM"
         EndProperty
         BeginProperty Panel5 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   3
            Enabled         =   0   'False
            Object.Width           =   1411
            MinWidth        =   1411
            TextSave        =   "Ins"
         EndProperty
         BeginProperty Panel6 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   1
            Enabled         =   0   'False
            Object.Width           =   1411
            MinWidth        =   1411
            TextSave        =   "CAPS"
         EndProperty
         BeginProperty Panel7 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   9349
            MinWidth        =   9349
            Text            =   "总记录数："
            TextSave        =   "总记录数："
         EndProperty
         BeginProperty Panel8 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   14887
            MinWidth        =   14887
            Text            =   "大连华录影音实业有限公司"
            TextSave        =   "大连华录影音实业有限公司"
         EndProperty
      EndProperty
   End
   Begin VB.Menu mnu_Popup 
      Caption         =   "弹出式菜单"
      Visible         =   0   'False
      Begin VB.Menu mnu_Add 
         Caption         =   "添加到规格单"
      End
      Begin VB.Menu mnu_View 
         Caption         =   "查看此条信息"
      End
      Begin VB.Menu mnu_Find 
         Caption         =   "查找客户财产"
      End
      Begin VB.Menu mnu_Exit 
         Caption         =   "退出节目添加"
      End
   End
End
Attribute VB_Name = "Frm_OutStemperSpecBill_AddArt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Tree_Change()
On Error GoTo err
  Dim node1, node2 As Node
  Dim key As String
  Dim text As String
  Dim Record_Position As Integer
  Record_Position = 0
  Set Cn_Area = New ADODB.Connection
  Cn_Area.Open Cs
  Set Rs_Area = New ADODB.Recordset
  Rs_Area.Open "select * from Area_Customer order by 地区编码,客户编码", Cn_Area, adOpenKeyset, adLockOptimistic, adCmdText
  If Rs_Area.RecordCount > 0 Then
    Rs_Area.MoveFirst
    Do While Rs_Area.EOF = False
        Record_Position = Record_Position + 1
          If Record_Position = 1 Then
            AreaCode = Trim(Rs_Area.Fields("地区编码"))
            CustomerCode = Trim(Rs_Area.Fields("客户编码"))
            key = Trim(Rs_Area.Fields("地区编码"))
            text = "(" & Trim(Rs_Area.Fields("地区编码")) & ")" & Trim(Rs_Area.Fields("地区名称"))
            Set node1 = Tvw_Customer.Nodes.Add(, , key, text, 1)
            
            key = Trim(Rs_Area.Fields("客户编码"))
            text = "(" & Trim(Rs_Area.Fields("客户编码")) & ")" & Trim(Rs_Area.Fields("客户名称"))
            Set node2 = Tvw_Customer.Nodes.Add(node1.Index, tvwChild, key, text, 1)
          Else
             '同地区不同客户
            If AreaCode = Trim(Rs_Area.Fields("地区编码")) And CustomerCode <> Trim(Rs_Area.Fields("客户编码")) Then
              CustomerCode = Trim(Rs_Area.Fields("客户编码"))
              key = Trim(Rs_Area.Fields("客户编码"))
              text = "(" & Trim(Rs_Area.Fields("客户编码")) & ")" & Trim(Rs_Area.Fields("客户名称"))
              Set node2 = Tvw_Customer.Nodes.Add(node2.Index, tvwLast, key, text, 1)
            End If
            '不同地区不同客户
            If AreaCode <> Trim(Rs_Area.Fields("地区编码")) And CustomerCode <> Trim(Rs_Area.Fields("客户编码")) Then
              AreaCode = Trim(Rs_Area.Fields("地区编码"))
              CustomerCode = Trim(Rs_Area.Fields("客户编码"))
              key = Trim(Rs_Area.Fields("地区编码"))
              text = "(" & Trim(Rs_Area.Fields("地区编码")) & ")" & Trim(Rs_Area.Fields("地区名称"))
              Set node1 = Tvw_Customer.Nodes.Add(, , key, text, 1)
              
              key = Trim(Rs_Area.Fields("客户编码"))
              text = "(" & Trim(Rs_Area.Fields("客户编码")) & ")" & Trim(Rs_Area.Fields("客户名称"))
              Set node2 = Tvw_Customer.Nodes.Add(node1.Index, tvwChild, key, text, 1)
            End If
          End If
          Rs_Area.MoveNext
    Loop
    
  Else
     MsgBox "记录为空!"
  End If
  Rs_Area.Close
  Cn_Area.Close
  
Exit Sub
err:
  MsgBox err.Description, vbCritical
End Sub

Private Sub Form_Load()
On Error GoTo err
  Me.StatusBar1.Panels(3).text = ("操作员： " + OperatorName)
  Call Tree_Change
  Set Cn_OutCR = New ADODB.Connection
  Cn_OutCR.Open Cs
  Set Rs_OutCR = New ADODB.Recordset
  Rs_OutCR.Open "select * from OutCustomer_Riches order by 节目名称,母盘号码", Cn_OutCR, adOpenKeyset, adLockOptimistic, adCmdText 'adOpenKeyset, adLockOptimistic, adCmdText
  Set TDBGrid_CusRiches.DataSource = Rs_OutCR
  
  Call DGrid_Width_Set(Frm_OutStemperSpecBill_AddArt)
  
  Me.StatusBar1.Panels(7).text = "记录总数： " & Str(Rs_OutCR.RecordCount)

Exit Sub
err:
  MsgBox err.Description, vbCritical
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
   AreaCustomer_Key = ""
   AreaCustomer_Text = ""
   If Rs_OutCR.State = 1 Then
     Rs_OutCR.Close
     Cn_OutCR.Close
   End If
   Set Rs_OutCR = Nothing
   Set Cn_OutCR = Nothing
End Sub

Private Sub Mnu_Add_Click()
On Error GoTo err
  If Len(AreaCustomer_Key) = 5 And Rs_OutCR.RecordCount <> 0 And Rs_OutCR.EOF = False And Rs_OutCR.BOF = False Then
    Load Frm_OutStemperSpecBill_AddArt_Affirm
    Frm_OutStemperSpecBill_AddArt_Affirm.Show vbModal
  End If
Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub

Private Sub Mnu_Exit_Click()
On Error Resume Next
  Unload Me
End Sub

Private Sub Mnu_Find_Click()
On Error GoTo err
    Load Frm_OutStemperSpecBill_CusRiches_Find
    Frm_OutStemperSpecBill_CusRiches_Find.Show vbModal
Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub

Private Sub Mnu_View_Click()
On Error GoTo err
  Call TDBGrid_CusRiches_DblClick
Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub

Private Sub TDBGrid_CusRiches_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo err
    If Button And vbRightButton _
        Then PopupMenu mnu_Popup
Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub


Private Sub TDBGrid_CusRiches_DblClick()
On Error GoTo err

    If Len(AreaCustomer_Key) = 5 And Rs_OutCR.RecordCount <> 0 And Rs_OutCR.EOF = False And Rs_OutCR.BOF = False Then
      Load Frm_OutStemperSpecBill_AddArt_View
      Frm_OutStemperSpecBill_AddArt_View.Show vbModal
    End If
    
Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error GoTo err
  Select Case Button.Index
      Case 4 '添加到规格单(Add)
         Call Mnu_Add_Click
'        Load Frm_SpecBill_AddArt_Affirm
'        Frm_SpecBill_AddArt_Affirm.Show vbModal
      Case 5 '查看此条信息(View)
        Call TDBGrid_CusRiches_DblClick
      Case 6 '查找客户财产(Find)
        Call Mnu_Find_Click
'        Load Frm_SpecBill_CusRiches_Find
'        Frm_SpecBill_CusRiches_Find.Show vbModal
      Case 7 '退出节目添加(Exit)
          Unload Me
  End Select

Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub

Private Sub Tvw_Customer_Collapse(ByVal Node As MSComctlLib.Node)
On Error GoTo err
  AreaCustomer_Key = ""
  AreaCustomer_Text = ""
Exit Sub
err:
  MsgBox err.Description, vbCritical
End Sub

Private Sub Tvw_Customer_Expand(ByVal Node As MSComctlLib.Node)
On Error GoTo err
  AreaCustomer_Key = ""
  AreaCustomer_Text = ""
Exit Sub
err:
  MsgBox err.Description, vbCritical
End Sub

Private Sub Tvw_Customer_NodeClick(ByVal Node As MSComctlLib.Node)
On Error GoTo err
  AreaCustomer_Key = Node.key
  AreaCustomer_Text = Node.text
   If Node.Image = 1 Then
     Node.Image = 2
   Else
     Node.Image = 1
   End If
   
   If Rs_OutCR.State = 1 Then Rs_OutCR.Close
   Rs_OutCR.Open "select * from OutCustomer_Riches where 内编码 like '%'+ '" & Node.key & "'+'%'" & _
              "order by 节目名称,母盘号码", Cn_OutCR, adOpenKeyset, adLockOptimistic, adCmdText
   Me.TDBGrid_CusRiches.Close
   Set TDBGrid_CusRiches.DataSource = Rs_OutCR
   Call DGrid_Width_Set(Frm_OutStemperSpecBill_AddArt)
  
   Me.StatusBar1.Panels(7).text = "记录总数： " & Str(Rs_OutCR.RecordCount)
   
Exit Sub
err:
  MsgBox err.Description, vbCritical
End Sub