请问statusbar的pannel中所显示的字体能否设置字体的颜色?急~~~~~~

echo_zx 2004-01-07 12:51:33
我查了一下,没找到相应的属性。
另外,toolbar中可以吗?
...全文
329 7 打赏 收藏 转发到动态 举报
写回复
用AI写文章
7 条回复
切换为时间正序
请发表友善的回复…
发表回复
rainstormmaster 2004-01-08
  • 打赏
  • 举报
回复
或者你试试在窗体中放入一个隐藏的图片框(可设置前景色和背景色),根据需要适时在图片框上print 输出文字,然后设置:
StatusBar.Panels(Index).Picture =picturebox.Image

注意,图片框的autoredraw属性要设为true
flyingZFX 2004-01-08
  • 打赏
  • 举报
回复
上面的程序都有问题,,,只窗体稍微的改变一下大小,文字就消失了,不好不好
rainstormmaster 2004-01-07
  • 打赏
  • 举报
回复
mdi中有许多属性不在被支持了,当然就不行了,不过也可以实现,当然代码要复杂一些
echo_zx 2004-01-07
  • 打赏
  • 举报
回复
我在mdi主窗体中试过上面的代码,怎么不行?
northwolves 2004-01-07
  • 打赏
  • 举报
回复
好。
你也可以加一个textbox模拟:
Private Sub Command2_Click()
StatusBar1.Panels.Add 1, , "abcd"
StatusBar1.Panels.Add 2, , "1234"
Text1.Move StatusBar1.Panels(1).Left + 40, StatusBar1.Top + 40, StatusBar1.Panels(1).Width - 100, StatusBar1.Height - 100
Text1.Text = StatusBar1.Panels(1).Text & vbCrLf & "with color"
Text1.BorderStyle = 0
Text1.Appearance = 0
Text1.backcolor = Me.backcolor
Text1.ForeColor = vbRed
End Sub
rainstormmaster 2004-01-07
  • 打赏
  • 举报
回复
toolbar的实现是一样的原理,要想真正实现,必须Owner Draw,比较麻烦,具体的可以看看msdn
rainstormmaster 2004-01-07
  • 打赏
  • 举报
回复
窗体:
Option Explicit

'设定StatusBar的文字成不同的颜色
'设定StatusBar上的文字,该文字以StatusBar所在Form的字型设定为准,并以form
'的ForeColor为字的颜色,文字过长时,自动会截除
'这个程式的实质意义不太大,因为当文字被盖掉後需自行重新再呼叫这个Sub才能再
'将文字显示出来,除非我们再使用Subclassing的方式,於statusBar接收到WM_PAINT
'时,去呼叫这个SubRoutine,这程式着重於Font的了解
'窗体代码:
Private Sub Command1_Click()
Call ShowPanelText(StatusBar1, 1, "test", vbGreen, vbBlack)
End Sub

'第一个叁数传入StatusBar
'第二个叁数表示文字要在第几个panel上 显示,由1算起
'第三个叁数是待显示的字串
'第四个叁数是待显示的字串的前景色
'第五个叁数是待显示的字串的背景色
Private Sub ShowPanelText(StatusBar1 As StatusBar, Pno As Long, ByVal PanelText As String, mForeColor As Long, backcolor As Long)
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, mForeColor) '设字的颜色
bkcolor = backcolor
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
模块:
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 Long

Declare 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 Long
Public Const COLOR_BTNFACE = 15
Public Const TA_TOP = 0

1,451

社区成员

发帖
与我相关
我的任务
社区描述
VB 控件
社区管理员
  • 控件
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