Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0749: ListBox - Modul und Demo

 von 

Beschreibung 

Haben Sie sich auch schon immer über die fehlende Such-Funktion der Listbox geärgert und darüber dass nur bis zu 32767 Einträge möglich sind? Dafür gibt es folgende Lösung: Ein kompaktes BAS-Modul stellt diese Funktionalität für eigene Anwendungen bereit.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

SendMessageA (SendMessage)

Download:

Download des Beispielprojektes [148,29 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'--------- Anfang Projektdatei ListBox im Griff.vbp ---------
' Die Komponente 'Microsoft Windows Common Controls 6.0 (SP6) (MSCOMCTL.OCX)' wird benötigt.

'------- Anfang Formular "frmMain" alias frmMain.frm  -------
' Steuerelement: Fortschrittsanzeige "ProgressBar1"
' Steuerelement: Statusbar "StatusBar1"
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Rahmensteuerelement "Frame1" auf Picture1
' Steuerelement: Kontrollkästchen-Steuerelement "chkAutoSelect" auf Frame1
' Steuerelement: Anzeige-Steuerelement "cmdQuit" auf Picture1
' Steuerelement: Anzeige-Steuerelement "cmdInfo" auf Picture1
' Steuerelement: Anzeige-Steuerelement "cmdClearList" auf Picture1
' Steuerelement: Anzeige-Steuerelement "cmdFillList" auf Picture1
' Steuerelement: Rahmensteuerelement "frameListBox"
' Steuerelement: Textfeld "txtSuchstring" auf frameListBox
' Steuerelement: Listen-Steuerelement "List1" auf frameListBox
' Steuerelement: Anzeige-Steuerelement "cmdSuche2" auf frameListBox
' Steuerelement: Anzeige-Steuerelement "cmdSuche" auf frameListBox
' Steuerelement: Beschriftungsfeld "lblListText" auf frameListBox
' Steuerelement: Beschriftungsfeld "Label3" auf frameListBox
' Steuerelement: Beschriftungsfeld "lblIndexNr" auf frameListBox
' Steuerelement: Beschriftungsfeld "Label2" auf frameListBox
' Steuerelement: Beschriftungsfeld "Label1" auf frameListBox
' Steuerelement: Menü "mnuListeBearbeiten"
' Steuerelement: Menü "mnuListAppendItem" auf mnuListeBearbeiten
' Steuerelement: Menü "mnuListItemInsert" auf mnuListeBearbeiten
' Steuerelement: Menü "mnuListLine1" auf mnuListeBearbeiten
' Steuerelement: Menü "mnuListItemDelete" auf mnuListeBearbeiten

' Author:       M. Ruhwald
' Erstellt:     01.12.2007 (20:55)
' Geändert:     04.12.2007 (17:58)
' Beschreibung:

' Hauptform zu VB-Tipp

' Dieses kleine Demo, geschrieben als

'   Tipp für ArchiveVB.de

' zeigt die Funktionsweise auf, wie die Index-Grenze
' von 32767 Listen-Einträgen überschritten werden kann.

Option Explicit

Private Sub chkAutoSelect_Click()

    If chkAutoSelect Then
            
            ' AutoSelect aktiviert
            txtSuchstring.BackColor = vbGreen
            'txtSuchstring.ForeColor = vbWhite
            StatusBar1.Panels(2).Text = "Automatische Textselektion bei Texteingabe eingeschaltet!"
            txtSuchstring.SetFocus
        
        Else
        
            txtSuchstring.BackColor = vbWhite
            'txtSuchstring.ForeColor = vbBlack
            StatusBar1.Panels(2).Text = "Automatische Textselektion bei Texteingabe ausgeschaltet!"
    
    End If
    
End Sub

Private Sub cmdClearList_Click()
    
    ' List1 löschen
    List1.Clear
    frameListBox.Caption = "Einträge: 0"
    StatusBar1.Panels(1).Text = "Einträge: 0"
    StatusBar1.Panels(2).Text = "Liste wurde gelöscht!"
        
End Sub

Private Sub cmdFillList_Click()
    
    ' Liste mit KFZ-Kennzeichen füllen füllen
    
    Const MaxItem As Long = 50000
    Const Buchstaben = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    Const Zahlen = "0123456789"
    
    Dim i As Long
    Dim Kennzeichen As String
    Dim tmp As String
    Dim Ziffer As Integer
    
    ' List1 füllen mit zufälligen Zahlen zwischen 1 und 100.000
    
    StatusBar1.Panels(2).Text = "Listenfeld wird gefüllt. Bitte warten ..."
    
    With ProgressBar1
        .Max = MaxItem
        .Value = 0
        .Visible = True
    End With
    
    List1.Clear
    Randomize Timer
    
    List1.Enabled = False
    
    DoEvents
    
    For i = 1 To MaxItem
        
        Kennzeichen = ""
        
ErstesZeichen:
        tmp = Mid$(Buchstaben, Int(Rnd() * Len(Buchstaben) + 1), 1)
        Kennzeichen = tmp
ZweitesZeichen:
        tmp = Mid$(Buchstaben, Int(Rnd() * Len(Buchstaben) + 1), 1)
        Kennzeichen = Kennzeichen & tmp & "-"
DrittesZeichen:
        tmp = Mid$(Buchstaben, Int(Rnd() * Len(Buchstaben) + 1), 1)
        Kennzeichen = Kennzeichen & tmp
ViertesZeichen:
        tmp = Mid$(Buchstaben, Int(Rnd() * Len(Buchstaben) + 1), 1)
        Kennzeichen = Kennzeichen & tmp & " "

Ziffern:
        For Ziffer = 1 To 4
            tmp = Mid$(Zahlen, Int(Rnd() * Len(Zahlen) + 1), 1)
            Kennzeichen = Kennzeichen & tmp
        Next

        List1.AddItem Kennzeichen
        
        frameListBox.Caption = "Einträge: " & i & " "
        ProgressBar1.Value = i
        
        If i Mod 10000 = 0 Then DoEvents
        
    Next i

    ' Anzeigen aktualisieren
    StatusBar1.Panels(1).Text = "Einträge: " & LBGetListCount(List1)
    StatusBar1.Panels(2).Text = ""
    ProgressBar1.Visible = False
    List1.Enabled = True
    
End Sub

Private Sub cmdInfo_Click()

    ' Info anzeigen
    frmHinweis.Show vbModal
    
End Sub

Private Sub cmdQuit_Click()

    ' Programm beenden
    Unload Me
    
End Sub

Private Sub cmdSuche_Click()

    ' Suche exakte Übereinstimmung
    
    Dim ListIndex As Long
    
    ' Eintrag suchen
    ListIndex = LBFindExactItem(List1, 0, txtSuchstring.Text)
    
    If ListIndex = -1 Then  ' keine Übereinstimmung
    
            MsgBox "Keine Übereinstimmung gefunden!", vbExclamation
        
        Else    ' Übereinstimmung gefunden
        
            If MsgBox("Eintrag bei Index: " & ListIndex & " gefunden!" & vbCrLf & vbCrLf & _
                       "Soll der Eintrag markiert werden?", vbQuestion Or vbYesNo) = vbYes Then
                
                ' Eintrag in List1 Markieren
                Call LBSetListIndex(List1, ListIndex)
            
                ' wenn kein Click-Ereignis gewünscht,
                ' dann die folgende Zeile remmen!
                List1_Click
            
            End If
    
    End If
    
End Sub

Private Sub cmdSuche2_Click()
    ' Suche ohne exakte Übereinstimmung
    
    Dim ListIndex As Long
    
    ' Eintrag suchen
    ListIndex = LBFindItem(List1, 0, txtSuchstring)
    
    If ListIndex = -1 Then
            
            MsgBox "Keine Übereinstimmung gefunden!", vbExclamation
            StatusBar1.Panels(1).Text = "Keine Übereinstimmung gefunden!"
            
        Else
            
            StatusBar1.Panels(2).Text = "Übereinstimmung bei Index: " & ListIndex
            
            If MsgBox("Eintrag wurde bei Index: " & ListIndex & " gefunden!" & vbCrLf & _
                vbCrLf & "Soll der Eintrag markiert werden?", vbQuestion Or vbYesNo) = vbYes Then
                
                ' Eintrag markieren
                Call LBSetListIndex(List1, ListIndex)
                
            End If
    
    End If
    
End Sub

Private Sub Form_Load()
    
    Me.Show
    
    lblIndexNr.Caption = "-"
    lblListText.Caption = "-"
    
    ' Liste gleich füllen
    cmdFillList_Click
    Form_Resize
    
    mnuListeBearbeiten.Visible = False ' Popup für Liste unsichtbar machen
    Set ProgressBar1.Container = StatusBar1.Container
    ProgressBar1.Visible = False
    
End Sub

Private Sub Form_Resize()
    
    Dim X As Single, Y As Single
    Dim w As Single, h As Single
    Dim dx As Single, dy As Single
    
    
    If Me.Width < 7940 Then Exit Sub
    If Me.Height < 5070 Then Exit Sub
    
    ' frameListBox positionieren
    
    With frameListBox
        dx = .Left
        dy = .Top
        .Height = Me.ScaleHeight - (dy * 2) - StatusBar1.Height
    End With
    
    With Picture1
        .Left = Me.ScaleWidth - .Width - dx
    End With
    
    With Label1
        .Top = frameListBox.Height - .Height - Screen.TwipsPerPixelX * 20
    End With
    
    With txtSuchstring
        .Top = Label1.Top - Screen.TwipsPerPixelY * 5
    End With
    
    With cmdSuche
        .Top = txtSuchstring.Top
    End With
    
    With cmdSuche2
        .Top = cmdSuche.Top
    End With
    
    With List1
        dy = .Top
        dx = .Left
        .Height = frameListBox.Height - 2.5 * dy
        .Width = frameListBox.Width - 2 * dx
    End With
    
    ' Progressbar positionieren
    With ProgressBar1
        '.Value = 100
        .Top = Me.ScaleHeight - StatusBar1.Height + Screen.TwipsPerPixelY * 3
        .Left = StatusBar1.Panels(1).Left
        .Height = StatusBar1.Height - Screen.TwipsPerPixelY * 4
        .Width = StatusBar1.Panels(1).Width
    End With

End Sub

Private Sub List1_Click()
    
    ' aktueller Index ermitteln
    lblIndexNr.Caption = LBGetListIndex(List1)
    
    ' ListBox-Text ermitteln
    lblListText.Caption = List1 ' nicht List1.List(...) verwenden
    
End Sub

Private Sub List1_DblClick()

    ' Eintrag bearbeiten
    
    Dim Text As String
    Dim NewText As String
    Dim ListIndex As Long
    
    ListIndex = LBGetListIndex(List1)
    Text = LBGetItemText(List1, ListIndex)
    
    NewText = InputBox("Kennzeichen bearbeiten", "Eintrag bearbeiten", Text)
    
    If NewText > "" Then
        LBSetItemText List1, ListIndex, NewText
    End If

End Sub

Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    ' Kontext-Menü List1 einblenden
    
    If (List1.SelCount = 0) And (Button = 2) Then
        
            ' nur zulässige Funktionen zulassen
            mnuListItemDelete.Enabled = False
            mnuListItemInsert.Enabled = False
            Me.mnuListAppendItem.Enabled = True
            PopupMenu mnuListeBearbeiten
        
        ElseIf (List1.SelCount > 0) And (Button = 2) Then
        
            ' nur zulässige Funktionen zulassen
            Me.mnuListAppendItem = True
            Me.mnuListItemDelete = True
            Me.mnuListItemInsert = True
            PopupMenu mnuListeBearbeiten
        
    End If
    
End Sub

Private Sub mnuListAppendItem_Click()

    ' Listen-Eintrag Anhängen
    
    Dim ListIndex As Long
    Dim ItemText As String
    
    ' Text-Eingabe
    ItemText = InputBox("Die folgende Eingabe wird am Schluss der Liste angehängt:", _
        "Eintrag Anhängen")
    
    If ItemText > "" Then   ' Eingabe gemacht?
        
        ' Eintrag anhängen
        ListIndex = LBAppendItem(List1, ItemText)
        
        ' Eintrag gleich markieren (ohne Click)
        LBSetListIndex List1, ListIndex
        
        ' Click auslösen
        List1_Click
        
    End If
    
End Sub

Private Sub mnuListItemDelete_Click()

    ' Listen-Eintrag löschen (Kontext-Menü)
    
    Dim ListIndex As Long
    Dim ListCount As Long
    Dim ListText As String
    
    ' aktuellen Listen-Index ermitteln
    ListIndex = LBGetListIndex(List1)
    
    ' Ist Eintag markiert?
    If ListIndex >= 0 Then
        
        ' bei gültigem ListIndex Löschen Bestätigen
        
        ' Text des Listen-Eintrags ermitteln
        ListText = LBGetItemText(List1, ListIndex)
        
        If MsgBox("Möchten Sie den Eintrag '" & ListText & "' wirklich löschen?", _
            vbCritical Or vbOKCancel, "Listen-Eintrag löschen") = vbOK Then
            
            ' Eintrag löschen
            ListCount = LBDeleteItem(List1, ListIndex)
            If ListCount = -1 Then
                
                    ' Eintrag wurde nicht gelöscht
                    StatusBar1.Panels(2).Text = "Eintrag nicht gelöscht!"
                    MsgBox StatusBar1.Panels(2).Text
                
                Else
                
                    StatusBar1.Panels(1).Text = "Einträge: " & ListCount
                    frameListBox.Caption = "Einträge: " & ListCount
                
            End If
        End If
    
    End If
    
End Sub

Private Sub mnuListItemInsert_Click()
    
    ' Einen Eintrag einfügen
    
    Dim InsertText As String
    Dim ListIndex As Long
    
    ' aktuelle Position ermitteln
    ListIndex = LBGetListIndex(List1)
    
    ' Text-Eingabe
    
    InsertText = InputBox("An die markierte Position in der Liste wird der " & _
        "folgende Text eingefügt:", "Eintrag Einfügen")
    
    If InsertText > "" Then     ' Eintrag gemacht?
        
        ' Text in Liste einfügen
        LBInsertItem List1, ListIndex, InsertText
        
        ' Eingefügter Text selektieren (ohne Click)
        Call LBSetListIndex(List1, ListIndex)
        
    End If
    
End Sub

Private Sub txtSuchstring_Change()

    ' Automatische Textsuche, wenn AutoSelect=True

    Dim ListIndex As Long
    
    If txtSuchstring = "" Then Exit Sub
    
    If Me.chkAutoSelect = 1 Then
        
        ListIndex = LBSelectListItem(List1, 0, txtSuchstring.Text)
        Call LBSetListIndex(List1, ListIndex)
        
        If ListIndex >= 0 Then
            
                StatusBar1.Panels(2).Text = "Übereinstimmung gefunden bei Index: " & ListIndex
                txtSuchstring.BackColor = vbGreen
                
            Else
            
                StatusBar1.Panels(2).Text = "Keine Übereinstimmung!"
                txtSuchstring.BackColor = vbRed
                
        End If
        
        List1_Click
        
    End If
End Sub

Private Sub txtSuchstring_KeyPress(KeyAscii As Integer)
    
    ' nur Zeichen für KFZ-Kennzeichen zulassen
    Select Case KeyAscii
        Case 97 To 122
            KeyAscii = KeyAscii - 32
        Case Asc(" "), Asc("-"), Is < 32, 48 To 57
            ' zulassen
        Case Else
            KeyAscii = 0
    End Select
    'Debug.Print KeyAscii
End Sub
'-------- Ende Formular "frmMain" alias frmMain.frm  --------
'------ Anfang Modul "modListBox" alias modListBox.bas ------

' Author:       M. Ruhwald
' Erstellt:     01.12.2007 (20:55)
' Geändert:     04.12.2007 (17:57)
' Beschreibung:

' Funktions-Modul für LISTBOX-Controls
' ------------------------------------

' ListBox-Controls in VB6 können nur bis
' zu 32767 Einträge verarbeiten (Integer).
' Versucht man Index-Werte (ListIndex) oberhalb
' dieser Grenze zu verwenden, gibt es Laufzeitfehler.
'
' Dieses Manko kann umgangen werden, wenn dieses Modul
' verwendet wird. Es erlaubt eine Index-Grende vom Typ Long.
' Somit ist es möglich, die Anzahl der Listen-Einträge
' auf eine Million und mehr zu erhöhen.

Option Explicit

' ***********************************************
' *             API-Deklaration                 *
' ***********************************************

' Messages für ListBox
Private Const LB_FINDSTRING As Long = &H18F
Private Const LB_FINDSTRINGEXACT As Long = &H1A2
Private Const LB_SELECTSTRING As Long = &H18C
Private Const LB_GETCURSEL As Long = &H188
Private Const LB_SETCURSEL As Long = &H186
Private Const LB_GETTEXTLEN As Long = &H18A
Private Const LB_GETTEXT As Long = &H189
Private Const LB_GETCOUNT As Long = &H18B
Private Const LB_DELETESTRING As Long = &H182
Private Const LB_ADDFILE As Long = &H196
Private Const LB_ADDSTRING As Long = &H180
Private Const LB_CTLCODE As Long = 0&
Private Const LB_DIR As Long = &H18D
Private Const LB_GETHORIZONTALEXTENT As Long = &H193
Private Const LB_GETITEMDATA As Long = &H199
Private Const LB_GETITEMHEIGHT As Long = &H1A1
Private Const LB_GETITEMRECT As Long = &H198
Private Const LB_GETLOCALE As Long = &H1A6
Private Const LB_GETSEL As Long = &H187
Private Const LB_GETSELCOUNT As Long = &H190
Private Const LB_ITEMFROMPOINT As Long = &H1A9
'Private Const LB_Okay As Long = 0
Private Const LB_SELITEMRANGE As Long = &H19B
Private Const LB_SELITEMRANGEEX As Long = &H183
Private Const LB_SETTABSTOPS As Long = &H192
Private Const LB_SETTOPINDEX As Long = &H197
Private Const LB_SETITEMHEIGHT As Long = &H1A0
Private Const LB_INSERTSTRING As Long = &H181
Private Const LB_SETITEMDATA As Long = &H19A

Private Type POINTAPI
    X As Long
    Y As Long
End Type


Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
     ByVal hwnd As Long, _
     ByVal wMsg As Long, _
     ByVal wParam As Long, _
     ByRef lParam As Any) As Long



' ***********************************************
' *     Benutzer-Funktionen ListBox-Control     *
' ***********************************************


' Sucht String in ListBox, gibt Index zurück
' wenn Übereinstimmung gefunden, sonst -1
' Der Eintrag wird Markiert
Public Function LBSelectListItem(Obj As ListBox, StartIndex As Long, FindString As String) As Long
    LBSelectListItem = SendMessage(Obj.hwnd, LB_SELECTSTRING, 0, ByVal FindString)
End Function

' Sucht exakten String in ListBox, gibt Index bei
' Übereinstimmung zurück, sonst -1
' Der Eintrag wird nicht markiert
Public Function LBFindExactItem(Obj As ListBox, StartIndex As Long, FindString As String) As Long
    LBFindExactItem = SendMessage(Obj.hwnd, LB_FINDSTRINGEXACT, StartIndex, ByVal FindString)
End Function

' Sucht (nicht exakten) String in ListBox, gibt Index bei
' Übereinstimmung zurück, sonst -1
' Der Eintrag wird nicht Markiert
Public Function LBFindItem(Obj As ListBox, StartIndex As Long, FindString As String) As Long
    LBFindItem = SendMessage(Obj.hwnd, LB_FINDSTRING, StartIndex, ByVal FindString)
End Function

' ListIndex von ListBox ermitteln
' Gibt den aktuell selektierten Index zurück
Public Function LBGetListIndex(Obj As ListBox) As Long
    LBGetListIndex = SendMessage(Obj.hwnd, LB_GETCURSEL, 0, ByVal 0&)
End Function

' ListIndex von ListBox setzen
' setzt den ListIndex und markiert den Eintrag
' Ein Click wird nicht ausgelöst!
Public Sub LBSetListIndex(Obj As ListBox, NewIndex As Long)
    Call SendMessage(Obj.hwnd, LB_SETCURSEL, NewIndex, ByVal 0&)
End Sub

' Anzahl List-Einträge ermitteln (ListCount)
Public Function LBGetListCount(Obj As ListBox) As Long
    LBGetListCount = SendMessage(Obj.hwnd, LB_GETCOUNT, 0, ByVal 0&)
End Function

' Liest den Text in einer ListBox aus mit dem
' angegebenen Index aus und gibt diesen zurück
Public Function LBGetItemText(Obj As ListBox, Index As Long) As String
    Dim Buffer As String
    Dim TextLen As Long
    TextLen = SendMessage(Obj.hwnd, LB_GETTEXTLEN, Index, ByVal 0&)
    If TextLen > 0 Then
        Buffer = Space(TextLen)
        Call SendMessage(Obj.hwnd, LB_GETTEXT, Index, ByVal Buffer)
    End If
    LBGetItemText = Buffer
End Function

' Löscht den Text aus der ListBox
' Gibt bei Erfolg die Anzahl der verbleibenden
' Einträge in der Liste zurück, bei Fehler -1
Public Function LBDeleteItem(Obj As ListBox, Index As Long) As Long
    LBDeleteItem = SendMessage(Obj.hwnd, LB_DELETESTRING, Index, ByVal 0&)
End Function
 
' Fügt ein Eintrag an die Position 'Index' ein
' Der eingefügte Text wird nicht matkiert.
Public Sub LBInsertItem(Obj As ListBox, Index As Long, Text As String)
    Call SendMessage(Obj.hwnd, LB_INSERTSTRING, Index, ByVal Text)
End Sub

' Hängt ans Ende der Listbox einen Eintrag an.
' Liefert die Position zurück, an der der text eingefügt wurde
' Der hinzugefügte Text wird nicht markiert
Public Function LBAppendItem(Obj As ListBox, Text As String) As Long
    LBAppendItem = SendMessage(Obj.hwnd, LB_ADDSTRING, 0, ByVal Text)
End Function

' Ersetzt den Item-Text an der Position 'Index' mit 'NewText'
' Der Eintrag wird markiert!
Public Sub LBSetItemText(Obj As ListBox, Index As Long, NewText As String)
    ' zunächst Eintrag löschen
    If SendMessage(Obj.hwnd, LB_DELETESTRING, Index, ByVal 0&) > 0 Then
        ' und neuen Eintrag an diese Position wieder einfügen
        Call SendMessage(Obj.hwnd, LB_INSERTSTRING, Index, ByVal NewText)
        ' und noch selectieren
        Call SendMessage(Obj.hwnd, LB_SETCURSEL, Index, ByVal 0)
    End If
