dlgpersonvideo.frm

本系统可用于医院和专业体检中心的健康体检管理

VERSION 5.00
Object = "{0B81E4A9-BE4E-4AEF-9272-33AB5B51C6FC}#1.0#0"; "XPControls.ocx"
Begin VB.Form dlgPersonVideo 
   BackColor       =   &H80000018&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "影像信息"
   ClientHeight    =   4830
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   7695
   Icon            =   "dlgPersonVideo.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4830
   ScaleWidth      =   7695
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.Frame Frame1 
      BackColor       =   &H80000018&
      Caption         =   "影像浏览"
      Height          =   4425
      Left            =   120
      TabIndex        =   3
      Top             =   210
      Width           =   5265
      Begin VB.PictureBox picScan 
         Height          =   4005
         Left            =   150
         ScaleHeight     =   3945
         ScaleWidth      =   4905
         TabIndex        =   4
         Top             =   300
         Width           =   4965
      End
      Begin VB.PictureBox picPhotography 
         Height          =   4005
         Left            =   150
         ScaleHeight     =   3945
         ScaleWidth      =   4905
         TabIndex        =   5
         Top             =   300
         Width           =   4965
      End
   End
   Begin VB.Frame Frame2 
      BackColor       =   &H80000018&
      Caption         =   "图像选择"
      Height          =   2685
      Left            =   5520
      TabIndex        =   2
      Top             =   210
      Width           =   2025
      Begin VB.OptionButton optIDCard 
         Caption         =   "身份证"
         Height          =   645
         Left            =   270
         Style           =   1  'Graphical
         TabIndex        =   7
         Top             =   1560
         Width           =   1485
      End
      Begin VB.OptionButton optPhoto 
         Caption         =   "照    片"
         Height          =   645
         Left            =   270
         Style           =   1  'Graphical
         TabIndex        =   6
         Top             =   630
         Width           =   1485
      End
   End
   Begin VB.Frame Frame3 
      BackColor       =   &H80000018&
      Caption         =   "操作"
      Height          =   1395
      Left            =   5520
      TabIndex        =   0
      Top             =   3240
      Width           =   2025
      Begin XPControls.XPCommandButton cmdOK 
         Default         =   -1  'True
         Height          =   405
         Left            =   480
         TabIndex        =   1
         Top             =   600
         Width           =   1125
         _ExtentX        =   1984
         _ExtentY        =   714
         Caption         =   "确定(&O)"
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
   End
End
Attribute VB_Name = "dlgPersonVideo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Private Sub cmdOK_Click()
    Unload Me
End Sub

'被调函数
Public Function ShowPersonVideo(ByVal strHealthID As String) As String
    Dim strSQL As String
    Dim rsVideo As ADODB.Recordset
    Dim strPhotoFile As String
    Dim strScanFile As String
    Dim blnShow As Boolean
    
    '***********************************************************************
    '个人相片或身份证扫描浏览
    '***********************************************************************
    blnShow = False
    
    strPhotoFile = GetTempPathW & "Photo.jpg"
    strScanFile = GetTempPathW & "Scan.jpg"
    If Dir(strPhotoFile) <> "" Then Kill strPhotoFile
    If Dir(strScanFile) <> "" Then Kill strScanFile
    
    strSQL = "select * from SET_GRXX_VIDEO" _
            & " where GUID in(" _
                & "select Max(GUID) from SET_GRXX" _
                & " where HealthID='" & strHealthID & "'" _
            & ")"
    Set rsVideo = New ADODB.Recordset
    rsVideo.Open strSQL, GCon, adOpenForwardOnly, adLockReadOnly
    If Not rsVideo.EOF Then
        If Not IsNull(rsVideo("Photo_Person")) Then
            If ColumnToFile(rsVideo("Photo_Person"), strPhotoFile, rsVideo) = True Then
                picPhotography.PICTURE = LoadPicture(strPhotoFile)
                
                optPhoto.Value = True
                blnShow = True
            End If
        End If
        
        If Not IsNull(rsVideo("Photo_IDCard")) Then
            If ColumnToFile(rsVideo("Photo_IDCard"), strScanFile, rsVideo) = True Then
                picScan.PICTURE = LoadPicture(strScanFile)
                
                If Not blnShow Then
                    optIDCard.Value = True
                End If
            End If
        End If
        
        rsVideo.Close
    End If
    
    Me.Show vbModal
End Function

Private Sub optIDCard_Click()
    picScan.ZOrder 0
End Sub

Private Sub optPhoto_Click()
    picPhotography.ZOrder 0
End Sub