sys_qysz.frm

基于SQL2000的企业管理MRPII,包含进销存,财务,报关等组件,VB6开发,带文档说明.

      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   "AdoprimaryRs"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "PMingLiU"
         Size            =   9
         Charset         =   136
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
End
Attribute VB_Name = "sys_qysz"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False



'*******************************************************
'*            曹汉华   2002.8.29  编写                 *
'*******************************************************
Private Sub cmdnext_Click() '向后

  On Error GoTo GoNextError
  If Not AdoprimaryRs.Recordset.EOF Then AdoprimaryRs.Recordset.MoveNext
  If AdoprimaryRs.Recordset.EOF And AdoprimaryRs.Recordset.RecordCount > 0 Then
    Beep
    AdoprimaryRs.Recordset.MoveLast
  End If
  
  Exit Sub
GoNextError:
  MsgBox Err.Description

End Sub

Private Sub Cmdqd_Click() '首端
  If AdoprimaryRs.Recordset.RecordCount > 0 Then
  If AdoprimaryRs.BOFAction = False Then
  AdoprimaryRs.Recordset.MoveFirst
  Else
  AdoprimaryRs.Recordset.MoveNext
  End If
  Else
  Exit Sub
  End If
  End Sub

Private Sub Cmdreturn_Click()
Unload Me
End Sub
Private Sub cmdxq_Click() '向前
  On Error GoTo GoPrevError
  If Not AdoprimaryRs.Recordset.BOF Then AdoprimaryRs.Recordset.MovePrevious
  If AdoprimaryRs.Recordset.BOF And AdoprimaryRs.Recordset.RecordCount > 0 Then
    Beep
    AdoprimaryRs.Recordset.MoveFirst
  End If
  
  Exit Sub
GoPrevError:
  MsgBox Err.Description
End Sub

Private Sub cmdmd_Click() '末端
 If AdoprimaryRs.Recordset.RecordCount > 0 Then
 If AdoprimaryRs.Recordset.EOF = False Then
    AdoprimaryRs.Recordset.MoveLast
    Else
    AdoprimaryRs.Recordset.MovePrevious
 End If
 Else
 Exit Sub
 End If
End Sub
Private Sub Combo1_Click()
Set combo3_data = New Recordset
combo3_data.Open "select DISTINCT shi from sys_qysz where sheng='" & Trim(Combo1.Text) & "'", DB, adOpenStatic
 If combo3_data.RecordCount > 0 Then
   Combo2.Clear
   For i = 1 To combo3_data.RecordCount
   Combo2.AddItem (combo3_data.Fields("shi"))
   If combo3_data.EOF = False Then
   combo3_data.MoveNext
   End If
   Next i
   Combo2.Refresh
   combo3_data.MoveFirst
 Else
 Exit Sub
 End If
TreeView1.Refresh
Combo2.Enabled = True
Combo2.Text = ""
Combo2.ZOrder
End Sub
Private Sub Form_Load() '列表框数据
Me.Width = main_FRM.Picture1.Width - 30
 Me.Top = main_FRM.ActiveBar21.Bands("Band7").Height * 2.5 - 65
 Me.Height = main_FRM.Picture1.Height - 300
 Me.Left = main_FRM.Picture1.Left + 15
 Cmdcancel.Enabled = False
 CmdOK.Enabled = False
 Call tree_load
 Call combo_load
  AdoprimaryRs.ConnectionString = Conn_Str
  AdoprimaryRs.RecordSource = "select * FROM SYS_qysz"
  For i = 0 To Text.Count - 1
  Set Text(i).DataSource = AdoprimaryRs
  Next i
 End Sub

Private Sub Form_Unload(Cancel As Integer)
AdoprimaryRs.Recordset.Close
End Sub



Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Cmdcancel.Enabled = True Then
If UnloadMode <> VBRUN.QueryUnloadConstants.vbFormCode Then
Cancel = 1
Exit Sub
End If
End If
End Sub

Private Sub text_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = 40 Then        '向下箭头
   If Index + 1 < Text.Count Then
   Text(Index + 1).SetFocus
   Else
   Text(0).SetFocus
  End If
End If
If KeyCode = 38 Then        '向上箭头
  If Index - 1 >= 0 Then
  Text(Index - 1).SetFocus
  Else
  Text(Text.Count - 1).SetFocus
  End If
End If
End Sub

Private Sub Text_KeyPress(Index As Integer, KeyAscii As Integer)
   If KeyAscii = 13 Then    ' 按回车
      KeyAscii = 0
      SendKeys "{TAB}"
   End If
