首页
社区
课程
招聘
[求助]如何才能给vb6的text控件加个背景图片?
发表于: 2008-3-3 19:41 6517

[求助]如何才能给vb6的text控件加个背景图片?

2008-3-3 19:41
6517
收藏
免费 0
支持
分享
最新回复 (11)
雪    币: 2384
活跃值: (766)
能力值: (RANK:410 )
在线值:
发帖
回帖
粉丝
2
'子类化窗口函数。
'Module.pas File (在VB的全局模块文件定义如下代码,注:一定要全局模块里定义如下代码)
Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpProc As Long, ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Public Const GWL_WNDPROC = -4
Public Const WM_CTLCOLOREDIT = &H133
Public Const TRANSPARENT = 1
Public lpOldProc As Long
Public hBlackBrush As Long

Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  If uMsg = WM_CTLCOLOREDIT Then
    SetBkMode wParam, TRANSPARENT
    WndProc = hBlackBrush '替换Text的背景刷子换成我们定义的图像背景刷子。
    Exit Function
  End If
  WndProc = CallWindowProc(lpOldProc, hwnd, uMsg, wParam, lParam)
End Function

'Code File (在程序的代码文件写入如下过程)
Private Sub Form_Load()
  Image1.Visible = False '这里我使用了Image1控件加载一张图片并隐藏Image控件
  hBlackBrush = CreatePatternBrush(Image1.Picture.Handle) '用Image控件加载的图片创建一个Text使用的刷子
  lpOldProc = GetWindowLong(hwnd, GWL_WNDPROC)
  SetWindowLong hwnd, GWL_WNDPROC, AddressOf WndProc
End Sub

Private Sub Form_Unload(Cancel As Integer)
  If hBlackBrush <> 0 Then
    DeleteObject hBlakBrush
  End If
End Sub
2008-3-3 23:57
0
雪    币: 321
活跃值: (271)
能力值: ( LV13,RANK:1050 )
在线值:
发帖
回帖
粉丝
3
好,回答的精彩
2008-3-4 08:29
0
雪    币: 223
活跃值: (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
4
太利害..
2008-3-4 17:19
0
雪    币: 208
活跃值: (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
5
Good ! ~
2008-3-6 16:32
0
雪    币: 266
活跃值: (52)
能力值: ( LV9,RANK:210 )
在线值:
发帖
回帖
粉丝
6
好,学了一招
2008-3-6 20:10
0
雪    币: 209
活跃值: (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
7
谢谢2楼的精彩回答,不过text中的字体颜色好像改不了了。
2008-3-9 21:22
0
雪    币: 2384
活跃值: (766)
能力值: (RANK:410 )
在线值:
发帖
回帖
粉丝
8
当然的,因为修改字体和背景的消息都给拦了。你可以再加一个SetTextColor函数修改字体颜色。
call SetTextColor(wParam,&H0000ff); // 字体设置为红色。你要修改颜色只须修改&H******的值就行了。
2008-3-9 21:28
0
雪    币: 209
活跃值: (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
9
在哪加啊?在模块中加call SetTextColor(wParam,&H0000ff)后,运行就退出。
2008-3-9 21:48
0
雪    币: 2384
活跃值: (766)
能力值: (RANK:410 )
在线值:
发帖
回帖
粉丝
10
在模块文件里添加
Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal ncrColor As Long) As Long

Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  If uMsg = WM_CTLCOLOREDIT Then
    SetBkMode wParam, TRANSPARENT
    SetTextColor wParam, &HFF
    WndProc = hBlackBrush '替换Text的背景刷子换成我们定义的图像背景刷子。
    Exit Function
  End If
  WndProc = CallWindowProc(lpOldProc, hwnd, uMsg, wParam, lParam)
End Function
2008-3-9 22:01
0
雪    币: 209
活跃值: (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
11
谢谢小虾,终于成功了。
2008-3-9 22:07
0
雪    币: 209
活跃值: (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
12
谢谢小虾,终于成功了
2008-3-9 22:22
0
游客
登录 | 注册 方可回帖
返回
//