📄 ihms-main console.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.MDIForm frmMain
BackColor = &H8000000C&
Caption = "智能医院管理系统 Version"
ClientHeight = 8730
ClientLeft = 165
ClientTop = 450
ClientWidth = 11805
Icon = "IHMS-Main Console.frx":0000
LinkTopic = "MDIForm1"
Picture = "IHMS-Main Console.frx":6852
StartUpPosition = 1 '所有者中心
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 255
Left = 0
TabIndex = 0
Top = 8475
Width = 11805
_ExtentX = 20823
_ExtentY = 450
Style = 1
SimpleText = "当前没有用户登录！"
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
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 MSComctlLib.ImageList imgLstToolBar1
Left = 600
Top = 5400
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 48
ImageHeight = 48
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 8
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "IHMS-Main Console.frx":2F44A
Key = "loginout"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "IHMS-Main Console.frx":35CAC
Key = "newreg"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "IHMS-Main Console.frx":3C50E
Key = "openexisting"
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "IHMS-Main Console.frx":42D70
Key = "admitdischarge"
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "IHMS-Main Console.frx":495D2
Key = "diagnose"
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "IHMS-Main Console.frx":4BD84
Key = "about"
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "IHMS-Main Console.frx":525E6
Key = ""
EndProperty
BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "IHMS-Main Console.frx":55668
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.Toolbar tbrMainToolbar
Align = 1 'Align Top
Height = 1020
Left = 0
TabIndex = 1
Top = 0
Width = 11805
_ExtentX = 20823
_ExtentY = 1799
ButtonWidth = 1561
ButtonHeight = 1799
Style = 1
ImageList = "imgLstToolBar1"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 11
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "用户登录"
Object.ToolTipText = "进入系统 / 退出系统"
ImageIndex = 1
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "病人登记"
Object.ToolTipText = "登记新病人信息"
ImageIndex = 2
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "资料搜索"
Object.ToolTipText = "查找病人信息"
ImageIndex = 3
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "住院/出院"
Object.ToolTipText = "病人住院 / 出院管理"
ImageIndex = 4
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "诊断管理"
Object.ToolTipText = "病人诊断病例管理"
ImageIndex = 5
EndProperty
BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 4
EndProperty
BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "帮助"
ImageIndex = 7
EndProperty
BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "关于系统"
Object.ToolTipText = "本软件的有关信息"
ImageIndex = 6
EndProperty
BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "退出程序"
ImageIndex = 8
EndProperty
EndProperty
End
Begin VB.Menu mnuFile
Caption = "文件(&F)"
Begin VB.Menu mnuLogIn
Caption = "登录(&I)"
Shortcut = ^I
End
Begin VB.Menu mnuSep1
Caption = "-"
Visible = 0 'False
End
Begin VB.Menu mnuNewPatient
Caption = "病人登记(&N)"
Shortcut = ^N
Visible = 0 'False
End
Begin VB.Menu mnuOpen
Caption = "打开病人信息(&O)"
Shortcut = {F3}
Visible = 0 'False
End
Begin VB.Menu mnuClose
Caption = "关闭(&C)"
Enabled = 0 'False
Visible = 0 'False
End
Begin VB.Menu mnuSep2
Caption = "-"
Visible = 0 'False
End
Begin VB.Menu mnuLogOut
Caption = "注销(&O)"
Enabled = 0 'False
Shortcut = ^O
End
Begin VB.Menu mnuSep3
Caption = "-"
End
Begin VB.Menu mnuExit
Caption = "退出(&E)"
End
End
Begin VB.Menu mnuTools
Caption = "工具(&T)"
Enabled = 0 'False
Begin VB.Menu mnuToolsUsers
Caption = "操作员管理(&U)"
End
End
Begin VB.Menu mnuHelp
Caption = "帮助(&H)"
Begin VB.Menu mnuHelpAbout
Caption = "关于(&A)..."
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
' ：） 人人为我，我为人人 ：）
'枕善居汉化收藏整理
'发布日期：06/02/21
'描 述：智能医院管理系统 Version 1.0
'网 站：http://www.mndsoft.com/
'e-mail ：mnd@mndsoft.com
'OICQ ：88382850
'****************************************************************************
Option Explicit
Private Sub MDIForm_DblClick()
If LoginSucceeded = True Then
'The user is currently logged in.
frmNewReg.Show
frmNewReg.SetFocus
Else
'The user is currently logged out
'Check if database is available. if not, exit the app.
If Dir(App.Path & "\IHMS.mdb") = "" Then
MsgBox "需要工作的数据库文件不存在." + vbCrLf + "请检查，然后重新登录." + vbCrLf + vbCrLf + "更多信息请登录枕善居(http://mndsoft.com).", vbCritical, "错误"
'End
Else
frmLogin.Show 1
End If
End If
End Sub
Private Sub MDIForm_Load()
Me.Caption = Me.Caption & App.Major & "." & App.Minor & "." & App.Revision
End Sub
Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If LoginSucceeded = False Then Exit Sub
If MsgBox("程序某些任务正在进行中，终止可能会造成数据和文件丢失. " & vbCrLf & "确认要退出系统吗?", vbCritical + vbYesNo, "退出系统") = vbYes Then
Cancel = 0
End
Else
Cancel = 1
End If
End Sub
Private Sub mnuClose_Click()
Unload frmOldPatient
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuHelpAbout_Click()
frmAbout.Show 1
End Sub
Private Sub mnuLogIn_Click()
'Check if database is available. if not, exit the app.
If Dir(App.Path & "\IHMS_97.mdb") = "" Then
MsgBox "需要工作的数据库文件不存在." + vbCrLf + "请检查，然后重新登录." + vbCrLf + vbCrLf + "更多信息请登录枕善居(http://mndsoft.com).", vbCritical, "错误"
'End
Else
frmLogin.Show 1
End If
End Sub
Private Sub mnuLogOut_Click()
If MsgBox("Logging out will abort all tasks in progress. Data and files might be lost. " & vbCrLf & "Are you sure you want to Log Out?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
LoginSucceeded = False
Call ConfigMenus
End Sub
Private Sub mnuNewPatient_Click()
frmNewReg.Show
mnuNewPatient.Enabled = False
tbrMainToolbar.Buttons(1).Enabled = False
End Sub
Private Sub mnuOpen_Click()
'f3: Search for record by hospital number.
patientNumberX = 0 'hosp number being sought for
patientNumberX = Val(InputBox("Please enter the patient's HOSPITAL NUMBER:"))
If patientNumberX = 0 Then Exit Sub 'User selects cancel
Unload frmOldPatient
frmWait.Show 1
End Sub
Private Sub mnuToolsKnowledgeBase_Click()
MsgBox "This function is still under development.", vbInformation
End Sub
Private Sub mnuToolsOptions_Click()
MsgBox "This function is still under development.", vbInformation
End Sub
Private Sub mnuToolsUsers_Click()
frmUserMgt.Show 1
End Sub
Private Sub tbrMainToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case 1
'Log In/Log Out.
If LoginSucceeded = False Then
'The user is currently logged out
'Check if database is available. if not, exit the app.
If Dir(App.Path & "\IHMS.mdb") = "" Then
MsgBox "需要工作的数据库文件不存在." + vbCrLf + "请检查，然后重新登录." + vbCrLf + vbCrLf + "更多信息请登录枕善居(http://mndsoft.com).", vbCritical, "错误"
'End
Else
frmLogin.Show 1
End If
Else
'The user is currently logged in
If MsgBox("Logging out will abort all tasks in progress. Data and files might be lost. " & vbCrLf & "Are you sure you want to Log Out?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
LoginSucceeded = False
Call ConfigMenus
End If
Case 3
'Register New Patient.
frmNewReg.Show
mnuNewPatient.Enabled = False
tbrMainToolbar.Buttons(2).Enabled = False 'New Patient toolbar button
Case 4
'Search DB for existing patient file.
'f3: Search for record by hospital number.
patientNumberX = 0 'hosp number being sought for
patientNumberX = Val(InputBox("Please enter the patient's HOSPITAL NUMBER:"))
If patientNumberX = 0 Then Exit Sub 'User selects cancel
Unload frmOldPatient
frmWait.Show 1
Case 5
'Admit/Discharge this patient.
'MsgBox "This function is still under development.", vbInformation
If somePatient.AdmissionStatus = "IN" Then
'Patient is currently admitted. therefore, the admit command is
'not available, but the discharge command is.
frmDischarge.Show 1
Else
'Patient is currently NOT admitted. therefore, the admit command is
'available, but the discharge command is not.
'NOTE: This part is also executed if no existing hospital history record is found for the patient
'i.e when somePatient.AdmissionStatus = ""
frmAdmitExisting.Show 1
End If
Case 6
'Diagnose this patient.
frmDiagnosis.Show 1
'MsgBox "This function is still under development.", vbInformation
Case 9
'About This App.
frmAbout.Show 1
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -