WM_MOUSEMOVE   strona główna:
A po co ten Excel ;-)
 
    Choć będzie tu mapa Polski z podziałem na powiaty to jednak tematem głównym będzie coś innego. Mianowicie. Na UserForm'ie  
lub na jego kontrolkach mamy zdarzenie MouseMove które zostaje wyzwolone w momencie kiedy kursor myszki znajdzie się nad   
elementem którego w.w. zdarzenie zostało oprogramowane. Nie ma jednak takiego zdarzenia "nad" arkuszem. Jednak nie jest   Tworzenie Shape'ów o kształcie powiatu na podstawie mapy Polski. A więc prezentowanie danych na mapie - podejście 2 
niemożliwym napisanie procedury która zareaguje właśnie na mousemove "nad" elementami arkusza.  
 
Mamy więc Mapę Polski z podziałem na powiaty utworzoną za pomocą niedawno omawianej metody --->>  
i wygląda to tak:
 
 
 
    Nie twierdzę że procedura którą  
tworzyłem tę mapę jest doskonała.  
Jednak przy odrobinie cierpliwości  
(zapisując efekty pracy co pare  
powiatów ;-) ) stworzyłem tę mapę  
w godzinę!!!. A to chyba wynik nie  
najgorszy.  
 
   Mamy więc tę mapę. I zadanie:  
Nad jakim powiatem znajduje się  
kursor?  
 
Jednak może nam to nie wystarczyć.  
Metoda idzie jednak dalej: tworzy  
zmienną objShp która reprezentuje  
powiat nad którym w danej chwili   
znajduje się kursor. My z tej zmiennej  
odczytamy nazwe obiektu, a mając  
nazwe i baze z danymi nt. nazw  
Województw i powiatów tworzących  
mapę.. Również te dane. :-)  
Jednak mając ten obiekt mamy też  
dostęp do jego właściwości. Tu   
chodzi np.: o kolor i wartość jaką  
reprezentuje.  
 
Jak procedura to realizuje?  
  Hook na Scrollu Myszy
Podobną omawiałęm opisująć inne  
"zdarzenie" myszy tj. Ruch Scrolla.  
Tam wykorzystuję wiadomość:  
Const WM_MOUSEWHEEL = &H20A  
Tu będzie podobnie :-)  
 
Wiadomość wysyłana do okna podczas ruchu kursora nad danym oknem to:   
 Const WM_MOUSEMOVE = &H200  
 
a więc: w procedurze: LowLevelMouseProc (analogicznie jak w temacie nt scroll'a) napiszemy:  
 
         Select Case wParam  
             Case WM_MOUSEMOVE  
                   
             MMove lParam, bMouseProc, bEnd  
                   
             LowLevelMouseProc = bMouseProc  
             If bEnd Then Exit Function  
                   
         End Select  
 
Procedura Mmove:  
 
Sub MMove(HookStructLParam As Long, ByRef czyZdarzenieNastapilo As Boolean, ByRef bFlag As Boolean)  
       
     Dim objShp As Object  
     Dim point As POINTAPI: GetCursorPos point  
           
     On Error Resume Next  
     Set objShp = ActiveWindow.RangeFromPoint(x:=point.x, _  
                                              y:=point.y)  
     On Error GoTo 0  
     'Arkusz1.TextBoxes("txbTip").Characters.Text = TypeName(objShp)  
       
     Select Case TypeName(objShp)  
        Case "Drawing":  
            If objShp.Name <> droName Then  
                droName = objShp.Name  
                With PowiatInfo(droName)  
                    Arkusz1.TextBoxes("txbTip").Characters.Text = _  
                        "Nazwa objShape: " & objShp.Name & vbLf & _  
                        "Województwo: " & .Woj & vbLf & _  
                        "Powiat: " & .Powiat  
                End With  
                    czyZdarzenieNastapilo = False: bFlag = True  
            End If  
       
     End Select  
           
     Set objShp = Nothing  
 End Sub  
 
   a w niej najważniejsze to: (wcześniejesze omówione w poprzednim temacie do którego ciekawych odsyłam)  
 
     Select Case TypeName(objShp)  
        Case "Drawing":  
 
Tu właśnie określam nad jakimi obiektami ma działać moje MouseMove. Elementy mapy to obiekty Drawing. Jeżeli zależałoby nam   
żeby procedura działała nad komórami arkusza to interesujący nas "Case" to "Range", dla przycisków (z formularzy) "Buttons" (choć  
szczerze mówiąc nie sprawdzałem - zainteresowani sprawdzą ;-P )   
 
            If objShp.Name <> droName Then  
                droName = objShp.Name  
 
droName to zmienna do której zapisuję nazwe obiektu nad którym znajduje się kursor. Po przesunięciu kursora sprawdzam ponownie  
jak "nazywa się" obiekt nad którym się znajduję. Jeżeli tak samo jak wartośc zapisana do droName oznacza to że ciągle jesteśmy  
nad tym samym powiatem nie ma więc sensu żeby cokolwiek zmieniać.  
 
                With PowiatInfo(droName)  
                    Arkusz1.TextBoxes("txbTip").Characters.Text = _  
                        "Nazwa objShape: " & objShp.Name & vbLf & _  
                        "Województwo: " & .Woj & vbLf & _  
                        "Powiat: " & .Powiat  
                End With  
 
Funkcja PowiatInfo zwraca nazwy: Powiatu i Województwa dla danej nazwy obiekty.   
 
Public Type info  
    Powiat As String  
    Woj As String  
End Type  
 
Function PowiatInfo(strDroName As String) As info  
    Dim i As Long  
    For i = 1 To UBound(vTbl)  
        If vTbl(i, 3) = strDroName Then  
            PowiatInfo.Powiat = vTbl(i, 1)  
            PowiatInfo.Woj = vTbl(i, 2)  
            Exit For  
        End If  
    Next  
End Function  
 
Tablicę vTbl (publiczna tablica poziomu modułu)  
vTbl = ThisWorkbook.Worksheets("Arkusz3").[c2:e380]     
Określam w Workbook_Open . Z tych danych korzysta funkcja PowiatInfo.  
 
 Arkusz1.TextBoxes("txbTip") to TextBox (Pole tekstowe z formularzy) do niego zwracam interesujące mnie dane.  
 
No i chyba tyle :-)  
Ważne są jeszcze:   
 - nie powinno się przeglądac kodu podczas działania Hook'a. A więc przez cały czas od włączenia makr do zamknięcia pliku :-)  
    Jednak w arkuszu wstawiam przyciski wywołujące odpowiednio:  
 
 Sub StartTip()  
    'MsgBox "Start"  
     Hook_Mouse  
 End Sub  
       
 Sub StopTip()  
    'MsgBox "Stop"  
     UnHook_Mouse  
 End Sub  
 
    Chcąc więc przeglądnąć kod radzę wyłączyć procedurę.  
  Omawiany przykład 
 - choć mapa jest kompletna to wykorzystanie jej do swoich celów wiążące się z nadaniem kolorów pozostałym powiatom, przyjęciu   można pobrać:
    własnej skali kolorów, … itd. Zagadnienia te były już omówione na mojej stronie i nie widze potrzeby tu się tym zajmować.   xl0000100v2.zip
 
 Jeżeli masz problem z dostosowaniem tego/innych moich rozwiązań do swoich potrzeb napisz do mnie na maila (np.: za pośrednictwem  
excelforum.pl) dogadamy warunki wspólpracy :-)