|
Visual Basic verwehrt Ihnen die Möglichkeit, die Höhe einer TextBox unter ein vor der aktuellen Schriftgröße der TextBox bestimmtes Maß zu verringern. Wenn Sie eine geringere Höhe setzen, wird die Höhe wieder automatisch auf diese Vorgabehöhe zurückgesetzt.
Zum einen können Sie diesen Effekt dazu nutzen, eine beim Anlegen in einem Formular zu hoch geratene TextBox wieder auf die Standard-Höhe zurückzusetzen. Sie brauchen lediglich im Eigenschaften-Fenster die Height-Eigenschaft auf 1 zu setzen.
Zum anderen gibt es natürlich einen Weg, eine TextBox in eine individuell gewünschte Höhe zu zwingen. Setzen Sie nämlich die Höhe über die API-Funktion  SetWindowPos, wird die VB-Automatik außer Kraft gesetzt, so lange Sie nicht erneut die Höhe über die Eigenschaft Height der TextBox setzen.
Am besten verpacken Sie den Aufruf in eine Hilfs-Prozedur (TextBoxHeight). Sie können dann ein paar weitere Kleinigkeiten gleich mit erledigen.
So erwartet SetWindowPos die ausdrückliche Angabe, ob das betreffende Steuerelement (Fenster) nach dem Aufruf aktiviert oder deaktiviert sein soll - im Falle eines Steuerelements wie bei der TextBox also, ob es den Fokus erhalten soll oder nicht. Falls nicht, ist das Flag SWP_NOACTIVATE zu setzen. Falls sich der aktuelle Fokus nicht ändern soll, unabhängig davon, ob die TextBox gerade den Fokus inne hat oder ein anderes Steuerelement, ermitteln Sie vor dem Aufruf von SetWindowsPos den aktuellen Fokus-Inhaber mit der API-Funktion GetFocus. Ist das von dieser Funktion gelieferte Fenster-Handle ungleich dem der TextBox, so hat diese nicht den Fokus inne, und das Flag SWP_NOACTIVATE wird gesetzt. Sie können aber auch den optionalen Parameter Activate von TextBoxHeight auf True setzen, wenn die TextBox mit dem Aufruf auf jeden Fall den Fokus erhalten soll.
Im ebenfalls optionalen Parameter ScaleMode können Sie angeben, welche Maßeinheit für die Höhenangabe gelten soll. Wenn Sie die Voreinstellung -1 belassen, wird versucht, über die ScaleMode-Einstellung des Containers zu ermitteln. Sollte dies fehlschlagen, werden TWIPS angenommen.
In jedem Fall muss die Höhenangabe in Pixels umgerechnet werden. Sollte das Parent-Objekt der TextBox nicht über die dazu benötigte ScaleY-Methode verfügen, wird für den Fall, dass Sie in ScaleMode explizit Pixels (Konstante vbPixels) gewünscht haben sollten, der Wert im Parameter Height als bereits in Pixels vorliegend betrachtet und verwendet. Anderenfalls wird von der VB-Standard-Maßeinheit TWIPS ausgegangen.
Das Zurücksetzen auf die von automatisch von Visual Basic vorgegebene Höhe der TextBox erreichen Sie, indem sie den (dazu optional deklarierten) Parameter Height weglassen (die weiteren, nachfolgenden Parameter erübrigen sich dann sowieso), oder auf einen Wert kleiner oder gleich 0 setzen.
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetFocus Lib "user32" () As Long
Public Sub TextBoxHeight(TextBox As TextBox, _
Optional ByVal Height As Single, _
Optional ByVal Activate As Variant, _
Optional ByVal ScaleMode As Integer = -1)
Dim nHeight As Long
Dim nScaleMode As Integer
Dim nFlags As Long
Const SWP_NOMOVE = &H2
Const SWP_NOZORDER = &H4
Const SWP_NOACTIVATE = &H10
With TextBox
If Height < 1 Then
.Height = 1
Exit Sub
Else
If ScaleMode = -1 Then
On Error Resume Next
nScaleMode = .Container.ScaleMode
If Err.Number Then
nScaleMode = vbTwips
End If
On Error GoTo 0
Else
nScaleMode = ScaleMode
End If
On Error Resume Next
nHeight = .Parent.ScaleY(Height, nScaleMode, vbPixels)
If Err.Number Then
If ScaleMode = vbPixels Then
nHeight = Height
Else
nHeight = Height \ Screen.TwipsPerPixelY
End If
End If
On Error GoTo 0
End If
If IsMissing(Activate) Then
If GetFocus() = .hwnd Then
nFlags = SWP_NOMOVE Or SWP_NOZORDER
Else
nFlags = SWP_NOMOVE Or SWP_NOZORDER Or SWP_NOACTIVATE
End If
Else
If Activate Then
nFlags = SWP_NOMOVE Or SWP_NOZORDER
Else
nFlags = SWP_NOMOVE Or SWP_NOZORDER Or SWP_NOACTIVATE
End If
End If
SetWindowPos .hwnd, 0, 0, 0, .Width \ Screen.TwipsPerPixelX, _
nHeight, nFlags
End With
End Sub
|