📄 selectpart.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form SelectPartForm
BackColor = &H00C0C000&
BorderStyle = 1 'Fixed Single
Caption = "检查部位选择"
ClientHeight = 5265
ClientLeft = 45
ClientTop = 330
ClientWidth = 9510
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5265
ScaleWidth = 9510
StartUpPosition = 2 '屏幕中心
Begin MSComctlLib.ListView ListVSelPart
Height = 4215
Left = 120
TabIndex = 0
TabStop = 0 'False
Top = 120
Width = 9255
_ExtentX = 16325
_ExtentY = 7435
View = 2
Arrange = 1
LabelWrap = 0 'False
HideSelection = -1 'True
Checkboxes = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = 14737632
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 1
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Object.Width = 2540
EndProperty
End
Begin VB.CommandButton CmdInSelPart
Caption = "清 空"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 1
Left = 5160
TabIndex = 2
Top = 4560
Width = 1935
End
Begin VB.CommandButton CmdInSelPart
Caption = "确 定"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 0
Left = 2400
TabIndex = 1
Top = 4560
Width = 1935
End
End
Attribute VB_Name = "SelectPartForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'选择诊断部位界面,具体做法与选择临床诊断信息界面类似:
' 1. 当主窗体点击选择部位按钮时,打开选择诊断部位界面.在该界面初始化时,将完成两个任务:(1).打开数据库中的检查部位表,通过
' SQL语句提取部位名称字段的所有记录,并按照显示顺序排列.(2).根据提取出来的记录集,将记录一条一条的添加到列表视图中.
' 2. 当窗体初始化完毕后,针对列表视图的一些问题,要做相关处理.问题一:有时候在窗体初始化完毕后或是列表视图获得焦点时,列表
' 视图会默认选中第一项,因此处理方法为在列表视图获得焦点时,要将第一项取消选中.问题二:列表视图中的各个待选项如果处于
' 选中状态,那么再点击一次该待选项或是点击窗体其它位置就可以对待选项进行修改,因此处理方法为在点击待选项或者点击窗体
' 其它位置时,取消对待选项的选中状态.
' 3. 在选择诊断部位时候,要判断待选项的复选框是否是选中状态,然后再做相应调整.在点击待选项之后还要取消待选项的选中状态.
' 4. 点击确定按钮时,需要做两件事情:(1).将所有待选项的复选框处于选中状态的诊断部位字符串连接起来,各个诊断部位之间用分号
' 隔开.最后去除掉最后一个分号.(2).对应所选择的检查部位,在检查部位表中一个一个的查找,找到对应该检查部位的正常报告结
' 点,然后调用过程,再在诊断知识库中查找对应该结点的正常报告,然后将正常报告记录集的检查所见和检查提示加载到主窗体诊断
' 编辑模块的检查所见和检查提示文本框中.
' 5. 当点击清空按钮时,取消所有复选框的选中状态.
Private Sub Form_Load()
Dim RecSelectPart As ADODB.Recordset '提取检查部位表中的部位名称记录集
Dim strSQL As String '存储SQL语句
Dim k As Integer
SelectPartName = "" '初始化检查部位变量
Set RecSelectPart = New ADODB.Recordset '检查部位表记录集
strSQL = "SELECT 部位名称 FROM 检查部位表 ORDER BY 显示顺序"
RecSelectPart.CursorLocation = adUseClient
RecSelectPart.Open strSQL, PACSDataConn, adOpenDynamic, adLockOptimistic, adCmdText
ListVSelPart.ListItems.Clear '清空列表视图中的所有项
Do While Not RecSelectPart.EOF '将记录集中的所有部位添加到列表视图中
ListVSelPart.ListItems.Add , , RecSelectPart("部位名称")
RecSelectPart.MoveNext
Loop
ListVSelPart.Refresh '刷新列表视图
RecSelectPart.Close '关闭记录集
End Sub
Private Sub ListVSelPart_GotFocus() 'ListView获得焦点时,第一项如果默认选中,那么取消选择
If ListVSelPart.ListItems.Count > 0 Then '判断列表视图中是否加载了数据,如果加载做相应处理
If ListVSelPart.ListItems(1).Selected Then ListVSelPart.ListItems(1).Selected = False
End If
End Sub
Private Sub ListVSelPart_Click() '点击ListView的其它地方，目的：防止修改所列项目
Dim I As Integer
For I = 1 To ListVSelPart.ListItems.Count
If ListVSelPart.ListItems(I).Selected Then ListVSelPart.ListItems(I).Selected = False
Next I
End Sub
Private Sub ListVSelPart_ItemClick(ByVal Item As MSComctlLib.ListItem) '选择一条项目
If Item.Checked = False Then Item.Checked = True Else Item.Checked = False
Item.Selected = False
End Sub
Private Sub CmdInSelPart_Click(Index As Integer) '本窗体存在两个按钮,确定按钮和清空按钮
Select Case Index
Case 0 '确定按钮
Dim SelectPartName As String '用来保存选中的检查部位
Dim I As Integer
For I = 1 To ListVSelPart.ListItems.Count '将选中的检查部位组合成字符串
If ListVSelPart.ListItems(I).Checked Then '在选中检查部位之后,将诊断知识库中对应检查部位的正常报告填写
'到主窗体诊断编辑的检查所见文本框和检查提示文本框中
Dim RecSelectPart As ADODB.Recordset '根据选中的检查部位,到检查部位表中查找对应的正常报告结点
Dim strSQL As String '存储SQL语句
Dim strNode As String '存储正常结点字符串
Dim SecNode As String '如果选中[胆囊、胆管]则存在两个正常结点,此变量存储第二个结点
Set RecSelectPart = New ADODB.Recordset '查找检查部位表,得到检查部位记录集
strSQL = "SELECT * FROM 检查部位表 WHERE 部位名称 = '" & ListVSelPart.ListItems(I).Text & "'"
RecSelectPart.CursorLocation = adUseClient
RecSelectPart.Open strSQL, PACSDataConn, adOpenDynamic, adLockOptimistic, adCmdText
strNode = Trim("" & RecSelectPart.Fields("正常报告结点").Value) '获得记录集中的正常报告结点值
If Len(strNode) <= 6 Then '如果只有一个结点,也就是没有选中[胆囊、胆管]的情况
strNode = Mid(strNode, 2, 4) '由于结点数被括号括着,于是要做字符串处理,选取中间的4个
AddDiagHintText (Val(strNode)) '调用过程加载对应检查部位的正常报告
End If
If Len(strNode) > 6 Then '如果选中了[胆囊、胆管]
SecNode = Mid(strNode, 2, 4) '先取出一个结点
AddDiagHintText (Val(SecNode)) '调用过程加载对应检查部位的正常报告
strNode = Mid(strNode, 8, 4) '再取出一个结点
AddDiagHintText (Val(strNode)) '再次调用过程加载对应检查部位的正常报告
End If
SelectPartName = SelectPartName & ListVSelPart.ListItems(I).Text & ";" '组合字符串,为了显示在新建
'病人列表的检查部位文本框中
End If
Next I
I = Len(SelectPartName) '查看检查部位字符串是否为空,不为空则去掉最后一个分号
If I > 0 Then MainForm.TextBoxIn1(3).Text = left(SelectPartName, (I - 1))
Unload Me '任务完成,卸载窗体
Case 1 '清空按钮
Dim k As Integer
For k = 1 To ListVSelPart.ListItems.Count '将所有检查部位取消选择
ListVSelPart.ListItems(k).Checked = False
Next k
End Select
End Sub
Private Sub AddDiagHintText(NodeID As Integer) '得到正常报告的结点
Dim RecSelPInDiag As ADODB.Recordset '查询诊断知识库所用的记录集
Dim strSQL As String '存储SQL语句
Dim I As Integer
Set RecSelPInDiag = New ADODB.Recordset '查询出正常报告子结点的超声所见和超声提示
strSQL = "SELECT * FROM 知识库表 WHERE 父结点标识 = " & NodeID & ""
RecSelPInDiag.CursorLocation = adUseClient
RecSelPInDiag.Open strSQL, DiagnoseRepositoryConn, adOpenDynamic, adLockOptimistic, adCmdText
RecSelPInDiag.MoveFirst '将超声所见和超声提示加载到主窗体(MainForm)中诊断编辑模块中的相应文本框中
For I = 1 To RecSelPInDiag.RecordCount
If RecSelPInDiag.Fields("结点标志").Value = "1" Then '1表示检查所见
MainForm.RichTBIn5DiagText(0).Text = MainForm.RichTBIn5DiagText(0).Text & RecSelPInDiag.Fields("结点描述") & vbCrLf
End If
If RecSelPInDiag.Fields("结点标志").Value = "2" Then '2表示检查提示
MainForm.RichTBIn5DiagText(1).Text = MainForm.RichTBIn5DiagText(1).Text & RecSelPInDiag.Fields("结点描述") & vbCrLf
End If
RecSelPInDiag.MoveNext '向下移动记录集,一般来说,搜寻到的记录集有两个,一个是检查所见,一个是检查提示
Next I
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -