1. Herfried K. Wagner’s VB.Any
  2. Visual Basic
  3. Code

Steuerelemente

Manipulieren des Eingabefeldes von ComboBox-Steuerelementen

Das ComboBox-Steuerelement unter Visual Basic bietet keine Möglichkeit, die Länge des eingegebenen Textes zu begrenzen, das Textfeld für Eingaben zu sperren oder den eingegebenen Text mit einem Platzhalterzeichen unlesbar zu machen. Über die API-Funktion SendMessage kann diese Funktionalität nachgerüstet werden:

Private Declare Function GetWindow _
    Lib "user32.dll" _
( _
    ByVal hWnd As Long, _
    ByVal wCmd As Long _
) As Long

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

Private Const EM_LIMITTEXT As Long = &HC5&
Private Const EM_SETPASSWORDCHAR As Long = &HCC&
Private Const EM_SETREADONLY As Long = &HCF&

Private Const CB_LIMITTEXT As Long = &H141&

Private Const GW_CHILD As Long = 5&

Private Sub ComboBoxSetReadOnly( _
    ByVal ComboBox As ComboBox, _
    ByVal ReadOnly As Boolean _
)
    Call SendMessage( _
        GetWindow(ComboBox.hWnd, GW_CHILD), _
        EM_SETREADONLY, _
        IIf(ReadOnly, 1&, 0&), _
        0& _
    )
    Call ComboBox.Refresh
End Sub

Private Sub ComboBoxSetPasswordChar( _
    ByVal ComboBox As ComboBox, _
    ByVal PasswordChar As String _
)
    If Len(PasswordChar) = 0 Then
        PasswordChar = vbNullChar
    ElseIf Len(PasswordChar) > 1 Then
        PasswordChar = Left(PasswordChar, 1)
    End With
    Call SendMessage( _
        GetWindow(ComboBox.hWnd, GW_CHILD), _
        EM_SETPASSWORDCHAR, _
        Asc(PasswordChar), _
        0& _
    )
    Call ComboBox.Refresh
End Sub

Private Sub ComboBoxSetMaxLength( _
    ByVal ComboBox As ComboBox, _
    ByVal Length As Long _
)
    
    ' Folgende Aufrufe bewirken dasselbe, beim auskommentierten Aufruf wird
    ' die Zugriffsnummer des Textfeldes des ComboBox-Steuerelements
    ' ermittelt und die Textlänge des Textfeldes festgelegt.
    Call SendMessage(ComboBox.hWnd, CB_LIMITTEXT, Length, 0&)
    'Call SendMessage( _
    '    GetWindow(ComboBox.hWnd, GW_CHILD), _
    '    EM_LIMITTEXT, _
    '    Length, _
    '    0& _
    ')
    Call ComboBox.Refresh
End Sub

Ändern von Fensterstilen

Visual Basic bietet keine Möglichkeit der direkten Manipulation der Fensterstile von Formularen und Steuerelementen. Die nachfolgend angegebene Prozedur SetStyleBits vereinfacht das Setzen von normalen und erweiterten Fensterstilen:

Private Declare Function GetWindowLong _
    Lib "user32.dll" _
    Alias "GetWindowLongA" _
( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long _
) As Long

Private Declare Function SetWindowLong _
    Lib "user32.dll" _
    Alias "SetWindowLongA" _
( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long _
) As Long

Private Const GWL_EXSTYLE As Long = (-20&)
Private Const GWL_STYLE As Long = (-16&)

' Sets normal and extended style-bits for a control/form.
'
' Parameters:
'
'   'hWnd'       -  The control's handle.
'   'Apply'      -  'True', if the style should be applied.
'                   'False', when the style should be removed.
'   'IsExStyle'  -  Determines if the style is an extended style.
'
' Note that it's sometimes necessary to update the window by sending an
' update message or using 'UpdateWindow' to show the new style-bits.
Private Sub SetStyleBits( _
    ByVal hWnd As Long, _
    ByVal Style As Long, _
    Optional ByVal Apply As Boolean = True, _
    Optional ByVal IsExStyle As Boolean = False _
)
    Dim OldStyle As Long, StyleID As Long
    StyleID = IIf(IsExStyle, GWL_EXSTYLE, GWL_STYLE)
    OldStyle = GetWindowLong(hWnd, StyleID)    
    If Apply Then
        Call SetWindowLong(hWnd, StyleID, OldStyle Or Style)
    Else
        Call SetWindowLong(hWnd, StyleID, OldStyle And Not Style)
    End If
End Sub

Verwenden eines ScrollBar-Steuerelements als Größenänderungsdreieck

Fenster, die in der Größe geändert werden können, besitzen vielfach ein Größenänderungsdreieck, das sich in der rechten unteren Ecke eines Fensters befindet. Es gibt verschiedene Möglichkeiten, ein solches Dreieck in mit Visual Basic erstellten Anwendungsfenstern zu erzeugen. Ein ausgefallener Weg bedient sich dazu einer Bildlaufleiste, die durch Manipulation ihrer Fensterstile und ihrer Eigenschaften in ein Größenänderungsdreieck verwandelt wird. Die Vorgehensweise funktioniert sowohl mit horizontalen als auch vertikalen Bildlaufleisten. Das folgende Beispiel setzt voraus, daß sich auf dem Formular eine Bildlaufleiste mit Namen HScroll1 befindet:

Private Declare Function SetWindowLong _
    Lib "user32.dll" _
    Alias "SetWindowLongA" _
( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long _
) As Long

