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 Const CCM_FIRST = &H2000 Private Const CCM_SETBKCOLOR = (CCM_FIRST + 1) Private Const SB_SETBKCOLOR = CCM_SETBKCOLORPrivate Sub Form_Load() SendMessage StatusBar1.hwnd, SB_SETBKCOLOR, 0, ByVal RGB(128, 128, 255) End Sub
//另外,设置其文字颜色应该用什么参数?没有这样的消息,你要么用图片代替,要么自绘//我对API函数还不是很熟,照你这样使用后发现StatusBar控件右边还有一小部分是默认的按钮表面色,请问该怎么调整参数使整个控件颜色统一?(StatusBar属性我用的是1-sbrSimple)这是StatusBar控件具有的SBARS_SIZEGRIP风格的具体表现SBARS_SIZEGRIP The status bar control will include a sizing grip at the right end of the status bar. A sizing grip is similar to a sizing border; it is a rectangular area that the user can click and drag to resize the parent window. 解决办法: 1:设置StatusBar控件的Align属性为0(其实不是2就行,但估计只有0才符合你的要求)这种方法需要你处理窗体的 Form_Resize事件2:改变窗体的BorderStyle属性,BorderStyle属性值为0、1、3、4都可以3:自己用代码创建StatusBar,一切都在你掌握之中
楼上的高人讲的不错,修改字体颜色我知道是哪个api函数,但有一个常数的值暂时找不到 我再找找看。
刚才找到篇文章《设定StatusBar的文字成不同的颜色》,试了一下,成功了。 在此贴出来与大家分享。同时,仍期待laviewpbt(pbt) 朋友的方法。------------------------------------------------------------------------- 设定StatusBar上的文字,该文字以StatusBar所在Form的字型设定为准,并以form 的ForeColor为字的颜色,文字过长时,自动会截除 这个程式的实质意义不太大,因为当文字被盖掉後需自行重新再呼叫这个Sub才能再 将文字显示出来,除非我们再使用Subclassing的方式,於statusBar接收到WM_PAINT 时,去呼叫这个SubRoutine,这程式着重於Font的了解------------------------------------------------------------------------- 'below is within Form Private Sub Command1_Click() Call ShowPanelText(StatusBar1, 1, "这是一个有趣的程式hahahaha") End Sub'第一个叁数传入StatusBar '第二个叁数表示文字要在第几个panel上 显示,由1算起 '第三个叁数是待显示的字串 Private Sub ShowPanelText(StatusBar1 As StatusBar, Pno As Long, ByVal PanelText As String) Dim bkcolor As Long Dim Color As Long Dim res As Long Dim aRect As RECT, rect5 As RECT Dim hfont As Long Dim hdc2 As Long Dim TextHeight As Long Dim tx As TEXTMETRIC Dim oScaleT As Long, oScaleL As Long, oScaleH As Long, oScaleW As Long Dim oScaleM As Long oScaleM = Me.ScaleMode oScaleT = Me.ScaleTop oScaleL = Me.ScaleLeft oScaleH = Me.ScaleHeight oScaleW = Me.ScaleWidth Me.ScaleMode = 3 hdc2 = GetDC(StatusBar1.hwnd) Call GetTextMetrics(Me.hdc, tx) '取得form 字型资讯 hfont = CreateFont(tx.tmHeight, tx.tmAveCharWidth, 0, 0, _ tx.tmWeight, 0, 0, 0, tx.tmCharSet, 0, 0, 0, _ tx.tmPitchAndFamily, Me.Font.Name) '依form的字型产生另一个font '因为不知如何取得font的handle只好,使用CreateFont的方式来取得 hfont Call SelectObject(hdc2, hfont) '设字型 res = SetTextColor(hdc2, Me.ForeColor) '设字的颜色 bkcolor = GetSysColor(COLOR_BTNFACE) SetBkColor hdc2, bkcolor '设字的背景色 SetTextAlign hdc2, TA_TOP TextHeight = Me.TextHeight(PanelText) aRect.Top = (StatusBar1.Height - TextHeight) \ 2 If StatusBar1.Style = 0 Then aRect.Left = StatusBar1.Panels(Pno).Left + 2 aRect.Right = aRect.Left + StatusBar1.Panels(Pno).Width - 6 Else aRect.Left = StatusBar1.Left + 2 aRect.Right = StatusBar1.Width - 6 End If aRect.Bottom = StatusBar1.Height InvalidateRect StatusBar1.hwnd, aRect, 1 '宣告工作区无效,用来重画statusBar UpdateWindow StatusBar1.hwnd DrawText hdc2, PanelText, LenB(StrConv(PanelText, vbFromUnicode)), aRect, 0 ReleaseDC StatusBar1.hwnd, hdc2 DeleteObject (hfont) Me.ScaleMode = oScaleM Me.ScaleHeight = oScaleH Me.ScaleTop = oScaleT Me.ScaleLeft = oScaleL Me.ScaleWidth = oScaleW End Sub------------------------------------------------------------------------- 'below is within .bas module Option Explicit Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Type TEXTMETRIC tmHeight As Long tmAscent As Long tmDescent As Long tmInternalLeading As Long tmExternalLeading As Long tmAveCharWidth As Long tmMaxCharWidth As Long tmWeight As Long tmOverhang As Long tmDigitizedAspectX As Long tmDigitizedAspectY As Long tmFirstChar As Byte tmLastChar As Byte tmDefaultChar As Byte tmBreakChar As Byte tmItalic As Byte tmUnderlined As Byte tmStruckOut As Byte tmPitchAndFamily As Byte tmCharSet As Byte End Type Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" _ (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, _ ByVal W As Long, ByVal I As Long, ByVal u As Long, ByVal S As Long, _ ByVal C As Long, ByVal OP As Long, ByVal CP As Long, _ ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" _ (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, _ ByVal crColor As Long) As Long Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _ ByVal hdc As Long) As Long Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, _ ByVal crColor As Long) As Long Declare Function SetTextAlign Lib "gdi32" (ByVal hdc As Long, _ ByVal wFlags As Long) As Long Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _ ByVal hObject As Long) As Long Declare Function DrawText Lib "user32" Alias "DrawTextA" _ (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, _ lpRect As RECT, ByVal wFormat As Long) As Long Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, _ lpRect As RECT, ByVal bErase As Long) As LongDeclare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPublic Const COLOR_BTNFACE = 15 Public Const TA_TOP = 0
Private Const CCM_FIRST = &H2000
Private Const CCM_SETBKCOLOR = (CCM_FIRST + 1)
Private Const SB_SETBKCOLOR = CCM_SETBKCOLORPrivate Sub Form_Load()
SendMessage StatusBar1.hwnd, SB_SETBKCOLOR, 0, ByVal RGB(128, 128, 255)
End Sub
我对API函数还不是很熟,照你这样使用后发现StatusBar控件右边还有一小部分是默认的按钮表面色,请问该怎么调整参数使整个控件颜色统一?(StatusBar属性我用的是1-sbrSimple)另外,设置其文字颜色应该用什么参数?再次谢谢!
(StatusBar控件的Style属性我用的是1-sbrSimple)
The status bar control will include a sizing grip at the right end of the status bar. A sizing grip is similar to a sizing border; it is a rectangular area that the user can click and drag to resize the parent window. 解决办法:
1:设置StatusBar控件的Align属性为0(其实不是2就行,但估计只有0才符合你的要求)这种方法需要你处理窗体的 Form_Resize事件2:改变窗体的BorderStyle属性,BorderStyle属性值为0、1、3、4都可以3:自己用代码创建StatusBar,一切都在你掌握之中
我再找找看。
在此贴出来与大家分享。同时,仍期待laviewpbt(pbt) 朋友的方法。-------------------------------------------------------------------------
设定StatusBar上的文字,该文字以StatusBar所在Form的字型设定为准,并以form
的ForeColor为字的颜色,文字过长时,自动会截除
这个程式的实质意义不太大,因为当文字被盖掉後需自行重新再呼叫这个Sub才能再
将文字显示出来,除非我们再使用Subclassing的方式,於statusBar接收到WM_PAINT
时,去呼叫这个SubRoutine,这程式着重於Font的了解-------------------------------------------------------------------------
'below is within Form
Private Sub Command1_Click()
Call ShowPanelText(StatusBar1, 1, "这是一个有趣的程式hahahaha")
End Sub'第一个叁数传入StatusBar
'第二个叁数表示文字要在第几个panel上 显示,由1算起
'第三个叁数是待显示的字串
Private Sub ShowPanelText(StatusBar1 As StatusBar, Pno As Long, ByVal PanelText
As String)
Dim bkcolor As Long
Dim Color As Long
Dim res As Long
Dim aRect As RECT, rect5 As RECT
Dim hfont As Long
Dim hdc2 As Long
Dim TextHeight As Long
Dim tx As TEXTMETRIC
Dim oScaleT As Long, oScaleL As Long, oScaleH As Long, oScaleW As Long
Dim oScaleM As Long oScaleM = Me.ScaleMode
oScaleT = Me.ScaleTop
oScaleL = Me.ScaleLeft
oScaleH = Me.ScaleHeight
oScaleW = Me.ScaleWidth
Me.ScaleMode = 3 hdc2 = GetDC(StatusBar1.hwnd)
Call GetTextMetrics(Me.hdc, tx) '取得form 字型资讯
hfont = CreateFont(tx.tmHeight, tx.tmAveCharWidth, 0, 0, _
tx.tmWeight, 0, 0, 0, tx.tmCharSet, 0, 0, 0, _
tx.tmPitchAndFamily, Me.Font.Name) '依form的字型产生另一个font
'因为不知如何取得font的handle只好,使用CreateFont的方式来取得 hfont
Call SelectObject(hdc2, hfont) '设字型
res = SetTextColor(hdc2, Me.ForeColor) '设字的颜色
bkcolor = GetSysColor(COLOR_BTNFACE)
SetBkColor hdc2, bkcolor '设字的背景色
SetTextAlign hdc2, TA_TOP
TextHeight = Me.TextHeight(PanelText)
aRect.Top = (StatusBar1.Height - TextHeight) \ 2
If StatusBar1.Style = 0 Then
aRect.Left = StatusBar1.Panels(Pno).Left + 2
aRect.Right = aRect.Left + StatusBar1.Panels(Pno).Width - 6
Else
aRect.Left = StatusBar1.Left + 2
aRect.Right = StatusBar1.Width - 6
End If
aRect.Bottom = StatusBar1.Height
InvalidateRect StatusBar1.hwnd, aRect, 1 '宣告工作区无效,用来重画statusBar
UpdateWindow StatusBar1.hwnd
DrawText hdc2, PanelText, LenB(StrConv(PanelText, vbFromUnicode)), aRect, 0
ReleaseDC StatusBar1.hwnd, hdc2
DeleteObject (hfont)
Me.ScaleMode = oScaleM
Me.ScaleHeight = oScaleH
Me.ScaleTop = oScaleT
Me.ScaleLeft = oScaleL
Me.ScaleWidth = oScaleW
End Sub-------------------------------------------------------------------------
'below is within .bas module
Option Explicit
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Type TEXTMETRIC
tmHeight As Long
tmAscent As Long
tmDescent As Long
tmInternalLeading As Long
tmExternalLeading As Long
tmAveCharWidth As Long
tmMaxCharWidth As Long
tmWeight As Long
tmOverhang As Long
tmDigitizedAspectX As Long
tmDigitizedAspectY As Long
tmFirstChar As Byte
tmLastChar As Byte
tmDefaultChar As Byte
tmBreakChar As Byte
tmItalic As Byte
tmUnderlined As Byte
tmStruckOut As Byte
tmPitchAndFamily As Byte
tmCharSet As Byte
End Type
Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" _
(ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, _
ByVal W As Long, ByVal I As Long, ByVal u As Long, ByVal S As Long, _
ByVal C As Long, ByVal OP As Long, ByVal CP As Long, _
ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" _
(ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, _
ByVal crColor As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
ByVal hdc As Long) As Long
Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, _
ByVal crColor As Long) As Long
Declare Function SetTextAlign Lib "gdi32" (ByVal hdc As Long, _
ByVal wFlags As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
ByVal hObject As Long) As Long
Declare Function DrawText Lib "user32" Alias "DrawTextA" _
(ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, _
lpRect As RECT, ByVal wFormat As Long) As Long
Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, _
lpRect As RECT, ByVal bErase As Long) As LongDeclare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPublic Const COLOR_BTNFACE = 15
Public Const TA_TOP = 0