frmmain.frm

VB城市排水系统

            Case "饮食业"
            Set xnode = tvTreeView.Nodes.Add("饮食业", tvwChild, , adoPrimaryRS!企业名称, 2)
            xnode.Tag = adoPrimaryRS!编号ID

            Case "教育事业"
            Set xnode = tvTreeView.Nodes.Add("教育事业", tvwChild, , adoPrimaryRS!企业名称, 2)
            xnode.Tag = adoPrimaryRS!编号ID

            Case "其他行业"
            Set xnode = tvTreeView.Nodes.Add("其他行业", tvwChild, , adoPrimaryRS!企业名称, 2)
            xnode.Tag = adoPrimaryRS!编号ID

        End Select
        adoPrimaryRS.MoveNext
    Loop
    '在TreeView1控件中按企业分布不同显示数据库中的记录

    Set xnode = TreeView1.Nodes.Add(, , "企业分布", "企业分布", 3)
    xnode.Expanded = True
    Set xnode = TreeView1.Nodes.Add("企业分布", tvwChild, "城东", "城东", 1)
    Set xnode = TreeView1.Nodes.Add("企业分布", tvwChild, "城南", "城南", 1)
    Set xnode = TreeView1.Nodes.Add("企业分布", tvwChild, "城西", "城西", 1)
    Set xnode = TreeView1.Nodes.Add("企业分布", tvwChild, "城北", "城北", 1)
    adoPrimaryRS.MoveFirst
    Do Until adoPrimaryRS.EOF
        Select Case adoPrimaryRS!地区
            Case "城东"
            Set xnode = TreeView1.Nodes.Add("城东", tvwChild, , adoPrimaryRS!企业名称, 2)
            xnode.Tag = adoPrimaryRS!编号ID
            
            Case "城南"
            Set xnode = TreeView1.Nodes.Add("城南", tvwChild, , adoPrimaryRS!企业名称, 2)
            xnode.Tag = adoPrimaryRS!编号ID
            
            Case "城西"
            Set xnode = TreeView1.Nodes.Add("城西", tvwChild, , adoPrimaryRS!企业名称, 2)
            xnode.Tag = adoPrimaryRS!编号ID

            Case "城北"
            Set xnode = TreeView1.Nodes.Add("城北", tvwChild, , adoPrimaryRS!企业名称, 2)
            xnode.Tag = adoPrimaryRS!编号ID
        End Select
        adoPrimaryRS.MoveNext
    Loop
    Set adoprimary = Nothing
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    Set Label1(13).DataSource = adoPrimaryRS
    Set Label1(26).DataSource = adoPrimaryRS
    '初始化MSFlexGrid2控件
    For introw = 0 To 2 Step 2
        MSFlexGrid2.Row = introw
        For intcol = 0 To 5
        MSFlexGrid2.Col = intcol
        MSFlexGrid2.CellBackColor = &HC25B10
        If introw = 0 Then
        MSFlexGrid2.Text = Str(intcol + 1) & "月"
        Else
        MSFlexGrid2.Text = Str(intcol + 7) & "月"
        End If
        Next intcol
    Next introw
    '初始化MSFlexGrid1控件
    For introw = 0 To 4 Step 2
        MSFlexGrid1.Row = introw
        For intcol = 0 To 10
        MSFlexGrid1.Col = intcol
        MSFlexGrid1.CellBackColor = &HC25B10
        If introw = 0 Then
        MSFlexGrid1.Text = Str(intcol + 1) & "号"
        ElseIf introw = 2 Then
        MSFlexGrid1.Text = Str(intcol + 12) & "号"
        ElseIf introw = 4 And intcol < 9 Then
        MSFlexGrid1.Text = Str(intcol + 23) & "号"
        End If
        Next intcol
    Next introw
    '初始化Combo1、Combo2、Combo3控件
    For intyear = 1998 To 2009
        Combo1.AddItem intyear
        Combo2.AddItem intyear
    Next intyear
    For intmonth = 1 To 12
        If intmonth < 10 Then
        Combo3.AddItem Str(intmonth)
        Else
        Combo3.AddItem Str(intmonth)
        End If
    Next intmonth
    Dim olbl As Label
  '绑定文本框到数据提供者
    For Each olbl In Me.lblfields
        Set olbl.DataSource = adoPrimaryRS
    Next
    '日流量监测图
    Picture2.DrawWidth = 1
    Picture2.Scale (-10, 2)-(10, -2)
    For introw = -2 To 2
    Picture2.Line (-10, introw)-(10, introw)
    Next introw
    For intcol = -10 To 10
    Picture2.Line (intcol, 2)-(intcol, -2)
    Next intcol

    
End Sub





Private Sub Form_Unload(Cancel As Integer)
    Dim i As Integer
    '关闭所有窗口
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    Next
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
End Sub



Private Sub Form_Resize()
    On Error Resume Next
    If Me.Width < 3000 Then Me.Width = 3000
    SizeControls imgSplitter.Left '调用SizeControls函数，调整各控件大小及位置
End Sub


Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With imgSplitter
        picSplitter.Move .Left, .Top, .Width \ 2, .Height - 20
    End With
    picSplitter.Visible = True
    mbMoving = True
End Sub


Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim sglPos As Single
    

    If mbMoving Then
        sglPos = X + imgSplitter.Left
        If sglPos < sglSplitLimit Then
            picSplitter.Left = sglSplitLimit
        ElseIf sglPos > Me.Width - sglSplitLimit Then
            picSplitter.Left = Me.Width - sglSplitLimit
        Else
            picSplitter.Left = sglPos
        End If
    End If
End Sub


Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    SizeControls picSplitter.Left
    picSplitter.Visible = False
    mbMoving = False
End Sub


Private Sub TabStrip2_Click()
If TabStrip2.SelectedItem = "按行业" Then
    tvTreeView.ZOrder
Else
    TreeView1.ZOrder
End If
End Sub

Private Sub TreeView1_DragDrop(Source As Control, X As Single, Y As Single)
    If Source = imgSplitter Then
        SizeControls X
    End If
End Sub


Sub SizeControls(X As Single)
    On Error Resume Next
    '设置 Width 属性
    If X < 2850 Then X = 2850
    If X > (Me.Width - 2850) Then X = Me.Width - 2850
    TabStrip2.Width = X
    tvTreeView.Width = X
    TreeView1.Width = X
    imgSplitter.Left = X
    TabStrip1.Left = X + 40
    TabStrip1.Width = Me.Width - (tvTreeView.Width + 160)
    lblTitle(0).Width = tvTreeView.Width
    lblTitle(1).Left = TabStrip1.Left + 20
    lblTitle(1).Width = TabStrip1.Width - 40
    '设置 Top 属性
    If tbToolBar.Visible Then
        tvTreeView.Top = tbToolBar.Height + picTitles.Height + 305
    Else
        tvTreeView.Top = picTitles.Height + 305
    End If
    TreeView1.Top = tvTreeView.Top
    TabStrip1.Top = tvTreeView.Top - 305
    TabStrip2.Top = tvTreeView.Top - 305
    '设置 height 属性
    If sbStatusBar.Visible Then
        tvTreeView.Height = Me.ScaleHeight - (picTitles.Top + picTitles.Height + sbStatusBar.Height) - 305
    Else
        tvTreeView.Height = Me.ScaleHeight - (picTitles.Top + picTitles.Height) - 305
    End If
    TreeView1.Height = tvTreeView.Height
    TabStrip2.Height = tvTreeView.Height + 305
    TabStrip1.Height = tvTreeView.Height + 305
    imgSplitter.Top = tvTreeView.Top
    imgSplitter.Height = tvTreeView.Height
    '设置Picture1控件的大小及位置
    Dim intindex As Single
    For intindex = 0 To 2
        Picture1(intindex).Left = TabStrip1.Left
        Picture1(intindex).Top = TabStrip1.Top + 305
        Picture1(intindex).Width = TabStrip1.Width
        Picture1(intindex).Height = TabStrip1.Height - 305
    Next
End Sub

Private Sub mnudo_Click()
frm排污企业.Show
End Sub