Private Declare Function GetWindowLong _
    Lib "user32.dll" _
    Alias "GetWindowLongA" _
( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long _
) As Long

Private Const GWL_STYLE As Long = (-16&)

Private Sub Form_Load()
    With HScroll1
        Dim PrevScaleMode As ScaleModeConstants
        PrevScaleMode = Me.ScaleMode
        Me.ScaleMode = vbPixels
        Const GrabberWidth As Integer = 16
        Const GrabberHeight As Integer = GrabberWidth
        Call .Move( _
            Me.ScaleWidth - GrabberWidth, _
            Me.ScaleHeight - GrabberHeight, _
            GrabberWidth, _
            GrabberHeight _
        )
        Me.ScaleMode = PrevScaleMode
        .TabStop = False
        .Enabled = False
        .MousePointer = vbSizeNWSE
        
        ' Funktioniert nicht unter Windows NT 3.51.
        Call SetWindowLong( _
            .hWnd, _
            GWL_STYLE, _
            GetWindowLong(.hWnd, GWL_STYLE) Or &H10& _
        )
        
        ' Steuerelement aktualisieren.
        Call .Refresh
    End With
End Sub

Private Sub Form_Resize()
    With HScroll1
        Call .Move(Me.ScaleWidth - .Width, Me.ScaleHeight - .Height)
    End With
End Sub

Wurde das Aussehen erst einmal angepaßt, muß noch dafür gesorgt werden, daß das Dreieck immer in der rechten unteren Ecke des Fensters gehalten wird, wenn sich dieses in seiner Größe ändert. Dazu wird in der Behandlungsroutine des Resize-Ereignisses des Formulars die Bildlaufleiste neu positioniert.

Ausrichten der Beschriftung von Steuerelementen

Einige Steuerelemente unterstützen direkt das Ändern der Ausrichtung ihrer Beschriftung mittels Eigenschaften. Manche Steuerelemente besitzen jedoch keine derartigen Eigenschaften. Für Steuerelemente, die sich von der Fensterklasse BUTTON ableiten, wie etwa Schaltflächen, Rahmen, Auswahlfelder und Optionsfelder, kann über die im Folgenden vorgestellte Technik die Ausrichtung der Beschriftung festgelegt werden:

Private Declare Function SetWindowLong _
    Lib "user32.dll" _
    Alias "SetWindowLongA" _
( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long _
) As Long

Private Declare Function GetWindowLong _
    Lib "user32.dll" _
    Alias "GetWindowLongA" _
( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long _
) As Long

Private Const GWL_STYLE As Long = (-16&)

Private Const BS_TOP As Long = &H400&
Private Const BS_VCENTER As Long = &HC00&
Private Const BS_BOTTOM As Long = &H800&
Private Const BS_LEFT As Long = &H100&
Private Const BS_CENTER As Long = &H300&
Private Const BS_RIGTH As Long = &H200&

Private Enum AlignmentConstants
    Top = BS_TOP
    VerticalCenter = BS_VCENTER
    Bottom = BS_BOTTOM
    Left = BS_LEFT
    Center = BS_CENTER
    Right = BS_RIGTH
End Enum

Private Sub Form_Load()
    
    ' Beschriftung eines CommandButton-Steuerelements rechts ausrichten.
    Call SetAlignment(Me.Command1, Right)
    
    ' Beschriftung eines Frame-Steuerelements zentrieren.
    Call SetAlignment(Me.Frame1, Center)
    
    ' Beschriftung eines CheckBox-Steuerelements unten rechts ausrichten.
    Call SetAlignment(Me.Check1, Bottom Or Right)
    
    ' Beschriftung eines OptionButton-Steuerelements links oben ausrichten.
    Call SetAlignment(Me.Option1, Top)
End Sub

Private Sub SetAlignment( _
    ByVal Control As Control, _
    ByVal Alignment As AlignmentConstants _
)
    Call SetWindowLong( _
        Control.hWnd, _
        GWL_STYLE, _
        GetWindowLong(Control.hWnd, GWL_STYLE) Or Alignment _
    )
    Call Control.Refresh
End Sub

Arbeiten mit der Controls-Auflistung

Die Steuerelemente eines Formulars können über dessen Controls-Auflistung durchlaufen werden. Dabei ist es auch möglich, auf Eigenschaften eines Steuerelements, von dem nur der Name als Zeichenfolge bekannt ist, zuzugreifen bzw. diese zu manipulieren. Das folgende Beispiel ändert die Enabled-Eigenschaften der Steuerelemente mit den Namen Command1 bis Command6:

Dim i As Long
For i = 1 To 6
    Me.Controls("Command" & CStr(i)).Enabled = False
Next i

Einzelne Elemente aus Steuerelementenfeldern können angesprochen werden, wie das folgende Beispiel zeigt. Hier wird immer das Element mit Index 2 deaktiviert:

Dim i As Long
For i = 1 To 6
    Me.Controls("Command" & CStr(i))(2).Enabled = False
Next i

Das folgende Beispiel setzt die Text-Eigenschaften aller Textfelder des Formulars auf die leere Zeichenfolge:

Dim ctr As Control
For Each ctr In FMain.Controls
    If TypeOf ctl Is TextBox Then
        ctr.Text = ""
    End If
Next ctr

Es ist auch möglich, Steuerelemente zur Laufzeit in die Controls-Auflistung aufzunehmen. Im folgenden Beispiel wird eine ereignissensitive Schaltfläche erzeugt:

Private WithEvents cmdNewButton As CommandButton

Private Sub cmdMakeControls_Click()
    Set cmdNewButton = Me.Controls.Add("VB.CommandButton", "cmdNewButton", Me)
    With cmdNewButton
        .Width = 1800
        .Height = 340
        .Caption = "&Show Message"
        .Top = 300
        .Left = 300
        .Visible = True
    End With
End Sub

Private Sub cmdNewButton_Click()
    Call MsgBox("Hello World!")
End Sub

Definieren aktiver Regionen innerhalb eines Bildes

In verspielten Oberflächen kommen oft Bilder zum Einsatz, bei denen der Benutzer auf bestimmte Stellen klicken kann, um eine Aktion auszulösen. Das ist auch einfach in Visual Basic-Anwendungen realisierbar, indem auf einem PictureBox-Steuerelement, das die Graphik enthält, Label- oder Image-Steuerelemente in der Größe der aktiven Region plaziert werden. Die Eigenschaft BackStyle muß auf transparent und die Eigenschaft BorderStyle auf vbBSNone festgelegt werden. Weiters sollten vorhandene Steuerelementbeschriftungen gelöscht werden. Nun können wie gewohnt die Ereignisse MouseMove und Click des Label-Steuerelements ausgewertet werden.

Beschränken der Eingabe eines Textfeldes auf Zahlen

Wenn in ein Textfeld nur Zahlen eingegeben werden sollen, dann muß dafür nicht unbedingt ein zusätzliches Steuerelement (wie etwa MaskedEdit) herangezogen werden. Diese Funktionalität läßt sich auch mit wenigen zusätzlichen Zeilen Quellcode realisieren. Die beiden vorgestellten Lösungen sind nicht immun gegen das Einfügen von beliebigem Text über die Zwischenablage.

Wichtig ist dabei das Ereignis KeyPress des TextBox-Steuerelements. Es wird für ein Steuerelement ausgelöst, wenn eine Taste gedrückt wurde und es gerade den Fokus besitzt. Im Parameter KeyAscii wird der Code des Zeichens übergeben, welcher der gedrückten Taste entspricht. Wird dieser Parameter in der Prozedur KeyPress auf 0 gesetzt, so wird der Tastendruck ignoriert und das Zeichen erscheint nicht im Textfeld. Mit der Funktion InStr kann die Eingabe auf beliebige Zeichen eingeschränkt werden:

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If InStr("1234567890-," & Chr$(vbKeyBack), Chr$(KeyAscii)) = 0 Then
        KeyAscii = 0
    End If
End Sub

In diesem Beispiel wurde auch noch Chr$(vbKeyBack) an die Zeichenfolge der erlaubten Zeichen angehängt, damit mit der Löschtaste eingegebene Zeichen auch wieder gelöscht werden kann. Wenn die Umwandlung des Zeichens mit Chr$(KeyAscii) zu umständlich oder zu langsam ist, kann stattdessen direkt den Zeichencode geprüft werden. Dies führt jedoch zu schwerer lesbarem Code (die Zahlen 0 bis 9 entsprechen den Zeichencodes 48 bis 57):

Private Sub Text1_KeyPress(KeyAscii As Integer)
    
    ' Allow the user to press Backspace. You can add other keys (for example
    ' plus minus and comma) here.
    If KeyAscii = vbKeyBack Then Exit Sub
    
    ' ASCII value 48-57 = key 1-9.
    If KeyAscii < 48 Or KeyAscii > 57 Then
        KeyAscii = 0
    End If
End Sub

Markieren des Inhalts eines Textfeldes bei Fokuserhalt

Um den gesamten Inhalt eines Textfeldes zu markieren, wenn dieses den Fokus erhält, können zwei Methoden verwendet werden. Dabei bezeichnet Text1 das TextBox-Steuerelement:

Private Sub Text1_GotFocus()
    Me.Text1.SelStart = 0
    Me.Text1.SelLength = Len(Me.Text1.Text)
End Sub

Private Sub Text1_GotFocus()
    Call SendKeys("{home}+{end}")
End Sub

Anwenden von Standardoperationen auf ein TextBox-Steuerelement

Um Standardfunktionen wie Kopieren, Einfügen und Ausschneiden auf ein TextBox- oder RichTextBox-Steuerelement anzuwenden, bietet sich die generische Routine DoEdit an:

Private Enum EditOperation
    Copy
    Cut
    Paste
    Undo
End Enum

'
' 'Control' must point to a textbox or richtextbox control.
'
Private Sub DoEdit( _
    ByVal Control As Control, _
    ByVal Operation As EditOperation _
)
    Dim s As String
    Select Case Operation
        Case Copy:  s = "^C"
        Case Cut:   s = "^X"
        Case Paste: s = "^V"
        Case Undo:  s = "^Z"
    End Select
    Call Control.SetFocus
    Call SendKeys(s)
End Sub

Unterbinden des Pieptons bei Drücken der Eingabetaste in einem TextBox-Steuerelement

Nach dem Drücken der Eingabetaste in einem Textfeld erfolgt kein „Beep“:

Private Sub Text1_KeyPress(KeyAscii As Integer)
    
    ' Wenn Eingabetaste gedrückt wurde.
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0    ' Piepton unterdrücken.
    End If
End Sub

Schnelles Füllen von ListBox- und ComboBox-Steuerelementen

