FlexGrid Editing With Blinking Cursor (Caret)

[VBClassicRocks]

We've all seen the floating textbox to edit cells. And we've
all seen the use of the FlexGrid's KeyPress event to enter and
edit text. This uses the latter method, but adds a new wrinkle,
a blinking cursor, to show the user that editing is in progress.

Option Explicit
Private Declare Function CreateCaret Lib "user32" (ByVal hwnd As Long, ByVal hBitmap As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function ShowCaret Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetCaretPos Lib "user32.dll" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Function DestroyCaret Lib "user32.dll" () As Long
Private TPx As Long, TPy As Long
Private Sub Form_Load()
 Dim r As Long, c As Long
 TPx = Screen.TwipsPerPixelX
 TPy = Screen.TwipsPerPixelY
 With Grid 'load some data
  For r = .FixedRows To .Rows - 1
   For c = .FixedCols To .Cols - 1
    .TextMatrix(r, c) = "R" & r & "C" & c
   Next
  Next
 End With
 Picture1.Visible = False 'for the textwidth
 Set Picture1.Font = Grid.Font
End Sub

Private Sub Form_Unload(Cancel As Integer)
'free gdi objects
 Grid.Clear
 DestroyCaret
End Sub
Private Sub DrawCaret()
 With Grid
  .FocusRect = flexFocusNone 'like highlighted text
  DestroyCaret 'resources
  CreateCaret .hwnd, 0&, 1&, .CellHeight \ TPy - 2 * .GridLineWidth
  SetCaretPos .CellLeft \ TPx + Picture1.TextWidth(.Text) \ TPx, .CellTop \ TPy
  ShowCaret .hwnd
 End With
End Sub
Private Sub Grid_Click()
 DrawCaret
End Sub

Private Sub Grid_EnterCell()
 DrawCaret
End Sub

Private Sub Grid_KeyPress(KeyAscii As Integer)
 With Grid
  .FocusRect = flexFocusLight
  Select Case KeyAscii
   Case 8
    If .Text <> "" Then .Text = _
      Left$(.Text, (Len(.Text) - 1))
   Case 13, 9
    Select Case .Col
     Case Is < (.Cols - 1): SendKeys "{right}"
     Case (.Cols - 1)
      If (.Row + 1) = .Rows Then .Rows = .Rows + 1
      SendKeys "{home}" + "{down}"
    End Select
   Case Else
    .Text = .Text + Chr$(KeyAscii)
  End Select
 End With
 SetCaretPos Grid.CellLeft \ TPx + Picture1.TextWidth(Grid.Text) \ TPx, Grid.CellTop \ TPy
End Sub

[afdoal]

thanks man...
u a best

[DataAnalyzer]

Thanks for the code but what's Picture1?

Is there a way to reference the cell directly for situations where it's unbound and the user can edit it?

[dilettante]

An interesting idea but not too practical.

Setting aside the problems SendKeys has on supported OSs, you have code to handle a lot of things you get for free using a marquee TextBox "floated over" the grid. And as it stands there is no select/copy/cut/paste, drag/drop, DDE, etc. etc.

I'm not sure anyone would really use it but I suppose it has its clever points.