Private Sub mnuFilePrint_Click()
    '打印报表
    On Error Resume Next
    If ActiveForm Is Nothing Then Exit Sub
    

    With dlgCommonDialog
        .DialogTitle = "Print"
        .CancelError = True
        .Flags = cdlPDReturnDC + cdlPDNoPageNums
        If ActiveForm.rtfText.SelLength = 0 Then
            .Flags = .Flags + cdlPDAllPages
        Else
            .Flags = .Flags + cdlPDSelection
        End If
        .ShowPrinter
        If Err <> MSComDlg.cdlCancel Then
            ActiveForm.rtfText.SelPrint .hDC
        End If
    End With

End Sub

Private Sub mnufind_Click()
frmfind.Show
End Sub

Private Sub mnupwd_Click()
frmchange.Show
End Sub

Private Sub mnuset_Click()
frmset.Show
End Sub

Private Sub TabStrip1_Click()
If TabStrip1.SelectedItem = "实时监控" Then
    Picture1(0).ZOrder
Else
    Picture1(2).ZOrder
    
End If

End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "返回"
            cmdpreview
        Case "向后"
            cmdNext
        Case "删除"
            straswr = MsgBox("真的想删除这个记录吗?", vbOKCancel + vbQuestion, "提示")
            If straswr = vbOK Then cmdDelete
        Case "查找"
            frmfind.Show
        Case "showrealtime"
            Picture1(0).ZOrder
            TabStrip1.Tabs.Item(1).Selected = True
        Case "showhistorydata"
            Picture1(2).ZOrder
            TabStrip1.Tabs.Item(2).Selected = True
    End Select
End Sub

Private Sub mnuHelpAbout_Click()
    frmAbout.Show
End Sub

Private Sub mnuViewStatusBar_Click()
    mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
    sbStatusBar.Visible = mnuViewStatusBar.Checked
    SizeControls imgSplitter.Left
End Sub

Private Sub mnuViewToolbar_Click()
    mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
    tbToolBar.Visible = mnuViewToolbar.Checked
    SizeControls imgSplitter.Left
End Sub


Private Sub mnuFileClose_Click()
    Unload Me
End Sub

Private Sub cmdpreview()
'显示前一条记录
  On Error GoTo GoPrevError
  If Not adoPrimaryRS.BOF Then adoPrimaryRS.MovePrevious
  If adoPrimaryRS.BOF And adoPrimaryRS.RecordCount > 0 Then
    Beep
    '已到最后返回
    adoPrimaryRS.MoveFirst
  End If
  Exit Sub
GoPrevError:
  MsgBox Err.Description
End Sub

Private Sub cmdNext()
'显示下一条记录
  On Error GoTo GoNextError
  If Not adoPrimaryRS.EOF Then adoPrimaryRS.MoveNext
  If adoPrimaryRS.EOF And adoPrimaryRS.RecordCount > 0 Then
    Beep
     '已到最后返回
    adoPrimaryRS.MoveLast
  End If
  Exit Sub
GoNextError:
  MsgBox Err.Description
End Sub
Private Sub cmdDelete()
'删除记录
  On Error GoTo DeleteErr
  With adoPrimaryRS
    .Delete
    .MoveNext
    '已到最后返回
    If .EOF Then .MoveLast
  End With
  Exit Sub
DeleteErr:
  MsgBox Err.Description
End Sub



Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
'由TreeView1控件选项在其他控件中显示相应记录
 If Node.Image = 2 Then
   adoPrimaryRS.MoveFirst
  Do Until adoPrimaryRS.EOF
    If adoPrimaryRS!企业名称 = TreeView1.SelectedItem.Text Then
    Exit Do
    End If
    adoPrimaryRS.MoveNext
  Loop
End If
End Sub

Private Sub tvTreeView_NodeClick(ByVal Node As MSComctlLib.Node)
'由tvTreeView控件选项在其他控件中显示相应记录
 If Node.Image = 2 Then
   adoPrimaryRS.MoveFirst
  Do Until adoPrimaryRS.EOF
    If adoPrimaryRS!企业名称 = tvTreeView.SelectedItem.Text Then
    Exit Do
    End If
    adoPrimaryRS.MoveNext
  Loop
End If
End Sub