Die von Visual Basic bereitgestellten Methoden der ListBox-Klasse sind sehr langsam im Vergleich zu den entsprechenden Windows-API-Funktionen. Damit folgendes Beispiel funktioniert wird ein Formular mit einer Schaltfläche cmdFillList und eine ListBox List1 benötigt. Damit das Beispiel auch mit Kombinationsfeldern funktioniert, muß anstelle von LB_ADDSTRING die Konstante CB_ADDSTRING = &H143& verwendet werden. In diesem Beispiel wird außerdem zuerst ein Informationstext der ListBox hinzugefügt, die Aktualisierung der ListBox unterbunden, die Elemente hinzugefügt, das Informationselement entfernt und die Fensteraktualisierung wieder aktiviert:

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

Private Declare Function LockWindowUpdate Lib "user32.dll" ( _
    ByVal hWnd As Long _
) As Long

Private Const LB_ADDSTRING As Long = &H180&

Private Sub LockWindow(ByVal hWnd As Long)
    Call LockWindowUpdate(hWnd)
End Sub

Private Sub UnlockWindow()
    Call LockWindowUpdate(0&)
End Sub

Private Sub cmdFillList_Click()
    Me.cmdFillList.Enabled = False
    
    Screen.MousePointer = vbHourglass
    Call Me.List1.Clear
    Me.List1.Enabled = False
    Call Me.List1.AddItem("Lade Liste...")
    Call Me.List1.Refresh
    
    Dim hWndListBox As Long
    hWndListBox= Me.List1.hWnd
    Call LockWindow(hWndListBox)
    Dim i As Long
    For i = 1 To 32000
        Call SendMessage( _
            hWndListBox, _
            LB_ADDSTRING, _
            0&, _
            "Item " & CStr(i) & vbNullChar _
        )
        If i Mod 10 = 0 Then
            DoEvents
        End If
    Next i  
    Call Me.List1.RemoveItem(0)
    Me.List1.Enabled = True
    Call UnlockWindow
    
    Screen.MousePointer = vbNormal
    Me.cmdFillList.Enabled = True
End Sub

Aktivieren von Steuerelementen ohne Laufzeitfehler

Die SetFocus-Methode der Steuerelemente unter Visual Basic hat einen grossen Nachteil: Ist beispielsweise das Steuerelement, dessen Methode SetFocus aufgerufen wurde, nicht sichtbar oder deaktiviert, so löst der Aufruf über Control1.SetFocus (Control1 bezeichnet hier ein Steuerelement) einen Laufzeitfehler aus. Dies kann umgangen werden, indem der Fokus über die API-Funktion SetFocus gesetzt wird. Der Rückgabewert dieser Funktion gibt Auskunft über den Erfolg, der aber normalerweise uninteressant ist:

Private Declare Function SetFocusAPI Lib "user32.dll" Alias "SetFocus" ( _
    ByVal hWnd As Long _
) As Long

Um den Fokus auf Control1 zu setzen, wird dann folgender Code verwendet:

Call SetFocusAPI(Me.Control1.hWnd)

Entfernen des Rahmens eines WebBrowser-Steuerelements

Das WebBrowser-Steuerelement hat standardmäßig eine Clientkante als Rahmen, aber es besitzt keine Eigenschaft BorderStyle, um diesen Rahmen zu entfernen oder zu ändern. Dies ist besonders dann notwendig, wenn die Formularoberfläche eine HTML-Seite sein soll. Dabei sollte der Übergang zwischen HTML-Dokument und Formular möglichst unsichtbar sein.

Die intuitive Lösung zum Entfernen des Rahmens ist denkbar einfach, allerdings nicht sehr professionell: Man erstellt vier rahmenlose Frame-Steuerelemente und plaziert sie so über dem WebBrowser-Steuerelement, daß dessen Rahmen überdeckt wird. Dazu sollte der Rahmen der Frames entfernt werden und die Hintergrundfarbe auf vbButtonFace eingestellt werden.

Jedoch gibt es auch eine professionelle Lösung, den Rahmen vom Steuerelement weg zu bekommen. Der 3D-Rahmen sowie die horizontale Bildlaufleiste, die selbst dann angezeigt wird, wenn sie nicht benötigt wird, sind nämlich nicht Teil des Steuerelements sondern des darin angezeigten Dokument. Für eine Änderung des Rahmens ist es also erforderlich, daß bereits ein Dokument in das Steuerelement geladen wurde und über die Document-Eigenschaft bereitsteht. Dies ist mit Eintritt des Ereignisses DocumentComplete des WebBrowser-Steuerelements gegeben. In diesem Ereignis kann daher die Eigenschaft border des Document-Objekts, die sich über Document.body.style.border erreichen läßt, ändern:

Private Sub WebBrowser1_DocumentComplete( _
    ByVal pDisp As Object, _
    ByRef URL As Variant _
)
    Me.WebBrowser1.Document.body.style.border = "none"
End Sub

Entfernen der Bildlaufleisten eines WebBrowser-Steuerelements

Die dauerhaft angezeigte Bildlaufleiste kann in gleicher Weise im DocumentComplete-Ereignis beeinflußt werden: Soll sie nur dann angezeigt werden, wenn sie benötigt wird, um durch den Inhalt scrollen zu können, kann hierfür die Eigenschaft Document.body.scroll auf „auto“ gesetzt werden; soll die Leiste hingegen nie angezeigt werden, dann kann dazu der Wert „no“ angegeben werden. Im folgenden Beispiel wird eingestellt, daß die Bildlaufleiste nur bei Bedarf sichtbar ist:

Private Sub WebBrowser1_DocumentComplete( _
    ByVal pDisp As Object, _
    ByRef URL As Variant _
)
    Me.WebBrowser1.Document.body.scroll = "auto"
