frmimageresult.frm

VB6.0编写的医院影像系统

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmImageResult 
   Caption         =   "图像浏览"
   ClientHeight    =   3405
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8070
   Icon            =   "frmImageResult.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MDIChild        =   -1  'True
   ScaleHeight     =   3405
   ScaleWidth      =   8070
   Begin MSComDlg.CommonDialog cdlImage 
      Left            =   75
      Top             =   2850
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      CancelError     =   -1  'True
      DialogTitle     =   "选择要添加的图片"
      Filter          =   "位图文件(*.BMP)|*.BMP|所有文件(*.*)|*.*"
   End
   Begin VB.Frame fra 
      Height          =   600
      Left            =   0
      TabIndex        =   0
      Top             =   -60
      Width           =   7995
      Begin VB.CheckBox chkAskConfirm 
         Caption         =   "删除前要求确认"
         Height          =   195
         Left            =   1920
         TabIndex        =   5
         Top             =   240
         Value           =   1  'Checked
         Visible         =   0   'False
         Width           =   1695
      End
      Begin VB.CommandButton cmdDelete 
         Caption         =   "删除图片"
         Height          =   360
         Left            =   6810
         TabIndex        =   4
         Top             =   165
         Visible         =   0   'False
         Width           =   1050
      End
      Begin VB.CommandButton cmdAdd 
         Caption         =   "添加图片"
         Height          =   360
         Left            =   5670
         TabIndex        =   3
         Top             =   165
         Visible         =   0   'False
         Width           =   1050
      End
      Begin VB.CheckBox chkShowAll 
         Caption         =   "显示全部图像"
         Height          =   195
         Left            =   180
         TabIndex        =   1
         Top             =   240
         Width           =   1695
      End
   End
   Begin USNet.ImageBrowserControl IB 
      Height          =   1965
      Left            =   60
      TabIndex        =   2
      Top             =   720
      Width           =   7935
      _ExtentX        =   13996
      _ExtentY        =   3466
      ShowInfo        =   -1  'True
      ShowAttachInfo  =   -1  'True
      AllowDelete     =   0   'False
   End
End
Attribute VB_Name = "frmImageResult"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public Loaded As Boolean

Private Sub chkShowAll_Click()
    
    '显示全部图像
    If chkShowAll.Value = 1 Then
        ShowAllReportImage
        cmdAdd.Visible = False
        cmdDelete.Visible = False
    Else
        Form_Load
        ShowReportImage
    End If
    
End Sub

Private Sub cmdAdd_Click()
    
    '添加一幅图片
    On Error GoTo ErrHandle
    
    Dim rsTemp As ADODB.Recordset
    Dim strSQL As String
    Dim strFile As String
    Dim FileNo As String
    Dim FileType As String
    Dim Media_Type As String
    
    Select Case frmReport.WorkType
        Case "Edit", "Browse"
        Case "Add"
            If Not frmReport.Saved Then
                MsgBox "对不起, 报告还没有保存!", vbOKOnly + vbInformation, "提示"
                Exit Sub
            End If
        Case Else
    End Select
    strSQL = "SELECT * FROM US_MEDIA WHERE FILE_TYPE = 'IMAGE' AND US_NO = '" & frmReport.txtUSNo.Text & "' ORDER BY SERIAL_ID"
    Set rsTemp = OpenRSClient(strSQL, "Data")
    If rsTemp.RecordCount <> 0 Then
        rsTemp.MoveLast
        FileNo = GetFileName(rsTemp!FILE_NAME)
    Else
        FileNo = frmReport.txtUSNo.Text & "_0.xxx"
    End If
    FileNo = Right(FileNo, Len(FileNo) - Len(frmReport.txtUSNo.Text) - 1)
    cdlImage.Filter = "Pictures (*.bmp;*.jpg)|*.bmp;*.jpg"
    cdlImage.ShowOpen
    FileType = Right(cdlImage.FileName, Len(cdlImage.FileName) - (InStrRev(cdlImage.FileName, ".") - 1))
    '此处应加入判断媒体文件类型的过程
    Media_Type = Make_Media_Type(cdlImage.FileName)
    If Media_Type = "" Then
        MsgBox "文件类型不符！", vbOKOnly + vbInformation, "提示"
        Exit Sub
    End If
    strFile = gstrImageDir & "\" & frmReport.txtUSNo.Text & "_" & Trim(str(Val(Left(FileNo, Len(FileNo) - Len(FileType))) + 1)) & FileType
    FileNo = Right(GetFileName(strFile), Len(GetFileName(strFile)) - Len(frmReport.txtUSNo.Text) - 1)
    While ExistRecordUSData("US_MEDIA", "FILE_NAME", strFile, "AND FILE_TYPE = '" & Media_Type & "' AND US_NO = '" & frmReport.txtUSNo.Text & "'")
        strFile = gstrImageDir & "\" & frmReport.txtUSNo.Text & "_" & Trim(str(Val(Left(FileNo, Len(FileNo) - Len(FileType))) + 1)) & FileType
        FileNo = Right(GetFileName(strFile), Len(GetFileName(strFile)) - Len(frmReport.txtUSNo.Text) - 1)
    Wend
    FileCopy cdlImage.FileName, strFile
    If Media_Type = "IMAGE" Then
        IB.ImageFiles.Add strFile
        IB.ShowImage
    End If
    strSQL = "INSERT INTO US_MEDIA (US_NO,FILE_TYPE,FILE_NAME) VALUES ('" & frmReport.US_NO & "','" & Media_Type & "','" & strFile & "')"
    ConnData.Execute strSQL
    
    Exit Sub
    
