form1.frm

很好的教程原代码！

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   BackColor       =   &H8000000B&
   Caption         =   "Form1"
   ClientHeight    =   2940
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5745
   ForeColor       =   &H0080FF80&
   LinkTopic       =   "Form1"
   ScaleHeight     =   2940
   ScaleWidth      =   5745
   StartUpPosition =   3  '窗口缺省
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   375
      Left            =   0
      TabIndex        =   1
      Top             =   2565
      Width           =   5745
      _ExtentX        =   10134
      _ExtentY        =   661
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   1
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
      EndProperty
   End
   Begin VB.CommandButton Command1 
      Caption         =   "设定状态条文字颜色"
      Height          =   735
      Left            =   1560
      TabIndex        =   0
      Top             =   960
      Width           =   2175
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'below is within Form
Private Sub Command1_Click()
Call ShowPanelText(StatusBar1, 1, "设定状态条的文字颜色")
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