End Sub


Private Sub Cmdadd_Click()   '添加
  cmdqd.Enabled = False
  cmdxq.Enabled = False
  cmdmd.Enabled = False
  cmdnext.Enabled = False
  Cmddelete.Enabled = False
  Cmdadd.Enabled = False
  Cmdedit.Enabled = False
  Cmdreturn.Enabled = False
  CmdOK.Enabled = True
  Cmdcancel.Enabled = True
  On Error GoTo AddErr
  If AdoprimaryRs.Recordset.RecordCount > 0 Then
  AdoprimaryRs.Recordset.MoveLast
  End If
  AdoprimaryRs.Recordset.AddNew
  For i = 0 To Text.Count - 1
      Text(i).Locked = False
  Next i
  Text(0).SetFocus
  Text(0).Text = Combo1.Text
  Text(1).Text = Combo2.Text
  Exit Sub
AddErr:
  MsgBox Err.Description
End Sub

Private Sub cmdDelete_Click() '删除
 If MsgBox("是否真的删除此项记录?", vbYesNo + 16, "严重警告") = vbYes Then
 ' On Error GoTo DeleteErr
  On Error Resume Next
  If AdoprimaryRs.Recordset.RecordCount > 0 Then

  With AdoprimaryRs
    .Recordset.Delete
    If .Recordset.EOF = False Then .Refresh
     If AdoprimaryRs.Recordset.RecordCount > 0 Then
    .Recordset.MoveLast
    Else
    Exit Sub
    End If
    End With
 Else
  Exit Sub
  End If
  Call tree_load
  Call combo_load
End If
End Sub

Private Sub cmdEdit_Click() '修改
  For i = 0 To Text.Count - 1
      Text(i).Locked = False
  Next i
  cmdqd.Enabled = False
  cmdxq.Enabled = False
  cmdmd.Enabled = False
  cmdnext.Enabled = False
  Cmddelete.Enabled = False
  Cmdadd.Enabled = False
  Cmdedit.Enabled = False
  Cmdreturn.Enabled = False
  CmdOK.Enabled = True
  Cmdcancel.Enabled = True
  On Error GoTo EditErr
  Exit Sub
EditErr:
  MsgBox Err.Description
End Sub
Private Sub cmdCancel_Click() '取消
  For i = 0 To Text.Count - 1
      Text(i).Locked = True
  Next i
   Cmddelete.Enabled = True
  Cmdadd.Enabled = True
  Cmdedit.Enabled = True
  Cmdreturn.Enabled = True
  Cmddelete.Enabled = True
  Cmdadd.Enabled = True
  Cmdedit.Enabled = True
  Cmdreturn.Enabled = True
  CmdOK.Enabled = False
  Cmdcancel.Enabled = False
  cmdqd.Enabled = True
  cmdxq.Enabled = True
  cmdmd.Enabled = True
  cmdnext.Enabled = True
  On Error Resume Next
  AdoprimaryRs.Recordset.CancelUpdate
  If mvBookMark > 0 Then
    AdoprimaryRs.Recordset.Bookmark = mvBookMark
  Else
    AdoprimaryRs.Recordset.MoveFirst
  End If
  End Sub

Private Sub cmdOK_Click()    '确认
If Text(2).Text = "" Then
   MsgBox "所有名称不能为空", 48, "提示"
   Text(0).SetFocus
   Exit Sub
End If
If Text(0).Text = "" Then
   MsgBox "所有名称不能为空", 48, "提示"
   Text(0).SetFocus
   Exit Sub
End If
If Text(1).Text = "" Then
   MsgBox "所有名称不能为空", 48, "提示"
   Text(0).SetFocus
   Exit Sub
End If
  For i = 0 To Text.Count - 1
      Text(i).Locked = True
  Next i
  cmdqd.Enabled = True
  cmdxq.Enabled = True
  cmdmd.Enabled = True
  cmdnext.Enabled = True
  Cmddelete.Enabled = True
  Cmdadd.Enabled = True
  Cmdedit.Enabled = True
  Cmdreturn.Enabled = True
  CmdOK.Enabled = False
  Cmdcancel.Enabled = False
  On Error GoTo UpdateErr
  AdoprimaryRs.Recordset.UpdateBatch adAffectAll
  If mbAddNewFlag Then
    AdoprimaryRs.Recordset.MoveLast
  End If
  Cmdcancel.Enabled = False
  CmdOK.Enabled = False
  Call tree_load
  Call combo_load
  Exit Sub
