mouseover label

HMG en Español

Moderator: Rathinagiri

User avatar
gfilatov
Posts: 1060
Joined: Fri Aug 01, 2008 5:42 am
Location: Ukraine
Contact:

Re: mouseover label

Post by gfilatov »

KDJ wrote: Sun Jun 10, 2018 4:36 pm Grigory
...
Why WM_MOUSELEAVE in HMG Extended works and in classic HMG doesn't work?
Krzysztof

IMHO Because HMG Extended uses a Label subclassing on C-level 8-)
Kind Regards,
Grigory Filatov

"Everything should be made as simple as possible, but no simpler." Albert Einstein
KDJ
Posts: 243
Joined: Mon Sep 05, 2016 3:04 am
Location: Poland

Re: mouseover label

Post by KDJ »

Grigory, thank you very much for your explanation.
User avatar
koke
Posts: 116
Joined: Wed Aug 21, 2013 3:54 pm
DBs Used: DBF, mySql, mariaDB

Re: mouseover label

Post by koke »

Gracias a todos han sido de mucha ayuda.

Google translate

Thank you all, you have been very helpful.
,___,
[O.o]
/)__)
-”–”-
KoKe
KDJ
Posts: 243
Joined: Mon Sep 05, 2016 3:04 am
Location: Poland

Re: mouseover label

Post by KDJ »

gfilatov wrote: Sun Jun 10, 2018 4:50 pm
KDJ wrote: Sun Jun 10, 2018 4:36 pm Grigory
...
Why WM_MOUSELEAVE in HMG Extended works and in classic HMG doesn't work?
Krzysztof

IMHO Because HMG Extended uses a Label subclassing on C-level 8-)

Grigory

I solved this problem.
Before that I completely forgot about the function EventProcessAllHookMessage().
WM_MOUSELEAVE works also in classic HMG:

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
User avatar
mol
Posts: 3718
Joined: Thu Sep 11, 2008 5:31 am
Location: Myszków, Poland
Contact:

Re: mouseover label

Post by mol »

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.
User avatar
mol
Posts: 3718
Joined: Thu Sep 11, 2008 5:31 am
Location: Myszków, Poland
Contact:

Re: mouseover label

Post by mol »

This is my little sample, can you test it?

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
User avatar
andyglezl
Posts: 1461
Joined: Fri Oct 26, 2012 7:58 pm
Location: Guadalajara Jalisco, MX
Contact:

Re: mouseover label

Post by andyglezl »

Hace tiempo hice algo parecido...
El ejemplo completo se encuentra aquí.
viewtopic.php?f=6&t=4468&p=42585&hilit= ... enu#p42585

---------------------------------------------

Some time ago I did something similar ...
The complete example is here.
viewtopic.php?f=6&t=4468&p=42585&hilit= ... enu#p42585

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
Andrés González López
Desde Guadalajara, Jalisco. México.
KDJ
Posts: 243
Joined: Mon Sep 05, 2016 3:04 am
Location: Poland

Re: mouseover label

Post by KDJ »

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.
Maybe in this way it will be good:

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
mol wrote: Thu Jun 21, 2018 5:37 am This is my little sample, can you test it?
Yes, I have tested your example.
It uses WM_SETCURSOR to determine the cursor location, although this is not explicitly written in the code.
It works fine, but if you place the cursor on the label "OPTON 1" and then quickly move the cursor to the left outside the main window - the color of this label will not change, it will remain yellow.
User avatar
mol
Posts: 3718
Joined: Thu Sep 11, 2008 5:31 am
Location: Myszków, Poland
Contact:

Re: mouseover label

Post by mol »

Sucha a interface with labels looks like webside and it's very fine.
The only one problem is that the label can't get focus and it's not possible to interact with keyboard (some people still want to work in this way :-D)
Post Reply