End Sub

Entfernen des Kontextmenüs eines WebBrowser-Steuerelements

Bei HTML-Oberflächen in Anwendungen ist es meist vorteilhaft, wenn der Benutzer keine Möglichkeit hat, Text und andere Dokumentelemente zu kopieren. Der Mauszeiger kann in der HTML-Datei auf default gesetzt werden, weiters muß jedoch die Auswahl unterbunden werden. Dazu kann man den gesamten Inhalt der HTML-Datei in eine Tabelle schreiben, die folgendermaßen aussieht (wichtig dabei ist der nicht korrekt geschlossene Hyperlink!):

<a style="cursor: default" href="#">
<table>
  <tr>
    <td></a>Page body goes here!</td>
  </tr>
</table>

Jetzt muß nur mehr das Kontextmenü des WebBrowser-Steuerelements entfernt werden. Dies ist über JavaScript möglich. Das öffnende body-Element müßte folgendermaßen modifiziert werden:

<body onContextMenu="return false">

Befehle des WebBrowser-Steuerelements

Der Inhalt eines WebBrowser-Steuerelements kann gedruckt oder ausgewählt werden. Es gibt auch noch zahlreiche andere Funktionen, die über die Methode ExecWB ausgeführt werden können. Der nachstehende Code zeigt, wie man den gesamten Inhalt eines WebBrowser-Steuerelements auswählt und wie man eine HTML-Datei damit ausdruckt:


' Alles auswählen.
Call Me.WebBrowser1.ExecWB(OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT)

' Ausdrucken.
Call Me.WebBrowser1.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT)

Die Verlaufsliste des WebBrowser-Steuerelements

Das WebBrowser-Steuerelement besitzt u. a. die Methode Navigate, bei der im zweiten Parameter Flags angegeben werden können. Wird die Konstante navNoHistory hier angegeben, fügt das WebBrowser-Steuerelement die Seite, zu der navigiert wird, nicht der Verlaufsliste hinzu. Bei einigen Programmierern führt dies zur grossen Verwunderung, da die besuchte Seite trotzdem in der Verlaufsliste aufscheint.

Daher soll hier darauf hingewiesen werden, daß die Verlaufsliste nicht gleich der History ist: Die History ist eine interne Liste, die dem Browser dazu dient, vorwärts und rückwärts navigieren zu können. Bei der Angabe der angeführten Konstanten wird die Seite lediglich nicht in die interne History aufgenommen, im Verlauf scheint sie aber trotzdem auf.

Bestimmen der ausgewählten Option in einem Array von Optionsfeldern

Folgende Funktion bestimmt die ausgewählte Option in einem Array von Optionsfeldern. Zu beachten ist dabei, daß das Array von Steuerelementen als Object übergeben wird:

Private Function GetSelOption(ByVal OptionGroup As Object) As Integer
    Dim Index As Integer
    For Index = OptionGroup.LBound To OptionGroup.UBound
        If OptionGroup(Index).Value Then
            GetSelOption = Index
            Exit Function
        End If
    Next Index
End Function

Ein Aufruf könnte folgendermaßen aussehen:

Debug.Print _
    "Sie haben Option Nummer " & CStr(GetSelOption(Me.Option1)) & "gewählt."

Dabei ist Option1 ein Feld von Optionsfeldern.

Anzeigen von Laufwerken, Ordnern und Dateien in einem ListBox-Steuerelement

Das FileListBox-Steuerelement ist ziemlich langsam. Windows stellt für Listenfelder einen eigenen Darstellungsmodus zur Verfügung, bei dem Laufwerke, Ordner und Dateien wahlweise angezeigt werden können. In folgendem Beispiel bezeichnet List1 ein ListBox-Steuerelement:

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

Private Const LB_DIR As Long = &H18D&   ' Dateianzeige.

' Dateien ohne spezielle Attribute anzeigen.
Private Const DDL_READWRITE As Long = &H0&

' Schreibgeschützte Dateien anzeigen.
Private Const DDL_READONLY As Long = &H1&

' Versteckte Dateien anzeigen.
Private Const DDL_HIDDEN As Long = &H2&

' Systemdateien anzeigen.
Private Const DDL_SYSTEM As Long = &H4&

' Ordner anzeigen.
Private Const DDL_DIRECTORY As Long = &H10&

' Archivierte Dateien anzeigen.
Private Const DDL_ARCHIVE As Long = &H20&

' Laufwerke anzeigen.
Private Const DDL_DRIVES As Long = &H4000&

' Nur Dateien mit dem gewünschten Attribut anzeigen, sonst werden Dateien ohne
' spezielle Attribute immer angezeigt.
Private Const DDL_EXCLUSIVE As Long = &H8000&

Der Einsatz wäre mit dem folgenden Code möglich:

'
' Die Konstanten werden nacheinander in separaten Aufrufen von 'SendMessage' gesendet,
' da sonst keine Sortierung nach Laufwerken, Ordnern und Dateien erfolgt.
'

' Laufwerke hinzufügen.
Call SendMessage( _
    Me.List1.hWnd, _
    LB_DIR, _
    DDL_DRIVES Or DDL_EXCLUSIVE, _
    ByVal "C:\*.*" _
)

' Ordner hinzufügen.
Call SendMessage( _
    Me.List1.hWnd, _
    LB_DIR, _
    DDL_DIRECTORY Or DDL_EXCLUSIVE, _
    ByVal "C:\*.*" _
)

