📄 m45.htm
字号:
<html>
<head>
<title>VB教程</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</head>
<p align="center"><script src="../../1.js"></script></a>
<body bgcolor="#ffffff" leftmargin="5" topmargin="1" marginheight="5" marginwidth="5">
<div align=center>
<table border=0 cellpadding=0 cellspacing=0 width=680 align="center">
<tbody>
<tr>
<td width=200 height="59">
<div align="center">
</td>
<td colspan=2 valign=baseline height="59">
<div align=center><script language="JavaScript" src="../../ad/ads_b.asp">
</script>
<br>
</div>
</td>
</tr>
<tr align=middle valign=top>
<td width=200>
</td>
<td width=295>
</td>
<td width=185> </td>
</tr>
</tbody>
</table>
<table border=1 bordercolordark=#000000 bordercolorlight=#000000 cellpadding=0
cellspacing=0 width=686 align="center" height="128">
<tbody>
<tr>
<td bgcolor=#000000 height=9>
<div align=center class=H1> <font color="#FFFFFF">TextBox模拟拖曳选取文字</font> </font> </font></div>
</td>
</tr>
<tr valign=top>
<td class=H1 height=76>
<p> <font color="#000000">我们知道Rich text或Word 或VB的程式撰写环境，可以将Mouse移到Select起来的文字
按Mouse左键做拖曳移动的功能，後来想，TextBox能不能做呢？这可真的吃了不少苦头<br>
，这个程式模拟其做法，但主要的精神是在於对TextBox的了解。 <br>
首先，TextBox中当选取一段文字之後，我们只要按Mosue，便使Select的区域失效，且 可能进入另外的一个Select域，故第一件事是如何在有Select的区域时，使这动作失效；<br>
的作法是在MouseUp时Check一下有没有选取文字，如果有，就使用SubClass的技术，拦截 Mouse的左键，所以当我们按左键时，不会再有选取文字又不见了的情况。<br>
<br>
第二，我们没有按下Mouse，那如何得知Mouse所在的地方到底是TextBox的哪个字呢，所幸 有EM_CHARFROMPOS这个讯息可Send给textBox，其传回值的HiWord
得该字元是在第几行<br>
0为base，LowWord是该字元在TextBox中的位置(含换行与LineFeed)，因而我们可以单 由MouseMove便得知何时Mouse要是箭号，何时是内定I形的Mouse。当然想得知Mouse所在<br>
可以透过Mouse Event的X, Y座标，但是它们是以Twips为单位，而另外也可以用GetCursorPos() 来得知Mouse的位置，但这是相对於萤幕者，EMCHARFROMPOS的讯息需要的是相对於TextBox<br>
的座标，有许多种方法可以完成这转换，但我选ScreenToClient()这个API，比较直接。 <br>
第叁，Caret如何隐藏呢？使用HideCaret可完成，但这个Function只能呼叫一次，以便 下回 ShowCaret()时可以将Caret
Show出来，这是因为呼叫2次的HideCaret时，也要呼<br>
叫2次的ShowCaret才能使Caret出现。另设定Caret的SetCaretPos() API只是令Caret出现 在什麽地，但如果您KeyIn任何字时，仍出现在原来之地方，而不是方才设定之处，而<br>
要用EM_SETSEL的Message才能设定KeyIn的位置是Caret的位置。<br>
<br>
另有一个取得textbox中第charindex个字元，在textbox中Mouse的位置(textbox的左上角为原点)<br>
pos = SendMessage(hwnd, EM_POSFROMCHAR, charindex, 0)<br>
my = pos \ 2 ^ 16 'Y座标<br>
mx = pos Mod 2 ^ 16 'X座标<br>
<br>
这个程式的重点便是上面所写的，其他是苦功<br>
<br>
</font></span>
<table border=1 width=702>
<tbody>
<tr>
<td> '以下在.Bas<br>
'注:本程式之所以要用一个变数来存Caret是否被隐藏，原因是：当HideCaret()呼叫N次<br>
'便得呼叫N次 ShowCaret()来复原，反之亦然，所以程式中，用一个变数来确认Hide/Show<br>
'的动作只做一次<br>
Option Explicit<br>
<br>
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA"
_<br>
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
As Long<br>
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA"
_<br>
(ByVal hwnd As Long, ByVal nIndex As Long) As Long<br>
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA"
_<br>
(ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long,
_<br>
ByVal wParam As Long, ByVal lParam As Long) As Long<br>
<br>
Public Const GWL_WNDPROC = (-4)<br>
Public Const WM_MOUSEMOVE = &H200<br>
Public Const WM_RBUTTONDOWN = &H204<br>
Public Const WM_LBUTTONDOWN = &H201<br>
Public Const WM_CUT = &H300<br>
Public Const WM_PASTE = &H302<br>
Public Const EM_POSFROMCHAR = 214<br>
Public Const EM_CHARFROMPOS = 215<br>
Public Const EM_SETSEL = &HB1<br>
Public Const EM_GETSEL = &HB0<br>
Public Const EM_SCROLL = &HB5<br>
Public Const EM_LINEFROMCHAR = &HC9<br>
Public Const EM_LINEINDEX = &HBB<br>
Public Const EM_LINESCROLL = &HB6<br>
<br>
Public Const SB_LINEDOWN = 1<br>
Public Const SB_LINEUP = 0<br>
<br>
Type POINTAPI<br>
X As Long<br>
Y As Long<br>
End Type<br>
Type RECT<br>
Left As Long<br>
Top As Long<br>
Right As Long<br>
Bottom As Long<br>
End Type<br>
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long,
lpRect As RECT) As Long<br>
Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long,
lpRect As RECT) As Long<br>
<br>
<br>
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal
hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam
As Long) As Long<br>
Declare Function HideCaret Lib "user32" (ByVal hwnd As Long) As
Long<br>
Declare Function ShowCaret Lib "user32" (ByVal hwnd As Long) As
Long<br>
Declare Function SetCaretPos Lib "user32" (ByVal X As Long, ByVal
Y As Long) As Long<br>
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI)
As Long<br>
Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long,
lpPoint As POINTAPI) As Long<br>
<br>
<br>
Private SelEnd As Long '存TextBox Mark起来的起点<br>
Private SelST As Long '存textBix Mark起来的终点<br>
Private CaretHide As Boolean '存Caret是否被隐藏<br>
Private CanPaste As Boolean '存是否处於可以Paste的状态<br>
Public preWinProc As Long<br>
'取得Mouse所在的字元在TextBox中的位置<br>
Public Function GetCharIndex(ByVal hwnd As Long, Optional CharLineNo
As Long) As Long<br>
Dim mx As Integer, my As Integer<br>
Dim wParam As Long, lParam As Long<br>
Dim i As Long<br>
Dim pos As Long, pt As POINTAPI<br>
<br>
Call GetCursorPos(pt) '取得相对Screen的Mouse之位置<br>
i = ScreenToClient(hwnd, pt) '将Mouse位置转换成相对於TextBox的位置<br>
mx = pt.X<br>
my = pt.Y<br>
If mx < 0 Then mx = 0<br>
If my < 0 Then my = 0<br>
lParam = mx + 2 ^ 16 * my<br>
wParam = 0<br>
i = SendMessage(hwnd, EM_CHARFROMPOS, 0, lParam)<br>
If Not IsMissing(CharLineNo) Then<br>
CharLineNo = i \ 2 ^ 16 '取得该字元是在第几行,0为base<br>
End If<br>
GetCharIndex = i Mod 2 ^ 16 '传回该字元是在textBox中的第几个字,0为base<br>
End Function<br>
<br>
Public Sub SetCaretPosition(ByVal hwnd As Long)<br>
Dim mx As Long, my As Long, pos As Long<br>
Dim charindex As Long<br>
Dim pt As POINTAPI, i As Long<br>
Dim rect5 As RECT, rect6 As RECT<br>
charindex = GetCharIndex(hwnd)<br>
'取得textbox中第charindex个字元，在textbox中Mouse的位置(textbox的左上角为点<br>
pos = SendMessage(hwnd, EM_POSFROMCHAR, charindex, 0)<br>
my = pos \ 2 ^ 16<br>
mx = pos Mod 2 ^ 16<br>
'设定Caret出现的位置，但只是显示的位置，实际keyin进去的字出现的地方没因而更动<br>
Call SetCaretPos(mx, my)<br>
'取得Mouse所在之座标(Screen左上角为原点)<br>
Call GetCursorPos(pt)<br>
'取得TextBox的萤幕座标(Screen左上角为原点)<br>
Call GetWindowRect(hwnd, rect6)<br>
'取得TextBox可keyin字的区域大小(textBox左上角为原点)<br>
Call GetClientRect(hwnd, rect5)<br>
'取得textbox Client区域相对Screen的座标<br>
rect5.Left = rect6.Left<br>
rect5.Right = rect5.Right + rect6.Left<br>
rect5.Top = rect6.Top<br>
rect5.Bottom = rect5.Bottom + rect6.Top<br>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -