+1
mouseover label
Moderator: Rathinagiri
Re: mouseover label
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
- serge_girard
- Posts: 3167
- Joined: Sun Nov 25, 2012 2:44 pm
- DBs Used: 1 MySQL - MariaDB
2 DBF - Location: Belgium
- Contact:
Re: mouseover label
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
KDJ Great Job
-
- Posts: 682
- Joined: Tue Jun 04, 2013 6:33 pm
- Location: Argentina
Re: mouseover label
Congratulations KDJ, a great job as allways.