ScaleWidth für TextBox

18/05/2011 - 15:31 von Wolfgang Wolf | Report spam
Hallo,

hat jemand eine ScaleWidth-Funktion für die TextBox
(welche Border und Scrollbar berücksichtigt)?

Schöne Grüße
W. Wolf
 

Lesen sie die antworten

#1 Ulrich Korndoerfer
18/05/2011 - 19:11 | Warnen spam
Hallo Wolfgang,

Option Explicit

Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal Index As Long) As Long

Private Declare Function GetClientRect Lib "user32" _
(ByVal hWnd As Long, Rect As RECTAPI) As Long

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

Private Enum SystemMetricsConsts
SM_CXSCREEN = 0: SM_CYSCREEN = 1: SM_CXDLGFRAME = 7
SM_CYDLGFRAME = 8: SM_CXFRAME = 32: SM_CYFRAME = 33
SM_CXBORDER = 5: SM_CYBORDER = 6: SM_CXEDGE = 45
SM_CYEDGE = 46: SM_CYCAPTION = 4:
SM_CYSMCAPTION = 51
SM_CXMIN = 28: SM_CYMIN = 29: SM_CXMINTRACK
= 34
SM_CYMINTRACK = 35: SM_CXMAXTRACK = 59: SM_CYMAXTRACK
= 60
SM_CXFULLSCREEN = 16: SM_CYFULLSCREEN = 17:
SM_MOUSEPRESENT = 19
SM_CMOUSEBUTTONS = 43: SM_SWAPBUTTON = 23: SM_CXCURSOR = 13
SM_CYCURSOR = 14: SM_CXICON = 11: SM_CYICON = 12
SM_CXICONSPACING = 38: SM_CYICONSPACING = 39: SM_CXVSCROLL = 2
SM_CYVSCROLL = 20: SM_CYVTHUMB = 9: SM_CYHSCROLL = 3
SM_CXHSCROLL = 21: SM_CXHTHUMB = 10: SM_CYMENU = 15
SM_CLEANBOOT = 67: SM_CMONITORS = 80:
SM_CXDOUBLECLK = 36
SM_CYDOUBLECLK = 37: SM_CXDRAG = 68: SM_CYDRAG = 69
SM_CXMAXIMIZED = 61: SM_CYMAXIMIZED = 62:
SM_CXMENUCHECK = 71
SM_CYMENUCHECK = 72: SM_CXMENUSIZE = 54: SM_CYMENUSIZE
= 55
SM_CXSIZE = 30: SM_CYSIZE = 31:
SM_CXMINIMIZED = 57
SM_CYMINIMIZED = 58: SM_SLOWMACHINE = 73: SM_SHOWSOUNDS
= 70
SM_CXSMICON = 49: SM_CYSMICON = 50: SM_NETWORK = 63
SM_MENUDROPALIGNMENT = 40: SM_MOUSEWHEELPRESENT = 75: SM_CXSMSIZE = 52
SM_CYSMSIZE = 53: SM_CXMINSPACING = 47:
SM_CYMINSPACING = 48
SM_SAMEDISPLAYFORMAT = 81: SM_SECURE = 44: SM_ARRANGE = 56
SM_XVIRTUALSCREEN = 76: SM_YVIRTUALSCREEN = 77:
SM_CXVIRTUALSCREEN = 78
SM_CYVIRTUALSCREEN = 79
End Enum 'SystemMetricConsts

Private Const mcAPPERANCE3D As Long = 1
Private Const mcBORDERSTYLESINGLE As Long = 1
'Assumes that the text area is always inset 1 pixel on each side
Private Const mcINSET As Long = 2


Public Sub gTextBoxInner1(ByVal TextBox As TextBox, _
ByRef InnerWidth As Long, _
ByRef InnerHeight As Long)

With TextBox

If .BorderStyle = mcBORDERSTYLESINGLE Then
If .Appearance = mcAPPERANCE3D Then
InnerWidth = .Width - (mcINSET + GetSystemMetrics(SM_CXEDGE) * 2&)
InnerHeight = .Height - (mcINSET + GetSystemMetrics(SM_CYEDGE) * 2&)
Else
InnerWidth = .Width - (mcINSET + 2&)
InnerHeight = .Height - (mcINSET + 2&)
End If
Else
InnerWidth = .Width - mcINSET
InnerHeight = .Height - mcINSET
End If

If (.ScrollBars And vbVertical) = vbVertical Then _
InnerWidth = InnerWidth - GetSystemMetrics(SM_CXVSCROLL)
If (.ScrollBars And vbHorizontal) = vbHorizontal Then _
InnerHeight = InnerHeight - GetSystemMetrics(SM_CYHSCROLL)

End With

End Sub

Public Sub gTextBoxInner2(ByVal TextBox As TextBox, _
ByRef InnerWidth As Long, _
ByRef InnerHeight As Long)
Dim Rect As RECTAPI
With TextBox

'Get the client area. This is the inner area available for drawing text.
'Visible scrollbars are already subtracted!
GetClientRect .hWnd, Rect
'Subtract 2 because the area the textbox uses for drawing text is
inset 1 pixel at each side
InnerHeight = Rect.Bottom - mcINSET
InnerWidth = Rect.Right - mcINSET
End With
End Sub

Es gibt bei beiden Methoden noch ein kleines Problem: eine Textbox nutzt
nicht den ganzen Platz, sondern rückt von den Ràndern her ein.
Gewöhnlich ist das jeweils 1 Pixel auf jeder Seite. Das kann man aber
àndern (per API). Ich nehme hier fest 1 Pixel an. Und natürlich muß der
Container der Textbox den ScaleMode vbPixels haben!


Wolfgang Wolf schrieb:
Hallo,

hat jemand eine ScaleWidth-Funktion für die TextBox
(welche Border und Scrollbar berücksichtigt)?

Schöne Grüße
W. Wolf



Ulrich Korndoerfer

VB tips, helpers, solutions -> http://www.prosource.de/Downloads/
MS Newsgruppen Alternativen -> http://www.prosource.de/ms-ng-umzug.html

Ähnliche fragen