' Dateien ohne spezielle Attribute hinzufügen.
Call SendMessage( _
    Me.List1.hWnd, _
    LB_DIR, _
    0&, _
    ByVal "C:\*.*" _
)

Suchen eines Eintrags in einem ListBox-Steuerelement

Um zu prüfen, ob sich ein Element bereits in einer ListBox befindet, muß man nicht alle Elemente über eine Schleife durchgehen und vergleichen, bis das Element gefunden oder das Ende der ListBox erreicht wurde. In folgendem Beispiel werden zwei Zeichenfolgen in der ListBox List1 gesucht:

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

Private Const LB_FINDSTRING As Long = &H18F&

Private Sub Form_Load()
    With Me.List1
        Call .AddItem("Karl")
        Call .AddItem("Peter")
        Call .AddItem("Frank")
        Call .AddItem("Brian")
        Call .AddItem("Adam")
    End With
    
    Debug.Print _
        "Suche nach ""Brian"":  " & _
        CStr(SendMessage(Me.List1.hWnd, LB_FINDSTRING, -1&, "Brian"))
    Debug.Print _
        "Suche nach ""John"":  " & _
        CStr(SendMessage(Me.List1.hWnd, LB_FINDSTRING, -1&, "John"))
End Sub

Mehrzeilige Textfelder und Standardschaltflächen

Die Verwendung von Standardschaltflächen (Eigenschaft Default) ist allgemein gebräuchlich. Ein Problem ergibt sich dabei, wenn auf einem Formular ein mehrzeiliges Textfeld (Eigenschaft MultiLine) und eine Standardschaltfläche plaziert sind. In diesem Fall kann nämlich der Benutzer nicht durch Drücken der Eingabetaste einen Zeilenumbruch im Textfeld erzwingen, sondern es wird der Code hinter der Standardschaltfläche ausgeführt und kein Ereignis des Textfeldes.

Es gibt aber eine einfache Abhilfe, die sich des Windows-API bedient, mit dem dieses Problem gelöst werden kann. Im Folgenden bezeichne cmdOK die Schaltfläche, deren Default-Eigenschaft aktiviert ist, Text1 sei das mehrzeileige Textfeld:

Private Declare Function GetFocus Lib "user32.dll" ( _
) As Long

Private Sub cmdOK_Click()
    If GetFocus = Me.Text1.hWnd Then
        Me.Text1.SelText = vbNewLine
    Else
        Call MsgBox("Die 'Default'-Schaltfläche wurde gedrückt.")
    End If
End Sub

Durch das Drücken der Eingabetaste wird nämlich nicht der Fokus auf ein anderes Steuerelement gesetzt, sondern bleibt dem Textfeld erhalten. Es muß also lediglich getestet werden, ob die TextBox immer noch den Fokus besitzt, ist dies der Fall, dann wurde die Eingabetaste in der TextBox gedrückt und es wird ein Zeilenumbruch an der aktuellen Position eingefügt.

Drehen einer Linie um einen Punkt

Nachstehender Code erfordert ein Formular, auf dem ein Timer-Steuerelement mit dem Namen Timer1 und ein Line-Steuerelement Line1 plaziert ist. Es wird eine Linie um einen Punkt gedreht, wie bei einem Zeiger einer analogen Uhr:

Private Const Radius As Long = 400&
Private Const StartX As Long = 1000&
Private Const StartY As Long = 1000&
Private Const PI As Double = 3.1415

Private Sub Form_Load()
    With Me.Timer1
        .Interval = 50
        .Enabled = True
    End With
End Sub

Private Sub Timer1_Timer()
    Static m_Angle As Double
    If m_Angle > 2 * PI Then
        m_Angle = m_Angle Mod PI
    End If
    m_Angle = m_Angle + PI / 40
    
    ' Drehpunkt der Linie.
    Me.Line1.X1 = StartX
    Me.Line1.Y1 = StartY
    
    ' Bewegung des Punktes am Kreis.
    If m_Angle < PI Then
        Me.Line1.Y2 = StartY + Abs(Radius * Sin(m_Angle))
        Me.Line1.X2 = StartX + Radius * Cos(m_Angle)
    Else
        Me.Line1.Y2 = StartY - Abs(Radius * Sin(m_Angle))
        Me.Line1.X2 = StartX + Radius * Cos(m_Angle)
    End If
End Sub

Kopieren des Textes des aktiven Steuerelements in die Zwischenablage

Ab und zu ist es sinnvoll, im Programm die Möglichkeit anzubieten, die Auswahl im aktuellen Steuerelement in die Zwischenablage zu kopieren. Zu diesem Zweck kann der folgende Code verwendet werden:

Private Sub mnuEditCopy_Click()
    If TypeOf Screen.ActiveControl Is TextBox Then
        Call Clipboard.Clear
        Call Clipboard.SetText(Screen.ActiveControl.Text)
    ElseIf ... Then
        .
        .
        .
    End If
End Sub

Je nach Typ des aktiven Steuerelements kann ein anderer Inhalt in die TextBox abgelegt werden. Man kann auch überprüfen, ob das aktive Steuerelement gleich einem bestimmten Steuerelement ist. Dazu muß man einfach Screen.ActiveControl über den Operator Is mit dem gewünschten Steuerelement vergleichen.

Erstellen von 3D-Trennlinien

Unter Windows verwenden viele Anwendungen dreidimensionale Trennlinien, um die Formulare in zusammengehörende Bereiche zu unterteilen. Eine solche Linie kann man entweder durch Zusammensetzen zweier Line-Steuerelemente erzielen oder man schreibt dafür ein eigenes Benutzersteuerelement. Folgender Code muß in ein Benutzersteuerelement, dessen Windowless-Eigenschaft aktiviert ist, eingefügt werden:

