说三道四技术文摘-感悟人生的经典句子
说三道四 > 文档快照

设定StatusBar的文字成不同的颜色-VB资料

HTML文档下载 WORD文档下载 PDF文档下载
设定StatusBar的文字成不同的颜色-VB资料


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

在VB应用程序中恰当的使用声音 在VB应用软件中实现动画效果 在VB中播放AVI文件 在VB中建立司旋转的文本特效 在VB中如何创建闪烁(标语)屏 在VB中显示动画鼠标图标 在VB中用PictureClip控件实现动画 在Visual Basic 6.0中实现自动播放VCD VB怎样在VB中播放Flash动画。 VB制作TopMost窗口 VB制作带有动画和声音的屏幕保护程序 VB制作自己的MP3播放器 用VB实现鼠标的隐藏 0、""(空字串)、Null、Empty、与 Nothing 的区别 -VB资料 VB中获取逻辑磁盘的信息 Command & Conquer 文件格式-VB资料 CrystaIReports for VB5报表编程经验 DirectX揭密-VB资料 HOOKS 说明书-VB资料 kb_event函数的使用 -VB资料 MaskEdit 中 9 的问题 -VB资料 MDB文件的导出(使用DAO)-VB资料 PaintPicture的和法 -VB资料 Shell & Wait 的程序怎么写? -VB资料 SHELL语句用法心得-VB资料 VarPtr、StrPtr和ObjPtr函数的用法-VB资料 VB 在ACADWIN中的使用 VB5.0应用程序的启动与退出设计 VB5如何取得CDROM的盘符? VB5三十六计 VB5中确定CPU类型 气死了,肺要炸了 在一个干干净净的98se上,如果想要运行一个C#的程序,需要安装哪些文件?注册哪些信息? 插入数据,简单问题,UP有分. 时间计算出错!急啊!!! 为什么我画透明位图,重画了n次后,位图会显示为黑色,重画次数少没问题 快来呀! 如何使用BDE打开有密码的PRODOX的数据库 为什么用Windows Media Encoder9做网络电台,有5个人连上后就不能有人再连接 update的问题 没分了,但还是要提问:为什么我的sleep(2000)会出错。 系统分析员工作状况和薪资大调查 我的自己怎么浏览 不了ASP。NET 如何在运行过程中动态生成一个非可视化的控件? 局域网中为什么就我不能共享上网? 有没有人帮忙? asc转换成字符的问题 关于句柄的解释! 在职研究生,值不值? 高分请教:指针赋值问题 用PB我怎么样才能一句一句读TXT文件??? 笑死不陪命!! http://top2u.net/~ec-soft 帮帮忙,解决一个不是asp的问题,给分!! 如何实现这样的功能 笑死不陪命!! http://top2u.net/~ec-soft qq设计 奇怪的VF,怎么修改Label1的caption? 赠送小程序者有分 如何配置外置Moderm??? 用户游览时在页面上启动了一个Timer,如何在用户关闭游览器时停止此Timer? 关于JBuilder中MSSQL2000在EJB设计时DataSource的连接问题?求救!!! linux 0.01是在UNIX上开发的吗? 裸机上怎么成功引导它的呢? 大家看看我程序错在何处,谢谢了 winroute代理怎么设置让指定的用户只能在指定的时间上网。。。 怎样写一份采用J2EE的框架的软件测试报告? C#还能使用BHO吗?如果能100分求C#使用BHO(browser helper object)的例子。 请问如何制作Win98启动盘(我现在没有Win98的机子)? 关于换行的问题 javascript判断操作系统 一个奇怪的time问题,偶是菜鸟了~~~~~~~~~~~ d7版本所带的qr是什么版本的? 请教:创建数据库表时,怎样突破默认字段长度? 免费注册 Jboss 或 应用服务器 除了网上有,买d版的不知道有没有啊,下载太慢啊!! datagrid 中的一例为4位小数的数据,如何在datagrid设置使其值显示为带二位小数?? 让你的企业、产品、网站一夜成名 企业中一般如何写数据字典阿?急,在线等待 文件上传 如何将txt文件导入mdb文件之中,在线等,解决问题立即给分。 在菜单中打开MDI窗口,但是每一次点击,就出现一个新窗口,如何只出现一个? 大侠,救命啊,这个编译错误,折磨我好几天了,如何解决啊?????? 求C语言程序:从键盘上输入若干个证书,去掉重复的,将剩余数的前n个输出显示 新手发问(有关C#和MySQL数据库)! About three hundred stars are shining in the sky 还是用 three hundred of stars 如何做的 courtesy什么意思音标 谁说的Only three things are infinite: the sky in its stars, the sea in its internet courtesy 原句是:Within a few seconds,she connects to the Internet courtesy of Starbuck's deal with T-mobile to create wireless HotSpots at over a thousand Starbucks stores. piece对吗 piece怎么读 piece together 如何用在什么情况下用这个词组,它是指把什么拼凑/组合成什么,是一个抽象的概念还是类似拼拼图似的? My life has been very calm just recentle.I like this kind of general antiderivative是什么意思 koop off the grass的意思和第2天英文意思 微积分indefinite integralEvaluate the indefinite integral.(Remember to use ln(abs(u)) where appropriate.) e^2x/e^2x+7 dx 海南多市现轻度污染 专家称大气远程迁马尼拉市长称并非只向华商募集人质事件30万欧元塞浦路斯购房可获永居权朴槿惠为球赛开球英国报纸窃听丑闻开庭审理天文学家发现酷似太阳系行星系美政府高官因奥巴马医改核心举措漏洞频国有银行副处长杀妻判死刑 被曝与多名村主任骗千万拆迁款获刑14年 称不了中国疾控中心专家:H7N9禽流感疫情纽约油价29日下跌男人怎么过圣诞节?待你胡子及腰,借我爸爸是个骗子:风靡全球,提前祝所有爸【快点回家】全球12大快销品牌你所不当人贩子知道只有一死,他会…看完这个,你还敢随意畅饮红酒吗?惊呆戴珠宝十男九Gay?要戴Man很简单土豪家9000万电视机墙,看完惊呆了【每周宝姐答疑】品质决定价值,不可一酒店人2015年的15个决心,你有吗【海味珠宝】从海里捞几套首饰戴戴吧激励30亿人的短片,声音调大,让你瞬
备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