?? 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 + -