form3.frm

一、 设计构想： 为减轻财政局非税收入管理处票据准购薄管理工作量

      NumItems        =   0
   End
   Begin VB.Image Image1 
      Height          =   645
      Left            =   2400
      Picture         =   "Form3.frx":8572
      Top             =   0
      Width           =   3585
   End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL, connstr As String
Dim zgID, zgcataID As Long

Private Sub Command1_Click()
On Error Resume Next
If Text1(1).Text = "" Or Text1(0).Text = "" Then
MDIForm1.StatusBar1.Panels(1).Text = "请填写完全"
Exit Sub
End If
    SQL = "select * from zgbm_cata where id=" & zgID
    rs.Open SQL, conn, 1, 3
    If rs.EOF Then
    rs.AddNew
    End If
    rs("zgbm") = Text1(0).Text
    rs("num") = CInt(Text1(1).Text)
    rs.Update
    rs.Close
    If Err.Number = 0 Then
    Call RefillList(ListView1)
Command2.Enabled = False
Text1(0).Text = ""
Text1(1).Text = ""
zgID = 0
    MDIForm1.StatusBar1.Panels(1).Text = "操作成功"
    Else
        MsgBox ("操作失败")
    End If
End Sub

Private Sub Command2_Click()
On Error Resume Next
If zgID = 0 Then
MDIForm1.StatusBar1.Panels(1).Text = "未选择主管部门，不允许操作"
Exit Sub
End If
SQL = "delete from zgbm_cata where id=" & zgID
conn.Execute SQL
SQL = "delete from zgbm where cataid=" & zgID
conn.Execute SQL
If Err.Number = 0 Then
Call RefillList(ListView1)

Text1(0).Text = ""
Text1(1).Text = ""
zgID = 0
Command2.Enabled = False
Else
MDIForm1.StatusBar1.Panels(1).Text = "数据库删除失败."
End If
End Sub

Private Sub Command3_Click()
On Error Resume Next
If zgcataID = 0 Then
MDIForm1.StatusBar1.Panels(1).Text = "未选择主管部门，不允许操作"
Exit Sub
End If
SQL = "delete from zgbm where id=" & zgcataID
conn.Execute SQL
If Err.Number = 0 Then
Call RefillList2(ListView2)

Text2(0).Text = ""
Text2(1).Text = ""
Text2(2).Text = ""
zgcataID = 0
Command3.Enabled = False
Else
MDIForm1.StatusBar1.Panels(1).Text = "数据库删除失败."
End If
End Sub

Private Sub Command4_Click()
On Error Resume Next
Text1(0).Text = ""
Text1(1).Text = ""
zgID = 0
Command2.Enabled = False
End Sub

Private Sub Command5_Click()
On Error Resume Next
If zgID = 0 Then
MDIForm1.StatusBar1.Panels(1).Text = "请先选择主管部门类别"
Exit Sub
End If
If Text2(2).Text = "" Or Text2(1).Text = "" Or Text2(0).Text = "" Then
MDIForm1.StatusBar1.Panels(1).Text = "请填写完全"
Exit Sub
End If
If Len(Text2(0).Text) <> 4 Then
MDIForm1.StatusBar1.Panels(1).Text = "请正确填写4位主管部门编号"
Exit Sub
End If
    SQL = "select * from zgbm where id=" & zgcataID
    rs.Open SQL, conn, 1, 3
    If rs.EOF Then
    rs.AddNew
    End If
    rs("dwbm") = Text2(0).Text
    rs("cataid") = zgID
    rs("zgbm") = Text2(1).Text
    rs("num") = CInt(Text2(2).Text)
    rs.Update
    rs.Close
    If Err.Number = 0 Then
    Call RefillList2(ListView2)
Command3.Enabled = False
Text2(0).Text = ""
Text2(1).Text = ""
Text2(2).Text = ""
zgcataID = 0
    MDIForm1.StatusBar1.Panels(1).Text = "操作成功"
    Else
        MsgBox ("操作失败")
    End If
End Sub

Private Sub Command6_Click()
On Error Resume Next
If zgID > 0 Then
Text2(0).Text = ""
Text2(1).Text = ""
Text2(2).Text = ""
zgcataID = 0
Command3.Enabled = False
Else
MsgBox "请先选择主管部门类别"
End If
End Sub

Private Sub Form_Load()
On Error Resume Next
    connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\GLNHHY.DLL;Persist Security Info=False"
    Set conn = New ADODB.Connection
    conn.Open connstr
    Set rs = New ADODB.Recordset
    Command2.Enabled = False
