Re: mouseover label
Posted: Sun Jun 10, 2018 4:50 pm
Exclusive forum for HMG, a Free / Open Source xBase WIN32/64 Bits / GUI Development System
http://hmgforum.com/
Code: Select all
#include "hmg.ch"
MEMVAR _HMG_SYSDATA
FUNCTION Main()
DEFINE WINDOW MainForm;
WIDTH 300;
HEIGHT 260;
TITLE "Move cursor over labels";
MAIN
DEFINE LABEL Label1
ROW 10
COL 10
WIDTH 140
HEIGHT 45
VALUE "This is LABEL1"
ALIGNMENT Center
FONTCOLOR BLACK
END LABEL
DEFINE LABEL Label2
ROW 65
COL 10
WIDTH 140
HEIGHT 45
VALUE "This is LABEL2"
ALIGNMENT Center
FONTCOLOR BLACK
END LABEL
DEFINE LABEL Label3
ROW 120
COL 10
WIDTH 140
HEIGHT 45
VALUE "This is LABEL3"
ALIGNMENT Center
FONTCOLOR BLACK
END LABEL
DEFINE BUTTON CloseButton
ROW 190
COL 10
WIDTH 80
HEIGHT 23
CAPTION "Close"
ACTION MainForm.RELEASE
END BUTTON
END WINDOW
HMG_ChangeWindowStyle(MainForm.Label1.HANDLE, 0x00800200 /*WS_BORDER|SS_CENTERIMAGE*/, NIL, .F., .T.)
HMG_ChangeWindowStyle(MainForm.Label2.HANDLE, 0x00800200 /*WS_BORDER|SS_CENTERIMAGE*/, NIL, .F., .T.)
HMG_ChangeWindowStyle(MainForm.Label3.HANDLE, 0x00800200 /*WS_BORDER|SS_CENTERIMAGE*/, NIL, .F., .T.)
EventProcessAllHookMessage(EventCreate("LabelEventHandler", MainForm.Label1.HANDLE), .T.)
EventProcessAllHookMessage(EventCreate("LabelEventHandler", MainForm.Label2.HANDLE), .T.)
EventProcessAllHookMessage(EventCreate("LabelEventHandler", MainForm.Label3.HANDLE), .T.)
MainForm.CENTER
MainForm.ACTIVATE
RETURN NIL
FUNCTION LabelEventHandler()
STATIC lTracking := .F.
LOCAL nHWnd := EventHWND()
LOCAL nMsg := EventMSG()
LOCAL cControl
LOCAL cForm
SWITCH nMsg
CASE WM_MOUSEMOVE
IF ! lTracking
GetControlNameByHandle(nHWnd, @cControl, @cForm)
SetProperty(cForm, cControl, "FONTCOLOR", RED)
SetProperty(cForm, cControl, "FONTBOLD", .T.)
lTracking := TrackMouseEvent(nHWnd) //TME_LEAVE is default flag
ENDIF
EXIT
CASE WM_MOUSELEAVE
GetControlNameByHandle(nHWnd, @cControl, @cForm)
SetProperty(cForm, cControl, "FONTCOLOR", BLACK)
SetProperty(cForm, cControl, "FONTBOLD", .F.)
lTracking := .F.
EXIT
ENDSWITCH
RETURN NIL
#pragma BEGINDUMP
#include "SET_COMPILE_HMG_UNICODE.ch"
#include "HMG_UNICODE.h"
#include <windows.h>
#include "hbapi.h"
// https://msdn.microsoft.com/en-us/library/windows/desktop/ms646265(v=vs.85).aspx
// TrackMouseEvent(nHWnd, [nFlags], [nHoverTime]) --> lSuccess
HB_FUNC( TRACKMOUSEEVENT )
{
TRACKMOUSEEVENT tmi;
tmi.cbSize = sizeof(TRACKMOUSEEVENT);
tmi.dwFlags = HB_ISNUM(3) ? (DWORD) hb_parni(2) : TME_LEAVE;
tmi.hwndTrack = (HWND) HMG_parnl(1);
tmi.dwHoverTime = HB_ISNUM(3) ? (DWORD) hb_parni(3) : HOVER_DEFAULT;
hb_retl(TrackMouseEvent(&tmi));
}
#pragma ENDDUMP
Code: Select all
// OnMouseHover demo
// 2016.06.20 Marek Olszewski
#include "hmg.ch"
Function Main
private aLabelColors := { => }
aLabelColors [ "KAFEL1" ] := {100,100,100}
aLabelColors [ "KAFEL2" ] := {100,200,0}
aLabelColors [ "KAFEL3" ] := {0,200,200}
// turn off case sensitive hash keys matching
hb_HCaseMatch(aLabelColors, .F.)
DEFINE WINDOW Form_Main ;
AT 0,0 ;
WIDTH 640 HEIGHT 600 ;
TITLE 'Main Window' ;
MAIN
@ 60,10 LABEL KAFEL1 ;
WIDTH 200 HEIGHT 200 ;
VALUE "OPTION 1";
BACKCOLOR aLabelColors [ "KAFEL1" ];
CENTERALIGN
@ 60,220 LABEL KAFEL2 ;
WIDTH 200 HEIGHT 200 ;
VALUE "OPTION 2";
BACKCOLOR aLabelColors [ "KAFEL2" ];
CENTERALIGN
@ 270,220 LABEL KAFEL3 ;
WIDTH 200 HEIGHT 200 ;
VALUE "OPTION 3";
BACKCOLOR aLabelColors [ "KAFEL3" ];
CENTERALIGN
@ 270,10 LABEL KAFEL4 ;
WIDTH 200 HEIGHT 200 ;
VALUE "STATIC OPTION NOT COLORIZED";
BACKCOLOR {255,255,255};
CENTERALIGN
END WINDOW
CENTER WINDOW Form_Main
CREATE EVENT PROCNAME OnMouseHover( EventWPARAM(), "FORM_MAIN" ) HWND Form_Main.Handle
ACTIVATE WINDOW Form_Main
Return
*---------------------
function OnMouseHover
param hWnd, cFormName
LOCAL cControl := ""
LOCAL cForm := ""
static cPrevious := ""
GetControlNameByHandle( hWnd, @cControl, @cForm )
if empty(cControl)
if !empty(cPrevious)
// set oryginal color to previous control
SetProperty(cFormName, cPrevious, "BackColor",aLabelColors [ cPrevious ])
//to prevent flickering
cPrevious := ""
return
endif
endif
// to avoid errors - eliminate changes for absent controls in aLabelColors array
if HB_HPOS( aLabelColors, cControl) == 0
return
endif
if !empty(cPrevious)
// to avoid flickering
if !(cControl == cPrevious)
SetProperty(cFormName, cPrevious, "BackColor",aLabelColors [ cPrevious ])
endif
endif
SetProperty(cForm, cControl, "BackColor",{255,255,0})
cPrevious := cControl
return
Code: Select all
FUNCTION SelCtrl( wParam )
LOCAL cCtrl, cForm, cCtrlPso := "", nOpc := 0
GetControlNameByHandle( wParam, @cCtrl, @cForm )
cForm := ALLTRIM( cForm )
cCtrl := ALLTRIM( cCtrl )
IF "LB_A" $ cCtrl
nOpc := ASCAN( aActi, "Y" )
IF nOpc > 0
cCtrlPso := "LB_A"+STRZERO( nOpc, 2 )
FormMain.&cCtrlPso..BACKCOLOR := { 210, 233, 255 }
FormMain.&cCtrlPso..FONTCOLOR := BLACK
aActi[ nOpc ] := "N"
ENDIF
FormMain.&cCtrl..BACKCOLOR := { 0, 191, 255 }
FormMain.&cCtrl..FONTCOLOR := YELLOW
aActi[ VAL( SUBSTR( cCtrl, 5, 2 ) ) ] := "Y"
ENDIF
RETURN Nil
Maybe in this way it will be good:mol wrote: ↑Thu Jun 21, 2018 4:55 am Hi Krzysztof!
Your sample works fine till application has focus.
When I switched to another application and return to Label Test, onMouseEvent stopped to work
When I leave mouse cursor over label - it becomes RED - I'm switching by Alt-Tab to another application and return to Test - label stays RED and another label does not react with mouse overlapping.
When I leave mouse cursor outside label and swith by Alt-Tab and return to Test - everything looks OK.
Code: Select all
#include "hmg.ch"
MEMVAR _HMG_SYSDATA
FUNCTION Main()
DEFINE WINDOW MainForm;
WIDTH 300;
HEIGHT 260;
TITLE "Move cursor over labels";
MAIN;
ON GOTFOCUS MainFormOnGotFocus()
DEFINE LABEL Label1
ROW 10
COL 10
WIDTH 140
HEIGHT 45
VALUE "This is LABEL1"
ALIGNMENT Center
FONTCOLOR BLACK
END LABEL
DEFINE LABEL Label2
ROW 65
COL 10
WIDTH 140
HEIGHT 45
VALUE "This is LABEL2"
ALIGNMENT Center
FONTCOLOR BLACK
END LABEL
DEFINE LABEL Label3
ROW 120
COL 10
WIDTH 140
HEIGHT 45
VALUE "This is LABEL3"
ALIGNMENT Center
FONTCOLOR BLACK
END LABEL
DEFINE BUTTON CloseButton
ROW 190
COL 10
WIDTH 80
HEIGHT 23
CAPTION "Close"
ACTION MainForm.RELEASE
END BUTTON
END WINDOW
HMG_ChangeWindowStyle(MainForm.Label1.HANDLE, 0x00800200 /*WS_BORDER|SS_CENTERIMAGE*/, NIL, .F., .T.)
HMG_ChangeWindowStyle(MainForm.Label2.HANDLE, 0x00800200 /*WS_BORDER|SS_CENTERIMAGE*/, NIL, .F., .T.)
HMG_ChangeWindowStyle(MainForm.Label3.HANDLE, 0x00800200 /*WS_BORDER|SS_CENTERIMAGE*/, NIL, .F., .T.)
EventProcessAllHookMessage(EventCreate("LabelEventHandler", MainForm.Label1.HANDLE), .T.)
EventProcessAllHookMessage(EventCreate("LabelEventHandler", MainForm.Label2.HANDLE), .T.)
EventProcessAllHookMessage(EventCreate("LabelEventHandler", MainForm.Label3.HANDLE), .T.)
MainForm.CENTER
MainForm.ACTIVATE
RETURN NIL
FUNCTION MainFormOnGotFocus()
PostMessage(MainForm.Label1.HANDLE, WM_MOUSELEAVE, 0, 0)
PostMessage(MainForm.Label2.HANDLE, WM_MOUSELEAVE, 0, 0)
PostMessage(MainForm.Label3.HANDLE, WM_MOUSELEAVE, 0, 0)
RETURN NIL
FUNCTION LabelEventHandler(cParam)
STATIC lTracking := .F.
LOCAL nHWnd := EventHWND()
LOCAL nMsg := EventMSG()
LOCAL cControl
LOCAL cForm
SWITCH nMsg
CASE WM_MOUSEMOVE
IF ! lTracking
GetControlNameByHandle(nHWnd, @cControl, @cForm)
SetProperty(cForm, cControl, "FONTCOLOR", RED)
SetProperty(cForm, cControl, "FONTBOLD", .T.)
lTracking := TrackMouseEvent(nHWnd) //TME_LEAVE is default flag
ENDIF
EXIT
CASE WM_MOUSELEAVE
GetControlNameByHandle(nHWnd, @cControl, @cForm)
SetProperty(cForm, cControl, "FONTCOLOR", BLACK)
SetProperty(cForm, cControl, "FONTBOLD", .F.)
lTracking := .F.
EXIT
ENDSWITCH
RETURN NIL
#pragma BEGINDUMP
#include "SET_COMPILE_HMG_UNICODE.ch"
#include "HMG_UNICODE.h"
#include <windows.h>
#include "hbapi.h"
// https://msdn.microsoft.com/en-us/library/windows/desktop/ms646265(v=vs.85).aspx
// TrackMouseEvent(nHWnd, [nFlags], [nHoverTime]) --> lSuccess
HB_FUNC( TRACKMOUSEEVENT )
{
TRACKMOUSEEVENT tmi;
tmi.cbSize = sizeof(TRACKMOUSEEVENT);
tmi.dwFlags = hb_parnidef(2, TME_LEAVE);
tmi.hwndTrack = (HWND) HMG_parnl(1);
tmi.dwHoverTime = hb_parnidef(3, HOVER_DEFAULT);
hb_retl(TrackMouseEvent(&tmi));
}
#pragma ENDDUMP
Yes, I have tested your example.