📄 frmmain.frm
字号:
End
Begin VB.Menu MenuYjsm
Caption = "搜索(&S)..."
End
Begin VB.Menu mnuHelpBar0
Caption = "-"
End
Begin VB.Menu MenuJszc
Caption = "公司主页(&W)"
End
Begin VB.Menu MenuWeb
Caption = "Web上的电费系统"
Begin VB.Menu MenuMfzl
Caption = "免费资料(&F)"
End
Begin VB.Menu MenuCpxx
Caption = "产品信息(&P)"
End
Begin VB.Menu MenuCjwt
Caption = "常见问题(&Q)"
End
Begin VB.Menu MenuYcwh
Caption = "远程维护(&S)"
End
Begin VB.Menu mnuHelpBar6
Caption = "-"
End
Begin VB.Menu MenuXxfk
Caption = "信息反馈(&K)"
End
Begin VB.Menu MenuRjlt
Caption = "软件论坛(&L)"
End
End
Begin VB.Menu MenuRjzc
Caption = "软件注册(R)"
End
Begin VB.Menu mnuHelpBar1
Caption = "-"
End
Begin VB.Menu MenuSjxd
Caption = "使用向导建立数据(&Z)"
End
Begin VB.Menu MenuRjyl
Caption = "每天一招(&D)"
End
Begin VB.Menu MenuAbou
Caption = "关于(&A)..."
End
End
Begin VB.Menu Popresh
Caption = "刷新"
Visible = 0 'False
Begin VB.Menu resfh
Caption = "系统刷新(&R)"
End
Begin VB.Menu pMenuWall
Caption = "更换壁纸(&W)"
End
Begin VB.Menu SysHelp
Caption = "系统帮助(&H)"
End
Begin VB.Menu pMenuBar1
Caption = "-"
End
Begin VB.Menu pMenuQuit
Caption = "退出系统(&Q)"
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function ReleaseCapture Lib "USER32" () As Long
Private Declare Function SetCapture Lib "USER32" (ByVal hWnd As Long) As Long
'Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
'Dim I, SureQ As Integer
'Dim ScaleRatio As Single, X1 As Single, Y1 As Single, SWidth As Single
'Const MF_BYPOSITION = &H400&
Private Sub Combo1_Change()
GzNian = Trim(Left(Combo1.Text, 4))
GzYue = Trim(Left(Combo2.Text, 2))
frmMain.StatusBar1.Panels(3).Text = Combo1.Text & Combo2.Text
Call sTruInfo
End Sub
Private Sub Combo2_Click()
GzNian = Trim(Left(Combo1.Text, 4))
GzYue = Trim(Left(Combo2.Text, 2))
frmMain.StatusBar1.Panels(3).Text = "默认日期:" & Combo1.Text & Combo2.Text
Call sTruInfo
End Sub
Private Sub Form_Load()
Dim BackColorSetup, ReadSetup, BackPic As String
On Error Resume Next
'Operator = "统管员"
'pbUserPermission = "系统管理员"
Me.Left = GetSetting(App.EXEName, "Settings", "MainLeft", 1000)
Me.Top = GetSetting(App.EXEName, "Settings", "MainTop", 1000)
Me.Width = GetSetting(App.EXEName, "Settings", "MainWidth", 6500)
Me.Height = GetSetting(App.EXEName, "Settings", "MainHeight", 6500)
App.HelpFile = App.Path + "\Help\EpsHelp.hlp"
Frame1.Visible = False
Command1.Width = 255
Command1.Height = 3015
Command2.Height = Screen.Height - 4650
TreeView1.Visible = False
Combo1.Visible = False
Combo2.Visible = False
'读取背景参数设置 =1 图片 =2 渐变色
BackColorSetup = GetSetting(App.EXEName, "SysSetup", "BackGroundSetup", "")
Label1.Caption = "CopyRight(c)" & LoadResString(102) & "1998-2005 All Rights Reserved"
Image7.Picture = LoadResPicture(101, 1)
If FormColor.BackColor = 16777215 Then
Label1.ForeColor = vbRed
End If
If BackColorSetup = "2" Then '读取图片存放目录位置
BackPic = GetSetting(App.EXEName, "SysSetup", "BackPictureSetup", "")
If FileExists(BackPic) Then
FormColor.Picture = LoadPicture(BackPic)
Else
Call FormPaintColor(FormColor, 222, 239, 245, 170, 180, 126) '2.173, 180, 153, 71, 159, 80 1.122, 215, 255, 0, 0, 0
End If
Else
ReadSetup = GetSetting(App.EXEName, "SysSetup", "DefaultBackGround", "")
If ReadSetup = "0" Then '用户
ReadSetup = GetSetting(App.EXEName, "SysSetup", "ShadeColor", "")
Call FormPaintColor(FormColor, Val(Mid(ReadSetup, 1, 3)), Val(Mid(ReadSetup, 4, 3)), Val(Mid(ReadSetup, 7, 3)), _
Val(Mid(ReadSetup, 10, 3)), Val(Mid(ReadSetup, 13, 3)), Val(Mid(ReadSetup, 16, 3)))
Else '系统默认
Call FormPaintColor(FormColor, 173, 180, 153, 71, 159, 80) '2.222, 239, 245, 170, 180, 126 1.122, 215, 255, 0, 0, 0
End If
FormColor.Refresh
End If
StatusBar1.Panels(4).Text = LoadResString(102) & " " & LoadResString(101)
'此处加入若系统初次使用则各菜单乡工具条无效
StatusBar1.Panels(6).Text = Format(Date, "yyyy.mm.dd")
OpenMdb
Set MdbR = NdMd.OpenRecordset("乡镇档案")
If MdbR.RecordCount = 0 Then
MenuTrueFlase (False)
SaveSetting App.EXEName, "SysStart", "Start", "One"
TownDossier.Show vbModal, Me
Else
Set MdbR = NdMd.OpenRecordset("系统信息")
If MdbR.RecordCount = 0 Then
If DirectoryExists(App.Path & "\BackUpData") = False Then
MakeDirectory (App.Path & "\BackUpData")
End If
If DirectoryExists(App.Path & "\B") = False Then
MakeDirectory (App.Path & "\BackUpData")
End If
PopDataTree
Else
pbDw = MdbR.Fields!使用单位
pbDwBm = MdbR.Fields!信用代码 & ""
PopDataTree
End If
End If
End Sub
Private Sub MenuTjjl_Click()
If XzCode = "" Then
Ms
Else
MsgBox "添加 '调整记录' 程序代码。", vbInformation, Me.Caption
End If
End Sub
Private Sub Form_Resize()
On Error Resume Next
FormColor.Left = 0
FormColor.Top = 800
FormColor.Width = Me.ScaleWidth - 140
FormColor.Height = Me.ScaleHeight - 1190
Label1.Top = Me.ScaleHeight - 1450
Label1.Left = Me.ScaleWidth - 4400
Image7.Top = Me.ScaleHeight - 2000
Image7.Left = Me.Width - 1500
FormColor.Move 0, 800, ScaleWidth - 140, ScaleHeight - 1190
End Sub
'右键属性
Private Sub FormColor_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbKeyRButton Then ' 单击鼠标右键
PopupMenu Popresh ' 显示快捷菜单
End If
End Sub
Private Sub Frame1_Click()
Frame1.Tag = " "
End Sub
'报表设置
Private Sub MenuBbsz_Click()
' FormRepSet.Show vbModal
End Sub
'表计打印
Private Sub MenuBjdy_Click()
On Error Resume Next
If XzCode = "" Then
Ms
Else
PrintMeter.Show vbModal
End If
End Sub
'建立表计档案
Private Sub MenuBjlr_Click()
On Error Resume Next
If XzCode = "" Then
Ms
Else
MeterCreate.Show vbModal
End If
End Sub
Private Sub MenuCftz_Click()
On Error Resume Next
If XzCode = "" Then
Ms
Else
PrintDunned.Show vbModal
End If
End Sub
Private Sub MenuCjwt_Click()
Const WEB = "http://www.china-huahang.com/zsj/yhyq.html"
Dim hyperjump
hyperjump = ShellExecute(0&, vbNullString, WEB, vbNullString, vbNullString, vbNormalFocus)
End Sub
Private Sub MenuCpxx_Click()
Const WEB = "http://www.china-huahang.com/zsj/yhyq.html"
Dim hyperjump
hyperjump = ShellExecute(0&, vbNullString, WEB, vbNullString, vbNullString, vbNormalFocus)
End Sub
Private Sub MenuCzjl_Click()
BrowRunInfo.Show vbModal
End Sub
Private Sub MenuDjwh_Click()
ElectPrice.Show vbModal, Me
End Sub
'银行生成数据
Private Sub MenuDksj_Click()
BankDataMake.Show vbModal 'DataBank.Show vbModal
End Sub
Private Sub MenuDlkl_Click()
OperatorManager.Show vbModal
End Sub
Private Sub MenuDltz_Click()
On Error Resume Next
If XzCode = "" Then
Ms
Else
AdjustAmount.Show vbModal
End If
End Sub
'读取银行数据
Private Sub MenuDqsj_Click()
' ReadBankDisk.Show vbModal ' ReadBankData.Show vbModal
End Sub
Private Sub MenuDwwh_Click()
VillageDoss.Show vbModal
End Sub
'打印报表
Private Sub MenuDybb_Click()
PrintAssort.Show vbModal
End Sub
Private Sub MenuDybb1_Click()
PrintGbyy.Show vbModal
End Sub
Private Sub MenuDybq_Click()
If XzCode = "" Then
Ms
Else
PriUserLabel.Show vbModal
' PrintLabel.Show vbModal
End If
End Sub
Private Sub MenuDycb_Click()
If XzCode = "" Then
Ms
Else
PrintCbList.Show vbModal
End If
End Sub
'打印催费清单
Private Sub MenuDycf_Click()
On Error Resume Next
If XzCode = "" Then
Ms
Else
' PrintUrgeList.Show vbModal
End If
End Sub
'打印电价分类
Private Sub MenuDydj_Click()
If XzCode = "" Then
Ms
Else
' PrintFeeSort.Show vbModal
End If
End Sub
Private Sub MenuDydz_Click()
If XzCode = "" Then
Ms
Else
PriUserCode.Show vbModal
End If
End Sub
Private Sub MenuDyfp_Click()
If XzCode = "" Then
Ms
Else
PrintInvoice.Show vbModal
End If
End Sub
Private Sub MenuDyhz_Click()
On Error Resume Next
If XzCode = "" Then
Ms
Else
PrintSum.Show vbModal
End If
End Sub
Private Sub MenuDyqd_Click()
On Error Resume Next
If XzCode = "" Then
Ms
Else
PrintFeeList.Show vbModal
End If
End Sub
Private Sub MenuDytq_Click()
If XzCode = "" Then
Ms
Else
PrintTqhz.Show vbModal
End If
End Sub
Private Sub MenuExit_Click()
FormQuit.Show vbModal
' Unload Me
End Sub
Private Sub MenuFlcx_Click()
PrintAssort.Show vbModal
End Sub
Private Sub MenuFpcx_Click()
If XzCode = "" Then
Ms
Else
BrowseInvoice.Show vbModal
End If
End Sub
Private Sub MenuGksr_Click()
InputHostmeter.Show vbModal
End Sub
Private Sub MenuJbwh_Click()
BasicData.Show vbModal
End Sub
Private Sub Menujsdr_Click()
'导入旧数据
'InputOldData.Show vbModal
ImportData.Show vbModal
End Sub
Private Sub MenuJszc_Click()
Const WEB = "http://www.china-huahang.com"
Dim hyperjump
hyperjump = ShellExecute(0&, vbNullString, WEB, vbNullString, vbNullString, vbNormalFocus)
End Sub
Private Sub MenuMfzl_Click()
Const WEB = "http://www.china-huahang.com/zsj/yhyq.html"
Dim hyperjump
hyperjump = ShellExecute(0&, vbNullString, WEB, vbNullString, vbNullString, vbNormalFocus)
End Sub
Private Sub MenuRjlt_Click()
Const WEB = "http://www.china-huahang.com/cgi-bin/bbs.cgi"
Dim hyperjump
hyperjump = ShellExecute(0&, vbNullString, WEB, vbNullString, vbNullString, vbNormalFocus)
End Sub
Private Sub MenuRjyl_Click()
SaveSetting App.EXEName, "Options", "Show Tips at Startup", 1
frmTip.Show
End Sub
Private Sub MenuRjzc_Click()
SysRegedit.Show vbModal
End Sub
Private Sub MenuSgsr_Click()
On Error Resume Next
If XzCode = "" Then
Ms
Else
InputRecord.Show vbModal
End If
End Sub
Private Sub MenuSjcs_Click()
If XzCode = "" Then
Ms
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -