用响应消息做判断右键显示一个菜单,菜单对应“剪切”“复制”“粘贴”“全选” *** 作,在每个菜单选项对应芹胡一个 *** 作,这些誉首兆 *** 作获取当前文庆租本框的状态
您好!设置文本框datafield和datasource属性,datasource是指猛闹罩定数据控件绑定数据,如data控件,datafield属性是让文本框显示datasource是指定数据库文件的字段内容举例:ta.mdb是c盘下的一个数据库文件,有一个表名stu,有两个字段名,序号和姓名。
在工程窗枝闹口中画一个data控件,和两个文本框,将data控件的databasename属性指定为c:\ta.mdb,recordsource属性设置为数据库表的名字,将文本框的datasource属性弯唤选中为data1控件,datafield属性分别选中序号和姓名,运行就能看到效果注:以上是最简单的例子,可以有复杂点的用adodc控件+sql语句
富文本框和文本框一样,每次输入文字都会有刷新动作,每次刷新之后,你所绘制的野桥图片也就没了.所以需要每次文字输入都重新绘制背景.这里有个设置文本框背景的代码,希望对你有所帮助:
------------------------------------------窗口的代码-------------------
窗体: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
-------------------------------------------------------------------------------------------------------
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)