 |
|
|
 首页 |
名片设计 CorelDRAW Illustrator AuotoCAD Painter 其他软件 Photoshop Fireworks Flash |
|
------------------------------------------窗口的代码------------------- 窗体：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 下调试通过。有一个缺点是闪动比较厉害，希望各位大虾指正。 返回类别: 教程 上一教程: Remoting编程知识二 下一教程: 用.net中的socket实现文件传输 您可以阅读与"在 普通的文本框 里加入图片背景"相关的教程: · 在RichTextBox控件加入图片 · 将一个图片以二进制值的形式存入Xml文件中 · 用Asp.net实现简朴的文字水印 · 在ASP.NET中上传图片并生成缩略图的C#源码 · .net中PictureBox中图片的拖动 |
  |
| 快精灵印艺坊 版权所有 |
首页 会员中心在线印刷在线编辑付款方式索取样品设计指南连锁门店
|
||
