📄 frmexpense.frm
字号:
AutoSize = -1 'True
Caption = "药品支出(&F)"
Height = 180
Index = 4
Left = 1590
TabIndex = 11
Top = 825
Width = 990
End
Begin VB.Label lblNote
AutoSize = -1 'True
Caption = "比例 %"
Height = 180
Index = 2
Left = 5670
TabIndex = 9
Top = 405
Width = 1440
End
Begin VB.Label lblNote
AutoSize = -1 'True
Caption = "医疗支出(&E)"
Height = 180
Index = 1
Left = 1590
TabIndex = 7
Top = 390
Width = 990
End
Begin VB.Image imgWizard
BorderStyle = 1 'Fixed Single
Height = 3315
Index = 1
Left = 90
Stretch = -1 'True
Tag = "140"
Top = 180
Width = 1335
End
End
Begin VB.Frame fraWizard
Height = 3585
Index = 0
Left = 75
TabIndex = 24
Top = 360
Width = 7320
Begin VB.Frame fraNote
Caption = "说明"
Height = 1350
Index = 0
Left = 1620
TabIndex = 25
Top = 2130
Width = 5505
Begin VB.Label lblNote
Caption = " 本功能用于把管理费用转入医疗支出、药品支出、在加工材料-制剂生产。"
Height = 405
Index = 3
Left = 675
TabIndex = 26
Top = 555
Width = 3975
End
End
Begin ListRefer.ListText ltxtAcc1
Height = 300
Left = 3420
TabIndex = 6
Top = 930
Width = 3315
_ExtentX = 5847
_ExtentY = 529
CodeSort = -1 'True
BackColor = -2147483643
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Image imgWizard
BorderStyle = 1 'Fixed Single
Height = 3315
Index = 0
Left = 90
Stretch = -1 'True
Tag = "140"
Top = 180
Width = 1335
End
Begin VB.Label lblNote
AutoSize = -1 'True
Caption = "管理费用科目(&A)"
Height = 180
Index = 0
Left = 1935
TabIndex = 5
Top = 990
Width = 1350
End
End
End
End
Attribute VB_Name = "frmExpense"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 管理费用分配
' 1998.7.13
' 作者：唐维勇
'
' 过程：
' InitStep 向导每步初始化
' ValidStep 向导每步合法检查
' Execute 向导完成后需执行的操作
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private Const HelpID = 60017 '25002
Private mintStepNum As Integer '向导总步骤
Private mintStep As Integer '向导当前步骤
Private mblnEnd As Boolean '完成按扭是否有效
Private mblnValid() As Boolean '向导每步是否合法
Private WithEvents mclsMainControl As MainControl '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private VoucherData(2) As VoucherRecord '凭证结果
Private mlngFormatID As Long
Private mblnAcc22IsDetail As Boolean
Private Sub Form_Activate()
'进入向导第一步
If Not mblnValid(0) Then
stabWizard.Tab = 0
stabWizard_Click -1
End If
gclsSys.CurrFormName = hwnd
SetHelpID HelpContextID
mclsMainControl_ChildActive
End Sub
Private Sub Form_Load()
Height = 5085
width = 7740
Me.HelpContextID = HelpID
mlngFormatID = 41
'初始凭证结构
ReDim VoucherData(0).Detail(0)
ReDim VoucherData(1).Detail(0)
ReDim VoucherData(2).Detail(0)
'主控对象
Set mclsMainControl = gclsSys.MainControls.Add(Me)
'向导初始化(包括每步仅需初始一次的部分)
mintStepNum = stabWizard.Tabs - 1
mintStep = -1
mblnEnd = False
ReDim mblnValid(mintStepNum)
End Sub
Private Sub Form_Resize()
If Left < 0 Or Left > Screen.width Then Left = (Screen.width - width) / 2
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
gclsSys.MainControls.Remove Me
Set mclsMainControl = Nothing
'删除科目参照
If Not ltxtAcc1.Recordset Is Nothing Then
Utility.RemoveListRecordSet lrtAccount
End If
If Not ltxtAcc20.Recordset Is Nothing Then
Utility.RemoveListRecordSet lrtAccount
End If
If Not ltxtAcc21.Recordset Is Nothing Then
Utility.RemoveListRecordSet lrtAccount
End If
If Not ltxtAcc22.Recordset Is Nothing Then
Utility.RemoveListRecordSet lrtAccount
End If
'删除凭证类型参照
If Not ltxtType.Recordset Is Nothing Then
Utility.RemoveListRecordSet lrtVoucherType
End If
End Sub
'更新与子窗体相关的菜单项的可用性
Private Sub UpdateMenuStatus()
With frmMain
' 设置MDI主窗口菜单可用标志
.mnuEditUndo.Enabled = False
.mnuEditCut.Enabled = False
.mnuEditCopy.Enabled = False
.mnuEditPaste.Enabled = False
.mnuEditInsLine.Enabled = False
.mnuEditDelLine.Enabled = False
.mnuEditEdit.Enabled = False
.mnuEditNew.Enabled = False
.mnuEditDel.Enabled = False
.mnuEditInActive.Enabled = False
.mnuEditShowAll.Enabled = False
.mnuEditShowList.Enabled = False
.mnuEditUse.Enabled = False
.mnuEditNotepad.Enabled = False
.mnuEditFilter.Enabled = False
.mnuEditColumn.Enabled = False
.mnuFilePrintSetup.Enabled = False
.mnuFilePrint.Enabled = False
.mnuReportQuick.Enabled = False
.mnuToolRefresh.Enabled = False
.SetToolBar
End With
End Sub
Private Sub fraWizard_Click(Index As Integer)
Debug.Print Screen.ActiveControl.Name
End Sub
Private Sub ltxtType_Choose()
RefreshTemplate ltxtTemplate.ID
End Sub
Private Sub mclsMainControl_ChildActive()
Dim vntMessage As Variant
On Error Resume Next
'响应消息
If fraWizard(1).Tag = "已设置" Then
For Each vntMessage In mclsMainControl.Messages
Select Case vntMessage
Case Message.msgVoucherType
mclsMainControl.Messages.Remove CStr(vntMessage)
RefreshVoucherType ltxtType.ID
Case Message.msgTemplate
mclsMainControl.Messages.Remove CStr(vntMessage)
RefreshTemplate ltxtTemplate.ID
Case Message.msgAccount
mclsMainControl.Messages.Remove CStr(vntMessage)
RefreshAccount 0
End Select
Next
End If
gclsSys.CurrFormName = hwnd
UpdateMenuStatus
End Sub
Private Sub stabWizard_Click(PreviousTab As Integer)
Dim intCnt As Integer
For intCnt = 0 To stabWizard.Tabs - 1
fraWizard(intCnt).Visible = (intCnt = stabWizard.Tab)
Next intCnt
' 若向导进入其他步骤，进行该步骤合法检查
If stabWizard.Tab > mintStep And mintStep < mintStepNum Then
If ValidStep(mintStep) Then
mintStep = stabWizard.Tab
'初始向导步骤
InitStep mintStep
End If
ElseIf mintStep <> stabWizard.Tab Then
mintStep = stabWizard.Tab
InitStep mintStep
RefreshCmd
End If
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'向导公用过程
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 向导每步合法检查
Private Function ValidStep(ByVal TabIndex As Integer) As Boolean
Dim strMsg As String, lngBottom As Integer
Select Case TabIndex
Case 0: ValidStep = ValidAccount1(strMsg) '管理费用
Case 1: ValidStep = ValidAccount2(strMsg) '费用分配
Case 2: ValidStep = ValidResult(strMsg) '凭证预演
Case Else
ValidStep = True
End Select
'返回上一步
If Not ValidStep Then
If mintStep < stabWizard.Tab Then
stabWizard.Tab = mintStep
Else
mintStep = stabWizard.Tab
RefreshCmd
End If
ShowMsg hwnd, strMsg, vbExclamation + vbOKOnly, Caption
End If
'设置每步合法性
If TabIndex <> -1 Then
mblnValid(TabIndex) = ValidStep
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -