form1.frm

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

Private Sub Command2_Click()
On Error Resume Next
If dwID = 0 Then
MDIForm1.StatusBar1.Panels(1).Text = "添加单位时，不允许操作"
Exit Sub
End If
If Text2(0).Text = "" Or Text2(1).Text = "" Or Text2(2).Text = "" Or Text3.Text = "" Then
MDIForm1.StatusBar1.Panels(1).Text = "请填写完全"
Exit Sub
End If


If dwID = 0 Then
MDIForm1.StatusBar1.Panels(1).Text = "添加单位时，不允许操作"
Exit Sub
End If
SQL = "select * from xmxx where dwid=" & dwID & " and id=" & xmID
rs.Open SQL, conn, 1, 3
If rs.EOF Then
rs.AddNew
rs("dwid") = dwID
End If
rs("xmbm") = Text2(0).Text
rs("xmmc") = Text2(1).Text
rs("yjwj") = Text3.Text
rs("sfxz") = Combo5.List(Combo5.ListIndex)
rs("sfbz") = Text2(2).Text
rs("bz") = Text2(3).Text
rs.Update
rs.Close
If Err.Number = 0 Then
Call RefillList(ListView1)

Text2(0).Text = ""
Text2(1).Text = ""
Text2(2).Text = ""
Text2(3).Text = ""
Text3.Text = ""
Combo5.ListIndex = 0
xmID = 0
Else
MDIForm1.StatusBar1.Panels(1).Text = "数据库操作失败."
End If
End Sub

Private Sub Command3_Click()
On Error Resume Next
If dwID = 0 Then
MDIForm1.StatusBar1.Panels(1).Text = "添加单位时，不允许操作"
Exit Sub
End If
SQL = "delete from xmxx where id=" & xmID
conn.Execute SQL
If Err.Number = 0 Then
Call RefillList(ListView1)

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

Private Sub Command4_Click()
On Error Resume Next
Text2(0).Text = ""
Text2(1).Text = ""
Text2(2).Text = ""
Text2(3).Text = ""
Text3.Text = ""
Combo5.ListIndex = 0
xmID = 0
Command3.Enabled = False
End Sub

Private Sub Form_Activate()
On Error Resume Next
If dwID <> Pub_dwID Then
dwID = Pub_dwID
    If dwID > 0 Then
        Frame1.Caption = "基本信息-更新信息"
        Frame2.Visible = True
        ListView1.Visible = True
        SQL = "select * from jbxx where id=" & dwID
        rs.Open SQL, conn, 1, 1
            If Not (rs.EOF) Then
            Text1(0).Text = rs("dwbh")
            Text1(1).Text = rs("dwmc")
            Text1(2).Text = rs("jgdm")
            Text1(3).Text = rs("sfxk")
            If rs("xkqx") = "9999-12-31" Then
            DTPicker1.Value = Now()
            Check1.Value = 0
            Else
            DTPicker1.Value = rs("xkqx")
            Check1.Value = 1
            End If
            Text1(4).Text = rs("dwdz")
            Text1(5).Text = rs("lxr")
            Text1(6).Text = rs("lxdh")
            Text1(7).Text = rs("pjmc")
            Text1(8).Text = rs("bkfs")
            
            
            t1 = rs("dwxz")
            For i = 1 To Combo2.ListCount
            If t1 = Combo2.List(i - 1) Then
            Combo2.ListIndex = i - 1
            Exit For
            End If
            Next
            
            t1 = rs("bkfs")
            For i = 1 To Combo4.ListCount
            If t1 = Combo4.List(i - 1) Then
            Combo4.ListIndex = i - 1
            Exit For
            End If
            Next
            
            
            
            t1 = rs("zgbm")  '主管部门名称
            SQL = "select * from zgbm_cata where id in (select cataid from zgbm where zgbm='" & t1 & "')"
            rs1.Open SQL, conn, 1, 1
            t2 = rs1("zgbm") '主管部门类别
            rs1.Close
            Combo1.Clear
            Combo3.Clear
            
            SQL = "select * from zgbm_cata order by num"
            rs1.Open SQL, conn, 1, 1
            Do Until rs1.EOF
            Combo1.AddItem rs1("zgbm")
            Combo1.ItemData(Combo1.NewIndex) = rs1("id")
            rs1.MoveNext
            Loop
            rs1.Close
            For i = 1 To Combo1.ListCount
            If t2 = Combo1.List(i - 1) Then
            Combo1.ListIndex = i - 1
            Exit For
            End If
            Next
            
            SQL = "select * from zgbm where cataid in (select id from zgbm_cata where zgbm='" & t2 & "') order by num"
            rs1.Open SQL, conn, 1, 1
            Do Until rs1.EOF
            Combo3.AddItem rs1("zgbm")
            Combo3.ItemData(Combo3.NewIndex) = rs1("id")
            rs1.MoveNext
            Loop
            rs1.Close
            For i = 1 To Combo3.ListCount
            If t1 = Combo3.List(i - 1) Then
            Combo3.ListIndex = i - 1
            Exit For
            End If
            Next
            
            Else
            MDIForm1.StatusBar1.Panels(1).Text = "当前操作没有数据可以更新"
            End If
        rs.Close
    Else
    Frame1.Caption = "基本信息-添加信息"
        Frame2.Visible = False
        ListView1.Visible = False
        For i = 0 To 8
        Text1(i).Text = ""
        Next
    End If
