VB-Tec.de Visual Basic - Technik, FAQ, Tricks, Beispiele

Historie
17.08.2001	Container durch Parent ersetzt, so dass ListBoxen z.B. auch in Frames liegen dürfen (Hinweis von Philipp v.Thunen); Routine unabhängig von eingestellten Fonts gemacht
24.08.2000	Automatische Spaltenanpassung
??.??.1999	Erste Version

Einführung

Möchte man in einer ListBox mehrere Spalten anzeigen (dies geht mit vbTab als Separator), so stößt man schnell auf das Problem, daß die Tabulator-Postionen fest vorgegeben sind. Allerdings kann der ListBox via API eine Nachricht geschickt werden, um beliebige Positionen einzustellen.

Nun stellt sich u.U. ein weiteres Problem: Oft weiss man gar nicht vorher, wie breit die Spalten sein müssen. Daher habe ich in der folgenden Routine eine "Automatik" eingebaut, die selbstständig alle Spalten nach den längsten Einträgen durchsucht und sich daraus die Positionen der Tabulatoren berechnet.

Beispiel

Diese Routine wird sinnvollerweise in Form_Load aufgerufen. Die Tabulator-Positionen müssen dabei in Twips angegeben werden:

Private Sub Form_Load()
  ListSetTabs lst, 1000, 3000, 4000
End Sub

Die Tabulator-Positionen können aber auch weggelassen werden, um die automatische Spaltenanpassung zu nutzen. Dann dürfen die Tabulatoren natürlich erst nach dem Füllen der ListBox gesetzt werden:

Private Sub Form_Load()
  DBFillListBox lst, "select * from tPerson"
  ListSetTabs lst
End Sub

Code / Quelltext

Folgende API-Funktion muss im Deklarationsteil bekanntgemacht werden:

Private Declare Function SendMessageA Lib "user32" ( _
    ByVal hWnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, lParam As Any) As Long

Die folgende Routine bestimmt den Modus und setzt entsprechend die Tabulator-Positionen:

Public Sub ListSetTabs( _
    ByRef lst As ListBox, ParamArray Positions())
  'Deklarationen:
  Const LB_SETTABSTOPS = &H192
  Const TwipsChar = 0.044 'Faktor Twips -> TabPos
  Dim i As Long
  Dim v As Variant
  Dim TabPos() As Long

  'Modus bestimmen:
  If UBound(Positions) < LBound(Positions) Then
    'TabStops automatisch bestimmen:
    GetTabPos lst, TabPos
  Else
    'TabStops wurden übergeben...
    If IsArray(Positions(0)) Then
      v = Positions(0) '... als Array
    Else
      v = Positions    '... als Parameterliste
    End If
    ReDim TabPos(0 To UBound(v))
    For i = 0 To UBound(v)
      TabPos(i) = v(i)
    Next i
  End If
  
  'TabStops "normieren" und setzen:
  For i = 0 To UBound(TabPos)
    TabPos(i) = CLng(TabPos(i) * TwipsChar)
  Next i
  SendMessageA _
      lst.hwnd, LB_SetTabStops, _
      UBound(TabPos) + 1, TabPos(0)
End Sub

Sind keine Tabulatoren angegeben, müssen die vorhandenen Spalten "ausgemessen" werden:

Private Sub GetTabPos( _
    ByRef lst As ListBox, ByRef MaxLen() As Long)
  'Deklarationen:
  Dim Col As Long
  Dim ColMax As Long
  Dim Row As String
  Dim Breite As Long
  Dim Value As String
  Dim iStart As Long
  Dim iEnd As Long
  Dim i As Long
  Dim FontTmp As StdFont

  ReDim MaxLen(0 To 99)
  With lst
    'Font sichern und anpassen:
    Set FontTmp = .Parent.Font
    Set .Parent.Font = .Font
  
    'Spalten analysieren:
    For i = 0 To .ListCount - 1
      'Nächstes Zeile (Element):
      Row = .List(i) & vbTab
      Col = -1
      iStart = 1
      iEnd = InStr(Row, vbTab)
      Do While iEnd
        'Nächste Spalte gefunden:
        Col = Col + 1
        Value = Mid$(Row, iStart, iEnd - iStart)
        With .Parent
          Breite = .ScaleX(.TextWidth("W" & Value), .ScaleMode, vbTwips)
        End With
        If Breite > MaxLen(Col) Then MaxLen(Col) = Breite
        iStart = iEnd + 1
        iEnd = InStr(iStart, Row, vbTab)
      Loop
      If Col > ColMax Then ColMax = Col
    Next i

    'Font restaurieren:
    Set .Parent.Font = FontTmp
  End With
  
  'Spaltenbreiten in Positionen umrechnen:
  ReDim Preserve MaxLen(0 To ColMax)
  For Col = 1 To ColMax
    MaxLen(Col) = MaxLen(Col) + MaxLen(Col - 1)
  Next Col
End Sub