2014-02-27 67 views
0

我一直在试图计算矩形的右侧,以避免鼠标移过图片框中的特定区域。能正常工作时的缩放因子是上,变焦升高后右侧变得比Picturebox的宽度小,因此我不能移动鼠标在整个Picturebox区域计算矩形的右侧和底部

(计算矩形的底部时也会发生这种情况)这是我写的代码,任何帮助将不胜感激。 PIC_SMALL_CLICK_1函数是我在做计算的地方请指教,谢谢!

Public Class Form1 
    Private selectedArea As Rectangle 
    Private loadedImage As Image 
    Private thumbnail As Image 
    Private selectionColor As Color 

    Public Sub New() 
      InitializeComponent() 
      loadedImage = My.Resources.UPsafety_e_citation_lg 

      'the zoom area in the thumbnail 
      selectedArea = New Rectangle(0, 0, 80, 60) 
      tZoom.Value = 1 

      resizePictureArea() 
      updateZoom() 
      frmMagnifier.Show() 
    End Sub 



    ''' <summary> 
    ''' Stretches out a selected zoom area of an image 
    ''' </summary> 

    Private Function ZoomImage(ByVal input As Image, ByVal zoomArea As Rectangle, ByVal sourceArea As Rectangle) As Image 
     Dim newBmp As New Bitmap(sourceArea.Width, sourceArea.Height) 

     Using g As Graphics = Graphics.FromImage(newBmp) 
      'high interpolation 
      g.InterpolationMode = InterpolationMode.HighQualityBicubic 

      g.DrawImage(input, sourceArea, zoomArea, GraphicsUnit.Pixel) 
     End Using 

     Return newBmp 
    End Function 

    ''' <summary> 
    ''' Draws the selection rectangle on an image 
    ''' </summary> 
    Private Function MarkImage(ByVal input As Image, ByVal selectedArea As Rectangle, ByVal selectColor As Color) As Image 
     Dim newImg As New Bitmap(input.Width, input.Height) 

     Using g As Graphics = Graphics.FromImage(newImg) 
      'Prevent using images internal thumbnail 
      input.RotateFlip(RotateFlipType.Rotate180FlipNone) 
      input.RotateFlip(RotateFlipType.Rotate180FlipNone) 

      g.DrawImage(input, 0, 0) 

      'Draw the selection rect 
      Using p As New Pen(Brushes.Black, 4) 
       g.DrawRectangle(p, selectedArea) 
      End Using 
     End Using 

     Return DirectCast(newImg, Image) 
    End Function 

    ''' <summary> 
    ''' Resizes an image 
    ''' </summary> 
    Private Function ResizeImage(ByVal input As Image, ByVal newSize As Size, ByVal interpolation As InterpolationMode) As Image 
     Dim newImg As New Bitmap(newSize.Width, newSize.Height) 

     Using g As Graphics = Graphics.FromImage(newImg) 
      'Prevent using images internal thumbnail 
      input.RotateFlip(RotateFlipType.Rotate180FlipNone) 
      input.RotateFlip(RotateFlipType.Rotate180FlipNone) 

      'Interpolation 
      g.InterpolationMode = interpolation 

      'Draw the image with the new dimensions 
      g.DrawImage(input, 0, 0, newSize.Width, newSize.Height) 

     End Using 

     Return DirectCast(newImg, Image) 
    End Function 


    ''' <summary> 
    ''' Calculates the opposite color of a given color. 
    ''' Source: 
    ''' </summary> 
    ''' <param name="clr"></param> 
    ''' <returns></returns> 
    Private Function CalculateOppositeColor(ByVal clr As Color) As Color 
     Return Color.FromArgb(255 - clr.R, 255 - clr.G, 255 - clr.B) 
    End Function 

    ''' <summary> 
    ''' Constricts a set of given dimensions while keeping aspect ratio. 
    ''' </summary> 
    Private Function ShrinkToDimensions(ByVal originalWidth As Integer, ByVal originalHeight As Integer, ByVal maxWidth As Integer, ByVal maxHeight As Integer) As Size 
     Dim newWidth As Integer = 0 
     Dim newHeight As Integer = 0 

     If originalWidth >= originalHeight Then 
      'Match area width to max width 
      If originalWidth <= maxWidth Then 
       newWidth = originalWidth 
       newHeight = originalHeight 
      Else 
       newWidth = maxWidth 
       newHeight = originalHeight * maxWidth \ originalWidth 
      End If 
     Else 
      'Match area height to max height 
      If originalHeight <= maxHeight Then 
       newWidth = originalWidth 
       newHeight = originalHeight 
      Else 
       newWidth = originalWidth * maxHeight \ originalHeight 
       newHeight = maxHeight 
      End If 
     End If 

     Return New Size(newWidth, newHeight) 
    End Function 

    Private Sub resizePictureArea() 
     'Create a thumbnail image (maintaining aspect ratio) 

     Dim newSize As Size = ShrinkToDimensions(loadedImage.Width, loadedImage.Height, 160, 130) 

     'use low interpolation 
     'thumbnail = ResizeImage(loadedImage, New Size(newSize.Width, newSize.Height), InterpolationMode.Low) 
     thumbnail = ResizeImage(loadedImage, New Size(400, 700), InterpolationMode.Low) 

     picSmall.Invalidate() 
    End Sub 

    Private Sub updateZoom() 
     If loadedImage IsNot Nothing Then 
      'Map the area selected in the thumbail to the actual image size 
      Dim zoomArea As New Rectangle() 
      zoomArea.X = selectedArea.X * loadedImage.Width/thumbnail.Width 
      zoomArea.Y = selectedArea.Y * loadedImage.Height/thumbnail.Height 
      zoomArea.Width = selectedArea.Width * loadedImage.Width/thumbnail.Width 
      zoomArea.Height = selectedArea.Height * loadedImage.Height/thumbnail.Height 

      'Adjust the selected area to the current zoom value 
      zoomArea.Width /= tZoom.Value 
      zoomArea.Height /= tZoom.Value 

      frmMagnifier.picZoom.Image = ZoomImage(loadedImage, zoomArea, frmMagnifier.picZoom.ClientRectangle) 
      frmMagnifier.picZoom.Refresh() 
     End If 
    End Sub 


    Private Sub tZoom_Scroll(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tZoom.Scroll 
     updateZoom() 
    End Sub 

    Private Sub picSmall_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles picSmall.Click 
     'Update the selected area when the user clicks on the thumbnail 
     Dim mouseLoc As Point = picSmall.PointToClient(Cursor.Position) 

     selectedArea.X = mouseLoc.X - ((selectedArea.Width/tZoom.Value)/2) 
     selectedArea.Y = mouseLoc.Y - ((selectedArea.Height/tZoom.Value)/2) 

     'Bound the box to the picture area bounds 
     If selectedArea.Left < 0 Then 
      selectedArea.X = 0 
     ElseIf selectedArea.Right > picSmall.Width Then 
      selectedArea.X = picSmall.Width - selectedArea.Width - 1 
     End If 

     If selectedArea.Top < 0 Then 
      selectedArea.Y = 0 
     ElseIf selectedArea.Bottom > picSmall.Height Then 
      selectedArea.Y = picSmall.Height - selectedArea.Height - 1 
     End If 

     picSmall.Invalidate() 
     updateZoom() 
    End Sub 

    Private Sub picSmall_Paint_1(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles picSmall.Paint 
     If loadedImage IsNot Nothing Then 
      'Adjust the selected area to reflect the zoom value 
      Dim adjustedArea As New Rectangle() 
      adjustedArea.X = selectedArea.X 
      adjustedArea.Y = selectedArea.Y 
      adjustedArea.Width = selectedArea.Width/tZoom.Value 
      adjustedArea.Height = selectedArea.Height/tZoom.Value 

      'Draw the selected area on the thumbnail 
      picSmall.Image = MarkImage(thumbnail, adjustedArea, selectionColor) 
     End If 
    End Sub 
End Class 

回答

0

好了,所以最后我能解决这个问题,我将发布的情况下,有一个 灵魂通过同样的痛苦我去的代码。 基本上,我能够找到通过执行不同的 计算

Private Sub picSmall_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles picSmall.Click 
     'Update the selected area when the user clicks on the thumbnail 
     Dim mouseLoc As Point = picSmall.PointToClient(Cursor.Position) 

     'These are the new calculations. that set bound limit for right and bottom 
     Dim RightLimit as Single = picSmall.Width - SelectedArea.Width/tZoom.Value 
     Dim BottomLimit as Single = picSmall.Height - SelectedArea.Height/tZoom.value 

     selectedArea.X = mouseLoc.X - ((selectedArea.Width/tZoom.Value)/2) 
     selectedArea.Y = mouseLoc.Y - ((selectedArea.Height/tZoom.Value)/2) 

     'Bound the box to the picture area bounds 
     If selectedArea.X < 0 Then 
      selectedArea.X = 0 
     ElseIf selectedArea.X > RightLimit Then 
      selectedArea.X = RightLimit 
     End If 

     If selectedArea.Y < 0 Then 
      selectedArea.Y = 0 
     ElseIf selectedArea.Y > BottomLimit Then 
      selectedArea.Y = BottomLimit 
     End If 

     picSmall.Invalidate() 
     updateZoom() 
    End Sub 
右侧和底部极限
相关问题