frmgetphotoedit.frm

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

            ToolTipText     =   "90度"
            Top             =   2520
            Width           =   735
         End
         Begin VB.CommandButton btnLeftRight 
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   12
               Charset         =   134
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   530
            Left            =   120
            Picture         =   "frmGetPhotoEdit.frx":222E0
            Style           =   1  'Graphical
            TabIndex        =   22
            ToolTipText     =   "左右"
            Top             =   1940
            Width           =   735
         End
         Begin VB.CommandButton btnUpdown 
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   12
               Charset         =   134
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   530
            Left            =   960
            Picture         =   "frmGetPhotoEdit.frx":23134
            Style           =   1  'Graphical
            TabIndex        =   21
            ToolTipText     =   "上下"
            Top             =   1940
            Width           =   735
         End
         Begin VB.CommandButton btnAdjustWindow 
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   12
               Charset         =   134
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   530
            Left            =   960
            Picture         =   "frmGetPhotoEdit.frx":23F88
            Style           =   1  'Graphical
            TabIndex        =   20
            ToolTipText     =   "调窗"
            Top             =   240
            Width           =   735
         End
         Begin VB.CommandButton btnExit 
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   12
               Charset         =   134
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   495
            Index           =   0
            Left            =   960
            Picture         =   "frmGetPhotoEdit.frx":24DDC
            Style           =   1  'Graphical
            TabIndex        =   19
            ToolTipText     =   "返回"
            Top             =   6480
            Width           =   735
         End
         Begin MSComDlg.CommonDialog CDialog 
            Left            =   120
            Top             =   8640
            _ExtentX        =   847
            _ExtentY        =   847
            _Version        =   393216
         End
      End
      Begin VB.Label Label2 
         BackColor       =   &H00354B34&
         Caption         =   "获取图片"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   21.75
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000FF&
         Height          =   495
         Left            =   0
         TabIndex        =   42
         Top             =   0
         Width           =   1815
      End
      Begin VB.Label Label1 
         BackColor       =   &H00354B34&
         Caption         =   "获取图片"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   21.75
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000FF&
         Height          =   495
         Left            =   -75000
         TabIndex        =   41
         Top             =   0
         Width           =   1815
      End
   End
   Begin VB.Label lblPatientInfo 
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   0
      TabIndex        =   43
      Top             =   8760
      Width           =   9945
   End
End
Attribute VB_Name = "frmGetPhotoEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'图片大小每次增加或减少的幅度
Const DICOM_ADD_SCALE = 2

'放大镜倍数
Const DICOM_MAG_ZOOM_SIZE = 2

Const PHOTO_MOVE = 4


Dim bArrowDown As Boolean
Dim bSharpen As Boolean

'上一次使用的DCM ImageTool
Dim giPrvTool As Integer
Dim gbSetImageTool As Boolean

Dim gbCopyImage As Boolean


'鼠标 坐标--DCM编辑区域
Dim Dcm_Mouse_X1 As Long
Dim Dcm_Mouse_Y1 As Long

Dim Dcm_Mouse_X2 As Long
Dim Dcm_Mouse_Y2 As Long




Private Sub btnAddScale_Click()
    On Error GoTo ErrHandler
    dcmEdit.ImageZoomPct = dcmEdit.ImageZoomPct + DICOM_ADD_SCALE
    
    
    Exit Sub
ErrHandler:
    
End Sub

'按钮事件--调窗
Private Sub btnAdjustWindow_Click()
On Error GoTo ErrHandler
    dcmEdit.ImageTool = 1
    Exit Sub
ErrHandler:
    
End Sub


'按钮事件--角度
Private Sub btnAngle_Click()
    dcmEdit.ImageTool = 9
End Sub

'按钮事件--箭头
Private Sub btnArrow_Click()
    dcmEdit.ImageTool = 10
End Sub

'按钮事件--最佳
Private Sub btnBestFit_Click()
    dcmEdit.ImageZoomBestFit = True
End Sub


Private Sub btnBlur_Click()
On Error GoTo ErrHandler
    
    dcmEdit.ImageProcessBlur = True
    Exit Sub
ErrHandler:
End Sub