End If
Call RefillList(ListView1)
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
    Set rs1 = New ADODB.Recordset
dwID = 0
xmID = 0
Command3.Enabled = False
    SQL = "select * from zgbm_cata order by num"
    rs.Open SQL, conn, 1, 1
    Do Until rs.EOF
    Combo1.AddItem rs("zgbm")
    Combo1.ItemData(Combo1.NewIndex) = rs("id")
    rs.MoveNext
    Loop
    rs.Close
    Combo1.ListIndex = 0
    Combo2.ListIndex = 0
    Combo4.ListIndex = 0
    Combo5.ListIndex = 0
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 * 8)
   Set clm = lv.ColumnHeaders.Add(, , "项目编码", ListView1.Width / 100 * 16, 2)
   Set clm = lv.ColumnHeaders.Add(, , "项目名称", ListView1.Width / 100 * 24)
   Set clm = lv.ColumnHeaders.Add(, , "收费性质", ListView1.Width / 100 * 16, 2)
   Set clm = lv.ColumnHeaders.Add(, , "依据文件", ListView1.Width / 100 * 16, 2)
   Set clm = lv.ColumnHeaders.Add(, , "收费标准", ListView1.Width / 100 * 23)
   Set clm = lv.ColumnHeaders.Add(, , "备  注", ListView1.Width / 100 * 12)
i = 0
SQL = "select * from xmxx where dwid=" & dwID
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(, "Row" & i, rs("id"))
      itm.SubItems(1) = rs("xmbm") & ""
      itm.SubItems(2) = rs("xmmc") & ""
      itm.SubItems(3) = rs("sfxz") & ""
      itm.SubItems(4) = rs("yjwj") & ""
      itm.SubItems(5) = rs("sfbz") & ""
      itm.SubItems(6) = rs("bz") & ""
rs.MoveNext
Loop
rs.Close
End Sub



Private Sub Image3_Click()
On Error Resume Next
Pub_DIR = Text3.Text
Call goform(Form5, "0,1,2")
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 dwID = 0 Then
MDIForm1.StatusBar1.Panels(1).Text = "添加单位时，不允许操作"
Exit Sub
End If
If Err.Number = 3705 Then rs.Close
SQL = "select * from xmxx where id=" & Item.Text
rs.Open SQL, conn, 1, 1
If Not (rs.EOF) Then
xmID = CLng(rs("id"))
Text2(0).Text = rs("xmbm")
Text2(1).Text = rs("xmmc")
            t1 = rs("sfxz")
            For i = 1 To Combo5.ListCount
            If t1 = Combo5.List(i - 1) Then
            Combo5.ListIndex = i - 1
            Exit For
            End If
            Next
Text3.Text = rs("yjwj")
Text2(2).Text = rs("sfbz")
Text2(3).Text = rs("bz")
End If
rs.Close
Command3.Enabled = True
End Sub


Private Sub Text3_DblClick()
On Error Resume Next
Pub_DIR = Text3.Text
Call goform(Form5, "0,1,2")
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
On Error Resume Next
KeyAscii = 0
End Sub
Private Sub Image2_Click()
On Error Resume Next
Dim rpt As New ActiveReport3
If dwID > 0 Then


    rpt.DataControl1.Source = "select xmxx.*,wjxx.mc as wjmc,wjxx.bh as wjbh from xmxx,wjxx where xmxx.yjwj=wjxx.dir and xmxx.dwid=" & dwID
    rpt.dwID = dwID
    rpt.Show
Else
MDIForm1.StatusBar1.Panels(1).Text = "添加单位时，不允许打印"
End If
End Sub

Private Sub Image2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Image2.Top = 30
Image2.Left = 9720
End Sub

Private Sub Image2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Image2.Top = 20
Image2.Left = 9720
End Sub