📄 frmcase.frm
字号:
VERSION 5.00
Begin VB.Form frmCase
BorderStyle = 3 'Fixed Dialog
Caption = "病例"
ClientHeight = 4875
ClientLeft = 45
ClientTop = 315
ClientWidth = 14295
Icon = "frmCase.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4875
ScaleWidth = 14295
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.ListBox lstIll
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3300
Left = 2280
TabIndex = 11
Top = 420
Width = 1875
End
Begin VB.ListBox lstOrgan
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3300
ItemData = "frmCase.frx":000C
Left = 180
List = "frmCase.frx":000E
TabIndex = 10
Top = 420
Width = 1875
End
Begin VB.CommandButton cmdDeleteOrgan
Caption = "删除"
BeginProperty Font
Name = "楷体_GB2312"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 840
Picture = "frmCase.frx":0010
Style = 1 'Graphical
TabIndex = 9
Top = 4080
Width = 555
End
Begin VB.CommandButton cmdAddOrgan
Caption = "添加"
BeginProperty Font
Name = "楷体_GB2312"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 180
Picture = "frmCase.frx":015A
Style = 1 'Graphical
TabIndex = 8
Top = 4080
Width = 555
End
Begin VB.CommandButton cmdDeleteIll
Caption = "删除"
BeginProperty Font
Name = "楷体_GB2312"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 2940
Picture = "frmCase.frx":02A4
Style = 1 'Graphical
TabIndex = 7
Top = 4080
Width = 555
End
Begin VB.CommandButton cmdAddIll
Caption = "添加"
BeginProperty Font
Name = "楷体_GB2312"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 2280
Picture = "frmCase.frx":03EE
Style = 1 'Graphical
TabIndex = 6
Top = 4080
Width = 555
End
Begin VB.CommandButton cmdEditOrgan
Caption = "编辑"
BeginProperty Font
Name = "楷体_GB2312"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 1500
Picture = "frmCase.frx":0538
Style = 1 'Graphical
TabIndex = 5
Top = 4080
Width = 555
End
Begin VB.CommandButton cmdEditIll
Caption = "编辑"
BeginProperty Font
Name = "楷体_GB2312"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 3600
Picture = "frmCase.frx":0682
Style = 1 'Graphical
TabIndex = 4
Top = 4080
Width = 555
End
Begin VB.CommandButton cmdSaveCase
Caption = "保存"
BeginProperty Font
Name = "楷体_GB2312"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 11580
Picture = "frmCase.frx":07CC
Style = 1 'Graphical
TabIndex = 3
Top = 4080
Width = 555
End
Begin VB.CommandButton cmdAddToReport
Caption = "插入报告"
BeginProperty Font
Name = "楷体_GB2312"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 12240
Picture = "frmCase.frx":0916
Style = 1 'Graphical
TabIndex = 2
Top = 4080
Width = 855
End
Begin VB.CommandButton cmdClose
Caption = "关闭窗口"
BeginProperty Font
Name = "楷体_GB2312"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 13200
Picture = "frmCase.frx":0A60
Style = 1 'Graphical
TabIndex = 1
Top = 4080
Width = 855
End
Begin VB.TextBox txtDescribe
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3495
Left = 4380
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 420
Width = 9675
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "描述："
BeginProperty Font
Name = "楷体_GB2312"
Size = 9.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 4380
TabIndex = 14
Top = 120
Width = 675
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "疾病："
BeginProperty Font
Name = "楷体_GB2312"
Size = 9.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 2280
TabIndex = 13
Top = 120
Width = 675
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "器官："
BeginProperty Font
Name = "楷体_GB2312"
Size = 9.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 180
TabIndex = 12
Top = 120
Width = 675
End
End
Attribute VB_Name = "frmCase"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public Loaded As Boolean '是否已经加载的标志
Private rsCaseOrgan As ADODB.Recordset '病历器官记录集
Private rsCaseIll As ADODB.Recordset '病历疾病记录集
'Dim OrganChosen(200) As Integer '已选器官数组
Private Sub cmdAddIll_Click()
'----------------
'加入新的疾病
'----------------
Dim strIll As String
Dim strSQL As String
Dim rsTemp As String
strIll = Trim(InputBox("请输入新疾病名称:", "新疾病"))
If strIll = vbNullString Then Exit Sub
If ExistRecord("US_CASE", "ILL_NAME", strIll, "AND ORGAN_NAME = '" & lstOrgan.Text & "'") Then
MsgBox "已经存在该记录,请重新输入!", vbExclamation + vbOKOnly, "输入错误"
Exit Sub
End If
'加入新记录
strSQL = "INSERT INTO US_CASE (ORGAN_NAME,ILL_NAME) VALUES ('" & lstOrgan.Text & "', '" & strIll & "')"
GDB.Execute strSQL
'加入列表框
lstIll.AddItem strIll
lstIll.ListIndex = lstIll.ListCount - 1
End Sub
Private Sub cmdAddOrgan_Click()
Dim strOrgan As String
Dim strSQL As String
Dim rsTemp As String
'----------------
'加入新器官
'----------------
strOrgan = Trim(InputBox("请输入新部位名称:", "新部位"))
If strOrgan = vbNullString Then Exit Sub
If ExistRecord("US_CASE_PART", "ORGAN_NAME", strOrgan) Then
MsgBox "已经存在该记录,请重新输入!", vbExclamation + vbOKOnly, "输入错误"
Exit Sub
End If
'加入新记录
strSQL = "INSERT INTO US_CASE_PART (ORGAN_NAME) VALUES ('" & strOrgan & "')"
GDB.Execute strSQL
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -