frmtypeset.frm

1、以DLL形式提供医生工作站 2、 根据【检查项目】

VERSION 5.00
Begin VB.Form frmTypeSet 
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   8745
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   12375
   LinkTopic       =   "Form1"
   ScaleHeight     =   8745
   ScaleWidth      =   12375
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "打印胶片"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   10200
      TabIndex        =   3
      Top             =   8160
      Width           =   2055
   End
   Begin VB.PictureBox picPhotoPrint 
      AutoRedraw      =   -1  'True
      Height          =   7935
      Left            =   5520
      ScaleHeight     =   7875
      ScaleWidth      =   6675
      TabIndex        =   2
      Top             =   120
      Width           =   6735
   End
   Begin VB.Frame Frame1 
      Height          =   8055
      Left            =   120
      TabIndex        =   0
      Top             =   0
      Width           =   5295
      Begin VB.PictureBox picPreviewPhoto 
         AutoRedraw      =   -1  'True
         Height          =   3615
         Index           =   1
         Left            =   120
         ScaleHeight     =   3555
         ScaleWidth      =   4995
         TabIndex        =   4
         Top             =   3960
         Width           =   5055
      End
      Begin VB.PictureBox picPreviewPhoto 
         AutoRedraw      =   -1  'True
         Height          =   3615
         Index           =   0
         Left            =   120
         ScaleHeight     =   3555
         ScaleWidth      =   4995
         TabIndex        =   1
         Top             =   240
         Width           =   5055
      End
   End
End
Attribute VB_Name = "frmTypeSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'----------------------------------------------------------------------------------------------------
'文件：frmTypeSet.frm
'作者：冷家锋
'时间：2008-4-10
'说明：胶片打印--及设置
'----------------------------------------------------------------------------------------------------

Option Explicit

Private bPhotoPreviewOk As Boolean

Private Sub Command1_Click()
    'dcmpsprt -v -c dcmpstat.cfg --printer AGFA ct.dcm
    Dim strFilmSize As String
    
On Error GoTo ErrHandler
    strFilmSize = ""
    Dim nRtn As Integer
    nRtn = ShellExecute(Me.hwnd, "open", App.Path & "\htprint.exe", "-c htprint.cfg --printer IHEFULL -s " _
        & strFilmSize & " " & App.Path & "\PhotoPrint\PhotoPrint1.dcm", App.Path, vbHide)
        
    If nRtn <= 32 Then
        MsgBox "打印失败!", vbExclamation, "提示"
        Exit Sub
    End If
    
    Pause 500
    MsgBox "打印命令发送成功!", vbInformation, "提示"
    
    Exit Sub
ErrHandler:
    MsgBox "打印失败!", vbExclamation, "提示"
    
End Sub

Private Sub Form_load()
On Error GoTo ErrHandler
    bPhotoPreviewOk = False

    Me.picPreviewPhoto(0).PaintPicture LoadPicture("d:\wallcoo.jpg"), 0, 0, _
        picPreviewPhoto(0).Width, picPreviewPhoto(0).Height
        
        Exit Sub
ErrHandler:
        MsgBox Err.Description, vbExclamation, "提示"
End Sub




Private Sub picPhotoPrint_Click()
On Error GoTo ErrHandler
    
    If Not bPhotoPreviewOk Then
        Exit Sub
    End If
    
    picPhotoPrint.PaintPicture picPreviewPhoto(0).Image, 0, 0, picPhotoPrint.Width, picPhotoPrint.Height
    
    SavePicture picPreviewPhoto(0).Image, App.Path & "\PhotoPrint\PhotoPrint1.bmp"
    Dim strDstDcm As String
    
    strDstDcm = BmpToDcm(App.Path & "\PhotoPrint\PhotoPrint1.bmp")
    If strDstDcm = "" Then
        MsgBox "胶片预览出错!", vbExclamation, "提示"
        Exit Sub
    End If
    
    Exit Sub
ErrHandler:
    MsgBox "胶片预览出错, 请与系统管理员联系!", vbExclamation, "提示"
End Sub

'待打印图片 --鼠标单击 - --事件
Private Sub picPreviewPhoto_Click(Index As Integer)
    bPhotoPreviewOk = Not bPhotoPreviewOk
End Sub