在 普通的文本框 里加入图片背景

王朝other·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

这是最终的运行结果。下面给出代码。

------------------------------------------窗口的代码-------------------

窗体:form1

图片框 picture1

文本框 text1

Private Sub Form_Load()

Set pic = LoadResPicture(102, 0)

Set Picture1.Picture = pic

Dim hdc As Long

hdc = GetDC(Text1.hwnd) '建立一个临时DC

memDc = CreateCompatibleDC(hdc)

MemBitmap = CreateCompatibleBitmap(hdc, Text1.Width, Text1.Height)

SelectObject memDc, MemBitmap

StretchBlt memDc, 0, 0, Text1.Width, Text1.Height, Picture1.hdc, 0, 0, Text1.Width, Text1.Height, SRCCOPY

ReleaseDC Text1.hwnd, hdc

If memDc = 0 Or MemBitmap = 0 Then

MsgBox "error create dc"

End

End If

Oldproc = SetWindowLong(Text1.hwnd, GWL_WNDPROC, AddressOf winproc)

OldWndProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf winproc1)

End Sub

Private Sub Form_Unload(Cancel As Integer)

DeleteObject MemBitmap

DeleteDC memDc

SetWindowLong Me.hwnd, GWL_WNDPROC, OldWndProc

SetWindowLong Text1.hwnd, GWL_WNDPROC, Oldproc

End Sub

Private Sub Text1_DblClick()

SendMessage Text1.hwnd, WM_PAINT, 0, 0

End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

SendMessage Text1.hwnd, WM_PAINT, 0, 0

End Sub

Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

'选定文本的时候如果文本选顶发生了变化,则通知更

Static Startpos0 As Long, Endpos0 As Long

Dim Startpos As Long, Endpos As Long

If Button = 1 Then

Dim v As Long

v = SendMessage(Text1.hwnd, EM_GETSEL, 0, 0)

Endpos = v \ 65536: Startpos = v Mod 65536 '-->获得选定文本位置

If Startpos <> Endpos Then '--->发现有选定时候检查选定是否和上次的相同?不同的话则重画

If Startpos0 = Startpos And Endpos = Endpos0 Then

Else '---->内容发生变化的时候发送消息请求重画

SendMessage Text1.hwnd, WM_PAINT, 0, 0

Startpos0 = Startpos: Endpos0 = Endpos

End If

End If

End If

End Sub

Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

PostMessage Text1.hwnd, WM_PAINT, 0, 0

End Sub

Private Sub Text1_Change()

SendMessage Form1.Text1.hwnd, WM_PAINT, 0, 0

End Sub

--------------------------------------------模块代码-------------------------------------------------

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Public Const WM_ERASEBKGND = &H14

Public Const EN_VSCROLL = &H602

Public Const WM_COMMAND = &H111

Public Const EN_HSCROLL = &H601

Public Const EN_CHANGE = &H300

Public Const EN_UPDATE = &H400

Public Const EM_GETSEL = &HB0

Public Const SRCCOPY = &HCC0020 ' (DWORD) dest = source

Public Const SRCAND = &H8800C6 ' (DWORD) dest = source AND dest

Public Const SRCPAINT = &HEE0086 ' (DWORD) dest = source OR dest

Public Const SRCERASE = &H440328 ' (DWORD) dest = source AND (NOT dest )

Public Const EM_SCROLL = &HB5

Public Const GWL_WNDPROC = (-4)

Public Const WM_PAINT = &HF

Public memDc As Long

Public MemBitmap As Long

Public OldWndProc As Long

Public Oldproc As Long

Public pic As Picture

Public Function winproc(ByVal hwnd As Long, ByVal msg As Long, ByVal wp As Long, ByVal lp As Long) As Long

With Form1.Text1

If msg = WM_PAINT Then

Debug.Print Token

Dim hdc As Long

winproc = CallWindowProc(Oldproc, Form1.Text1.hwnd, msg, wp, lp)

If wp = 1 Then .Visible = False: .Visible = True

hdc = GetDC(Form1.Text1.hwnd)

BitBlt hdc, 0, 0, Form1.Text1.Width, Form1.Text1.Height, memDc, 0, 0, SRCAND

ReleaseDC Form1.Text1.hwnd, hdc

Exit Function

End If

winproc = CallWindowProc(Oldproc, Form1.Text1.hwnd, msg, wp, lp)

End With

End Function

Public Function winproc1(ByVal hwnd As Long, ByVal msg As Long, ByVal wp As Long, ByVal lp As Long) As Long

If msg = WM_COMMAND Then

Select Case wp \ 65536

Case EN_VSCROLL '---->获得文本框纵向滚动消息

SendMessage Form1.Text1.hwnd, WM_PAINT, 1, 0

Case EN_HSCROLL '----->获得横向滚动消息

SendMessage Form1.Text1.hwnd, WM_PAINT, 1, 0

Case EN_UPDATE

SendMessage Form1.Text1.hwnd, WM_PAINT, 0, 0

End Select

End If

winproc1 = CallWindowProc(OldWndProc, hwnd, msg, wp, lp)

End Function

-------------------------------------------------------------------------------------------------------

这样就可以 在图片里加如图片的背景了。

本程序在 2000/XP 下调试通过。有一个缺点是闪动比较厉害,希望各位大虾指正。

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航