Option Explicit
' Win32 API Declarations:
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private Const R2_XORPEN = 7
Private Const PS_DOT = 2
Private Const PS_DASHDOT = 3
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long
Private Declare Function Polyline Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
' Custom structure to hold information about a user's selection
Private Type SelectionType
Col As Long ' ColumnIndex of first selected column
Row As Long ' RowIndex of first selected row
Columns As Long ' Number of Columns in the selection
Rows As Long ' Number of Rows in the selection
AnimationIndex As Long ' Arbitrary value to indicate some kind of animation index
Active As Boolean ' Is the selection currently active
End Type
' Current selection information
Private m_selection As SelectionType
Private Sub Form_Load()
' Configure the FlexGrid and Timer, then clear the selection variable
With MSFlexGrid1
.Cols = 20
.Rows = 20
.FixedCols = 1
.FixedRows = 1
.BackColorSel = vbHighlight
.FocusRect = flexFocusHeavy
End With
Timer1.Interval = 200
ClearSelection
End Sub
Private Sub MSFlexGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
' Capture a user's keypress in the FlexGrid
Select Case KeyCode
Case vbKeyC And ((Shift And vbCtrlMask) = vbCtrlMask)
' Select a cell/cells using CTRL+C
SelectCurrentCells
Case vbKeyUp, vbKeyDown, vbKeyLeft, vbKeyRight, _
vbKeyMenu, vbKeyControl, vbKeyShift, vbKeyCapital, vbKeyTab, _
vbKeyPageUp, vbKeyPageDown, vbKeyEnd, vbKeyHome
' Do nothing special when using navigational/special keys
Case Else
' Any other key clears the current selection
ClearSelection
End Select
End Sub
Private Sub SelectCurrentCells()
' Mark the currently highlighted cells as "Selected"
With MSFlexGrid1
' Get the Left-most Column in the selection
m_selection.Col = IIf(.Col < .ColSel, .Col, .ColSel)
' Calculate the number of columns in the selection
m_selection.Columns = IIf(.Col > .ColSel, .Col, .ColSel) - m_selection.Col + 1
' Get the Top-most Row in the selection
m_selection.Row = IIf(.Row < .RowSel, .Row, .RowSel)
' Calculate the number of rows in the sleection
m_selection.Rows = IIf(.Row > .RowSel, .Row, .RowSel) - m_selection.Row + 1
' Activate the selection - which will cause the Timer to draw/animate it
m_selection.Active = True
End With
End Sub
Private Sub ClearSelection()
' Deactivate the current selection - stops the timer drawing/animating it
m_selection.Active = False
' Refresh the grid to remove any remaining image
MSFlexGrid1.Refresh
End Sub
Private Sub DrawSelectionRect(ByRef selection As SelectionType)
' Draw the current selection rectangle
Dim tRECT As RECT
Dim lDC As Long
Dim lPen As Long
Dim lOldPen As Long
Dim tPoints(1 To 5) As POINTAPI
Dim lOldMixMode As Long
Dim lIndex As Long
Dim lRegion As Long
With MSFlexGrid1
' Redraw the grid
.Refresh
' Get the Device Context of the Grid
lDC = GetWindowDC(.hwnd)
' Get the client rectangle of the FlexGrid
Call GetClientRect(.hwnd, tRECT)
' Now push in the Top and Left sides to exclude any Fixed Rows/Columns
' So that when we draw the selection box, it won't draw over anything
' it shouldn't
For lIndex = 0 To .FixedCols - 1
tRECT.Left = tRECT.Left + (.ColWidth(lIndex) / Screen.TwipsPerPixelX)
Next
For lIndex = 0 To .FixedRows - 1
tRECT.Top = tRECT.Top + (.RowHeight(lIndex) / Screen.TwipsPerPixelY)
Next
' Create a Region using this new Client Rect
lRegion = CreateRectRgn(tRECT.Left + 2, tRECT.Top + 2, tRECT.Right + 2, tRECT.Bottom + 2)
' Set the new region as the Clipping Region (anything outside the region won't be drawn)
Call SelectClipRgn(lDC, lRegion)
' Create a Rectangle using the Coord's of the selected cells in the grid
tRECT.Left = _
(.ColPos(selection.Col) / Screen.TwipsPerPixelX) + 2
tRECT.Top = _
(.RowPos(selection.Row) / Screen.TwipsPerPixelY) + 2
tRECT.Right = _
((.ColPos(selection.Col + selection.Columns - 1) + _
.ColWidth(selection.Col + selection.Columns - 1)) / _
Screen.TwipsPerPixelX) + 2
tRECT.Bottom = _
((.RowPos(selection.Row + selection.Rows - 1) + _
.RowHeight(selection.Row + selection.Rows - 1)) / _
Screen.TwipsPerPixelY) + 2
' Get the current mix mode of the device context,
' while changing it to XOR, so that anything we draw
' is XOR'd with the underlying pixels
lOldMixMode = SetROP2(lDC, R2_XORPEN)
' Convert the rectangle into an array of POINT structures
' So that we can draw an outline of the rectangle
tPoints(1).x = tRECT.Left
tPoints(1).y = tRECT.Top
tPoints(2).x = tRECT.Right
tPoints(2).y = tRECT.Top
tPoints(3).x = tRECT.Right
tPoints(3).y = tRECT.Bottom
tPoints(4).x = tRECT.Left
tPoints(4).y = tRECT.Bottom
tPoints(5).x = tRECT.Left
tPoints(5).y = tRECT.Top
' Perform some rudamentry animation...
Select Case selection.AnimationIndex
Case 0
' If the Index is Zero, use a DOT pen (......)
lPen = CreatePen(PS_DOT, 1, vbBlack)
Case Else
' If the Index is One, use a DOT/DASH pen (._._._._.)
lPen = CreatePen(PS_DASHDOT, 1, vbBlack)
End Select
' Create the pen, storing the old one
lOldPen = SelectObject(lDC, lPen)
' Draw the rectangle outline
Polyline lDC, tPoints(1), 5
' Reset the clipping region
Call SelectClipRgn(lDC, 0)
DeleteObject lRegion
' Restore the old mix-mode
Call SetROP2(lDC, lOldMixMode)
' Restore the old pen
SelectObject lDC, lOldPen
' Delete the pen we created
DeleteObject lPen
' Release the Device Context handle we obtained
ReleaseDC .hwnd, lDC
End With
End Sub
Private Sub Timer1_Timer()
' Animate the selection...
Static bOn As Boolean
' Only animate the selection if it's active
If m_selection.Active Then
' Toggle the "bOn" flag
bOn = Not bOn
' If "On", set the AnimationIndex to 1 (DOT/DASH pen)
' Otherwise, set the AnimationIndex to 0 (DOT pen)
m_selection.AnimationIndex = IIf(bOn, 1, 0)
' Draw the selection on the FlexGrid
DrawSelectionRect m_selection
End If
End Sub
