(c) 2002 Visual Studio Magazine 
Fawcette Technical Publications

Issue: April 2002
Section: Q&A
Author: Karl Peterson

VB5, VB6	Enable Drop-in Graphical Selection
Listing 1	This class provides a drop-in solution for allowing your users to select any rectangular region within a Picture box control. You could add elliptical selections easily by using VB's native Circle statement rather than Line, and a bit of coordinate transformation, in the delegated MouseMove event.

Option Explicit

' Member variables
Private WithEvents m_Client As PictureBox
Private m_X1 As Single, m_Y1 As Single
Private m_X2 As Single, m_Y2 As Single
Private m_Selecting As Boolean
Private m_Enabled As Boolean

' Events
Public Event Selecting()
Public Event Selected()

' ************************************************
'  Public Properties: Read/Write
' ************************************************
Public Property Set Client(ByVal obj As Object)
	' Store object reference to client.
	If TypeOf obj Is PictureBox Then
		Set m_Client = obj
	ElseIf obj Is Nothing Then
		Set m_Client = Nothing
	Else
		Err.Clear
		Err.Raise Number:=vbObjectError + 513, _
			Source:="CLasso", Description:= _
			"Client object must be a PictureBox."
	End If
End Property

Public Property Get Client() As Object
	' Return reference to client.
	Set Client = m_Client
End Property

Public Property Let Enabled(ByVal NewVal As _
	Boolean)
	m_Enabled = NewVal
End Property

Public Property Get Enabled() As Boolean
	Enabled = m_Enabled
End Property

' ************************************************
'  Public Properties: Read-Only
' ************************************************
Public Property Get X1() As Single
	X1 = m_X1
End Property

Public Property Get X2() As Single
	X2 = m_X2
End Property

Public Property Get Y1() As Single
	Y1 = m_Y1
End Property

Public Property Get Y2() As Single
	Y2 = m_Y2
End Property

' ************************************************
'  Sunken Events
' ************************************************
Private Sub m_Client_MouseDown(_
	Button As Integer, Shift As Integer, _
	X As Single, Y As Single)

	If m_Enabled Then
		' Store starting coordinates.
		m_X1 = X
		m_Y1 = Y
		m_X2 = X
		m_Y2 = Y

		' Draw initial rectangle. Will be 
		' dimensionless, but we need something to 
		' "erase" in the first MouseMove event.
		m_Selecting = True
		m_Client.Cls
		m_Client.Line (m_X1, m_Y1)-(m_X2, m_Y2), _
			, B
		' Notify client
		RaiseEvent Selecting
	End If
End Sub

Private Sub m_Client_MouseMove( _
	Button As Integer, Shift As Integer, _
	X As Single, Y As Single)

	Dim ds As Long, dm As Long

	If m_Selecting Then
		With m_Client
			' Stash drawstyle/drawmode
			ds = .DrawStyle
			dm = .DrawMode
			' Set new style/mode
			.DrawStyle = vbDot
			.DrawMode = vbNotXorPen ' vbInvert
			' Erase old rectangle
			m_Client.Line (m_X1, m_Y1)-(m_X2, _
				m_Y2), , B
			' Draw new one with new coords
			m_X2 = X
			m_Y2 = Y
			'.DrawMode = vbCopyPen
			m_Client.Line (m_X1, m_Y1)-(m_X2, _
				m_Y2), , B
			' Restore old style/mode
			.DrawStyle = ds
			.DrawMode = dm
			' Notify client
			RaiseEvent Selecting
		End With
	End If
End Sub

Private Sub m_Client_MouseUp(Button As Integer, _
	Shift As Integer, X As Single, Y As Single)
	If m_Selecting Then
		' Clear selection flag
		m_Selecting = False
		' Notify client
		RaiseEvent Selected
	End If
End Sub
