Страница: 1
Вопрос: Как выделить прорисовать выделение на форме
Добавлено: 18.02.14 12:27
Автор вопроса: Cramper
Такая проблема. На форме программно нарисовано что-то, например геометрические фигуры. Нужно очертить, выделить мышкой на форме какую-то прямоугольную область, не искажая рисунка.
Ответить
Номер ответа: 1Автор ответа: Дмитрий Юпатов Вопросов: 4Ответов: 457
Web-сайт: cargomaster.at.ua/ Профиль | | #1
Добавлено: 16.06.14 09:49
Создаем класс:
Public Class RubberBand
Public Enum RubberBandStyle
DashedLine
ThickLine
SolidBox
SolidBoxWithDashedLine
End Enum
Public Enum RubberBandState
Inactive
FirstTime
Active
End Enum
Private BasePoint As Point
Private ExtentPoint As Point
Private CurrentState As RubberBandState
Private BaseControl As Control
Public Style As RubberBandStyle
Public BackColor As Color
Public Sub New (ByVal useControl As Control, _
Optional ByVal useStyle As RubberBandStyle = _
RubberBandStyle.DashedLine)
BaseControl = useControl
Style = useStyle
BackColor = Color.Black
End Sub
Public Sub New (ByVal useControl As Control, ByVal useStyle As RubberBandStyle, ByVal useColor As Color)
BaseControl = useControl
Style = useStyle
BackColor = useColor
End Sub
Public ReadOnly Property Rectangle() As Rectangle
Get
Dim result As Rectangle
result.X = IIf(BasePoint.X < ExtentPoint.X, _
BasePoint.X, ExtentPoint.X)
result.Y = IIf(BasePoint.Y < ExtentPoint.Y, _
BasePoint.Y, ExtentPoint.Y)
result.Width = Math.Abs(ExtentPoint.X - BasePoint.X)
result.Height = Math.Abs(ExtentPoint.Y - BasePoint.Y)
Return result
End Get
End Property
Public Sub Start(ByVal x As Integer , ByVal y As Integer )
BasePoint.X = x
BasePoint.Y = y
ExtentPoint.X = x
ExtentPoint.Y = y
Normalize(BasePoint)
CurrentState = RubberBandState.FirstTime
End Sub
Public Sub Stretch(ByVal x As Integer , ByVal y As Integer )
Dim newPoint As Point
newPoint.X = x
newPoint.Y = y
Normalize(newPoint)
Select Case CurrentState
Case RubberBandState.Inactive
Return
Case RubberBandState.FirstTime
ExtentPoint = newPoint
DrawTheRectangle()
CurrentState = RubberBandState.Active
Case RubberBandState.Active
DrawTheRectangle()
ExtentPoint = newPoint
DrawTheRectangle()
End Select
End Sub
Public Sub Finish()
DrawTheRectangle()
CurrentState = 0
End Sub
Private Sub Normalize(ByRef whichPoint As Point)
If (whichPoint.X < 0) Then whichPoint.X = 0
If (whichPoint.X >= BaseControl.ClientSize.Width) Then whichPoint.X = BaseControl.ClientSize.Width - 1
If (whichPoint.Y < 0) Then whichPoint.Y = 0
If (whichPoint.Y >= BaseControl.ClientSize.Height) Then whichPoint.Y = BaseControl.ClientSize.Height - 1
End Sub
Private Sub DrawTheRectangle()
Dim drawArea As Rectangle
Dim screenStart, screenEnd As Point
screenStart = BaseControl.PointToScreen(BasePoint)
screenEnd = BaseControl.PointToScreen(ExtentPoint)
drawArea.X = screenStart.X
drawArea.Y = screenStart.Y
drawArea.Width = (screenEnd.X - screenStart.X)
drawArea.Height = (screenEnd.Y - screenStart.Y)
Select Case Style
Case RubberBandStyle.DashedLine
ControlPaint.DrawReversibleFrame( _
drawArea, BackColor, FrameStyle.Dashed)
Case RubberBandStyle.ThickLine
ControlPaint.DrawReversibleFrame( _
drawArea, BackColor, FrameStyle.Thick)
Case RubberBandStyle.SolidBox
ControlPaint.FillReversibleRectangle( _
drawArea, BackColor)
Case RubberBandStyle.SolidBoxWithDashedLine
ControlPaint.FillReversibleRectangle( _
drawArea, BackColor)
ControlPaint.DrawReversibleFrame( _
drawArea, Color.Black, FrameStyle.Dashed)
End Select
End Sub
End Class Friend SelectionArea As RubberBandSelectionArea = New RubberBand(Me .Poligon, RubberBand.RubberBandStyle.DashedLine, Color.FromArgb(255, 0, 255)) SelectionArea.Start(e.X, e.Y) If e.Button = Windows.Forms.MouseButtons.Left Then
SelectionArea.Stretch(e.X, e.Y)
End If Ответить
Страница: 1
Поиск по форуму
Cramper
Дмитрий Юпатов