设定StatusBar的文字成不同的颜色

 

 

设定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

补充：软件开发 , Vb ,
上一个：实现画面的各种切换方法
下一个：闪烁的标题栏
更多图片编程知识:

vb菜单的小图标

帮忙修改一段代码

用VB6.0设计随机选车牌的程序

求助！！！！！！！！！

小马过河

求VB实现的服装管理数据库！要完整的，后送上百分！！
  
更多VB疑问解答：
vb把图片转换成 base64代码
批处理转移文 之errorlevel
vb 6.0 调用vb.net dll混合程序集错误
VB inet控件访问ftp 本机测试通过客户机inet控件使用失败。急！！
求助在Dir1控件当前目录下新建一个文件夹的代码
CreateObject创建Word Excel对象失败，提示，无法加载DLL，怎么解决？
有两个磁盘阵列,如何使用能达到最好的效果
cloudStack 如何实现 vSphere的DRS功能
和难缠客户的那些事儿
批处理转移文 之errorlevel
vb 6.0 调用vb.net dll混合程序集错误
VB inet控件访问ftp 本机测试通过客户机inet控件使用失败。急！！
求助在Dir1控件当前目录下新建一个文件夹的代码
CreateObject创建Word Excel对象失败，提示，无法加载DLL，怎么解决？
有两个磁盘阵列,如何使用能达到最好的效果