'按钮事件--裁剪
Private Sub btnClip_Click()
    On Error GoTo ErrHandler
    'picEdit.Name
    If MsgBox("您确认将原图替换为剪切的区域?", vbYesNo Or vbQuestion, "提示") = vbNo Then
        Exit Sub
    End If
    '先保存Pic上的
    Dim strPicturePath As String
    strPicturePath = App.Path + "\" + FILM_EDIT_PATH
    If Dir(strPicturePath, vbDirectory Or vbSystem Or vbReadOnly Or vbHidden) = "" Then
        MkDir strPicturePath
    End If
    strPicturePath = strPicturePath + "\" + picEdit.Name
    If Dir(strPicturePath, vbArchive Or vbSystem Or vbReadOnly Or vbHidden) <> "" Then
        Kill strPicturePath
    End If
    
    SavePicture picEdit.Image, strPicturePath
    
    If Dir(strPicturePath, vbArchive Or vbSystem Or vbReadOnly Or vbHidden) <> "" Then
        If Not dcmEdit.OpenFile(strPicturePath) Then
            MsgBox "裁减失败, 原因：I/O错误, 请与系统管理员联系!", vbExclamation, "提示"
            Exit Sub
        End If
    Else
        MsgBox "裁减失败, 原因：I/O错误, 请与系统管理员联系!", vbExclamation, "提示"
        Exit Sub
    End If
    
    picEdit.Visible = False
    Exit Sub
ErrHandler:
    MsgBox "裁减失败, 原因：" + Err.Description, vbExclamation, "提示"
End Sub

Private Sub btnColorScheme_Click()
    dcmEdit.ImageColorScheme = 16
End Sub

Private Sub btnColorSchemeFalse_Click()
    dcmEdit.ImageColorScheme = -16
End Sub

'按钮事件--复制
Private Sub btnCopy_Click()
On Error GoTo ErrHandler
    giPrvTool = dcmEdit.ImageTool
    dcmEdit.ImageTool = 14
    gbCopyImage = True
    
    
    Exit Sub
ErrHandler:
End Sub

'按钮事件--Do Nothing
Private Sub btnDefault_Click()
On Error GoTo ErrHandler
    dcmEdit.ImageTool = 14
    
    picFilter.Visible = False
    
    Exit Sub
ErrHandler:
End Sub

Private Sub btnEllipse_Click()
    dcmEdit.ImageTool = 7
End Sub

Private Sub btnEmboss_Click()
On Error GoTo ErrHandler
    dcmEdit.ImageProcessEmboss = True
    Exit Sub
    
ErrHandler:
End Sub

'按钮事件--放大镜
Private Sub btnEnlarge_Click()
On Error GoTo ErrHandler
    dcmEdit.ImageMagnifyZoomSize = DICOM_MAG_ZOOM_SIZE
    
    dcmEdit.ImageTool = 3
    Exit Sub
ErrHandler:
    
End Sub

'按钮事件--退出
Private Sub btnExit_Click(Shift As Integer)
On Error GoTo ErrHandler
    Unload Me
    
    Exit Sub
ErrHandler:

End Sub

Private Sub btnExport_Click()
On Error GoTo ErrHandler
    CDialog.FileName = ""
    CDialog.DefaultExt = "*"
    CDialog.DialogTitle = "Save File"
    CDialog.Filter = "Bitmap File(*.bmp)|*.bmp|JPEG File(*.jpg)|*.jpg|TIFF File(*.tif)|*.tif"
    CDialog.ShowSave
    If CDialog.FileName <> "" Then
        dcmEdit.ImageSaveToFile = CDialog.FileName
    End If
    Exit Sub
ErrHandler:
    
End Sub

Private Sub btnFilter_Click()
On Error GoTo ErrHandler
    dcmEdit.ImageProcessFilter = True
    Exit Sub
ErrHandler:

End Sub

Private Sub btnFilterClean_Click()
    On Error GoTo ErrHandler
    dcmEdit.ImageTool = 14
    picFilter.Visible = True
    
    Exit Sub
ErrHandler:
    
    
End Sub

'按钮事件--左右
Private Sub btnLeftRight_Click()
On Error GoTo ErrHandler
    dcmEdit.ImageProcessFlipHorzontal = True
    Exit Sub
ErrHandler:
End Sub

Private Sub btnLength_Click()
    On Error GoTo ErrHandler
      dcmEdit.ImageTool = 5
      Exit Sub
ErrHandler:
      
End Sub

'按钮事件--移动