📄 frmsearchimage.frm
字号:
VERSION 5.00
Begin VB.Form frmSearchImage
BorderStyle = 3 'Fixed Dialog
Caption = "图像查询"
ClientHeight = 8145
ClientLeft = 45
ClientTop = 330
ClientWidth = 8805
Icon = "frmSearchImage.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 8145
ScaleWidth = 8805
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin USNet.ImageBrowserControl IBImage
Height = 4215
Left = 60
TabIndex = 12
Top = 2040
Width = 8715
_ExtentX = 15372
_ExtentY = 7435
End
Begin VB.TextBox txtInfo
BackColor = &H80000000&
Height = 1755
Left = 60
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 11
Text = "frmSearchImage.frx":000C
Top = 6300
Width = 8715
End
Begin VB.Frame Frame1
Height = 2055
Left = 60
TabIndex = 0
Top = -60
Width = 8715
Begin VB.CheckBox chkBlur
Caption = "模糊查询(&M)"
Height = 195
Left = 7080
TabIndex = 10
Top = 300
Value = 1 'Checked
Width = 1455
End
Begin VB.TextBox txtImageName
Height = 330
Left = 1320
TabIndex = 4
Top = 240
Width = 3795
End
Begin VB.Frame Frame2
Caption = "范围"
Height = 1215
Left = 180
TabIndex = 3
Top = 660
Width = 4935
Begin VB.CommandButton cmdFolder
Caption = "目录..."
Enabled = 0 'False
Height = 315
Left = 3180
TabIndex = 9
Top = 660
Width = 855
End
Begin VB.TextBox txtFolder
Enabled = 0 'False
Height = 330
Left = 540
TabIndex = 8
Top = 660
Width = 2595
End
Begin VB.OptionButton optSearchInDB
Caption = "在数据库中查询(&D)"
Height = 375
Left = 2280
TabIndex = 7
Top = 240
Value = -1 'True
Width = 1875
End
Begin VB.OptionButton optSearchInFolder
Caption = "在目录中查询(&F)"
Height = 375
Left = 300
TabIndex = 6
Top = 240
Width = 1875
End
End
Begin VB.CommandButton cmdSearch
Caption = "查询(&S)"
Height = 390
Left = 7080
TabIndex = 2
Tag = "确定"
Top = 780
Width = 1215
End
Begin VB.CommandButton cmdCancel
Caption = "关闭(&C)"
Height = 390
Left = 7080
TabIndex = 1
Tag = "确定"
Top = 1380
Width = 1215
End
Begin VB.Label Label1
Caption = "图象文件名:"
Height = 195
Left = 180
TabIndex = 5
Top = 300
Width = 1095
End
End
End
Attribute VB_Name = "frmSearchImage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdFolder_Click()
'----------------------------
'选择浏览的目录
'----------------------------
Dim strFolder As String
strFolder = BrowseFolder(Me.hwnd, "请选择查找图象的路径:")
If Trim(strFolder) <> vbNullString Then
txtFolder.Text = strFolder
End If
End Sub
Private Sub cmdSearch_Click()
'-------------------------------
'根据选择的条件进行图象查询
'-------------------------------
Dim cFolder As Folder
Dim cFile As File
Dim strSQL As String
Dim rsImage As ADODB.Recordset
On Error GoTo ErrHandle
Screen.MousePointer = vbHourglass
'清空图象控件
IBImage.Clear
'首先判断查询的范围
If optSearchInFolder.Value Then
'选择是按照目录浏览
'如果不存在所设定的目录，则提示并退出
If Not (FSO.FolderExists(txtFolder.Text)) Then
MsgBox "未发现指定的路径!", vbOKOnly + vbExclamation, "提示"
Screen.MousePointer = vbNormal
Exit Sub
End If
Set cFolder = FSO.GetFolder(txtFolder.Text)
For Each cFile In cFolder.Files
If chkBlur.Value = 1 Then
If InStr(1, cFile.Name, txtImageName.Text, vbTextCompare) > 0 Then
IBImage.ImageFiles.Add cFile.Path, "IMAGE"
End If
Else
If UCase(cFile.Name) = UCase(txtImageName.Text) Then
IBImage.ImageFiles.Add cFile.Path, "IMAGE"
End If
End If
Next cFile
Else
'选择是按照数据库浏览
If chkBlur.Value = 1 Then
strSQL = "SELECT * FROM US_MEDIA WHERE FILE_TYPE = 'IMAGE' AND FILE_NAME LIKE '%" & txtImageName.Text & "%'"
Else
strSQL = "SELECT * FROM US_MEDIA WHERE FILE_TYPE = 'IMAGE' AND FILE_NAME LIKE '%" & txtImageName.Text & "'"
End If
Set rsImage = OpenRSClient(strSQL, "Data")
'依次添加到控件
With rsImage
Do While Not .EOF
IBImage.ImageFiles.Add !FILE_NAME
.MoveNext
Loop
End With
End If
'刷新控件
IBImage.ShowImage
txtInfo.Text = vbNullString
If IBImage.ImageFiles.Count > 0 Then IBImage.MouseSelectItem 1, 0
'释放对象
Set cFolder = Nothing
Set cFile = Nothing
Set rsImage = Nothing
Exit Sub
ErrHandle:
Screen.MousePointer = vbNormal
Exit Sub
End Sub
Private Sub Form_Load()
'----------------------
'初试的路径是图象路径
'----------------------
txtFolder.Text = gstrImageDir
End Sub
Private Sub IBImage_SingleImageSelected(ImageFile As ImageFile)
'--------------------------------
'单图片选择时显示该记录的信息
'--------------------------------
Dim rsImage As ADODB.Recordset
Dim strSQL As String
strSQL = "SELECT * FROM US_MEDIA WHERE FILE_TYPE = 'IMAGE' AND FILE_NAME = '" & ImageFile.FileFullName & "'"
Set rsImage = OpenRSClient(strSQL, "Data")
If rsImage.RecordCount = 0 Then
txtInfo.Text = "数据库中无此文件详细信息。"
Else
strSQL = "SELECT * FROM US_REPORT WHERE US_NO = '" & rsImage!US_NO & "'"
Set rsImage = OpenRSClient(strSQL, "Data")
If rsImage.RecordCount = 0 Then
txtInfo.Text = "数据库中无此文件详细信息。"
Else
txtInfo.Text = "文件详细信息：" & vbCrLf
txtInfo.Text = txtInfo.Text & "超声号： " & rsImage!US_NO & vbCrLf
txtInfo.Text = txtInfo.Text & "病人号码：" & rsImage!SICK_NO & vbCrLf
txtInfo.Text = txtInfo.Text & "病人姓名：" & rsImage!SICK_NAME & vbCrLf
txtInfo.Text = txtInfo.Text & "超声性别：" & rsImage!SICK_SEX & vbCrLf
txtInfo.Text = txtInfo.Text & "超声类型：" & rsImage!US_TYPE & vbCrLf
txtInfo.Text = txtInfo.Text & "诊断医师：" & rsImage!DIAG_DOCTOR & vbCrLf
txtInfo.Text = txtInfo.Text & "检查日期：" & rsImage!diag_day & vbCrLf
txtInfo.Text = txtInfo.Text & "检查部位：" & rsImage!Organ_Name & vbCrLf
'txtInfo.Text = txtInfo.Text & "疾病种类：" & rsImage!ILL_TYPE & vbCrLf
txtInfo.Text = txtInfo.Text & "备注： " & rsImage!DESCRIBE & vbCrLf
End If
End If
End Sub
Private Sub optSearchInDB_Click()
If optSearchInDB.Value Then
txtFolder.Enabled = False
cmdFolder.Enabled = False
End If
End Sub
Private Sub optSearchInFolder_Click()
If optSearchInFolder.Value Then
txtFolder.Enabled = True
cmdFolder.Enabled = True
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -