m45.htm

vb教程 vb教程 vb教程 vb教程 vb教程 vb教程 vb教程 vb教程 vb教程 vb教程 vb教程

              'Mouse移到四个边时，自动scroll，就算不必Scroll时也可呼叫，只是不会有作用<br>
              If pt.Y &lt;= rect5.Top + 3 Then<br>
              i = SendMessage(hwnd, EM_SCROLL, SB_LINEUP, 0)<br>
              End If<br>
              If pt.Y &gt;= rect5.Bottom - 3 Then<br>
              Call SendMessage(hwnd, EM_SCROLL, SB_LINEDOWN, 0)<br>
              End If<br>
              If pt.X &lt;= rect5.Left + 3 Then<br>
              i = SendMessage(hwnd, EM_LINESCROLL, -1, 0)<br>
              End If<br>
              If pt.X &gt;= rect5.Right - 3 Then<br>
              Call SendMessage(hwnd, EM_LINESCROLL, 1, 0)<br>
              End If<br>
              End Sub<br>
              <br>
              '设定Mouse的形状<br>
              Public Sub SetMouseShap(hwnd As Long, ByVal Button As Integer)<br>
              Dim charindex As Long<br>
              Dim i As Long<br>
              If preWinProc &lt;&gt; 0 Then<br>
              If Button = 1 Then<br>
              Screen.ActiveControl.MousePointer = 99<br>
              Screen.ActiveControl.MouseIcon = LoadPicture("dragmove.cur")<br>
              '请自行设定dragmove.cur的位置<br>
              Call SetCaretPosition(hwnd)<br>
              Exit Sub<br>
              End If<br>
              charindex = GetCharIndex(hwnd)<br>
              '设定Mouse移过mark的区块时，Mouse变箭号<br>
              If charindex &gt;= SelST And charindex &lt;= SelEnd Then<br>
              If Button = 0 Then<br>
              Screen.ActiveControl.MousePointer = 1<br>
              End If<br>
              Else<br>
              Screen.ActiveControl.MousePointer = 0<br>
              End If<br>
              End If<br>
              End Sub<br>
              <br>
              Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, _<br>
              ByVal wParam As Long, ByVal lParam As Long) As Long<br>
              '以下程式会截取mouse move，处理完後，再将之送往原来的Window Procedure<br>
              Dim charindex As Long<br>
              Dim i As Long<br>
              If Msg = WM_LBUTTONDOWN Then<br>
              If CaretHide Then<br>
              Call ShowCaret(hwnd)<br>
              CaretHide = False<br>
              End If<br>
              If SelEnd - SelST &lt;&gt; 0 Then<br>
              charindex = GetCharIndex(hwnd)<br>
              If charindex &gt;= SelST And charindex &lt;= SelEnd Then<br>
              Call SetCaretPosition(hwnd)<br>
              Screen.ActiveControl.MousePointer = 99<br>
              Screen.ActiveControl.MouseIcon = LoadPicture("c:\tmp2\dragmove.cur")<br>
              CanPaste = True<br>
              Exit Function<br>
              End If<br>
              End If<br>
              End If<br>
              wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)<br>
              End Function<br>
              <br>
              Public Sub MoveText(ByVal hwnd As Long, CanFree As Boolean)<br>
              Dim i As Long, sellen As Long, charindex As Long<br>
              sellen = SelEnd - SelST<br>
              '如果Caret落在mark起来之处则不处理<br>
              charindex = GetCharIndex(hwnd)<br>
              If charindex &gt;= SelST And charindex &lt;= SelEnd Then<br>
              CanFree = False<br>
              Exit Sub<br>
              End If<br>
              Call SendMessage(hwnd, WM_CUT, 0, 0) '将Mark起来的地方Cut掉<br>
              Dim setpos As Long<br>
              If charindex &lt; SelST Then<br>
              setpos = charindex<br>
              Else<br>
              If charindex &gt; SelEnd Then setpos = charindex - sellen<br>
              End If<br>
              '设定Caret新位置，此时Keyin进去的字才真的会在此位置出现，使用SetCaretPos()则不行<br>
              Call SendMessage(hwnd, EM_SETSEL, setpos, setpos)<br>
              Call SendMessage(hwnd, WM_PASTE, 0, 0)<br>
              <br>
              End Sub<br>
              Public Sub SetHook(ByVal hwnd As Long, ByVal Button As Integer)<br>
              Dim ret As Long<br>
              Dim i As Long<br>
              Dim charindex As Long<br>
              If Button = 1 Then<br>
              If Screen.ActiveControl.SelLength &gt; 0 Then<br>
              If preWinProc = 0 Then<br>
              '记录原本的Window Procedure的位址<br>
              preWinProc = GetWindowLong(hwnd, GWL_WNDPROC)<br>
              ret = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf wndproc)<br>
              Call HideCaret(hwnd)<br>
              CaretHide = True<br>
              CanPaste = False<br>
              '取得Mark起来的区域之Start, End之Index，之所以不用Text.SelStart<br>
              '与Text.SelLength来做的原因是：vb对之的度量是字元为单位，但API<br>
              '的其他呼叫都以Byte为单位，我如此做，省得中间的转换<br>
              i = SendMessage(hwnd, EM_GETSEL, 0, 0)<br>
              SelEnd = i \ 2 ^ 16<br>
              SelST = i Mod 2 ^ 16<br>
              Else<br>
              Dim CanFree As Boolean<br>
              CanFree = True<br>
              If CanPaste Then<br>
              Call MoveText(hwnd, CanFree)<br>
              End If<br>
              If CanFree Then Call FreeHook(hwnd)<br>
              End If<br>
              Else<br>
              If preWinProc &lt;&gt; 0 Then<br>
              Call FreeHook(hwnd)<br>
              End If<br>
              End If<br>
              End If<br>
              End Sub<br>
              Public Sub FreeHook(ByVal hwnd As Long)<br>
              Dim ret As Long<br>
              If preWinProc &lt;&gt; 0 Then<br>
              ret = SetWindowLong(hwnd, GWL_WNDPROC, preWinProc)<br>
              End If<br>
              preWinProc = 0<br>
              Screen.ActiveControl.MousePointer = 0<br>
              If CaretHide Then<br>
              Call ShowCaret(hwnd)<br>
              CaretHide = False<br>
              End If<br>
              End Sub<br>
              Public Sub GetCaretPos(ByVal hwnd5 As Long, lineno As Long, colno 
              As Long)<br>
              Dim i As Long, j As Long<br>
              Dim lParam As Long, wParam As Long<br>
              Dim k As Long<br>
              i = SendMessage(hwnd5, EM_GETSEL, wParam, lParam)<br>
              j = i / 2 ^ 16 '取得目前Caret所在前面有多少个byte<br>
              lineno = SendMessage(hwnd5, EM_LINEFROMCHAR, j, 0) '取得前面有多少行<br>
              lineno = lineno + 1<br>
              k = SendMessage(hwnd5, EM_LINEINDEX, -1, 0)<br>
              '取得目前caret所在行前面有多少个byte<br>
              colno = j - k + 1<br>
              End Sub</font></span><br>
            </td>
          </tr>
          </tbody> 
        </table>
          <br>
        &gt;<br>
        </span> </font>
        <table border=1 width="706">
          <tbody> 
          <tr> 
            <td> <font color="#000000" class="unnamed1">'以下在Form<br>
              Private Sub Text1_LostFocus()<br>
              Call FreeHook(Text1.hwnd)<br>
              End Sub<br>
              <br>
              Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)<br>
              Call FreeHook(Text1.hwnd)<br>
              End Sub<br>
              <br>
              Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, 
              X As Single, Y As Single)<br>
              Call SetMouseShap(Text1.hwnd, Button)<br>
              End Sub<br>
              <br>
              Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X 
              As Single, Y As Single)<br>
              Call SetHook(Text1.hwnd, Button)<br>
              End Sub</font><br>
            </td>
          </tr>
          </tbody> 
        </table>
        <p align="left">  <br>
            　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 <br>
          <br>
          <br>
          　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 </b></font> </p>
      </td>
    </tr>
  
  </table>
</div>
<p align="center"><a href="../../pian/vb.htm">回首页</a>
<p align="center"><script src="../../2.js"></script></a>
</body>
</html>