mouseover label

HMG en Español

Moderator: Rathinagiri

User avatar
bpd2000
Posts: 1147
Joined: Sat Sep 10, 2011 4:07 am
Location: India
Has thanked: 246 times
Been thanked: 139 times

Re: mouseover label

Post by bpd2000 »

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: 242
Joined: Mon Sep 05, 2016 3:04 am
Location: Poland
Been thanked: 291 times

Post by KDJ »

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: 1147
Joined: Sat Sep 10, 2011 4:07 am
Location: India
Has thanked: 246 times
Been thanked: 139 times

Post by bpd2000 »

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

User avatar
serge_girard
Posts: 2512
Joined: Sun Nov 25, 2012 2:44 pm
DBs Used: 1 MySQL - MariaDB
2 DBF
Location: Belgium
Has thanked: 810 times
Been thanked: 154 times
Contact:

Post by serge_girard »

Great !

Serge

User avatar
mol
Posts: 3362
Joined: Thu Sep 11, 2008 5:31 am
Location: Myszków, Poland
Has thanked: 259 times
Been thanked: 163 times
Contact:

Post by mol »

Great, thank you, KDJ!

KDJ
Posts: 242
Joined: Mon Sep 05, 2016 3:04 am
Location: Poland
Been thanked: 291 times

Post by KDJ »

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

User avatar
mol
Posts: 3362
Joined: Thu Sep 11, 2008 5:31 am
Location: Myszków, Poland
Has thanked: 259 times
Been thanked: 163 times
Contact:

Post by mol »

Excellent job!

chrisjx2002
Posts: 173
Joined: Wed Jan 06, 2010 5:39 pm
Been thanked: 2 times

Post by chrisjx2002 »

Great job!

martingz
Posts: 294
Joined: Wed Nov 18, 2009 11:14 pm
Location: Mexico
Has thanked: 22 times
Been thanked: 18 times

Post by martingz »

KDJ Great Job

EduardoLuis
Posts: 665
Joined: Tue Jun 04, 2013 6:33 pm
Location: Argentina
Has thanked: 1 time
Been thanked: 62 times

Post by EduardoLuis »

Congratulations KDJ, a great job as allways.

Post Reply