End Sub

' Ermittelt den benutzerdefinierten Wert ItemData
' Der Wert wird mit LBSetItemData() zugewiesen
Public Function LBGetItemData(Obj As ListBox, Index As Long) As Long
    LBGetItemData = SendMessage(Obj.hwnd, LB_GETITEMDATA, Index, ByVal 0&)
End Function

' setzt den benutzerdefinierten Wert ItemData
Public Sub LBSetItemData(Obj As ListBox, Index As Long, ItemData As Long)
    Call SendMessage(Obj.hwnd, LB_SETITEMDATA, Index, ByVal ItemData)
End Sub
'------- Ende Modul "modListBox" alias modListBox.bas -------
'---- Anfang Formular "frmHinweis" alias frmHinweis.frm  ----
' Steuerelement: Textfeld "txtInfo"
' Steuerelement: Anzeige-Steuerelement "cmdClose"
' Steuerelement: Anzeige-Steuerelement "Image1" (Index von 0 bis 1)
' Steuerelement: Beschriftungsfeld "lblTitel" (Index von 0 bis 0)

' Author:       M. Ruhwald
' Erstellt:     02.12.2007 (00:59)
' Geändert:     04.12.2007 (17:59)
' Beschreibung:

' Info-Box für VB-Tipp

Option Explicit

Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Dim DistanzX As Single
    Dim DistanzY As Single
    
    DistanzX = Screen.TwipsPerPixelX * 3
    DistanzY = Screen.TwipsPerPixelY * 3

    lblTitel(0).ForeColor = RGB(30, 30, 200)
    Load lblTitel(1)
    With lblTitel(1)
        .Visible = True
        .Left = lblTitel(0).Left + DistanzX
        .Top = lblTitel(0).Top + DistanzY
        .ForeColor = RGB(80, 80, 80)
        .FontUnderline = True
        .Visible = True
        .ZOrder 1
    End With
    
    txtInfo.Text = "VB-Tipp" & vbCrLf & _
                "Von: Michael Ruhwald 2007/2008" & vbCrLf & _
                "Für: www.ActiveVB.de" & vbCrLf & vbCrLf & _
                "Dieser Tipp zeigt, wie man die Problematik bei Listboxen " & _
                "bei mehr als 32767 Listen-Einträgen in den Griff bekommt." & vbCrLf & vbCrLf & _
                "Eine Reihe von Funktionen hierfür sind im Modul ""modListBox.bas"" " & _
                "zusammengefasst. Bestimmt fehlt noch die eine oder andere nützliche Funktion. " & _
                "Die Erweitung des Funktionsumfang dürfte allerdings kein Problem sein, " & _
                "wenn man die MSDN nutzt." & vbCrLf & vbCrLf & _
                "Übrigens:" & vbCrLf & _
                "Die Funktionen können nur für die ListBox verwendet werden. " & _
                "Für ComboBoxen müssen andere Messages gesendet werden." & vbCrLf & _
                "(Konstantnamen wie: CB_FINDSTRING, CB_FINDSTRINGEXACT, usw.)" & vbCrLf & vbCrLf & _
                "Der Autor."
End Sub

'----- Ende Formular "frmHinweis" alias frmHinweis.frm  -----
'---------- Ende Projektdatei ListBox im Griff.vbp ----------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.