UpdateErr:
  MsgBox Err.Description
End Sub
Sub tree_load()
  Dim CON_P As Integer
  Dim nodX As Node
  Dim primary2 As Recordset
  Dim tree_rec As Recordset
       '返加表中数据
        Set tree_rec = New Recordset
        tree_rec.Open "select count(*) as [CCC] from sys_qysz", DB, adOpenStatic, adLockOptimistic
        On Error Resume Next
  TreeView1.Nodes.Clear
        '根节点
  Set nodX = TreeView1.Nodes.Add()
    nodX.Text = "区域图示"
    nodX.Tag = "ROOT"
    nodX.Image = 1
    TreeView1.LabelEdit = False
        '加入一级节点
  Set tree_rec = New Recordset
  tree_rec.Open "select DISTINCT sheng from sys_qysz", DB, adOpenStatic, adLockOptimistic
  With tree_rec
  Do Until .EOF
        Set nodX = TreeView1.Nodes.Add(1, tvwChild, , CStr(!sheng))
        nodX.Tag = "sheng"
        nodX.Image = 3
        intn = nodX.Index
        '二级节点
       Set adoprimaryrs1 = New Recordset
        adoprimaryrs1.Open "select distinct shi from sys_qysz where sheng='" & !sheng & "'", DB, adOpenStatic, adLockOptimistic
        Do Until adoprimaryrs1.EOF
             Set nodX = TreeView1.Nodes.Add(intn, tvwChild)
             nodX.Text = adoprimaryrs1!shi
             nodX.Image = 2
             nodX.Tag = "shi"
           '三级节点 曹汉华 2002.8.28
            sh = nodX.Text
            nindex = nodX.Index
            Set primary2 = New Recordset
            primary2.Open "select distinct zheng from sys_qysz where shi='" & sh & "'", DB, adOpenStatic, adLockOptimistic
            Do Until primary2.EOF
            Set nodX = TreeView1.Nodes.Add(nindex, tvwChild)
            nodX.Text = primary2!zheng
            nodX.Image = 4
            nodX.Tag = "zheng"
            primary2.MoveNext
            Loop
          adoprimaryrs1.MoveNext
        Loop
  .MoveNext
  Loop
  End With
   TreeView1.Style = tvwTreelinesPlusMinusPictureText
   TreeView1.BorderStyle = vbFixedSingle
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComCtlLib.Node)
Dim bz As String
Select Case Node.Tag
    Case "sheng"
    bz = Trim(Node.Text)
    AdoprimaryRs.Recordset.MoveFirst
    AdoprimaryRs.Recordset.Find ("sheng='" & Node.Text & "'")
    Case "shi"
    AdoprimaryRs.Recordset.MoveFirst
    AdoprimaryRs.Recordset.Find ("shi='" & Node.Text & "'")
    Case "zheng"
    AdoprimaryRs.Recordset.MoveFirst
    AdoprimaryRs.Recordset.Find ("zheng='" & Node.Text & "'")
End Select
        If AdoprimaryRs.Recordset.EOF = True Then
          MsgBox "没找到符合项目", 48, "查询"
          AdoprimaryRs.Recordset.MoveFirst
        End If
End Sub
Sub combo_load()
Dim she As String
Dim sx As String
Dim combo1_data As Recordset
Dim combo2_data As Recordset
Set combo1_data = New Recordset
combo1_data.Open "select DISTINCT sheng from sys_qysz", DB, adOpenStatic, adLockOptimistic
 If combo1_data.RecordCount > 0 Then
    she = Combo1.Text
    Combo1.Clear
   For i = 1 To combo1_data.RecordCount
     Combo1.AddItem (combo1_data.Fields("sheng"))
   If combo1_data.EOF = False Then
     combo1_data.MoveNext
   End If
   Next i
 combo1_data.MoveFirst
 Combo1.Text = she
 Else
 Exit Sub
 End If
 Set combo2_data = New Recordset
 combo2_data.Open "select DISTINCT shi from sys_qysz", DB, adOpenStatic, adLockOptimistic
 If combo2_data.RecordCount > 0 Then
     sx = Combo2.Text
    Combo2.Clear
   For i = 1 To combo2_data.RecordCount
     Combo2.AddItem (combo2_data.Fields("shi"))
   If combo2_data.EOF = False Then
     combo2_data.MoveNext
   End If
   Next i
 combo2_data.MoveFirst
 Combo2.Text = sx
 Else
 Exit Sub
 End If
 End Sub