Option Explicit

Private Sub UserControl_Paint()
    UserControl.Line _
        (0, 0)-(UserControl.Width, UserControl.Height), _
        vb3DHighlight, _
        BF
    UserControl.Line _
        (0, 0)-(UserControl.Width - 1 * Screen.TwipsPerPixelX, 0), _
        vb3DShadow
End Sub

Private Sub UserControl_Resize()
    UserControl.Height = 2 * Screen.TwipsPerPixelY
    Call UserControl.Refresh
End Sub

Im Resize-Ereignis wird sichergestellt, daß das Steuerelement nicht mehr als zwei Pixel hoch gezogen wird. Bei einer Größenänderung wird die Oberfläche neu gezeichnet. Jetzt muß man nur noch die Linien auf den Formularen aufziehen. Wenn man auch vertikale Linien zeichnen will, dann muß man den Code entsprechend anpassen, indem man beispielsweise eine Eigenschaft Orientation hinzufügt, bei der der Benutzer angeben kann, ob es sich um eine horizontale oder vertikale Trennlinie handeln soll. Zum Zeichnen von 3D-Rahmen kann man auch die API-Funktion DrawEdge verwenden.

Anpassen der Höhe eines Label-Steuerelements an den darzustellenden Text

Ab und zu ist es erforderlich, daß ein Label in seiner Höhe angepaßt werden muß, damit es einen bestimmten Text aufnehmen kann, ohne dabei jedoch die Breite des Steuerelements zu verändern. Die API-Funktion DrawText bietet eine Möglichkeit, das für die Darstellung eines Textes auf einem angegebenen Gerätekontext zu berechnen. Die im Folgenden angegebene Prozedur AdaptLabel paßt das übergebene Label so an, daß es den im zweiten Parameter übergebenen Text aufnehmen kann:

Private Declare Function DrawText Lib "user32.dll" Alias "DrawTextA" ( _
    ByVal hDC As Long, _
    ByVal lpStr As String, _
    ByVal nCount As Long, _
    ByRef lpRect As RECT, _
    ByVal wFormat As Long _
) As Long

Private Const DT_CALCRECT As Long = &H400&
Private Const DT_WORDBREAK As Long = &H10&

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

'
' Schreibt den in 'Text' angegebenen Text in das Label 'Label', wobei dieses
' in der Höhe angepaßt wird, damit es den gesamten Text aufnehmen kann.
' Die Breite des Labels bleibt unverändert.
'
' Beispielaufruf:
'
' \\\
' Call AdaptLabel(Me.Label1, "Hallo Welt!")
' ///
'
Public Sub AdaptLabel( _
    ByVal Label As Label, _
    ByVal Text As String, _
    Optional ByVal hDC As Long = 0 _
)
    If hDC = 0 Then
        hDC = Label.Parent.hDC
    End If
    Dim rct As RECT
    rct.Left = 0
    rct.Right = Label.Width \ Screen.TwipsPerPixelX
    Call DrawText( _
        hDC, _
        Text, _
        -1&, _
        rct, _
        DT_CALCRECT Or DT_WORDBREAK _
    )
    Label.Height = rct.Bottom * Screen.TwipsPerPixelY
    Label.Caption = Text
End Sub

Der Code kann leicht umgeschrieben werden, um die Abmaße eines Textes zu ermitteln, ohne dabei automatisch umzubrechen. Zu diesem Zweck darf im Parameter wFormat von DrawTextEx nicht das Flag DT_WORDBREAK gesetzt werden.

Unterscheiden zwischen „normaler“ Eingabetaste und jener am Ziffernblock

Es ist nicht möglich, mit reinen Visual Basic-Mitteln zwischen der „normalen“ Eingabetaste und jener am Ziffernblock zu unterscheiden. Zu diesem Zweck kann man im KeyDown-Ereignis mit der API-Funktion PeekMessage die letzte Fensternachricht ermittelt und überprüft:

Private Declare Function PeekMessage Lib "user32.dll" Alias "PeekMessageA" ( _
    ByRef lpMsg As msg, _
    ByVal hWnd As Long, _
    ByVal wMsgFilterMin As Long, _
    ByVal wMsgFilterMax As Long, _
    ByVal wRemoveMsg As Long _
) As Long

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type MSG
    hWnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Private Const PM_NOREMOVE As Long = &H0&

Private Const VK_RETURN As Long = &HD&

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim n As Long, msg_ As MSG
    n = PeekMessage(msg_, Me.Text1.hWnd, 0&, 0&, PM_NOREMOVE)
    If n <> 0 Then
        If msg_.wParam = VK_RETURN Then
            If CBool(msg_.lParam And &H1000000) Then
                Me.Caption = "Eingabetaste des Ziffernblocks"
            Else
                Me.Caption = "Normale Eingabetaste"
            End If
        Else
            Me.Caption = ""
        End If
    Else
        Me.Caption = ""
    End If
End Sub

Entfernen von Einträgen aus einem DriveListBox-Steuerelement

Die API-Funktion SendMessage wird verwendet, um über die Fensterzugriffsnummer (übergeben im Parameter hWnd) der DriveListBox den im Parameter wMsg abgelegten Befehl CB_DELETESTRING an das Steuerelement zu senden. Dem Parameter wParam wird dazu der Index des zu löschenden Eintrags übergeben, lParam ist hier nicht von Bedeutung und wird daher auf 0 gesetzt:

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

