Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 22.05.2021, 02:10   #1
KinBau
 
Регистрация: 05.01.2019
Сообщений: 5
По умолчанию Изменение свойств Controls вызванной на экран UserForm при перемещении пользователем курсора мыши по экрану

Здравствуйте!

Никак не могу найти ошибку в своем коде в силу недостаточности уровня знаний в понимании правил использования обратного вызова с использованием API функций.
Начнем по порядку.
Итак, есть задача - изменять для визуальной наглядности пользователю состояние свойств объектов (Controls) загруженной и выведенной на экран формы (UserForm) при перемещении пользователем мыши по экрану окна.
Возьмем для простоты простейшую форму, содержащую объект Image.
Желаемое.
Если пользователь навел курсор мыши на форму (курсор мыши внутри координат формы), то фон Image зеленый.
Если пользователь перевел курсор мыши за пределы координат формы , то фон Image становится красный.
Все это я пытаюсь реализовать в 64-bit операционной системе с установленной версией Office, использующего 64-разрядную версию VBA.
Создавая различного рода запросы в поисковике для решения своей задачи я выяснил, что в помощь мне функция API TRACKMOUSEEVENT.
И даже нашел практический пример по ссылке: http://rusproject.narod.ru/winapi/t/trackmouseevent.html
Изучив его, я понял, что мне его необходимо адаптировать в свою операционную среду.
И тут снова мне в помощь пришел найденный справочный материал: https://codekabinett.com/rdumps.php?...ion-vba-64-bit
Изучив на его основании типы аргументов необходимых мне API функций, я адаптировал их декларацию под версию VBA 64-bit.
При проверке компиляции кода в среде VBA.Project все хорошо.
Однако, результат выполнения кода не дает нужного результата.
Более того, при пошаговом выполнении наблюдается серьезный сбой, когда приложение Excel просто перезагружается или даже закрывается.
И это происходит именно на этапе срабатывания функции обратного вызова.
Теперь конкретно о коде.

Вот код основного модуля
Код:
Option Explicit

Public Const WM_MOUSELEAVE As Long = &H2A3&
Public Declare PtrSafe Function TRACKMOUSEEVENT Lib "user32" Alias "TrackMouseEvent" ( _
          lpEventTrack As TRACKMOUSEEVENT) As Long

Public Type TRACKMOUSEEVENT
    cbSize As Long
    dwFlags As Long
    hwndTrack As LongPtr
    dwHoverTime As Long
End Type

Public Const TME_LEAVE As Long = &H2

Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr

Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hWnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

Private Const GWLP_WNDPROC = (-4)
Dim PrevProc As LongPtr
Public Track As TRACKMOUSEEVENT
Public NoRecursForm As Boolean

Public Sub Hook(ByVal frmHWnd As LongPtr)
    PrevProc = SetWindowLong(frmHWnd, GWLP_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub UnHook(ByVal frmHWnd As LongPtr)
    SetWindowLong frmHWnd, GWLP_WNDPROC, PrevProc
End Sub

Public Function WindowProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    
    If uMsg = WM_MOUSELEAVE Then

        If UserForm1.Image1.BackColor = vbGreen Then
           UserForm1.Image1.BackColor = vbRed
        Else
           UserForm1.Image1.BackColor = vbGreen
        End If
        
    End If
    
    WindowProc = CallWindowProc(PrevProc, hWnd, uMsg, wParam, lParam)
End Function

Sub Example()
    Load UserForm1
    UserForm1.Show
End Sub
В процедуре Hook основного модуля используется параметр дескриптора окна пользовательской формы frmHwnd.
Я знаю, что у UserForm и его Controls нет свойства hwnd, поэтому мне опять же в помощь пришел справочный материал: https://colinlegg.wordpress.com/2016...userforms-vba/, изучив который я научился считывать дескриптор пользовательской формы.

Соответственно, код класса оговоренной для примера формы приобрел следующий вид:
Код:
Private Sub UserForm_Initialize()
   StorehWnd
   Hook Me.hWnd
   With Track
       .cbSize = Len(Track)
       .dwFlags = TME_LEAVE
       .hwndTrack = Me.hWnd
       .dwHoverTime = 400
   End With
End Sub
 
Private Sub StorehWnd()
 
    Dim strCaption As String
    Dim strClass As String
 
    'class name changed in Office 2000
    If Val(Application.Version) >= 9 Then
        strClass = "ThunderDFrame"
    Else
        strClass = "ThunderXFrame"
    End If
 
    'remember the caption so we can
    'restore it when we're done
    strCaption = Me.Caption
 
    'give the userform a random
    'unique caption so we can reliably
    'get a handle to its window
    Randomize
    Me.Caption = CStr(Rnd)
 
    'store the handle so we can use
    'it for the userform's lifetime
    mlnghWnd = FindWindowA(strClass, Me.Caption)
 
    'set the caption back again
    Me.Caption = strCaption
 
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    TRACKMOUSEEVENT Track
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    UnHook Me.hWnd
End Sub
Однако, не работает(
При пошаговом исполнении при обращении к функции WindowProc, я заметил, что параметр uMsg вообще даже близко не сопоставляется с установленной константой WM_MOUSELEAVE.
При этом происходит рекурсивное обращение к указанной функции, параметр uMsg меняется каждый раз, а после раза 4-5 рекурсивного вызова, приложение просто перезапускается или выгружается.

Уважаемые знатоки темы, подскажите, где у меня ошибка и/или чего мне не хватает (кроме ума и знаний, тут понятно, шутки будут неуместны).
KinBau вне форума Ответить с цитированием
Старый 22.05.2021, 09:26   #2
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

а файл у вас есть? с формой и имиджем в ней, народ крайне ленивый и никто не станет это собирать, т.е. нету файла - нет решения (не факт что оно будет при наличии файла, но без файла - шансы вообще ничтожны)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 22.05.2021, 14:44   #3
KinBau
 
Регистрация: 05.01.2019
Сообщений: 5
По умолчанию

Цитата:
Сообщение от IgorGO Посмотреть сообщение
а файл у вас есть?
Вообще без проблем.
Выкладываю файл описанного примера со стопроцентным идентичным выложенном в теме кодом.
Вложения
Тип файла: zip Пример.zip (21.1 Кб, 4 просмотров)
KinBau вне форума Ответить с цитированием
Старый 29.05.2021, 06:49   #4
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

см.вложение
Вложения
Тип файла: zip Книга1.zip (15.0 Кб, 6 просмотров)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете

Последний раз редактировалось IgorGO; 30.05.2021 в 01:51.
IgorGO вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сбрасывается состояние мыши при программном перемещении курсора. Drag&drop Yuran Общие вопросы Delphi 1 26.07.2016 14:15
Вывести поточные координаты курсора мыши относительно формы и экрана, при нажатии на кнопку реверсивное изменение кнопок мыши C++ carrie bradshaw Помощь студентам 0 06.02.2014 00:21
Перемещение курсора мыши по экрану KoBaL Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 3 04.10.2013 22:05
Перемещение курсора мыши по экрану Илья2204 Общие вопросы C/C++ 1 08.12.2010 13:34
Определение X и Y координат PaintBox при перемещении курсора мыши Vladimir K. Общие вопросы Delphi 3 04.01.2007 10:45