1,486
社区成员
发帖
与我相关
我的任务
分享【问】如何让ListBox的文字向右对齐？
只让它显示成向右对齐，但实际的List(I)内容却不改变
也就是说不是用插入多余的空格之类的办法。（主要是考虑效率的问题）
请问，能做到文字向右对齐吗？不知道自绘能做到吗？
注：这里只讨论VB内部控件，任何外接控件（比如ListView）不在考虑范围，谢谢！
也就是说不是用插入多余的空格之类的办法。（主要是考虑效率的问题）
请问，能做到文字向右对齐吗？不知道自绘能做到吗？
注：这里只讨论VB内部控件，任何外接控件（比如ListView）不在考虑范围，谢谢！
...全文
请发表友善的回复…
发表回复
vansoft 2006-01-06
- 打赏
- 举报
为什么每行前面必须加个vbTab呢？
否则就不行。
否则就不行。
northwolves 2006-01-05
- 打赏
- 举报
以上代码来自
http://vbnet.mvps.org/index.html?code/listapi/listrightalign.htm
http://vbnet.mvps.org/index.html?code/listapi/listrightalign.htm
northwolves 2006-01-05
- 打赏
- 举报
Private Const LB_SETTABSTOPS As Long = &H192
Private Const WM_GETFONT = &H31
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type SIZE
cx As Long
cy As Long
End Type
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
Private Declare Function GetDialogBaseUnits Lib "user32" () As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" _
Alias "GetTextExtentPoint32A" _
(ByVal hDC As Long, _
ByVal lpString As String, _
ByVal cbString As Long, _
lpSize As SIZE) As Long
Private Declare Function GetDC Lib "user32" _
(ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
(ByVal hWnd As Long, _
ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hDC As Long, _
ByVal hObject As Long) As Long
Private Declare Function GetClientRect Lib "user32" _
(ByVal hWnd As Long, _
lpRect As RECT) As Long
Private Function CalcPixelsPerDlgUnit(hwndLB As Long) As Single
'Returns the number of pixels-per-dialog
'unit for the given font.
'
'Provided to VBnet by Brad Martinez
Dim hFont As Long
Dim hFontOld As Long
Dim hDC As Long
Dim sz As SIZE
Dim cxAvLBChar As Long 'average LB char width, in pixels
Dim cxDlgBase As Long 'horizontal dialog box base units
Const sChars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"
'get the device contect of the listbox
hDC = GetDC(hwndLB)
If hDC Then
'select hwndLB's HFONT into its DC (VB
'does not select a control's Font into its DC)
hFont = SendMessage(hwndLB, WM_GETFONT, 0, ByVal 0&)
hFontOld = SelectObject(hDC, hFont)
If GetTextExtentPoint32(hDC, sChars, Len(sChars), sz) Then
'get the list box average char width
'and the system's horizontal dialog
'base units
cxAvLBChar = sz.cx / Len(sChars)
cxDlgBase = GetDialogBaseUnits And &HFFFF&
'calculate and return the number of
'pixels per dialog unit for the list
CalcPixelsPerDlgUnit = (2 * cxAvLBChar) / cxDlgBase
End If
Call SelectObject(hDC, hFontOld)
Call ReleaseDC(hwndLB, hDC)
End If
End Function
Private Sub Form_Load()
Dim x As Long
For x = 0 To Screen.FontCount - 1
List1.AddItem vbTab & Screen.Fonts(x)
Next
Dim hwndLB As Long
Dim rc As RECT
ReDim tabarray(0 To 0) As Long
'Assign list handle to a variable.
'A good rule of thumb is if you are
'using a property more than three
'times in a routine, it becomes more
'efficient to assign and use a variable
'rather than re-reference the property.
hwndLB = List1.hWnd
Call GetClientRect(hwndLB, rc)
'calculate the tab to align with
'the right-most edge.
tabarray(0) = -((rc.Right - rc.Left) / CalcPixelsPerDlgUnit(hwndLB))
'Clear any existing tabs and set the
'new tabstop
Call SendMessage(List1.hWnd, LB_SETTABSTOPS, 0&, ByVal 0&)
Call SendMessage(List1.hWnd, LB_SETTABSTOPS, 1&, tabarray(0))
List1.Refresh
End Sub
Private Const WM_GETFONT = &H31
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type SIZE
cx As Long
cy As Long
End Type
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
Private Declare Function GetDialogBaseUnits Lib "user32" () As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" _
Alias "GetTextExtentPoint32A" _
(ByVal hDC As Long, _
ByVal lpString As String, _
ByVal cbString As Long, _
lpSize As SIZE) As Long
Private Declare Function GetDC Lib "user32" _
(ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
(ByVal hWnd As Long, _
ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hDC As Long, _
ByVal hObject As Long) As Long
Private Declare Function GetClientRect Lib "user32" _
(ByVal hWnd As Long, _
lpRect As RECT) As Long
Private Function CalcPixelsPerDlgUnit(hwndLB As Long) As Single
'Returns the number of pixels-per-dialog
'unit for the given font.
'
'Provided to VBnet by Brad Martinez
Dim hFont As Long
Dim hFontOld As Long
Dim hDC As Long
Dim sz As SIZE
Dim cxAvLBChar As Long 'average LB char width, in pixels
Dim cxDlgBase As Long 'horizontal dialog box base units
Const sChars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"
'get the device contect of the listbox
hDC = GetDC(hwndLB)
If hDC Then
'select hwndLB's HFONT into its DC (VB
'does not select a control's Font into its DC)
hFont = SendMessage(hwndLB, WM_GETFONT, 0, ByVal 0&)
hFontOld = SelectObject(hDC, hFont)
If GetTextExtentPoint32(hDC, sChars, Len(sChars), sz) Then
'get the list box average char width
'and the system's horizontal dialog
'base units
cxAvLBChar = sz.cx / Len(sChars)
cxDlgBase = GetDialogBaseUnits And &HFFFF&
'calculate and return the number of
'pixels per dialog unit for the list
CalcPixelsPerDlgUnit = (2 * cxAvLBChar) / cxDlgBase
End If
Call SelectObject(hDC, hFontOld)
Call ReleaseDC(hwndLB, hDC)
End If
End Function
Private Sub Form_Load()
Dim x As Long
For x = 0 To Screen.FontCount - 1
List1.AddItem vbTab & Screen.Fonts(x)
Next
Dim hwndLB As Long
Dim rc As RECT
ReDim tabarray(0 To 0) As Long
'Assign list handle to a variable.
'A good rule of thumb is if you are
'using a property more than three
'times in a routine, it becomes more
'efficient to assign and use a variable
'rather than re-reference the property.
hwndLB = List1.hWnd
Call GetClientRect(hwndLB, rc)
'calculate the tab to align with
'the right-most edge.
tabarray(0) = -((rc.Right - rc.Left) / CalcPixelsPerDlgUnit(hwndLB))
'Clear any existing tabs and set the
'new tabstop
Call SendMessage(List1.hWnd, LB_SETTABSTOPS, 0&, ByVal 0&)
Call SendMessage(List1.hWnd, LB_SETTABSTOPS, 1&, tabarray(0))
List1.Refresh
End Sub
