?? frmmain.frm
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -