frmphotoedit1.frm

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

End Sub

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


'降噪处理
Private Sub btnProcessBlur_Click()
    On Error GoTo ErrHandler
    dcmEdit.ImageProcessBlur = True
    Exit Sub
ErrHandler:
    
End Sub

Private Sub btnProcessFilter_Click()
    On Error GoTo ErrHandler
    dcmEdit.ImageProcessFilter = True
    
    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 strDcmEditPath As String
    Dim strDcmEditName As String
    If dcmEdit.OpenFileName = "" Then
        Exit Sub
    End If
    strDcmEditName = Dir(dcmEdit.OpenFileName, vbArchive Or vbSystem Or vbReadOnly Or vbHidden)
    
    If strDcmEditName = "" Then
        Exit Sub
    End If
    
    
    Dim bOverlayOn As Boolean
    bOverlayOn = dcmEdit.ImageOverlayOn
    dcmEdit.ImageOverlayOn = False
    
    
    If Dir(App.Path + "\FilmEdit", vbDirectory Or vbSystem Or vbHidden Or vbReadOnly) = "" Then
        MkDir App.Path + "\FilmEdit"
    End If
    
    strDcmEditPath = App.Path + "\FilmEdit\" + strDcmEditName
    'dcmEdit.ImageCopyImageToClipboard
    If Dir(strDcmEditPath, vbArchive Or vbSystem Or vbReadOnly Or vbHidden) <> "" Then
        Kill strDcmEditPath
    End If
    strDcmEditPath = strDcmEditPath + ".bmp"
    'dcmEdit.ImageSaveToDICOMasGray = strDcmEditPath
    dcmEdit.ImageSaveToFile = strDcmEditPath
    
    
    

    If Dir(strDcmEditPath, vbArchive Or vbSystem Or vbReadOnly Or vbHidden) <> "" Then
        frmPhotoPrint.dcmToPrint(nSelectPhotoIndex).OpenFile strDcmEditPath
        Call LoadBmpFromDcm
        
    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.ImageOverlayShowRuler = True
    dcmEdit.ImageOverlayOn = True
    'dcmEdit.ImageWinCenter = dcmEdit.ImageWinCenter
    'dcmEdit.ImageWinWidth = dcmEdit.ImageWinWidth
    
    'dcmEdit.ToolBarVisible = True
    
    dcmEdit.ImageMeasureTextFontSize = 20
    'dcmEdit.ImagePOS = 5
    'dcmEdit.ImageZoomPct = dcmEdit.ImageZoomPct + 10
    'dcmEdit.ImageZoomPct = dcmEdit.ImageZoomPct - 10
    dcmEdit.ImageZoomBestFit = True
    
    Dim i As Long
    i = dcmEdit.ImagePOS
    
    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 - lblPatientInfo.Height
    
    Dim i As Long
    For i = 0 To Me.frmButtons.Count - 1
        Me.frmButtons(i).Top = 10
        Me.frmButtons(i).Height = Me.stabOperation.Height - 500
    Next
    
    Me.dcmEdit.Left = Me.stabOperation.Left + Me.stabOperation.Width
    Me.dcmEdit.Top = Me.frmButtons(0).Top
    dcmEdit.Width = Me.Width - stabOperation.Width
    dcmEdit.Height = Me.Height - lblPatientInfo.Height
    

    i = dcmEdit.ImagePOS
    lblPatientInfo.Top = stabOperation.Top + Me.stabOperation.Height
    lblPatientInfo.Width = Me.Width
    
    Exit Sub
ErrHandler:
    
    
End Sub




'将满意的DCM图片 加载至 frmPhotoPrint.frm界面
Private Sub LoadBmpFromDcm()
        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

'窗宽-=---窗位调整
Private Sub btnDefaultWHok_Click(Shifit As Integer)
On Error GoTo ErrHandler
    Me.dcmEdit.ImageWinWidth = CLng(Trim(txtDcmWidth.Text))
    Me.dcmEdit.ImageWinCenter = CLng(Trim(txtDcmCenter.Text))
    
    Me.frmDefaultDcmWH.Visible = False
    
    Exit Sub
ErrHandler:

End Sub


'默认窗宽，窗位
Private Sub btnDft_Click(Shifit As Integer)
    On Error GoTo ErrHandler
    txtDcmWidth.Text = CStr(nOriginalWinWidth)
    txtDcmCenter.Text = CStr(nOriginalWinCenter)
    
    Exit Sub
ErrHandler:
    
End Sub



'预设窗宽----窗位调整
Private Sub txtDcmCenter_KeyPress(KeyAscii As Integer)
    On Error GoTo ErrHandler
    If KeyAscii <> 8 And KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
        KeyAscii = 0
    End If
    
    Exit Sub
ErrHandler:
    
End Sub

Private Sub txtDcmWidth_KeyPress(KeyAscii As Integer)
    On Error GoTo ErrHandler
    If KeyAscii <> 8 And KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
        KeyAscii = 0
    End If
    
    Exit Sub
ErrHandler:
    
End Sub

'打开DCM文件
Public Function OpenDcmFile() As Boolean
On Error GoTo ErrHandler
    If Dir(strOriginalOpenFileName, vbArchive Or vbSystem Or vbReadOnly) <> "" Then
        dcmEdit.OpenFile strOriginalOpenFileName
        nOriginalWinWidth = dcmEdit.ImageWinWidth
        nOriginalWinCenter = dcmEdit.ImageWinCenter
    End If

    Exit Function
ErrHandler:
    
End Function