📄 frmmain.frm
字号:
Caption = "目录(&C)"
HelpContextID = 92
Shortcut = {F1}
End
Begin VB.Menu mnuHelpIndex
Caption = "索引(&I)"
HelpContextID = 93
End
Begin VB.Menu mnuHelpBar0
Caption = "-"
HelpContextID = 94
End
Begin VB.Menu mnuHelpAbout
Caption = "关于 集成账务(&A)..."
HelpContextID = 95
End
End
Begin VB.Menu mnuQueryAccount
Caption = "查账"
HelpContextID = 96
Visible = 0 'False
Begin VB.Menu mnuCellPreview
Caption = "预览(&P)"
HelpContextID = 97
End
Begin VB.Menu mnuCellPrint
Caption = "打印"
HelpContextID = 98
End
Begin VB.Menu mnuPopBar0
Caption = "-"
HelpContextID = 99
End
Begin VB.Menu mnuBalanceResult
Caption = "查总账(&G)"
HelpContextID = 100
End
Begin VB.Menu mnuDailyResult
Caption = "查日记账(&D)"
HelpContextID = 102
Visible = 0 'False
End
Begin VB.Menu mnuDetailResult
Caption = "查明细账(&D)"
HelpContextID = 103
End
Begin VB.Menu mnuVoucherResult
Caption = "查凭证(&V)"
HelpContextID = 104
End
Begin VB.Menu mnuPopBar1
Caption = "-"
HelpContextID = 105
Visible = 0 'False
End
Begin VB.Menu mnuCurrentHelp
Caption = "帮助(&H)"
HelpContextID = 106
Visible = 0 'False
End
Begin VB.Menu mnuCurrentExit
Caption = "退出(&E)"
HelpContextID = 107
Visible = 0 'False
End
End
Begin VB.Menu mnuPopupMenu
Caption = "弹出菜单"
Visible = 0 'False
Begin VB.Menu mnuPopupMenuSetTitleHigh
Caption = "设置打印标题行高"
End
Begin VB.Menu mnuPopupSetTitleFont
Caption = "设置打印标题字体"
End
Begin VB.Menu mnuPopupBar
Caption = "-"
End
Begin VB.Menu mnuPopupMenuSetHeadHigh
Caption = "设置打印表头行高"
End
Begin VB.Menu mnuPopupSetHeadFont
Caption = "设置打印表头字体"
End
Begin VB.Menu mnuPopupMenuBar2
Caption = "-"
End
Begin VB.Menu mnuPopupSetDataHigh
Caption = "设置打印数据行高"
End
Begin VB.Menu mnuPopupSetDataFont
Caption = "设置打印数据字体"
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 Sub MDIForm_Load()
Dim sFileName As String
On Error Resume Next
Call FillStatusBar
'从注册条读取界面位置
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)
'从注册表读取界面背景
sFileName = GetSetting(App.Title, "Settings", "MainBackground")
If sFileName <> "" Then
If Dir(sFileName) <> "" Then
Me.Picture = LoadPicture(sFileName)
End If
End If
glo.fCellFile = GetSetting(App.Title, "Settings", "fCellFile", App.Path + "\CellFiles\外币凭证.cll")
glo.nCellFile = GetSetting(App.Title, "Settings", "nCellFile", App.Path + "\CellFiles\凭证.cll")
'填充状态条
''''''''
'启用
m_WindowLong.lhWnd = Me.hwnd
' #If EnabledHook Then
' Hook
' #End If
End Sub
Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode <> 1 Then
Cancel = True
End If
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
Dim i As Integer
Dim frm As Form
On Error Resume 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
SaveSetting App.Title, "Settings", "fCellFile", glo.fCellFile
SaveSetting App.Title, "Settings", "nCellFile", glo.nCellFile
SaveSetting App.Title, "Settings", "IsDisplayBalance", CStr(IsDisplayBalance)
SaveSetting App.Title, "Settings", "IsDisplayVoucherInfo", CStr(IsDisplayVoucherInfo)
'卸载科目帮助窗体(全程变量)
For Each frm In Forms
If TypeOf frm Is frmMain Then
Else
Unload frm
End If
Next
' Unload frmUSU_Kmhelp
' Unload glo.frmProg
' '可能已经装入
' Unload frmUSU_KmHelp
'发送系统运行结束信息
Call Manage_TerminateProject
'''''''
'挂起
UnHook
Set s = Nothing
End Sub
Private Sub mneCheckbh_Click()
Dim iID As Integer
If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mneCheckbh") = False Then
iID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mneCheckbh", glo.sAccountID, glo.sUserID)
'-----------------------------------------
'检查记账月的凭证是否缺号
Dim m_sRecordAccountYear As String
Dim m_sRecordAccountMonth As String
Dim adoRst As ADODB.Recordset
Dim rstTemp As New ADODB.Recordset
Dim sSQL As String
Dim iPrePzbh As Integer '上一条记录的凭证编号
Dim iCurPzbh As Integer '当前记录的凭证编号
Dim sPrePzzl As String '上一条记录的凭证种类
Dim i As Integer
Dim j As Integer
'取得当前账套的结账月份, 记账月份等于结账月份加1;
rstTemp.CursorLocation = adUseClient
sSQL = "SELECT * FROM tSYS_SubSysUsed WHERE AccountID = '" & glo.sAccountID & _
"' AND SubSysID = '" & gloSys.sSubSysId & "'"
rstTemp.Open sSQL, gloSys.cnnSYS, adOpenStatic, adLockReadOnly
With rstTemp
If .Fields("ModiMonth").value = 12 Then
m_sRecordAccountYear = Val(.Fields("ModiYear").value) + 1
m_sRecordAccountMonth = 1
Else
m_sRecordAccountYear = Val(.Fields("ModiYear").value)
m_sRecordAccountMonth = Format(.Fields("ModiMonth").value + 1, "##")
End If
.Close
End With
Set adoRst = New ADODB.Recordset
With adoRst
.CursorLocation = adUseClient
.Open "SELECT DISTINCT pzzl,pzbh FROM tZW_Pzsj" & glo.sOperateYear & _
" WHERE kjqj = " & CInt(m_sRecordAccountMonth) & _
" ORDER BY pzzl,pzbh", _
glo.cnnMain, adOpenStatic, adLockReadOnly
i = 0
If .RecordCount > 0 Then
Do Until .EOF
i = i + 1
If i = 1 Then
iPrePzbh = CInt(.Fields("pzbh").value)
sPrePzzl = .Fields("pzzl").value
Else
'如果当前记录的凭证种类和上一条记录的凭证种类相同
If .Fields("pzzl").value = sPrePzzl Then
iCurPzbh = CInt(.Fields("pzbh").value)
'如果当前记录的凭证编号不等于上一条记录的凭证编号加1,则找出缺的凭证号
If iCurPzbh <> iPrePzbh + 1 Then
For j = iPrePzbh + 1 To iCurPzbh - 1
frmAC_LackNumber.mfgLackNumber.AddItem .Fields("pzzl").value & vbTab & Format(j, "0000")
Next j
End If
End If
iPrePzbh = CInt(.Fields("pzbh").value)
sPrePzzl = .Fields("pzzl").value
End If
.MoveNext
Loop
End If
.Close
End With
Set adoRst = Nothing
With frmAC_LackNumber
.usNian = m_sRecordAccountYear
.usMonth = m_sRecordAccountMonth
.HelpContextID = 2
.Show 1, Me
End With
'-------------------------------------------
m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mneCheckbh", iID
End If
End Sub
Private Sub mnuAccountAffiliation_Click()
'用的是关联交易关联交易统计表
Dim iID As Integer
' If m_Mutex.QueryNotEnter(gloSys.sSubSysID, glo.sAccountID, "mnuAccountAffiliation") = False Then
' iID = m_Mutex.InsertMutexID(gloSys.sSubSysID, "mnuAccountAffiliation", glo.sAccountID, glo.sUserID)
' '------------------------------------------
' Dim frmR As frmAC_AffiliationResult
' With frmAC_AffiliationSelect
' .Ok = False
' .Show 1, Me
' If .Ok Then
' Set frmR = New frmAC_AffiliationResult
' frmR.usMonthFrom = .usMonthFrom
' frmR.usMonthTo = .usMonthTo
' frmR.usSubjectCodeFrom = .usSubjectCodeFrom
' frmR.usSubjectCodeTo = .usSubjectCodeTo
' frmR.usSubjectNameFrom = .usSubjectNameFrom
' frmR.usSubjectNameTo = .usSubjectNameTo
' frmR.usCompany = .usCompany
' frmR.MutexID = iID
' frmR.ShowResult
' Else
' m_Mutex.DeleteMutexID gloSys.sSubSysID, glo.sAccountID, "mnuAccountAffiliation", iID
' End If
' End With
' Unload frmAC_AffiliationSelect
' '-------------------------------------------
' End If
End Sub
Private Sub mnuAccountIndex_Click()
Dim iID As Integer
If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuAccountIndex") = False Then
iID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuAccountIndex", glo.sAccountID, glo.sUserID)
'------------------------------------------
Dim frmR As frmAC_IndexResult
With frmAC_IndexSelect
.Ok = False
.HelpContextID = 302
.Show 1, Me
If .Ok Then
Set frmR = New frmAC_IndexResult
frmR.usMonthFrom = .usMonthFrom
frmR.usMonthTo = .usMonthTo
frmR.usSubjectCodeFrom = .usSubjectCodeFrom
frmR.usSubjectCodeTo = .usSubjectCodeTo
frmR.usSubjectLevelFrom = .uiSubjectLevelFrom
frmR.usSubjectLevelTo = .uiSubjectLevelTo
frmR.ubIsEndSubject = .ubIsEndSubject
frmR.usSort = .usSort
frmR.usStyle = .usStyle
frmR.usSubjectType = .usSubjectType
frmR.ubIncludeBlankKm = .ubIncludeBlankKm
frmR.ubIncludeNotRecordVoucher = .ubIncludeNotRecordVoucher
frmR.uIsFullSubject = .ubFullKm
frmR.MutexID = iID
frmR.HelpContextID = 302
frmR.ShowResult
Else
m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuAccountBalance", iID
End If
End With
Unload frmAC_IndexSelect
'-------------------------------------------
End If
End Sub
Private Sub mnuBankBillcode_Click()
Dim iID As Integer
If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuBankBillcode") = False Then
iID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuBankBillcode", glo.sAccountID, glo.sUserID)
'-----------------------------------------
Dim frmR As frmYH_Djwh
Dim iTemp As Integer
With frmYH_DjwhSelect
.Ok = False
.HelpContextID = 401
.Show 1, Me
If .Ok Then
Set frmR = New frmYH_Djwh
frmR.usYear = .txtYear.text
frmR.usFromMonth = Format(.txtMonthFrom.text, "00")
frmR.usToMonth = Format(.txtMonthTo.text, "00")
frmR.usFromDate = .txtYear.text & "-" & Format(.txtMonthFrom.text, "00") & _
"-" & Format(.txtDayFrom.text, "00")
frmR.usToDate = .txtYear.text & "-" & Format(.txtMonthTo.text, "00") & _
"-" & Format(.txtDayTo.text, "00")
iTemp = InStr(1, .CboSubject.text, "=")
frmR.usSubjectCode = Left$(.CboSubject.text, iTemp - 1)
frmR.usSubjectName = Mid$(.CboSubject.text, iTemp + 1)
Load frmR
frmR.usSubjectIndex = .CboSubject.ListIndex
frmR.ShowResult
frmR.HelpContextID = 401
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -