Page 3 of 3

Re: mouseover label

Posted: Mon Jun 25, 2018 7:35 am
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

Re: mouseover label

Posted: Mon Jun 25, 2018 8:48 pm
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

Re: mouseover label

Posted: Tue Jun 26, 2018 4:24 am
by bpd2000
Thank you, Krzysztof
Continue

Re: mouseover label

Posted: Tue Jun 26, 2018 12:33 pm
by serge_girard
Great !

Serge

Re: mouseover label

Posted: Tue Jun 26, 2018 4:56 pm
by mol
Great, thank you, KDJ!

Re: mouseover label

Posted: Tue Jun 26, 2018 6:48 pm
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

Re: mouseover label

Posted: Wed Jun 27, 2018 9:14 am
by mol
Excellent job!

Re: mouseover label

Posted: Thu Jun 28, 2018 9:51 am
by chrisjx2002
Great job!

Re: mouseover label

Posted: Thu Jun 28, 2018 3:16 pm
by martingz
KDJ Great Job

Re: mouseover label

Posted: Fri Jun 29, 2018 12:56 pm
by EduardoLuis
Congratulations KDJ, a great job as allways.