日期:2011-12-02  浏览次数:20377 次

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

窗体: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 Functio