Call RefillList(ListView1)
End Sub



Private Sub RefillList(ByVal lv As ListView)
On Error Resume Next
   Dim clm As ColumnHeader
   Dim itm As ListItem
   Dim i As Long, j As Long
   lv.ListItems.Clear
   lv.ColumnHeaders.Clear
   lv.View = lvwReport
   lv.LabelEdit = lvwManual
   '
   '
   Set clm = lv.ColumnHeaders.Add(, , "ID", ListView1.Width / 100 * 20)
   Set clm = lv.ColumnHeaders.Add(, , "主管部门名称", ListView1.Width / 100 * 48)
   Set clm = lv.ColumnHeaders.Add(, , "排列顺序", ListView1.Width / 100 * 30, 2)
i = 0
SQL = "select * from zgbm_cata order by num"
rs.Open SQL, conn, 1, 1
If rs.EOF Then
rs.Close
Exit Sub
End If
Do Until rs.EOF
If rs.EOF Then Exit Do
i = i + 1
      Set itm = lv.ListItems.Add(, , rs("id"))
      itm.SubItems(1) = rs("zgbm") & ""
      itm.SubItems(2) = rs("num") & ""
rs.MoveNext
Loop
rs.Close
End Sub



Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
On Error Resume Next
ListView1.SortKey = ColumnHeader.Index - 1
ListView1.Sorted = True
If ListView1.SortOrder = lvwDescending Then
ListView1.SortOrder = lvwAscending
Else
ListView1.SortOrder = lvwDescending
End If
End Sub

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
On Error Resume Next
If Err.Number = 3705 Then rs.Close
SQL = "select * from zgbm_cata where id=" & Item.Text
rs.Open SQL, conn, 1, 1
If Not (rs.EOF) Then
zgID = CLng(rs("id"))
Text1(0).Text = rs("zgbm")
Text1(1).Text = rs("num")
End If
rs.Close
Command2.Enabled = True
Frame2.Caption = "[" & Text1(0).Text & "]管理"
Call RefillList2(ListView2)
End Sub

Private Sub RefillList2(ByVal lv As ListView)
On Error Resume Next
   Dim clm As ColumnHeader
   Dim itm As ListItem
   Dim i As Long, j As Long
   lv.ListItems.Clear
   lv.ColumnHeaders.Clear
   lv.View = lvwReport
   lv.LabelEdit = lvwManual
   '
   '
   Set clm = lv.ColumnHeaders.Add(, , "ID", ListView1.Width / 100 * 13)
   Set clm = lv.ColumnHeaders.Add(, , "主管部门前缀", ListView1.Width / 100 * 33)
   Set clm = lv.ColumnHeaders.Add(, , "主管部门名称", ListView1.Width / 100 * 33)
   Set clm = lv.ColumnHeaders.Add(, , "排列顺序", ListView1.Width / 100 * 20, 2)
i = 0
SQL = "select * from zgbm where cataid=" & zgID & " order by num"
rs.Open SQL, conn, 1, 1
If rs.EOF Then
rs.Close
Exit Sub
End If
Do Until rs.EOF
If rs.EOF Then Exit Do
i = i + 1
      Set itm = lv.ListItems.Add(, , rs("id"))
      itm.SubItems(1) = rs("dwbm") & ""
      itm.SubItems(2) = rs("zgbm") & ""
      itm.SubItems(3) = rs("num") & ""
rs.MoveNext
Loop
rs.Close
End Sub

Private Sub ListView2_ItemClick(ByVal Item As MSComctlLib.ListItem)
On Error Resume Next
If Err.Number = 3705 Then rs.Close
SQL = "select * from zgbm where id=" & Item.Text
rs.Open SQL, conn, 1, 1
If Not (rs.EOF) Then
zgcataID = CLng(rs("id"))
Text2(0).Text = rs("dwbm")
Text2(1).Text = rs("zgbm")
Text2(2).Text = rs("num")
End If
rs.Close
Command3.Enabled = True

End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
On Error Resume Next
If Index = 1 Then
If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
If Len(Text1(1).Text) > 2 Then KeyAscii = 0
End If
End Sub
Private Sub Text2_KeyPress(Index As Integer, KeyAscii As Integer)
On Error Resume Next
If Index = 2 Then
If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
If Len(Text2(2).Text) > 2 Then KeyAscii = 0
End If
End Sub