frmgetphotoedit.frm

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

Private Sub btnMove_Click()
On Error GoTo ErrHandler
    dcmEdit.ImageTool = PHOTO_MOVE
    Exit Sub
ErrHandler:
End Sub

'按钮事件--90度
Private Sub btnNinety_Click()
    dcmEdit.ImageProcessRotate = 90
End Sub

'按钮事件--1:1
Private Sub btnOne_Click()
On Error GoTo ErrHandler
    dcmEdit.ImageZoomBestFit = False
    Exit Sub
ErrHandler:
    
End Sub



Private Sub btnOriginal_Click(Shift As Integer)
On Error GoTo ErrHandler
    dcmEdit.ImageColorScheme = 1
    dcmEdit.ImageReset

    picEdit.Visible = False
    Exit Sub
ErrHandler:

End Sub

Private Sub btnPatientInfo_Click()
    On Error GoTo ErrHandler
    dcmEdit.ImageOverlayOn = Not dcmEdit.ImageOverlayOn
    Exit Sub
ErrHandler:
    
End Sub

Private Sub btnProcessFilter_Click()
    On Error GoTo ErrHandler
    
    
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub

Private Sub btnRectangle_Click()
    dcmEdit.ImageTool = 6
End Sub

Private Sub btnResize_Click()
    On Error GoTo ErrHandler
    PHOTO_ZOOM_PROPORTION = dcmEdit.ImageZoomPct
    dcmEdit.ImageZoomPct = PHOTO_ZOOM_PROPORTION
    
    Exit Sub
ErrHandler:
    MsgBox "缩放错误, 原因:" + Err.Description, vbExclamation, "提示"
End Sub

'按钮事件--反色
Private Sub btnReverse_Click()
On Error GoTo ErrHandler
    dcmEdit.ImageProcessInvert = True
    dcmEdit.ImageColorScheme = -dcmEdit.ImageColorScheme
    Exit Sub
ErrHandler:
    
End Sub


Private Sub btnRuler_Click()
    On Error GoTo ErrHandler
    dcmEdit.ImageOverlayShowRuler = Not dcmEdit.ImageOverlayShowRuler
    Exit Sub
ErrHandler:
End Sub

'按钮事件----保存
Private Sub btnSave_Click()
    On Error GoTo ErrHandler
    Dim strDcmEditName As String
    If dcmEdit.OPENFILENAME = "" Then
        Exit Sub
    End If
    strDcmEditName = dcmEdit.OPENFILENAME
    If strDcmEditName = "" Then
        Exit Sub
    End If
    
    Dim bOverlayOn As Boolean
    bOverlayOn = dcmEdit.ImageOverlayOn
    dcmEdit.ImageOverlayOn = False
    
    If frmGetPhoto.picDcmPhoto(frmGetPhoto.nSelectPhotoIndex).OPENFILENAME <> "" Then
        frmGetPhoto.picDcmPhoto(frmGetPhoto.nSelectPhotoIndex).FreeMemory
    End If
    
    If Dir(strDcmEditName, vbArchive Or vbSystem Or vbReadOnly Or vbHidden) <> "" Then
        Kill strDcmEditName
    End If
    
    dcmEdit.ImageSaveToDICOM = strDcmEditName
    
    If Dir(strDcmEditName, vbArchive Or vbSystem Or vbReadOnly Or vbHidden) <> "" Then
        frmGetPhoto.picDcmPhoto(frmGetPhoto.nSelectPhotoIndex).OpenFile strDcmEditName
        
    End If
    
    dcmEdit.ImageOverlayOn = bOverlayOn
    
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub

'按钮事件--锐化
Private Sub btnSharpen_Click()
    bSharpen = Not bSharpen
    dcmEdit.ImageProcessSharpen = bSharpen
End Sub

'添加  L
Private Sub btnSignLeft_Click()
 On Error GoTo ErrHandler
    giPrvTool = dcmEdit.ImageTool
    dcmEdit.ImageMeasureTextPreSet = "L"
    dcmEdit.ImageTool = 11
    gbSetImageTool = True
    Exit Sub
ErrHandler:
    MsgBox "标记图片错误", vbExclamation, "XRay:提示"
End Sub

Private Sub btnSignRight_Click()
On Error GoTo ErrHandler
    giPrvTool = dcmEdit.ImageTool
    dcmEdit.ImageMeasureTextPreSet = "R"
    dcmEdit.ImageTool = 11
    gbSetImageTool = True
    Exit Sub
ErrHandler:
    MsgBox "标记图片错误", vbExclamation, "XRay:提示"
End Sub

Private Sub btnSmooth_Click()
    dcmEdit.ImageSmoothOn = Not dcmEdit.ImageSmoothOn
End Sub


Private Sub btnSubPartAdjust_Click()
    dcmEdit.ImageTool = 2
End Sub

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


'按钮事件--文字
Private Sub btnText_Click()
    dcmEdit.ImageTool = 11
End Sub

'按钮事件--上下
Private Sub btnUpdown_Click()
    dcmEdit.ImageProcessFlipVertical = True
End Sub


Private Sub Form_Unoad(cancel As Integer)
    On Error Resume Next
    dcmEdit.FreeMemory
End Sub



Private Sub Form_Load()
On Error GoTo ErrHandler
    'Me.BackColor = mHLSRGB.COLORSET
    'Me.frmButtons.BackColor = mHLSRGB.COLORSET
    
    
    bArrowDown = False
    bSharpen = False
    dcmEdit.ImageProcessSharpen = bSharpen
    dcmEdit.ImageMeasureTextFontColor = 5
    dcmEdit.ImagePOS = 5


    Call InitDcm(dcmEdit)
    dcmEdit.OCXLanguage = 0
    
    If Not dcmEdit.LicenseIsOK Then
        MsgBox "程序出错, 请与系统管理员联系!", vbInformation
        End
    End If
    dcmEdit.ImageOverlayLanguage = 1
    dcmEdit.ImageOverlayShowRuler = True
    dcmEdit.ImageOverlayOn = True
    dcmEdit.ImageWinCenter = dcmEdit.ImageWinCenter
    
    'dcmEdit.ToolBarVisible = True
    dcmEdit.ImageZoomBestFit = True
    dcmEdit.ImageMeasureTextFontSize = 20
    
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub


Private Sub Form_Resize()
    On Error GoTo ErrHandler
    'Me.frmButtons.Height = Me.Height - lblPatientInfo.Height
    
    Me.stabOperation.Height = Me.Height - Label1.Top - lblPatientInfo.Height
    frmButtons(0).Height = Me.stabOperation.Height + 845
    frmButtons(1).Height = frmButtons(0).Height
    
    Dim i As Long
    For i = 0 To Me.frmButtons.Count - 1
        Me.frmButtons(i).Top = Me.Label1.Height + Me.Label1.Top
        Me.frmButtons(i).Height = Me.stabOperation.Height - 1500
    Next
    
    Me.dcmEdit.Left = Me.stabOperation.Left + Me.stabOperation.Width
    dcmEdit.Width = Me.Width - stabOperation.Width
    dcmEdit.Height = Me.Height - lblPatientInfo.Height
    
    
    
    lblPatientInfo.Top = dcmEdit.Top + dcmEdit.Height
    lblPatientInfo.Left = stabOperation.Left
    lblPatientInfo.Width = Me.Width
    
    Exit Sub
ErrHandler:
    
    
End Sub




'将满意的DCM图片 加载至 frmGetPhoto.frm界面
Private Sub LoadFromDcm()
        On Error GoTo ErrHandler
        Dim lWidth, lHeight, lQuotient, w, h As Long

        w = frmPhotoPrint.dcmToPrint(nSelectPhotoIndex).ImageBMPStream.Width
        h = frmPhotoPrint.dcmToPrint(nSelectPhotoIndex).ImageBMPStream.Height
        
        If w <= 0 Or h <= 0 Then
                Pause 300
        End If
        
        If w <= 0 Or h <= 0 Then
            MsgBox "图片长或宽为0", vbExclamation, "提示"
            Exit Sub
        End If
            
        Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub



'DCM编辑 区域 鼠标MouseMove事件
Private Sub dcmEdit_DCMmouseMove(ByVal X As Long, ByVal Y As Long, ByVal Button As Long, ByVal Shift As Long)
    On Error GoTo ErrHandler
    Dim i As Long
    If picFilter.Visible And Button = 1 Then
        
        
        picFilter.Left = Me.ScaleX(X, vbPixels, vbTwips) + 2000
        picFilter.Top = Me.ScaleY(Y, vbPixels, vbTwips) - 650
        
        'picFilter.Cls
        'picFilter.PaintPicture dcmEdit.ImageBMPStream, 0, 0, _
        '    picFilter.Width, picFilter.Height, _
        '    picFilter.Left - 2680, picFilter.Top, _
        '    picFilter.Width, picFilter.Height, vbSrcCopy
        
            picFilter.PaintPicture dcmEdit.ImageBMPStream, 0, 0, _
            picFilter.Width, picFilter.Height, _
            picFilter.Left - 2680, picFilter.Top, _
            picFilter.Width, picFilter.Height, vbNotSrcCopy
            
    End If
    
    Exit Sub
ErrHandler:
    
End Sub




'DCM编辑 区域 鼠标MouseDown事件
Private Sub dcmEdit_DCMmouseDown(ByVal X As Long, ByVal Y As Long, ByVal Button As Long, ByVal Shift As Long)
    On Error GoTo ErrHandler
    'giPrvTool = dcmEdit.ImageTool
    If gbCopyImage Then
        Dcm_Mouse_X1 = Me.ScaleX(X, vbPixels, vbTwips)
        Dcm_Mouse_Y1 = Me.ScaleY(Y, vbPixels, vbTwips)
    End If
    
    Exit Sub
ErrHandler:
    Debug.Print Err.Description
    dcmEdit.ImageTool = giPrvTool
End Sub






'DCM编辑 区域 MouseUp事件
Private Sub dcmEdit_DCMmouseUp(ByVal X As Long, ByVal Y As Long, ByVal Button As Long, ByVal Shift As Long)
    'L  R
    On Error GoTo ErrHandler
    
    picFilter.Visible = False
    
    If gbSetImageTool Then
        SendKeys "{ENTER}"
        dcmEdit.ImageTool = giPrvTool
        'Exit Sub
    End If

    '复制
    If gbCopyImage Then
        'Dcm_Mouse_X2 = X
        'Dcm_Mouse_Y2 = Y
        
        Dcm_Mouse_X2 = Me.ScaleX(X, vbPixels, vbTwips)
        Dcm_Mouse_Y2 = Me.ScaleY(Y, vbPixels, vbTwips)
        
        If Dcm_Mouse_X2 = Dcm_Mouse_X1 Or Dcm_Mouse_Y2 = Dcm_Mouse_Y1 Then
            Exit Sub
        End If
        
        'picEdit.Left = Dcm_Mouse_X1 + dcmEdit.Left
        'picEdit.Top = Dcm_Mouse_Y1 + dcmEdit.Top
        picEdit.Width = Abs(Dcm_Mouse_X2 - Dcm_Mouse_X1)
        picEdit.Height = Abs(Dcm_Mouse_Y2 - Dcm_Mouse_Y1)
        
        picEdit.Picture = LoadPicture()
        picEdit.PaintPicture dcmEdit.ImageBMPStream, 0, 0, _
            picEdit.Width, picEdit.Height, _
            Dcm_Mouse_X1, Dcm_Mouse_Y1, _
            Abs(Dcm_Mouse_X2 - Dcm_Mouse_X1), Abs(Dcm_Mouse_Y2 - Dcm_Mouse_Y1)
        
        picEdit.Visible = True
        btnClip.Enabled = True
        gbCopyImage = False
    End If
    
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub