frmimageedit.frm

VB6.0编写的医院影像系统

    End If
    
    SavePicture picImage.Picture, Me.FileName
    
End Sub

Private Sub cmdSaveAs_Click()
    cdlSave.ShowSave
    If cdlSave.FileName = vbNullString Then Exit Sub
    SavePicture picImage.Image, cdlSave.FileName
End Sub

Private Sub ScaleImage()
    
    '缩放
    Dim i As Integer
    
    For i = 0 To optScale.Count - 1
        If optScale(i).Value Then ScaleRate = Val(optScale(i).Caption) / 100: Exit For
    Next i
    
    'With picImage
    With picMirror
        '.Width = OriginWidth * ScaleRate * Screen.TwipsPerPixelX
        '.Height = OriginHeight * ScaleRate * Screen.TwipsPerPixelY
        picImage.width = .width * ScaleRate
        picImage.height = .height * ScaleRate
        picImage.Picture = LoadPicture()
        picImage.Refresh
        picImage.PaintPicture picMirror.Image, 0, 0, .width / Screen.TwipsPerPixelX * ScaleRate, .height / Screen.TwipsPerPixelY * ScaleRate, 0, 0, .ScaleWidth, .ScaleHeight, vbSrcCopy
        '.Picture = .Image
        'Clipboard.SetData .Picture
        Me.Refresh
    End With
    
    '重绘图象
    Form_Resize
    
End Sub

Private Sub cmdUndo_Click()
    
    '-----------
    '恢复
    '-----------
    
    With picMirror
        .Picture = picBak.Picture
    End With
    
    ScaleImage
    
End Sub

Private Sub cmdZoom_Click()
    
    '-------------
    '开始局部察看
    '-------------
    
    Dim pt1 As POINTAPI, pt2 As POINTAPI
    
    
    Select Case True
        Case optZoom(0).Value
            ViewRate = 0.95
        Case optZoom(1).Value
            ViewRate = 2
        Case optZoom(2).Value
            ViewRate = 3.95
        Case optZoom(3).Value
            ViewRate = 8
    End Select
    
    With frmImageZoom
        FXImgDrag.Move (ShowWidth - FXImgDrag.width) / 2, (ShowHeight - FXImgDrag.height) / 2       '居中
        .Show , Me
        .Caption = "放大比例: ×" & Int(frmImageEdit.ViewRate + 0.1)
        
        '设置位置和尺寸
        pt1.x = Frame3.Left + picEdit.Left
        pt1.y = Frame3.Top + Frame3.height + picEdit.Top
        .height = cmdOpen.Top - pt1.y - 30
        .width = Frame3.width + 15
        ClientToScreen Me.hwnd, pt1
        .Move pt1.x - 15, pt1.y + 270
        
        
        '.Move Screen.width - .width - 15, Screen.height - .height - frmImageEdit.sbrEdit.height
        .FXImgView.Visible = True
        FXImgDrag.width = .FXImgView.width / ViewRate
        FXImgDrag.height = .FXImgView.height / ViewRate
        FXImgDrag.Refresh
        FXImgDrag.Visible = True
    End With
        
    'FXImgView.Visible = True
    'FXImgView.Move Me.ScaleWidth - FXImgView.Width, 0
    Call UpdateCapturedImage(FXImgDrag, Me, 0, 0, 2)
    frmImageZoom.FXImgView.Picture = FXImgDrag.Picture
    
End Sub

Private Sub Form_Load()

    CheckDog
    
    '---------------------------
    '设置位置,读取文件名
    'IniUS.LoadFormPlace Me
    '---------------------------
    
    '根据版本判断是否应该加载窗体
    If USV.AllowShowImage = False Then
        Unload Me
    End If
    
    If USV.AllowEditImage Then
        Me.Caption = "图像编辑"
    Else
        Me.Caption = "图像查看"
        picEdit.width = 0
    End If
        
    Me.WindowState = 2
    picImage.Move 0, 0
    If FileName <> vbNullString Then
        LoadImage FileName
        cmdOpen.Enabled = False
        Me.Caption = Me.Caption & " - [" & FileName & "]"
    End If
    
    NullCheck
    
End Sub

Private Sub LoadImage(strFileName As String)
    
    '-----------
    '加载图片
    '-----------
    
    With picMirror
        .BorderStyle = 0
        .Picture = LoadPicture(strFileName)
        OriginWidth = .ScaleWidth
        OriginHeight = .ScaleHeight
        sbrEdit.Panels("Info").Text = "图像尺寸: " & .ScaleWidth & " × " & .ScaleHeight
        DoEvents
    End With
    
    With picImage
        .BorderStyle = 0
        .Picture = picMirror.Picture
'        OriginWidth = .ScaleWidth
'        OriginHeight = .ScaleHeight
'        sbrEdit.Panels("Info").Text = "图像尺寸: " & .ScaleWidth & " × " & .ScaleHeight
        DoEvents
    End With
    
    optScale(5).Value = True    '重载时缩放应该为100%
    optZoom(0).Value = True     '应该恢复缺省的放大比例
    Unload frmImageZoom         '关闭放大窗口
    
    Form_Resize
    
End Sub

Private Sub ShowProgress(Mode As Boolean)

    Dim rc As RECT

    'sbrEdit.Panels("keyProgress").Visible = Mode
    
    If Mode Then
        '0 => Panel index (0 based)
        SendMessageAny sbrEdit.hwnd, SB_GETRECT, 0, rc
        With rc
            .Top = (.Top + 2) * Screen.TwipsPerPixelY
            .Left = (.Left + 1) * Screen.TwipsPerPixelX
            .Bottom = (.Bottom - 4) * Screen.TwipsPerPixelY - .Top
            .Right = (.Right - 2) * Screen.TwipsPerPixelX - .Left
        End With
    
        With pbr
            SetParent .hwnd, sbrEdit.hwnd
            .Move rc.Left, rc.Top, rc.Right, rc.Bottom
            .Visible = True
        End With
    Else
        SetParent pbr.hwnd, Me.hwnd
        pbr.Visible = False
    End If
    
End Sub

'Public Sub UpdateCapturedImage(FXImg As FXImage, frm As Form, x As Single, y As Single, ResetPos As Integer)
'
'    ' --------------------------------------------------------------
'    ' Update the viewport image with the new image in the drag image
'    ' --------------------------------------------------------------
'
'    FXImg.DeleteCapture 'Delete the captured image
'
'    Select Case ResetPos
'        Case True
'            FXImg.Move 0, 0
'        Case False
'            FXImg.Move FXImg.Left + x - (FXImg.width) / 2, FXImg.Top + y - (FXImg.height) / 2
'            'FXImg.Move x - LastX, y - LastY
'        Case 2
'    End Select
'
'    FXImg.Refresh
'    FXImg.CaptureNow 'Capture the area under the control
'    FXImg.CaptureToPicture 'Copy the captured area to the Picture property
'    'DoEvents
'
'End Sub

Private Sub Form_Resize()
    
    '---------------------
    '设置控件位置
    '---------------------
    
    If Me.WindowState = vbMinimized Then Exit Sub
    
    fraSplit.Move Me.ScaleWidth - picEdit.width, -90, fraSplit.width, Me.ScaleHeight - Me.sbrEdit.height + 90
    
    fscH.Move 0, Me.ScaleHeight - Me.sbrEdit.height - fscH.height
    fscV.Move fraSplit.Left - fscV.width, 0
    
    '如果可以容纳,则显示图片;如果不能容纳,则显示滚动条
    ShowWidth = fraSplit.Left
    ShowHeight = Me.ScaleHeight - Me.sbrEdit.height
    picConner.Move fraSplit.Left - picConner.width, Me.ScaleHeight - Me.sbrEdit.height - picConner.height
        
    With picImage
        If .width > ShowWidth Or .height > ShowHeight Then
            '根据具体位置决定,分水平/垂直/双向三种
            If .width > ShowWidth And .height <= ShowHeight Then        '水平滚动
                fscH.Visible = True
                fscV.Visible = False
                picConner.Visible = False
                fscH.width = ShowWidth
                fscH.Value = 0
                fscH.Max = (.width - ShowWidth) / 15
                fscH.LargeChange = (ShowWidth / .width) * fscH.Max
                .Move 0, (Me.ScaleHeight - Me.sbrEdit.height - .height - fscH.height) / 2

            End If
            
            If .width <= ShowWidth And .height > ShowHeight Then        '垂直滚动
                fscH.Visible = False
                fscV.Visible = True
                picConner.Visible = False
                fscV.height = ShowHeight
                fscV.Value = 0
                fscV.Max = (.height - ShowHeight) / 15
                fscV.LargeChange = (ShowHeight / .height) * fscV.Max
                .Move (fraSplit.Left - .width - fscV.width) / 2, 0
                
            End If
            
            If .width > ShowWidth And .height > ShowHeight Then         '双向滚动
                fscH.Visible = True
                fscV.Visible = True
                picConner.Visible = True
                
                ShowWidth = ShowWidth - picConner.width
                ShowHeight = ShowHeight - picConner.height
                
                fscH.width = ShowWidth
                fscH.Value = 0
                fscH.Max = (.width - ShowWidth) / 15
                fscH.LargeChange = (ShowWidth / .width) * fscH.Max
                
                fscV.height = ShowHeight
                fscV.Value = 0
                fscV.Max = (.height - ShowHeight) / 15
                fscV.LargeChange = (ShowHeight / .height) * fscV.Max
                .Move 0, 0
            End If
            
        Else
        
            '没有滚动的情况
            fscH.Visible = False
            fscV.Visible = False
            picConner.Visible = False
            .Move (fraSplit.Left - .width) / 2, (Me.ScaleHeight - Me.sbrEdit.height - .height) / 2
            
        End If
        
    End With
    
'    With picImage
'        picMirror.Move .Left, .Top, .Width, .Height
'    End With
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    '----------------------
    '存储窗体当前的位置
    '----------------------
    
    IniUS.SaveFormPlace Me
    
    Me.TagString = vbNullString
    
End Sub

Private Sub fscH_Change()
    
    '---------------------
    '点击水平滚动条
    '---------------------
    
    picImage.Left = -fscH.Value * 15
    
End Sub

Private Sub fscH_Scroll()
    
    fscH_Change
    
End Sub

Private Sub fscV_Change()
    
    '---------------------
    '点击垂直滚动条
    '---------------------
    
    picImage.Top = -fscV.Value * 15
    
End Sub

Private Sub fscV_Scroll()
    
    fscV_Change
    
End Sub

Private Sub fximgDrag_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    
    MouseDown = True
    'LastX = x
    'LastY = y
    
    '为了不让区域超出图像的范围,设置一个鼠标运动的限定区域
'    Dim rc As RECT
'    Dim pt1 As POINTAPI, pt2 As POINTAPI
'
'    pt1.x = x / 15
'    pt1.y = y / 15
'    pt2.x = (picEdit.Left + x - FXImgDrag.width) / 15
'    pt2.y = (Me.sbrEdit.Top + y - FXImgDrag.height) / 15
'    ClientToScreen Me.hwnd, pt1
'    ClientToScreen Me.hwnd, pt2
'    With rc
'        .Left = pt1.x
'        .Top = pt1.y
'        .Bottom = pt2.y
'        .Right = pt2.x
'    End With
'
'    ClipCursor rc
'    Debug.Print "ClipCursor: ", rc.Left, rc.Top, rc.Bottom, rc.Right
    
End Sub

Private Sub fximgDrag_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    
    If MouseDown Then
        Call UpdateCapturedImage(FXImgDrag, Me, x, y, False)
        frmImageZoom.FXImgView.Picture = FXImgDrag.Picture
        'frmImageZoom.FXImgView.Refresh
    End If

End Sub

Private Sub fximgDrag_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    
    MouseDown = False
'    ClipCursor 0
'    Debug.Print "Clip No"
    
End Sub


Private Sub optScale_Click(Index As Integer)
    
    '--------------------
    '缩放图像
    '--------------------
    
    ScaleImage
    
    
End Sub

Private Sub optZoom_Click(Index As Integer)
    
    If frmImageZoom.Loaded Then cmdZoom_Click
    
End Sub

Private Sub tabEdit_TabClick(ByVal NewTab As ActiveTabs.SSTab)
    
    
    'If NewTab.Caption <> "局部" Then CancelZoom
    
End Sub

Private Sub CancelZoom()
    
    '-------------
    '取消局部缩放
    '-------------
    
    FXImgDrag.Visible = False
    
End Sub