Re: DRAW around cell a rectangle with mouse move event in msflexgrid
I'm not sure why you desire such a Carmen Miranda UI esthetic, or perhaps Chinese web sites are your inspiration?
Why not focus on function and give the user value rather than try to dolly up a trivial effort?
The creaky old MSFlexGrid is also nearly always a mistake. We only had it to ease a first-cut port of old programs from VB4 or VB5 to the then-new VB6. New programs should be using the Unicode-aware and more capable MSHFlexGrid that replaced it back in 1998.
There are limits to what you can do without subclassing, which is even more difficult since neither flexgrid was ever documented to help support doing so. But here's a rough cut at what I suspect you are trying to accomplish:
Code:
Option Explicit
Private Const WIN32_NULL As Long = 0
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hWndLock As Long) As Long
Private HoverCol As Long
Private HoverRow As Long
Private Sub Form_Load()
Dim C As Long
Dim R As Long
'We'll assume that CellPicture isn't otherwise being used in this program. If it
'is then we will have to add more code.
With Picture1
.Visible = False
.BorderStyle = vbBSNone
.Appearance = 0 'Flat.
'Choose your colors, but it will be tricky to try to track the user's Windows
'UI colors appropriately here. We'll just punt and pick some:
.ForeColor = &HFFA0A0
.BackColor = &HFFF0E0
.DrawWidth = 1
End With
With MSHFlexGrid1
.Cols = 10
.Rows = 100
.ColWidth(0) = 300
'Add some dummy data:
For C = 1 To .Cols - 1
.ColWidth(C) = 420 + ScaleX(C * 5, vbPixels)
.TextMatrix(0, C) = String$(3, ChrW$(AscW("@") + C))
Next
For R = 1 To .Rows - 1
For C = 1 To .Cols - 1
.TextMatrix(R, C) = CStr(R) & ", " & CStr(C)
Next
Next
End With
End Sub
Private Sub Form_Resize()
If WindowState <> vbMinimized Then
MSHFlexGrid1.Move 0, 0, ScaleWidth, ScaleHeight
End If
End Sub
Private Sub MSHFlexGrid1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim MC As Long
Dim MR As Long
Dim SavedLC As Long
Dim SavedTR As Long
Dim SavedC As Long
Dim SavedR As Long
Dim SavedCS As Long
Dim SavedRS As Long
Dim CW As Single
Dim CH As Single
With MSHFlexGrid1
MC = .MouseCol
MR = .MouseRow
If MC <> HoverCol Or MR <> HoverRow Then
SavedLC = .LeftCol
SavedTR = .TopRow
SavedC = .Col
SavedR = .Row
SavedCS = .ColSel
SavedRS = .RowSel
If HoverCol <> 0 And HoverRow <> 0 Then
LockWindowUpdate .hWnd
.Col = HoverCol
.Row = HoverRow
Set .CellPicture = Nothing
End If
HoverCol = MC
HoverRow = MR
If MC > 0 And MR > 0 Then
LockWindowUpdate .hWnd
.Col = HoverCol
.Row = HoverRow
CW = .CellWidth
CH = .CellHeight
With Picture1
If .Width <> CW Or .Height <> CH Then
.Width = CW
.Height = CH
.AutoRedraw = True
.Cls
Picture1.Line (0, 0)- _
(.ScaleWidth - ScaleX(1, vbPixels), _
.ScaleHeight - ScaleY(1, vbPixels)), _
, _
B
.AutoRedraw = False
End If
Set MSHFlexGrid1.CellPicture = .Image
End With
End If
.Col = SavedC
.Row = SavedR
.ColSel = SavedCS
.RowSel = SavedRS
.LeftCol = SavedLC
.TopRow = SavedTR
LockWindowUpdate WIN32_NULL
End If
End With
End Sub
That uses an invisible borderless PictureBox as a quick and dirty canvas for drawing a hovered-cell backdrop image.
Re: DRAW around cell a rectangle with mouse move event in msflexgrid
I forgot that the MS(H)FlexGrid is not a container control.
I used the vsFlexGrid for such a long time and this is a container control.
So the Shape control can not be used, because it's a lightweight control.
But the MS(H)FlexGrid has also a built in focus rectangle:
Code:
Private Sub Form_Load()
With MSHFlexGrid1
.Rows = 10
.Cols = 10
.GridLines = flexGridFlat
.GridColor = RGB(127, 127, 127)
.FocusRect = flexFocusLight
End With
End Sub
Private Sub MSHFlexGrid1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
With MSHFlexGrid1
If .MouseRow >= .FixedRows And .MouseCol >= .FixedCols Then
.Row = .MouseRow: .RowSel = .MouseRow
.Col = .MouseCol: .ColSel = .MouseCol
End If
End With
End Sub