mouseover label

HMG en Español

Moderator: Rathinagiri

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

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: 243
Joined: Mon Sep 05, 2016 3:04 am
Location: Poland

Re: mouseover label

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: 1207
Joined: Sat Sep 10, 2011 4:07 am
Location: India

Re: mouseover label

Post by bpd2000 »

Thank you, Krzysztof
Continue
BPD
Convert Dream into Reality through HMG
User avatar
serge_girard
Posts: 3161
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 »

Great !

Serge
There's nothing you can do that can't be done...
KDJ
Posts: 243
Joined: Mon Sep 05, 2016 3:04 am
Location: Poland

Re: mouseover label

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
chrisjx2002
Posts: 190
Joined: Wed Jan 06, 2010 5:39 pm

Re: mouseover label

Post by chrisjx2002 »

Great job!
martingz
Posts: 394
Joined: Wed Nov 18, 2009 11:14 pm
Location: Mexico

Re: mouseover label

Post by martingz »

KDJ Great Job
EduardoLuis
Posts: 682
Joined: Tue Jun 04, 2013 6:33 pm
Location: Argentina

Re: mouseover label

Post by EduardoLuis »

Congratulations KDJ, a great job as allways.
Post Reply