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