This is the final result. The code is given below.
--------------------------------------------- ----------------
Form 1
Picture box Picture1
Text box text1
Private Sub Form_Load () Set pic = LoadResPicture (102, 0) Set Picture1.Picture = pic Dim hdc As Long hdc = GetDC (Text1.hwnd) 'to establish a temporary 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, OldprocEnd SubPrivate Sub Text1_DblClick () SendMessage Text1.hwnd, WM_PAINT, 0, 0End Sub
PRIVATE SUB TEXT1_MOUSEDOWN (Button as Integer, Shift As Integer, x as single, y as single) sendMessage text1.hwnd, wm_paint, 0, 0nd Sub
Private Sub Text1_MouseMove (Button As Integer, Shift As Integer, X as Single, Y as Single) When the text is selected, if the text selection changes, notify more 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 '-> Get selected text location if StartPOS <> Endpos Then '---> Found There is a selected time to check whether the selected is the same as the last time? Different words, then heavy painting if startpos0 = startpos and endpos = endpos0 then else '----> Send a message When the content changes, send a message to Heavy SendMessage Text1.hWnd, WM_Paint, 0, 0 StartPos0 = StartPos: Endpos0 = ENDPOS END IF Endness1_mouseUp (Button as Integer, Shift As Integer, x as single, y as single) PostMessage Text1.hwnd, WM_Paint, 0, 0nd Sub
Private sub text1_change () sendMessage form1.text1.hwnd, wm_paint, 0, 0nd Sub ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- ------------ Module code ---------------------------------------------------- -------------
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic 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 LongPublic 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 LongPublic Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long , lParam As Any) As LongPublic Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPublic Declare Function CreateCompatibleDC Lib "gdi32" (ByVal HDC as long) As longpublic declare function ion CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As LongPublic Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As LongPublic Declare Function DeleteObject Lib "gdi32 "(ByVal hObject As Long) As LongPublic Declare Function DeleteDC Lib" gdi32 "(ByVal hdc As Long) As LongPublic Declare Function GetDC Lib" user32 "(ByVal hwnd As Long) As LongPublic Declare Function ReleaseDC Lib" user32 "(ByVal hwnd As Long, Byval HDC As Long AS Long
Public Const WM_ERASEBKGND = & H14Public Const EN_VSCROLL = & H602Public Const WM_COMMAND = & H111Public Const EN_HSCROLL = & H601Public Const EN_CHANGE = & H300Public Const EN_UPDATE = & H400Public Const EM_GETSEL = & HB0Public Const SRCCOPY = & HCC0020 '(DWORD) dest = sourcePublic Const SRCAND = & H8800C6' (DWORD) dest = source AND destPublic Const SRCPAINT = & HEE0086 '(DWORD) dest = source OR destPublic Const SRCERASE = & H440328' (DWORD) dest = source AND (NOT dest) Public Const EM_SCROLL = & HB5Public Const GWL_WNDPROC = (-4) Public Const WM_PAINT = & HFPublic memDc As LongPublic MemBitmap As LongPublic OldWndProc As LongPublic Oldproc As LongPublic pic As PicturePublic 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 Withend 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 '----> Get text box portrait scrolling message SendMessage form1.text1.hwnd, wm_paint, 1, 0 case en_hscroll '-----> Get horizontal scrolling message sendMessage form1.text1.hwnd, wm_paint, 1, 0 case en_update sendMessage form1.text1.hwnd, wm_paint, 0, 0 END SELECT END IFWINPROC1 = CallWindowProc (OldWndProc, HWND, MSG, WP, LP) end function ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------- ----------------------- This can add as a picture in the picture.
This program is debugged at 2000 / XP. There is a disadvantage that it is relatively powerful, I hope you have prawn to correct.