Private Const CB_DELETESTRING As Long = &H144&

Private Sub Form_Load()
    
    ' Laufwerk mit dem Index 0 (normalerweise 1. Diskettenlaufwerk) löschen.
    Call SendMessage(Me.Drive1.hWnd, CB_DELETESTRING, 0&, 0&)
End Sub

Setzen von Tabulatoren in einem TextBox-Steuerelement

Will man in einem Textfeld tabellarische Daten darstellen, dann kann man den Text durch Tabulatorzeichen trennen, um Spalten zu simulieren. Visual Basic bietet jedoch keine direkte Möglichkeit, die Breite der Spalten zu beeinflussen. Hierzu kann man die API-Funktion SendMessage in Verbindung mit EM_SETTABSTOPS verwenden. Will man die Breite der Tabulatoren individuell festlegen, kann man deren Positionen in einem Array ablegen und dieses an die Funktion übergeben. Die Positionen der Tabulatoren muß dabei allerdings in Dialogeinheiten (Dialog Untis) angegeben werden.

Im folgenden Beispiel soll ein zweispaltiges Textfeld realisiert werden, das einen Tabulator genau in der horizontalen Mitte hat. Das Umrechnen der Position aus der Einheit Pixel in Dialogeinheiten gestaltet sich schwierig, da das Windows-API hierzu keine vorgefertigten Funktionen anbietet. Die im nächsten Listing gezeigte Funktionsprozedur GetDialogUnitsPerPixel implementiert ein heuristisches Verfahren zur Ermittlung dieses Wertes auf Basis der Fonteinstellungen des durch die im Parameter hWnd übergebene Fensterzugriffsnummer identifizierten Steuerelements.

Folgendes Beispiel erfordert ein Formular mit einem Textfeld, dessen MultiLine-Eigenschaft auf True gesetzt ist, sowie ein Line-Steuerelement:

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

Private Const WM_GETFONT As Long = &H31&

Private Const EM_SETTABSTOPS As Long = &HCB&

Private Declare Function GetClientRect Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByRef lpRect As RECT _
) As Long

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function GetDialogBaseUnits Lib "user32.dll" ( _
) As Long

Private Declare Function GetTextExtentPoint32 _
    Lib "gdi32.dll" _
    Alias "GetTextExtentPoint32A" _
( _
    ByVal hDC As Long, _
    ByVal lpString As String, _
    ByVal cbString As Long, _
    ByRef lpSize As SIZE _
) As Long

Private Type SIZE
   cx As Long
   cy As Long
End Type

Private Declare Function GetDC Lib "user32.dll" ( _
    ByVal hWnd As Long _
) As Long

Private Declare Function ReleaseDC Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByVal hDC As Long _
) As Long

Private Declare Function SelectObject Lib "gdi32.dll" ( _
    ByVal hDC As Long, _
    ByVal hObject As Long _
) As Long

Private Sub Form_Load()
    Me.Text1.Text = "Hallo" & vbTab & "Welt!"
End Sub

Private Sub Form_Resize()
    Call Me.Text1.Move(300, 300, Me.ScaleWidth - 600, Me.ScaleHeight - 600)
    Dim rct As RECT
    Call GetClientRect(Text1.hWnd, rct)
    Dim TabStops(0 To 0) As Long
    TabStops(0) = ((rct.Right - rct.Left) * 0.5) / GetDialogUnitsPerPixel(Text1.hWnd)
    Call SendMessage(Text1.hWnd, EM_SETTABSTOPS, 2, TabStops(0))
    With Line1
        .X1 = Me.ScaleWidth * 0.5
        .X2 = .X1
        .Y1 = 0
        .Y2 = Me.ScaleHeight
    End With
End Sub

'
' Berechnet die Anzahl an Dialogeinheiten pro Pixel für das angegebene Fenster.
'
Private Function GetDialogUnitsPerPixel(ByVal hWnd As Long) As Single
    
    ' Gerätekontext des Steuerelements ermitteln.
    Dim hDC As Long
    hDC = GetDC(hWnd)
    If hDC <> 0 Then
        Const Chars As String = _
            "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"
        
        ' Auswählen des 'HFONT's des Fensters in seinen Gerätekontext (VB
        ' wählt den Font des Steuerelements nicht in dessen Gerätekontext).
        Dim hFont As Long
        hFont = SendMessage(hWnd, WM_GETFONT, 0&, ByVal 0&)
        Dim hFontOld As Long
        hFontOld = SelectObject(hDC, hFont)
        Dim sz As SIZE
        If GetTextExtentPoint32(hDC, Chars, Len(Chars), sz) <> 0 Then
            
            ' Durchschnittliche Zeichenbreite in Pixeln ermitteln (heuristisch).
            Dim AverageCharacterWidth As Long
            AverageCharacterWidth = sz.cx / Len(Chars)
            
            ' Horizontale Dialogeinheiten ermitteln. Diese sind im Low-Word von
            ' 'GetDialogBaseUnits' enthalten.
            Dim DlgBaseX As Long
            DlgBaseX = GetDialogBaseUnits And &HFFFF&
            
            ' Anzahl der Dialogeinheiten pro Pixel zurückgeben.
            GetDialogUnitsPerPixel = _
                (2 * AverageCharacterWidth) / DlgBaseX
        End If
        Call SelectObject(hDC, hFontOld)
        Call ReleaseDC(hWnd, hDC)
    End If
End Function