ErrHandle:
    Exit Sub
End Sub


Private Sub cmdDelete_Click()
    
    '----------------------------
    '删除所选择的图片,并删除数据库中的记录
    '----------------------------
    
    Dim cIF  As ImageFile
    Dim strSQL As String
    Dim strWhere As String
    Dim Ret As Integer
    
    '如果选择的记录数>0,则询问是否确认
    If IB.SelectedImageFiles.Count = 0 Then
        MsgBox "对不起, 没有选定的文件!", vbOKOnly + vbInformation, "提示"
        Exit Sub
    End If
    
    If chkAskConfirm.Value = 1 Then
        Ret = MsgBox("这将从硬盘和数据库中删除所选择的图像文件,确定吗?", vbQuestion + vbYesNo, "提示")
        If Ret = vbNo Then Exit Sub
    End If
    
    '依次删除这些文件
    For Each cIF In IB.SelectedImageFiles
        strWhere = "WHERE US_NO = '" & frmReport.US_NO & "' AND FILE_NAME = '" & cIF.FileFullName & "'"
        strSQL = "SELECT US_NO FROM US_MEDIA " & strWhere
        If FindValue(strSQL, , "ConnData") <> vbNullString Then
            strSQL = "DELETE FROM US_MEDIA " & strWhere
            ConnData.Execute strSQL
            FSO.DeleteFile cIF.FileFullName
        End If
    Next cIF
    
    Set IB.SelectedItems = Nothing  '删除后将选择的文件清空
    
    '刷新显示
    ShowReportImage
    
End Sub

Private Sub Form_Load()
    
    Loaded = True
    
    '根据用户身份决定是否显示添加和删除图片的按钮
    If UserType = "超级管理员" Or UserType = "系统管理员" Then
        cmdAdd.Visible = True
        cmdDelete.Visible = True
        chkAskConfirm.Visible = True
    End If
    
End Sub

Private Sub Form_Resize()
    
    '--------------------------
    '调整各控件的位置
    '--------------------------
    
    On Error Resume Next
    
    fra.Move 0, -60, Me.ScaleWidth
    cmdDelete.Left = fra.width - cmdDelete.width - 90
    cmdAdd.Left = cmdDelete.Left - cmdAdd.width - 60
    IB.Move 0, fra.Top + fra.height, Me.ScaleWidth, Me.ScaleHeight - fra.Top - fra.height
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    Loaded = False
    
End Sub

Private Sub IB_BeforePrintSingleImage()
    
    On Error GoTo ErrHandle
    
    IB.TagString = vbNullString
    
    '当打印单幅图片时，输入当前报告的信息(超声号和病人姓名)
    With rsUS_ReportSick
        IB.TagString = "超声号：" & !US_NO
        IB.TagString = IB.TagString & "　　病人姓名：" & !SICK_NAME
    End With
    
    Exit Sub

ErrHandle:
    Exit Sub

End Sub

Private Function Make_Media_Type(FileFullName As String) As String
    Select Case UCase(Right(FileFullName, 3))
        Case "BMP", "GIF", "JPG", "ICO", "CUR", "WMF"
            Make_Media_Type = "IMAGE"
        Case "AVI"
            Make_Media_Type = "VIDEO"
        Case Else
            Make_Media_Type = ""
    End Select

End Function