• Thay đổi kiểu Cursor (con trỏ chuột) khi MouseMove
  • Thay đổi kiểu Cursor (con trỏ chuột) khi MouseMove

    ongke0711 > 17-01-19, 03:49 PM

    [Hình: 39808280713_de84977a1f_o.png]


    Tôi có sưu tầm của một bạn về cách thay đổi con trỏ chuột (Cursor) khi có sự kiện MouseMove trên một Control nào đó (Command Button, Lable...).

    Yêu cầu:
    - Có file ảnh dạng cursor mà bạn thích và phải đổi tên là: Cursor.cur
    - Lưu file cursor trên cùng thư mục file Access (.mdb, .accdb)
    - Copy code này vào module:


    Mã PHP:
    Option Explicit

    Public Const IDC_APPSTARTING 32650&
    Public Const 
    IDC_ARROW 32512&
    Public Const 
    IDC_CROSS 32515&
    Public Const 
    IDC_IBEAM 32513&
    Public Const 
    IDC_ICON 32641&
    Public Const 
    IDC_NO 32648&
    Public Const 
    IDC_SIZE 32640&
    Public Const 
    IDC_SIZEALL 32646&
    Public Const 
    IDC_SIZENESW 32643&
    Public Const 
    IDC_SIZENS 32645&
    Public Const 
    IDC_SIZENWSE 32642&
    Public Const 
    IDC_SIZEWE 32644&
    Public Const 
    IDC_UPARROW 32516&
    Public Const 
    IDC_WAIT 32514&

    Declare Function 
    LoadCursorBynum Lib "user32" Alias "LoadCursorA" _
     
    (ByVal hInstance As LongByVal lpCursorName As Long) As Long

    Declare Function LoadCursorFromFile Lib "user32" Alias _
     
    "LoadCursorFromFileA" (ByVal lpFileName As String) As Long

    Declare Function SetCursor Lib "user32" _
     
    (ByVal hCursor As Long) As Long

    Const curNAME "Cursor.cur"
    Private mhCursor As Long
    Private mstrCursorPath As String
    Private Const ERR_INVALID_CURSOR vbObjectError 3333

    Function MouseCursor(CursorType As Long)
     Dim lngRet As Long
     lngRet 
    LoadCursorBynum(0&, CursorType)
     lngRet SetCursor(lngRet)
    End Function

    Function 
    PointM(strPathToCursor As String)
       If mhCursor 0 Then
           mhCursor 
    LoadCursorFromFile(strPathToCursor)
       End If
       Call SetCursor(mhCursor)
    End Function

    Public 
    Sub GetCursor()
    On Error GoTo ErrHandler
       If Len
    (mstrCursorPath) = 0 Then
           mstrCursorPath 
    CurrentDb.Name
           mstrCursorPath 
    Left(mstrCursorPathInStr(mstrCursorPathDir(mstrCursorPath)) - 1)
           mstrCursorPath mstrCursorPath curNAME
           If Len
    (Dir(mstrCursorPath)) = 0 Then
               mstrCursorPath 
    vbNullString
           End 
    If
       End If
       If Len(mstrCursorPath) = 0 Then
           Err
    .Raise ERR_INVALID_CURSOR
       Else
           PointM 
    (mstrCursorPath)
       End If
    ExitHere:
       Exit Sub
    ErrHandler
    :
       With Err
           If 
    .Number ERR_INVALID_CURSOR Then
               MsgBox 
    "Error: " & .Number vbCrLf _
                   
    "Invalid Cursor type"_
                   vbCritical 
    Or vbOKOnly_
                   
    "Cursor Function"
           Else
               MsgBox 
    "Error: " & .Number vbCrLf _
                   
    .Description_
                   vbCritical 
    Or vbOKOnly_
                   
    "Cursor Function"
           End If
       End With
       Resume ExitHere
    End Sub 


    Link demo: http://www.mediafire.com/file/7f8kqc7g8g7n1f8/Demo_ChangeCursor.rar/file
  • RE: Thay đổi kiểu Cursor (con trỏ chuột) khi MouseMove

    mrsiro > 17-01-19, 10:09 PM

    có cách nào khi mình di chuột vào 1 unbound textbox thì nó hiện bàn tay không bạn, cái hình bàn tay như kiểu textbox có hyperlink ấy. Với kiểu unbound textbox thì mặc dù mình set thuộc tính hyperlink cho nó nhưng di chuột vào nó vẫn không hiện bàn tay.
  • RE: Thay đổi kiểu Cursor (con trỏ chuột) khi MouseMove

    ongke0711 > 17-01-19, 11:41 PM

    Sao bạn không áp dụng cái demo của tôi cho textbox?
  • RE: Thay đổi kiểu Cursor (con trỏ chuột) khi MouseMove

    mrsiro > 18-01-19, 09:02 AM

    có cách nào không phải dùng tới file cursor ở ngoài ko vậy bạn.
  • RE: Thay đổi kiểu Cursor (con trỏ chuột) khi MouseMove

    ongke0711 > 18-01-19, 12:22 PM

    (18-01-19, 09:02 AM)mrsiro Đã viết: có cách nào không phải dùng tới file cursor ở ngoài ko vậy bạn.

    Nếu muốn không muốn tuỳ biến kiểu Cursor mà muốn dùng Cursor của hệ thống thì đơn giản hơn. Đã có hàm để load cursor hệ thống trong module ở trên rồi. Ví dụ tôi đặt tên module ở trên tên là: "modChangeCursor"

    - Control nào muốn dùng thì ở sự kiện "MouseMove", gọi module này.
    Vd:

    Mã PHP:
    Private Sub Text6_MouseMove(Button As IntegerShift As IntegerAs SingleAs Single)
       modChangeCursor.SetCursor LoadCursorBynum(0IDC_HAND '-> Dùng Cursor hand'
    End Sub 


    Các hằng cho Cursor đã có khai báo trong cái module đầu tiên, bạn muốn dùng kiểu gì thì thay nó vô tham số thứ 2 của hàm LoadCursor(0,...) là được rồi.

    Mã PHP:
    Public Const IDC_APPSTARTING 32650&
    Public Const 
    IDC_HAND 32649&
    Public Const 
    IDC_ARROW 32512&
    Public Const 
    IDC_CROSS 32515&
    Public Const 
    IDC_IBEAM 32513&
    Public Const 
    IDC_ICON 32641&
    Public Const 
    IDC_NO 32648&
    Public Const 
    IDC_SIZE 32640&
    Public Const 
    IDC_SIZEALL 32646&
    Public Const 
    IDC_SIZENESW 32643&
    Public Const 
    IDC_SIZENS 32645&
    Public Const 
    IDC_SIZENWSE 32642&
    Public Const 
    IDC_SIZEWE 32644&
    Public Const 
    IDC_UPARROW 32516&
    Public Const 
    IDC_WAIT 32514
  • RE: Thay đổi kiểu Cursor (con trỏ chuột) khi MouseMove

    mrsiro > 18-01-19, 02:58 PM

    Hàm trên dùng tốt cho cả 64bit và 32bit không bạn.