FlexGrid: Funktion für Focus-Steuerung Funktion für (optische) Focus Steuerung bei MS(H)FlexGrid
Autor:   Norbert Grimm	Bewertung:	Views:  11.499
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Das Microsoft FlexGrid-Control ist ein beliebtes Control zur Datenausgabe, da die Formatierung der einzelnen Zellen sehr flexibel ist. Allerdings vermisst man den "Focus" in der ersten Spalte.

Die Funktion XFlexNavigation_Ex wertet das Click-Ereignis des Control aus und erzeugt einen Cursor(Focus) in der 0.Spalte des FlexGrids. Die Rückgabevariablen sind "vPos", "aPos" und optional "nData". Der Rückgabewert der Funktion (Ret) ist "Null=0", bei fehlerfreier Ausführung.

in VB.Form

Private Sub MSFlexGrid1_Click()
  Dim aPos    As Long
  Dim vPos    As Long
  Dim RD      As Long
  Dim Ret     As Long
 
  With MSFlexGrid1
    If .ColWidth(0) = -1 Then .ColWidth(0) = 250
    aPos = .RowSel
    If .Tag = "" Then .Tag = 0
    vPos = .Tag
 
    Ret = HFlexNavigation_Ex(MSFlexGrid1, vPos, aPos, RD)
 
    .Tag = aPos
  End With
End Sub

Code im Modul:

' Auswerten des Click_Events eines MSHFlexGrid
' MSHFLXGD.OCX
'
' Parameter
'  Flex     : referenziertes Object
'  vPos     : vorherige CursorPosition(Focus)
'  aPos     : aktuelle  CursorPosition(Focus)
'  [nData]  : RowData (optional)
Public Function HFlexNavigation_Ex(ByRef Flex As Object, _
  ByRef vPos As Long, _
  ByRef aPos As Long, _
  Optional ByRef nData As Long) As Long
 
  Dim I       As Long
  Dim P       As Long
  Dim R       As Long
  Dim RD      As Long     ' ->RowData
  Dim RR      As Long
  Dim RS      As Long     ' ->RowSel
  Dim Ret     As Long
  Dim errMsg  As String
                          ' ->vPos=vorher   Position
                          ' ->aPos=aktuelle Position
 
  ' Fehlerroutine
  On Error GoTo Err_Navi
 
  ' ->MSHFlexGrid
  With Flex
    .Redraw = False       ' neu zeichnen=AUS
 
    RS = .RowSel
    If TypeName(Flex) = "MSFlexGrid" Then
      R = .Rows - 1
      RR = .Rows - 2
    Else
      R = .Rows
      RR = .Rows - 1
    End If
 
    If RS = R Then RS = RR
    If vPos >= RR Then vPos = RR
    .Col = 0
    If vPos = 0 Then            ' vorher Pos Cursor,Focus
      For I = 1 To RR           ' löschen alle
        .Row = I
        .Text = ""
      Next I
    Else
      .Row = vPos               ' vorher Pos Cursor,Focus
      .Text = ""                ' löschen vPos
    End If
 
    If aPos = 0 Then aPos = RS
    If aPos < RR Then P = aPos Else P = RR
    If P Then
      .Row = P
      .TopRow = P
      RD = .RowData(P)
      vPos = P
    End If
                                ' freiwählbares Zeichen
                                ' Col=0, Cursor
    .CellFontName = "Marlett"
    .CellFontBold = True
    .CellFontSize = 14
    .CellAlignment = 4
    .Text = "4"
    .Redraw = True              ' neu zeichnen=EIN
  End With
 
  nData = RD                    ' Rückgabe: RowData
 
  ' Ret : =  0, o.k.
  '     : <> 0, Fehler
 
Exit_Navi:
  HFlexNavigation_Ex = Ret
  Exit Function
 
Err_Navi:
  With Err
    Ret = .Number
    errMsg = .Description
    .Clear
  End With
  ' Test
  ' MsgBox Ret & vbCr & errMsg, vbCritical, "HFlexNavigation_Ex"
  Resume Exit_Navi
End Function

Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.

Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.