mouseover label

HMG en Español

Moderator: Rathinagiri

User avatar
bpd2000
Posts: 1024
Joined: Sat Sep 10, 2011 4:07 am
Location: India

Re: mouseover label

Post by bpd2000 » Mon Jun 25, 2018 7:35 am

mol wrote:
Sun Jun 24, 2018 5:14 pm
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)
+1
BPD
Convert Dream into Reality through HMG

KDJ
Posts: 211
Joined: Mon Sep 05, 2016 3:04 am
Location: Poland

Re: mouseover label

Post by KDJ » Mon Jun 25, 2018 8:48 pm

Is this supposed to be something like that:

Code: Select all

#include "hmg.ch"

#define LABEL_NAME 1
#define LABEL_HWND 2

MEMVAR _HMG_SYSDATA

FUNCTION Main()
  LOCAL aLabel := {{"LABEL1", NIL}, ;
                   {"LABEL2", NIL}, ;
                   {"LABEL3", NIL}}
  LOCAL n

  DEFINE WINDOW MainForm;
    WIDTH  300;
    HEIGHT 260;
    TITLE  "Labels as buttons";
    MAIN;
    ON GOTFOCUS MainFormOnGotFocus(aLabel)

    //this labels can get focus and process keyboard/mouse messages
    FOR n := 1 TO Len(aLabel)
      DEFINE LABEL &(aLabel[n][LABEL_NAME])
        ROW       10 + 55 * (n - 1)
        COL       10
        WIDTH     140
        HEIGHT    45
        VALUE     "This is " + aLabel[n][LABEL_NAME]
        ALIGNMENT Center
        FONTCOLOR BLACK
      END LABEL

      aLabel[n][LABEL_HWND] := GetProperty("MainForm", aLabel[n][LABEL_NAME], "HANDLE")

      HMG_ChangeWindowStyle(aLabel[n][LABEL_HWND], 0x00010200 /*WS_TABSTOP|SS_CENTERIMAGE*/, NIL, .F., .F.)
      EventProcessAllHookMessage(EventCreate({ || LabelEventHandler(aLabel) }, aLabel[n][LABEL_HWND]), .T.)
    NEXT

    DEFINE LABEL LABEL4
      ROW    190
      COL    150
      WIDTH  140
      HEIGHT 13
      VALUE  "This is standard LABEL"
    END LABEL

    DEFINE BUTTON CloseButton
      ROW        190
      COL        10
      WIDTH      80
      HEIGHT     23
      CAPTION    "Close"
      ACTION     MainForm.RELEASE
      ONGOTFOCUS LabelSetBorder(aLabel, 0)
    END BUTTON
  END WINDOW

  SetFocus(aLabel[1][LABEL_HWND])
  LabelSetBorder(aLabel, aLabel[1][LABEL_HWND])

  MainForm.CENTER
  MainForm.ACTIVATE

RETURN NIL


FUNCTION MainFormOnGotFocus(aLabel)
  LOCAL n

  FOR n := 1 TO Len(aLabel)
    PostMessage(aLabel[n][LABEL_HWND], WM_MOUSELEAVE, 0, 0)
  NEXT

RETURN NIL


FUNCTION LabelEventHandler(aLabel)
  STATIC lTracking := .F.
  LOCAL  nHWnd   := EventHWND()
  LOCAL  nMsg    := EventMSG()
  LOCAL  nWParam := EventWPARAM()
  LOCAL  cControl
  LOCAL  cForm

  GetControlNameByHandle(nHWnd, @cControl, @cForm)

  SWITCH nMsg
    CASE WM_KEYDOWN
      IF nWParam == VK_TAB
        LabelSetBorder(aLabel, GetNextDlgTabItem(MainForm.HANDLE, nHWnd, (GetKeyState(VK_SHIFT) < 0)))
      ELSEIF (nWParam == VK_RETURN) .or. (nWParam == VK_SPACE)
        MsgBox(GetProperty(cForm, cControl, "VALUE"))
      ENDIF
      EXIT

    CASE WM_KEYUP
      IF nWParam == VK_TAB
        LabelSetBorder(aLabel, nHWnd)
      ENDIF
      EXIT

    CASE WM_LBUTTONDOWN
      SetFocus(nHWnd)
      LabelSetBorder(aLabel, nHWnd)
      MsgBox(GetProperty(cForm, cControl, "VALUE"))
      EXIT

    CASE WM_RBUTTONDOWN
      SetFocus(nHWnd)
      LabelSetBorder(aLabel, nHWnd)
      EXIT

    CASE WM_MOUSEMOVE
      IF ! lTracking
        SetProperty(cForm, cControl, "FONTCOLOR", RED)
        SetProperty(cForm, cControl, "FONTBOLD", .T.)
        lTracking := TrackMouseEvent(nHWnd) //TME_LEAVE is default flag
      ENDIF
      EXIT

    CASE WM_MOUSELEAVE
      SetProperty(cForm, cControl, "FONTCOLOR", BLACK)
      SetProperty(cForm, cControl, "FONTBOLD", .F.)
      lTracking := .F.
      EXIT
  ENDSWITCH

RETURN NIL


FUNCTION LabelSetBorder(aLabel, nHWnd)
  LOCAL nPos := aScan(aLabel, { |a1| nHWnd == a1[LABEL_HWND] })
  LOCAL n

  FOR n := 1 TO Len(aLabel)
    HMG_ChangeWindowStyle(aLabel[n][LABEL_HWND], NIL, 0x00800000 /*WS_BORDER*/, .F., .T.)
    HMG_ChangeWindowStyle(aLabel[n][LABEL_HWND], 0x00020000 /*WS_EX_STATICEDGE*/, NIL, .T., .T.)
  NEXT

  IF nPos > 0
    HMG_ChangeWindowStyle(aLabel[nPos][LABEL_HWND], 0x00800000 /*WS_BORDER*/, NIL, .F., .T.)
    HMG_ChangeWindowStyle(aLabel[nPos][LABEL_HWND], NIL, 0x00020000 /*WS_EX_STATICEDGE*/, .T., .T.)
  ENDIF

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

User avatar
bpd2000
Posts: 1024
Joined: Sat Sep 10, 2011 4:07 am
Location: India

Re: mouseover label

Post by bpd2000 » Tue Jun 26, 2018 4:24 am

Thank you, Krzysztof
Continue
BPD
Convert Dream into Reality through HMG

User avatar
serge_girard
Posts: 2092
Joined: Sun Nov 25, 2012 2:44 pm
DBs Used: 1 MySQL - MariaDB
2 DBF
Location: Belgium
Contact:

Re: mouseover label

Post by serge_girard » Tue Jun 26, 2018 12:33 pm

Great !

Serge


KDJ
Posts: 211
Joined: Mon Sep 05, 2016 3:04 am
Location: Poland

Re: mouseover label

Post by KDJ » Tue Jun 26, 2018 6:48 pm

A small improvement to avoid flickering:

Code: Select all

#include "hmg.ch"

#define LABEL_NAME 1
#define LABEL_HWND 2

MEMVAR _HMG_SYSDATA

FUNCTION Main()
  LOCAL aLabel := {{"LABEL1", NIL}, ;
                   {"LABEL2", NIL}, ;
                   {"LABEL3", NIL}}
  LOCAL n

  DEFINE WINDOW MainForm;
    WIDTH  300;
    HEIGHT 260;
    TITLE  "Labels as buttons";
    MAIN;
    ON GOTFOCUS MainFormOnGotFocus(aLabel)

    //this labels can get focus and process keyboard/mouse messages
    FOR n := 1 TO Len(aLabel)
      DEFINE LABEL &(aLabel[n][LABEL_NAME])
        ROW       10 + 55 * (n - 1)
        COL       10
        WIDTH     140
        HEIGHT    45
        VALUE     "This is " + aLabel[n][LABEL_NAME]
        ALIGNMENT Center
        FONTCOLOR BLACK
      END LABEL

      aLabel[n][LABEL_HWND] := GetProperty("MainForm", aLabel[n][LABEL_NAME], "HANDLE")

      HMG_ChangeWindowStyle(aLabel[n][LABEL_HWND], 0x00010200 /*WS_TABSTOP|SS_CENTERIMAGE*/, NIL, .F., .F.)
      HMG_ChangeWindowStyle(aLabel[n][LABEL_HWND], WS_EX_STATICEDGE, NIL, .T., .T.)
      EventProcessAllHookMessage(EventCreate({ || LabelEventHandler(aLabel) }, aLabel[n][LABEL_HWND]), .T.)
    NEXT

    DEFINE LABEL LABEL4
      ROW    190
      COL    150
      WIDTH  140
      HEIGHT 13
      VALUE  "This is standard LABEL"
    END LABEL

    DEFINE BUTTON CloseButton
      ROW        190
      COL        10
      WIDTH      80
      HEIGHT     23
      CAPTION    "Close"
      ACTION     MainForm.RELEASE
      ONGOTFOCUS LabelSetBorder(aLabel, 0)
    END BUTTON
  END WINDOW

  SetFocus(aLabel[1][LABEL_HWND])
  LabelSetBorder(aLabel, aLabel[1][LABEL_HWND])

  MainForm.CENTER
  MainForm.ACTIVATE

RETURN NIL


FUNCTION MainFormOnGotFocus(aLabel)
  LOCAL n

  FOR n := 1 TO Len(aLabel)
    PostMessage(aLabel[n][LABEL_HWND], WM_MOUSELEAVE, 0, 0)
  NEXT

RETURN NIL


FUNCTION LabelEventHandler(aLabel)
  STATIC lTracking := .F.
  LOCAL  nHWnd   := EventHWND()
  LOCAL  nMsg    := EventMSG()
  LOCAL  nWParam := EventWPARAM()
  LOCAL  cControl
  LOCAL  cForm

  GetControlNameByHandle(nHWnd, @cControl, @cForm)

  SWITCH nMsg
    CASE WM_KEYDOWN
      IF nWParam == VK_TAB
        LabelSetBorder(aLabel, GetNextDlgTabItem(GetProperty(cForm, "HANDLE"), nHWnd, (GetKeyState(VK_SHIFT) < 0)))
      ELSEIF (nWParam == VK_RETURN) .or. (nWParam == VK_SPACE)
        MsgBox(GetProperty(cForm, cControl, "VALUE"))
      ENDIF
      EXIT

    CASE WM_KEYUP
      IF nWParam == VK_TAB
        LabelSetBorder(aLabel, nHWnd)
      ENDIF
      EXIT

    CASE WM_LBUTTONDOWN
      SetFocus(nHWnd)
      LabelSetBorder(aLabel, nHWnd)
      MsgBox(GetProperty(cForm, cControl, "VALUE"))
      EXIT

    CASE WM_RBUTTONDOWN
      SetFocus(nHWnd)
      LabelSetBorder(aLabel, nHWnd)
      EXIT

    CASE WM_MOUSEMOVE
      IF ! lTracking
        SetProperty(cForm, cControl, "FONTCOLOR", RED)
        SetProperty(cForm, cControl, "FONTBOLD", .T.)
        lTracking := TrackMouseEvent(nHWnd) //TME_LEAVE is default flag
      ENDIF
      EXIT

    CASE WM_MOUSELEAVE
      SetProperty(cForm, cControl, "FONTCOLOR", BLACK)
      SetProperty(cForm, cControl, "FONTBOLD", .F.)
      lTracking := .F.
      EXIT
  ENDSWITCH

RETURN NIL


FUNCTION LabelSetBorder(aLabel, nHWnd)
  LOCAL nPosDel := aScan(aLabel, { |a1| HMG_IsWindowStyle(a1[LABEL_HWND], WS_BORDER) })
  LOCAL nPosSet := aScan(aLabel, { |a1| nHWnd == a1[LABEL_HWND] })

  IF nPosDel != nPosSet
    IF nPosDel > 0
      HMG_ChangeWindowStyle(aLabel[nPosDel][LABEL_HWND], NIL, WS_BORDER, .F., .T.)
      HMG_ChangeWindowStyle(aLabel[nPosDel][LABEL_HWND], WS_EX_STATICEDGE, NIL, .T., .T.)
    ENDIF

    IF nPosSet > 0
      HMG_ChangeWindowStyle(aLabel[nPosSet][LABEL_HWND], WS_BORDER, NIL, .F., .T.)
      HMG_ChangeWindowStyle(aLabel[nPosSet][LABEL_HWND], NIL, WS_EX_STATICEDGE, .T., .T.)
    ENDIF
  ENDIF

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


chrisjx2002
Posts: 164
Joined: Wed Jan 06, 2010 5:39 pm

Re: mouseover label

Post by chrisjx2002 » Thu Jun 28, 2018 9:51 am

Great job!

martingz
Posts: 237
Joined: Wed Nov 18, 2009 11:14 pm
Location: Mexico

Re: mouseover label

Post by martingz » Thu Jun 28, 2018 3:16 pm

KDJ Great Job

EduardoLuis
Posts: 578
Joined: Tue Jun 04, 2013 6:33 pm
Location: Argentina

Re: mouseover label

Post by EduardoLuis » Fri Jun 29, 2018 12:56 pm

Congratulations KDJ, a great job as allways.

Post Reply