📄 frmmain.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.MDIForm mdifrmMain
BackColor = &H8000000C&
Caption = "焦作市公共交通总公司收银核算系统"
ClientHeight = 8070
ClientLeft = 60
ClientTop = 630
ClientWidth = 8880
Icon = "frmmain.frx":0000
LinkTopic = "MDIForm1"
LockControls = -1 'True
MouseIcon = "frmmain.frx":08CA
WindowState = 2 'Maximized
Begin VB.PictureBox Picture1
Align = 3 'Align Left
Height = 8070
Left = 0
ScaleHeight = 8010
ScaleWidth = 2820
TabIndex = 0
Top = 0
Width = 2880
Begin VB.PictureBox VMnulist
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 8025
Left = 0
ScaleHeight = 7965
ScaleWidth = 2805
TabIndex = 1
Top = 0
Width = 2865
Begin MSComctlLib.TreeView Tre1
Height = 7965
Left = -30
TabIndex = 2
Top = 0
Width = 2865
_ExtentX = 5054
_ExtentY = 14049
_Version = 393217
Indentation = 18
LabelEdit = 1
Style = 7
ImageList = "imgRec"
Appearance = 1
End
End
End
Begin MSComctlLib.ImageList imgRec
Left = 4890
Top = 1470
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 25
ImageHeight = 25
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 7
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmmain.frx":0D0C
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmmain.frx":1160
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmmain.frx":15B4
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmmain.frx":1A08
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmmain.frx":22E4
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmmain.frx":2738
Key = ""
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmmain.frx":2B8C
Key = ""
EndProperty
EndProperty
End
Begin VB.Timer timerFlag
Enabled = 0 'False
Interval = 1
Left = 3120
Top = 270
End
Begin VB.Menu mnuInputEarning
Caption = "营收录入[&I]"
Begin VB.Menu mnuInput
Caption = "现金录入(&Input)"
End
Begin VB.Menu mnuIE
Caption = "现金浏览[&I]"
End
Begin VB.Menu mnuAmend
Caption = "现金修改[&A]"
End
Begin VB.Menu MenuConIn
Caption = "售票员缴款录入"
End
Begin VB.Menu menuConIE
Caption = "售票员缴款浏览"
End
Begin VB.Menu menuConmend
Caption = "售票员缴款修改"
End
Begin VB.Menu linea
Caption = "-"
End
Begin VB.Menu mnuExit
Caption = "退出 [E&xit]"
End
End
Begin VB.Menu mnuCollectStat
Caption = "综合管理[&C]"
Begin VB.Menu mnuDcyJob
Caption = "点钞员管理"
End
Begin VB.Menu mnuCheck
Caption = "复核员管理[&C]"
End
Begin VB.Menu LINEE
Caption = "-"
End
Begin VB.Menu mnuPrint
Caption = "点钞员工作量查询打印"
End
Begin VB.Menu sjsr
Caption = "司机收入查询"
End
Begin VB.Menu rk
Caption = "收入入库"
End
End
Begin VB.Menu mnuSystemManager
Caption = "系统管理[&M]"
Visible = 0 'False
Begin VB.Menu mnuCompnayM
Caption = "公司维护[&C]"
End
Begin VB.Menu mnuLineM
Caption = "线路维护[&Bus]"
End
Begin VB.Menu mnuBusM
Caption = "车辆维护[&Bus]"
End
Begin VB.Menu mnuEmployeeM
Caption = "职工维护[&E]"
End
Begin VB.Menu lineM
Caption = "-"
End
Begin VB.Menu mnuBackupDBDay
Caption = "当日数据备份[&B]"
End
Begin VB.Menu mnuBackupDBMonth
Caption = "当月数据备份[&B]"
End
Begin VB.Menu lineM1
Caption = "-"
End
Begin VB.Menu MNUpASSWORD
Caption = "更改口令[&P]"
End
Begin VB.Menu MNUDBTRANS
Caption = ""
End
End
Begin VB.Menu mnuWindows
Caption = "窗口[&W]"
WindowList = -1 'True
End
Begin VB.Menu mnuHlp
Caption = "帮助[&H]"
End
End
Attribute VB_Name = "mdifrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub lblEarning_Click(Index As Integer)
Call mnuInput_Click
End Sub
Private Sub MDIForm_Load()
Tre1.Height = Me.Height - 300
Set Tre1.ImageList = imgRec
Set nodx = Tre1.Nodes.Add(, , "R", "收银核算子系统", imgRec.ListImages(7).Index)
Set nodx = Tre1.Nodes.Add("R", tvwChild, "sell", "数据录入", imgRec.ListImages(5).Index)
Set nodx = Tre1.Nodes.Add("sell", tvwChild, "dinput", "现金录入", imgRec.ListImages(5).Index)
Set nodx = Tre1.Nodes.Add("sell", tvwChild, "dview", "现金浏览", imgRec.ListImages(4).Index)
Set nodx = Tre1.Nodes.Add("sell", tvwChild, "dupdate", "现金修改", imgRec.ListImages(6).Index)
Set nodx = Tre1.Nodes.Add("sell", tvwChild, "coninput", "售票员缴款录入", imgRec.ListImages(5).Index)
Set nodx = Tre1.Nodes.Add("sell", tvwChild, "conview", "售票员缴款浏览", imgRec.ListImages(4).Index)
Set nodx = Tre1.Nodes.Add("sell", tvwChild, "conupdate", "售票员缴款修改", imgRec.ListImages(6).Index)
Set nodx = Tre1.Nodes.Add("R", tvwChild, "Run", "综合管理", imgRec.ListImages(3).Index)
Set nodx = Tre1.Nodes.Add("Run", tvwChild, "dcy", "点钞员管理", imgRec.ListImages(2).Index)
Set nodx = Tre1.Nodes.Add("Run", tvwChild, "fhy", "复核员管理", imgRec.ListImages(2).Index)
'----------
Set nodx = Tre1.Nodes.Add("Run", tvwChild, "dcyview", "点钞员工作量报表", imgRec.ListImages(7).Index)
Set nodx = Tre1.Nodes.Add("Run", tvwChild, "Cashview", "司机投币收入报表", imgRec.ListImages(7).Index)
Set nodx = Tre1.Nodes.Add("Run", tvwChild, "Ticketview", "司机售票收入报表", imgRec.ListImages(7).Index)
Set nodx = Tre1.Nodes.Add("Run", tvwChild, "Check", "重复车辆录入检测", imgRec.ListImages(7).Index)
'-----------
Tre1.Nodes.Item(7).Selected = True
Tre1.Nodes.Item(10).Selected = True
Tre1.Nodes.Item(5).Selected = True
Tre1.Nodes.Item(8).Selected = True
CheckFlag = 1
End Sub
Private Sub MDIForm_Resize()
timerFlag.Enabled = True
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
End
End Sub
Private Sub MenuConIn_Click()
frmInputConEarning.Show
frmInputConEarning.ZOrder
End Sub
Private Sub menuConmend_Click()
FrmConUpdate.Show
FrmConUpdate.ZOrder
End Sub
Private Sub mnuAmend_Click()
frmAmendEarning.Show
frmAmendEarning.ZOrder
End Sub
Private Sub mnuBusM_Click()
frmDept.sstabBk.Tab = 2
frmDept.Show
frmDept.ZOrder
End Sub
Private Sub mnuCheck_Click()
frmCheck.Show
frmCheck.ZOrder
End Sub
Private Sub mnuCompnayM_Click()
frmDept.sstabBk.Tab = 0
frmDept.Show
frmDept.ZOrder
End Sub
Private Sub mnuDcyJob_Click()
frmDcy.Show
frmDcy.ZOrder
End Sub
Private Sub mnuEmployeeM_Click()
frmDept.sstabBk.Tab = 3
frmDept.Show
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuIE_Click()
frmCashIE.Show
frmCashIE.ZOrder
End Sub
Private Sub mnuInput_Click()
frmInputEarning.Show
frmInputEarning.ZOrder
End Sub
Private Sub mnuLineM_Click()
frmDept.sstabBk.Tab = 1
frmDept.Show
frmDept.ZOrder
End Sub
Private Sub mnuWindowArrangeIcons_Click()
Arrange vbArrangeIcons
End Sub
Private Sub mnuWindowCascade_Click()
Arrange vbCascade
End Sub
Private Sub mnuWindowTileHorizontal_Click()
Arrange vbTileHorizontal
End Sub
Private Sub mnuWindowTileVertical_Click()
Arrange vbTileVertical
End Sub
Private Sub mnuPrint_Click()
frmWorkLoad.Show
frmWorkLoad.ZOrder
End Sub
Private Sub VMnulist_MenuItemClick(MenuNumber As Long, MenuItem As Long)
Select Case CStr(MenuNumber) + CStr(MenuItem)
Case 11
Call mnuInput_Click
Case 12
Call mnuIE_Click
Case 13
Call mnuAmend_Click
Case 21
Call mnuDcyJob_Click
Case 22
frmCheck.Show
frmCheck.ZOrder
Case 31
frmWorkLoad.Show
frmWorkLoad.ZOrder
Case 32
frmReport.Show 1
frmReport.ZOrder
Case 33
frmReport.Show 1
frmReport.ZOrder
End Select
End Sub
Private Sub rk_Click()
If CheckFlag > 0 Then
MsgBox "还有重复车号，请检测！", vbOKOnly + vbExclamation, "警告"
Else
If MsgBox("现在开始数据入库吗？", vbQuestion + vbYesNo, "提示信息...") = vbYes Then
DateTransfer
End If
End If
End Sub
Private Sub DateTransfer()
'On Error Resume Next
'Dim adoConn As New ADODB.Connection
frmState.Show
frmState.lblTip.Caption = "正在进行数据预处理．．．"
frmState.Refresh
Dim rscmd As New ADODB.Command
'Set adoConn = New ADODB.Connection
'cnn.Open ConnectionSource
Set rscmd = New ADODB.Command
DoEvents
With rscmd
.ActiveConnection = cnn
.CommandText = "ZYSP_countbill_TRANSFER"
.CommandType = adCmdStoredProc
.CommandTimeout = 0
.Execute
End With
If Err.Number <> 0 Then
MsgBox "AMC 处理提示：" + vbCrLf + Err.Description, vbCritical, "提示..."
End If
ExecuteDTS '数据导出
'合法数据入库 ZZ_DRIVERCF
zzcnn.CommandTimeout = 300
zzcnn.ConnectionTimeout = 300
zzcnn.Open zzstrCollection
Set rscmd = New ADODB.Command
With rscmd
.ActiveConnection = zzcnn
.CommandText = "ZZ_WORKERCARD_ALL"
.CommandType = adCmdStoredProc
.CommandTimeout = 0
.Execute
End With
Set rscmd = New ADODB.Command
With rscmd
.ActiveConnection = zzcnn
.CommandText = "ZZ_RUNSTAT_ALL_DRIVER"
.CommandType = adCmdStoredProc
.CommandTimeout = 0
.Execute
End With
zzcnn.Close
If Err.Number <> 0 Then
MsgBox "ZZ_DRIVERCF 处理提示：" + vbCrLf + Err.Description, vbCritical, "提示..."
End If
Unload frmState
End Sub
Private Sub Tre1_NodeClick(ByVal Node As MSComctlLib.Node)
Select Case Node.Key
Case "dinput"
frmInputEarning.Show
frmInputEarning.ZOrder
Case "dview"
Case "dupdate"
frmAmendEarning.Show
frmAmendEarning.ZOrder
Case "coninput"
frmInputConEarning.Show
frmInputConEarning.ZOrder
Case "conview"
Case "conupdate"
FrmConUpdate.Show
FrmConUpdate.ZOrder
Case "dcy"
Case "fhy"
Case "dcyview"
frmWorkLoad.Show
frmWorkLoad.ZOrder
Case "Cashview"
ViewFlag = 1
frmReport.Show
frmReport.ZOrder
Case "Ticketview"
ViewFlag = 2
frmReport.Show
frmReport.ZOrder
Case "Check"
ViewFlag = 3
frmReport.Show
frmReport.ZOrder
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -