Ownerdrawn transparent menus-Herman Tan class
Herman Tan ownerdrawn menu (2005- last updated published 2006-2008) can be downloaded from this link:
http://hermantan.blogspot.com/2006/09/updated-ownerdrawn-menu-class.html
first version can be seen in https://www.universalthread.com/ViewPageArticle.aspx?ID=476
Its a big class using windows APIs & vfp9 to build menus.VFP menus are Ownerdrawn menus are described in https://msdn.microsoft.com/en-us/library/bb756947.aspx
I converted the original class to a prg and added to it a method to make the menu transparent with applying api setLayeredwindow to handle.
this class set menu on vfp window, top level form, contextuel menu with some cosmetics as colors, bitmaps,shapes.....(see the demo).
Procedure: the code creates:
-the constants file api_menu.h (mandatory recquired in source folder)
-the entire procedure class as popupmenu.prg ((mandatory recquired in source folder))
-The first running code yownerdrawn0.prg as demo
-the second demo form yownerdrawn1.prg as demo
*1)*-Create the constants file named : menu_api.h....save as const.prg and run it.
*Begin code
Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
*re generate the constants api_menu.h file (as it).
Local m.myvar
TEXT to m.myvar noshow
*** Header constants for Popup Menu Class
*** Version 1.62.052
***
*** Last update: August 22, 2008
* typedef struct _TRIVERTEX {
* LONG x;
* Long y;
* COLOR16 Red;
* COLOR16 Green;
* COLOR16 Blue;
* COLOR16 Alpha;
* }TRIVERTEX, *PTRIVERTEX
* typedef struct tagNONCLIENTMETRICS {
* UINT cbSize;
* int iBorderWidth;
* int iScrollWidth;
* int iScrollHeight;
* int iCaptionWidth;
* int iCaptionHeight;
* LOGFONT lfCaptionFont;
* int iSmCaptionWidth;
* int iSmCaptionHeight;
* LOGFONT lfSmCaptionFont;
* int iMenuWidth;
* int iMenuHeight;
* LOGFONT lfMenuFont;
* LOGFONT lfStatusFont;
* LOGFONT lfMessageFont;
* } NONCLIENTMETRICS, *LPNONCLIENTMETRICS
* typedef struct tagLOGFONT {
* LONG lfHeight;
* LONG lfWidth;
* LONG lfEscapement;
* LONG lfOrientation;
* LONG lfWeight;
* BYTE lfItalic;
* BYTE lfUnderline;
* BYTE lfStrikeOut;
* BYTE lfCharSet;
* BYTE lfOutPrecision;
* BYTE lfClipPrecision;
* BYTE lfQuality;
* BYTE lfPitchAndFamily;
* TCHAR lfFaceName[LF_FACESIZE];
* } LOGFONT, *PLOGFONT
* typedef struct MEASUREITEMSTRUCT {
* UINT CtlType;
* UINT CtlID;
* UINT itemID;
* UINT itemWidth;
* UINT itemHeight;
* ULONG_PTR itemData;
* } MEASUREITEMSTRUCT
* typedef struct tagDRAWITEMSTRUCT {
* UINT CtlType;
* UINT CtlID;
* UINT itemID;
* UINT itemAction;
* UINT itemState;
* HWND hwndItem;
* HDC hDC;
* RECT rcItem;
* ULONG_PTR itemData;
* } DRAWITEMSTRUCT
* typedef struct _RECT {
* LONG left;
* LONG top;
* LONG right;
* LONG bottom;
* } RECT, *PRECT
* typedef struct tagMYPOPITEM
* {
* char szItemText[MAX_TEXTLEN];
* UINT nLen;
* HBITMAP hBitmap;
* DWORD nFlags;
* LPSTR lpCommand;
* } MYPOPITEM
* typedef struct tagMENUINFO {
* DWORD cbSize;
* DWORD fMask;
* DWORD dwStyle;
* UINT cyMax;
* HBRUSH hbrBack;
* DWORD dwContextHelpID;
* ULONG_PTR dwMenuData;
* } MENUINFO, FAR *LPMENUINFO;
* typedef MENUINFO CONST FAR *LPCMENUINFO
* typedef struct tagMENUBARINFO {
* DWORD cbSize;
* RECT rcBar;
* HMENU hMenu;
* HWND hwndMenu;
* BOOL fBarFocused:1;
* BOOL fFocused:1;
* } MENUBARINFO, *PMENUBARINFO
* typedef struct tagMENUITEMINFO {
* UINT cbSize;
* UINT fMask;
* UINT fType;
* UINT fState;
* UINT wID;
* HMENU hSubMenu;
* HBITMAP hbmpChecked;
* HBITMAP hbmpUnchecked;
* ULONG_PTR dwItemData;
* LPTSTR dwTypeData;
* UINT cch;
* HBITMAP hbmpItem;
* } MENUITEMINFO, *LPMENUITEMINFO
* typedef struct tagBITMAP {
* LONG bmType;
* LONG bmWidth;
* LONG bmHeight;
* LONG bmWidthBytes;
* WORD bmPlanes;
* WORD bmBitsPixel;
* LPVOID bmBits;
* } BITMAP, *PBITMAP
*** Define type
#Define c0 chr(0)
#Define c1 chr(1)
#Define CR chr(13)
#Define LF chr(10)
#Define _TAB chr(9)
#Define w0 c0+c0
#Define dw0 w0+w0
#Define CRLF CR + LF
#Define PNULL 0
#Define BYTE_Size 1
#Define WORD_Size 2
#Define DWORD_Size 4
#Define LF_FACESIZE 32
#Define MAX_TEXTLEN 64
#Define MAX_ITEMTEXT MAX_TEXTLEN
#Define MAX_RGB 255
*** Structure size
#Define POINT_Size 8
** (DWORD_Size * 2)
#Define RECT_Size 16
** (DWORD_Size * 4)
#Define POPITEM_Size 80
** (MAX_TEXTLEN + (DWORD_Size * 4))
#Define MENUITEMINFO_Size 48
** (DWORD_Size * 12)
#Define LOGFONT_Size 60
** ((DWORD_Size * 5) + (BYTE_Size * 8) + LF_FACESIZE)
#Define TRIVERTEX_Size 16
**((DWORD_Size * 2) + (WORD_Size * 4))
#Define MENUINFO_Size 28
** (DWORD_Size * 7)
#Define MENUBARINFO_Size 32
** (DWORD_Size + RECT_Size + (DWORD_Size * 3))
#Define BITMAP_Size 24
** ((DWORD_Size * 4) + (WORD_Size * 2) + DWORD_Size)
#Define NONCLIENTMETRICS_size 340
** ((DWORD_Size * 6) + LOGFONT_Size + (DWORD_Size * 2) + ;
** LOGFONT_Size + (DWORD_Size * 2) + (LOGFONT_Size * 3))
** Menu Flags
#Define MF_BYCOMMAND 0x0000
#Define MF_BYPOSITION 0x0400
#Define MF_ENABLED 0x0000
#Define MF_GRAYED 0x0001
#Define MF_DISABLED 0x0002
#Define MF_STRING 0x0000
#Define MF_BITMAP 0x0004
#Define MF_POPUP 0x0010
#Define MF_OWNERDRAW 0x0100
#Define MF_SEPARATOR 0x0800
#Define MF_DEFAULT 0x1000
#Define MF_MOUSESELECT 0x8000
** Menu Flags State
#Define MFS_DISABLED 0x0003 && MF_GRAYED + MF_DISABLED
#Define MFS_DEFAULT 0x1000
** Menu Flags Type
#Define MFT_OWNERDRAW MF_OWNERDRAW
#Define MFT_SEPARATOR MF_SEPARATOR
#Define MIM_BACKGROUND 0x0002
#Define MIIM_STATE 0x0001
#Define MIIM_SUBMENU 0x0004
#Define MIIM_DATA 0x0020
#Define MIIM_STRING 0x0040
#Define MIIM_BITMAP 0x0080
#Define MIIM_FTYPE 0x0100
#Define TPM_LEFTALIGN 0x0000
#Define TPM_TOPALIGN 0x0000
#Define TPM_LEFTBUTTON 0x0000
#Define TPM_RIGHTBUTTON 0x0002
#Define TPM_NONOTIFY 0x0080
#Define TPM_RETURNCMD 0x0100
#Define DEFAULT_CHARSET 0x0001
#Define DEFAULT_QUALITY 0x0000
#Define DEFAULT_PITCH 0x0000
#Define CLIP_DEFAULT_PRECIS 0x0000
#Define OUT_TT_PRECIS 0x0004
#Define FW_NORMAL 400
#Define FW_MEDIUM 500
#Define FW_SEMIBOLD 600
#Define FW_BOLD 700
#Define FW_HEAVY 900
#Define GWL_WNDPROC -4
#Define SM_CXMENUCHECK 71
#Define MSGF_MENU 2
#Define NULL_BRUSH 5
#Define PS_NULL 5
#Define HTMENU 5
#Define SC_KEYMENU 0xF100
#Define GW_CHILD 5
*** Virtual Key
#Define VK_ENTER 0x00D && Enter key
#Define VK_ESCAPE 0x01B && Escape key
#Define VK_LEFT 0x025 && LEFT ARROW key
#Define VK_UP 0x026 && UP ARROW key
#Define VK_RIGHT 0x027 && RIGHT ARROW key
#Define VK_DOWN 0x028 && DOWN ARROW key
*** Windows Message
#Define WM_CREATE 0x0001
#Define WM_ACTIVATE 0x0006
#Define WM_SETFOCUS 0x0007
#Define WM_KILLFOCUS 0x0008
#Define WM_SYSCOLORCHANGE 0x0015
#Define WM_ACTIVATEAPP 0x001C
#Define WM_DRAWITEM 0x002B
#Define WM_MEASUREITEM 0x002C
#Define WM_WINDOWPOSCHANGED 0x047
#Define WM_CONTEXTMENU 0x007B
#Define WM_NCHITTEST 0x0084
#Define WM_NCPAINT 0x0085
#Define WM_NCMOUSEMOVE 0x00A0
#Define WM_NCLBUTTONDOWN 0x00A1
#Define WM_NCLBUTTONUP 0x00A2
#Define WM_KEYDOWN 0x0100
#Define WM_COMMAND 0x0111
#Define WM_SYSCOMMAND 0x0112
#Define WM_TIMER 0x0113
#Define WM_INITMENU 0x0116
#Define WM_INITMENUPOPUP 0x0117
#Define WM_MENUSELECT 0x011F
#Define WM_MENUCHAR 0x0120
#Define WM_ENTERIDLE 0x0121
#Define WM_UNINITMENUPOPUP 0x0125
#Define WM_MOUSEMOVE 0x0200
#Define WM_LBUTTONDOWN 0x0201
#Define WM_LBUTTONUP 0x0202
#Define WM_THEMECHANGED 0x031A
#Define WM_USER 0x0400
#Define WA_INACTIVE 0x0
#Define WA_ACTIVE 0x1
#Define ODA_DRAWENTIRE 0x1
#Define ODA_SELECT 0x2
#Define ODS_SELECTED 0x1
#Define ODS_GRAYED 0x2
#Define ODS_DISABLED 0x4
#Define COLOR_ACTIVECAPTION 2
#Define COLOR_INACTIVECAPTION 3
#Define COLOR_MENU 4
#Define COLOR_WINDOW 5
#Define COLOR_MENUTEXT 7
#Define COLOR_HIGHLIGHT 13
#Define COLOR_HIGHLIGHTTEXT 14
#Define COLOR_BTNFACE 15
#Define COLOR_BTNSHADOW 16
#Define COLOR_BTNHIGHLIGHT 20
#Define COLOR_3DDKSHADOW 21
#Define COLOR_GRADIENTACTIVECAPTION 27
#Define COLOR_GRADIENTINACTIVECAPTION 28
#Define COLOR_MENUHILIGHT 29
#Define COLOR_MENUBAR 30
#Define GRADIENT_FILL_RECT_H 0x00000000
#Define GRADIENT_FILL_RECT_V 0x00000001
#Define DT_LEFT 0x000000
#Define DT_CENTER 0x000001
#Define DT_RIGHT 0x000002
#Define DT_VCENTER 0x000004
#Define DT_SINGLELINE 0x000020
#Define DT_EXPANDTABS 0x000040
#Define DT_NOCLIP 0x000100
#Define DT_CALCRECT 0x000400
#Define DT_END_ELLIPSIS 0x008000
#Define DT_WORD_ELLIPSIS 0x040000
#Define BDR_RAISEDOUTER 0x01
#Define BDR_SUNKENOUTER 0x02
#Define BDR_RAISEDINNER 0x04
#Define BDR_SUNKENINNER 0x08
#Define BF_LEFT 0x01
#Define BF_TOP 0x02
#Define BF_RIGHT 0x04
#Define BF_BOTTOM 0x08
#Define BF_RECT 0x0F && BitOr( BF_LEFT, BF_TOP, BF_RIGHT, BF_BOTTOM )
#Define BF_SOFT 0x1000 && For softer buttons
#Define EDGE_RAISED 0x05 && BitOr( BDR_RAISEDOUTER, BDR_RAISEDINNER )
#Define EDGE_SUNKEN 0x0A && BitOr( BDR_SUNKENOUTER, BDR_SUNKENINNER )
#Define ETO_OPAQUE 0x0002
#Define TA_NOUPDATECP 0
#Define TA_UPDATECP 1
#Define TA_TOP 0
#Define TA_LEFT 0
#Define TA_RIGHT 2
#Define TA_CENTER 6
#Define TA_BOTTOM 8
#Define TA_BASELINE 24
#Define VTA_CENTER TA_CENTER
#Define TRANSPARENT 1
#Define OPAQUE 2
#Define BS_SOLID 0
#Define PS_SOLID 0
#Define HWND_DESKTOP 0
#Define HWND_TOP 0
#Define LOGPIXELSX 88
#Define LOGPIXELSY 90
#Define OBJID_MENU 0x0FFFFFFFD
#Define MNC_IGNORE 0
#Define MNC_EXECUTE 2
#Define SRCCOPY 0xCC0020
#Define SPI_GETNONCLIENTMETRICS 0x0029
#Define SPI_GETANIMATION 0x0048
#Define SPI_GETMENUSHOWDELAY 0x006A
#Define SPI_GETMENUFADE 0x1012
#Define SPI_GETDROPSHADOW 0x1024
*** ShowWindow
#Define SW_HIDE 0
#Define SW_SHOWNORMAL 1
#Define SW_SHOW 5
*** SetWindowPos Flags
#Define SWP_NOSIZE 0x0001
#Define SWP_NOZORDER 0x0004
#Define SWP_NOACTIVATE 0x0010
#Define SWP_NOCOPYBITS 0x0100
#Define SWP_NOSENDCHANGING 0x0400
*** MessageBox Icon
#Define MB_ICONHAND 0x00000010
#Define MB_ICONQUESTION 0x00000020
#Define MB_ICONEXCLAMATION 0x00000030
#Define MB_ICONASTERISK 0x00000040
#Define MB_USERICON 0x00000080
#Define MB_ICONWARNING MB_ICONEXCLAMATION
#Define MB_ICONERROR MB_ICONHAND
#Define MB_ICONINFORMATION MB_ICONASTERISK
#Define MB_ICONSTOP MB_ICONHAND
#Define IMAGE_BITMAP 0
#Define LR_LOADFROMFILE 0x0010
*** Heap Memory Flags
#Define HEAP_NO_SERIALIZE 1
#Define HEAP_GENERATE_EXCEPTIONS 4
#Define HEAP_ZERO_MEMORY 8
#Define LPTR 0x40
*** System Cursor ID
#Define IDC_ARROW 32512
#Define IDC_HAND 32649
*** My Constants
#Define WM_DOCOMMAND WM_USER+5
#Define WM_OPENWEB WM_USER+6
#Define IDT_ENTERIDLE 101
#Define IDT_NONCLIENT 102
#Define IDT_TOOLTIPS 103
#Define WIN_XP ((OS(3) == '5') and (val( OS(4) ) > 0))
#Define XP_OR_HIGHER WIN_XP or (OS(3) > '5')
*** My OD Menu Highlight Style
#Define ODHS_ALL 0x00
#Define ODHS_BITMAPONLY 0x01
#Define ODHS_ROUNDED 0x10
#Define ODHS_ROUNDED_BITMAP 0x20
*** My OD Menu Hilite Color
#Define ODHC_Office2003 0xC2EEFF
** Rgb( 255, 238, 194 ) - Thanks to Malcolm Greene
*** My OD Menu Flags
#Define myODF_WEBLINK 0x01
#Define myODF_HASALPHA 0x02 && PixelFormat Has Alpha
#Define myODF_FRAME 0x04 && Bottom popup frame border
#Define myODF_SKIPFOR 0x10
#Define OBJ_TOP 1
#Define OBJ_LEFT 2
#Define OBJ_WIDTH 3
#Define OBJ_HEIGHT 4
#Define VFP_START_IDE 0
#Define VFP_START_EXE 4
#Define VFP_SW_INSCREEN 0
#Define VFP_SW_ASTOPLEVEL 2
#Define FORM_MODAL 1
#Define FORM_MODELESS 2
#Define TBD_TOP 0
#Define TBD_LEFT 1
#Define IDM_RESTORE '&Restore'
#Define IDM_MINIMIZE 'Mi&nimize'
#Define IDM_MAXIMIZE 'Ma&ximize'
#Define IDM_CLOSE '&Close'
ENDTEXT
Strtofile(m.myvar,m.yrep+"API_Menu.h")
*End code
*2)*This creates the prg class of ownerdrawn.vcx big class-Save the 3 portions below *as popupmenu.prg (its a class with 98 koctets-sorry for exercice to join 3 codes
*popupmenu 1/3+2/3+3/3 and save to popupmenu.prg.Select 1+2+3/3 copy and paste *into popmenu.prg
*Popupmenu.prg part 1/3
*Begin code
Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
#INCLUDE "api_menu.h"
*
DEFINE CLASS popupmenu AS custom
*-- XML Metadata for customizable properties
_memberdata = ""
hwndparent = 0
PROTECTED porgproc
porgproc = 0
PROTECTED hfont
hfont = 0
PROTECTED hdarkpen
hdarkpen = 0
hlightpen = 0
nfirstid = 0
nloopidle = 0
hpennull = 0
ntop = 0
nright = 0
nlen = 0
nbottom = 0
nrightcolor = -1
ncounter = 0
hwndpopup = 0
hmainmenu = 0
nmenupos = 0
oparent = .NULL.
lfullrectline = .T.
lcleardll = .T.
nleftcolor = -1
nosver = 0
PROTECTED hactivepopup
hactivepopup = 0
nmainmenuitems = 0
nbarcolor = -1
hbarbrush = 0
ndisabledcolor = -1
ndisabledcolorshadow = -1
nhilitestyle = 0
nhilitecolor = 0
ncoordinate = 0
soldrect = ""
PROTECTED cmenutext
cmenutext = ""
hpenpad = 0
nred = 0
ngreen = 0
nblue = 0
cmenuname = ""
nxmenucheck = 0
nleftparent = 0
hheap = 0
hhandcursor = 0
holdcursor = 0
hfontcustom = 0
PROTECTED cwebsite
cwebsite = ""
hwndfocus = 0
hpenrect = 0
ptoken = 0
ntextcolor = 0
ntextshadowcolor = 0
hsysmenu = 0
hfontbold = 0
hfontwebding = 0
hfontwebdingbold = 0
ntexthilitecolor = 0
hfontcustombold = 0
lsysmenu_od = .F.
PROTECTED citemtext
citemtext = ""
PROTECTED nitemtextleft
nitemtextleft = 0
PROTECTED nitemtexttop
nitemtexttop = 0
PROTECTED lmouseselected
lmouseselected = .T.
ytrans = .F.
yhwnd = .F.
ntranspa = .F.
Name = "popupmenu"
lfirst = .F.
lusegradient = .F.
linitmenu = .F.
lusegradientpad = .F.
lthemed = .F.
lsyscommand = .F.
lnonclient = .F.
PROTECTED lkeydown
linitmenupopup = .F.
lshadow = .F.
lmenufade = .F.
lanimate = .F.
lthemeactive = .F.
lonmenubar = .F.
lselectedbykey = .F.
lintoplevel = .F.
lenhancedhilite = .F.
lusegradientbar = .F.
lwinxp = .F.
lglassy = .F.
lhiliteusefontbold = .F.
lxp_or_higher = .F.
DIMENSION astrleftvertexcolor[4]
DIMENSION apopupitem[1]
DIMENSION apopupbmp[1]
DIMENSION hpopmenu[1]
DIMENSION nmenucount[1]
DIMENSION hdropmenu[1]
DIMENSION hmenubrush[1]
DIMENSION astrpadvertexcolor[4]
DIMENSION astrpadvertexhilite[4]
DIMENSION amenupad[1,3]
PROTECTED apaddisabled[1]
DIMENSION apopupflags[1]
DIMENSION acmdskipforitem[1]
DIMENSION agdipimage[1]
DIMENSION astritemvertexhilite[4]
PROCEDURE createpopup
**********************************************
***
*** Popup Menu Class - OwnerDrawn Menu Library
*** Version 1.62.053
***
*** Author by: Herman Tan
*** Last update: September 3, 2008
***
**********************************************
LParameters tn_FirstId, tn_MenuIndex
#Define PixelFormatAlpha 0x00040000
Local ln_X, ln_FirstId, ln_Len, ln_PopId, ln_Result, ln_Counts, ln_PixelFormat
Local lh_Menu, lp_PopItem, lh_Bitmap, lp_Command, lp_Image
If (type( 'tn_FirstId' ) != 'N')
ln_FirstId = 101
else
ln_FirstId = tn_FirstId
endif
If (type( 'tn_MenuIndex' ) == 'N')
ln_MenuIndex = tn_MenuIndex
else
ln_MenuIndex = 1
endif
lh_Menu = CreatePopupMenu()
If (lh_Menu != 0)
With This
Dimension .hPopMenu[ ln_MenuIndex ], .nMenuCount[ ln_MenuIndex ], ;
.hDropMenu[ ln_MenuIndex ], .hMenuBrush[ ln_MenuIndex ]
.hPopMenu[ ln_MenuIndex ] = lh_Menu
.nMenuCount[ ln_MenuIndex ] = ALen( .aPopupItem, 1 ) - 1
.nFirstId = ln_FirstId
If (.nRightColor != -1)
.hMenuBrush[ ln_MenuIndex ] = CreateSolidBrush( .nRightColor )
else
.hMenuBrush[ ln_MenuIndex ] = CreateSolidBrush( GetSysColor( COLOR_MENU ))
endif
ls_MI = BinToC( MENUINFO_Size, '4rs' ) + BinToC( MIM_BACKGROUND, '4rs' ) + dw0 + dw0 + ;
BinToC( .hMenuBrush[ ln_MenuIndex ], '4rs' ) + replicate( c0, 8 )
SetMenuInfo( lh_Menu, @ls_MI )
** allocate memory for popup item
Store 0 to lp_Image, lh_Bitmap, ln_PixelFormat
ln_Counts = ALen( .aGdipImage, 1 )
For ln_X = 0 to .nMenuCount[ ln_MenuIndex ]
lp_PopItem = HeapAlloc( .hHeap, HEAP_ZERO_MEMORY, POPITEM_Size )
** For separator no need to fill the structure
If !empty( .aPopupItem[ln_X + 1] )
ln_Len = len( .aPopupItem[ln_X + 1] )
Copy2Mem( lp_PopItem, .aPopupItem[ln_X + 1], ln_Len )
CopyNum2Mem( lp_PopItem+MAX_TEXTLEN, ln_Len, DWORD_Size )
If !empty( .aPopupBmp[ ln_X + 1] ) and file( .aPopupBmp[ ln_X + 1], 1 )
If (JustExt( .aPopupBmp[ln_X + 1] ) == 'BMP')
lh_Bitmap = LoadImage( 0, .aPopupBmp[ln_X + 1], ;
IMAGE_BITMAP, 0,0, LR_LOADFROMFILE )
else
GdipLoadImageFromFile( strconv( .aPopupBmp[ln_X + 1] + c0, 5 ), @lp_Image )
GdipGetImagePixelFormat( lp_Image, @ln_PixelFormat )
If (BitAnd( ln_PixelFormat, PixelFormatAlpha ) != 0)
.aPopupFlags[ln_X + 1] = .aPopupFlags[ln_X + 1] + myODF_HASALPHA
lh_Bitmap = lp_Image
else
GdipCreateHBITMAPFromBitmap( lp_Image, @lh_Bitmap, 0 )
endif
If (.aGdipImage[ ln_Counts ] != 0)
ln_Counts = ln_Counts + 1
Dimension .aGdipImage[ ln_Counts ]
endif
.aGdipImage[ ln_Counts ] = lp_Image
endif
CopyNum2Mem( lp_PopItem+MAX_TEXTLEN+DWORD_Size, lh_Bitmap, DWORD_Size )
endif
If (.aPopupFlags[ ln_X + 1 ] != 0)
CopyNum2Mem( lp_PopItem+MAX_TEXTLEN+(DWORD_Size*2), ;
.aPopupFlags[ ln_X + 1 ], DWORD_Size )
If (BitAnd( .aPopupFlags[ ln_X + 1 ], myODF_SKIPFOR ) != 0)
lp_Command = HeapAlloc( .hHeap, HEAP_ZERO_MEMORY, MAX_TEXTLEN )
CopyNum2Mem( lp_PopItem+MAX_TEXTLEN+(DWORD_Size*3), lp_Command, DWORD_Size )
Copy2Mem( lp_Command, .aCmdSkipForItem[ ln_X + 1 ], ;
len( .aCmdSkipForItem[ln_X + 1] ))
endif
endif
AppendMenu( lh_Menu, MF_OWNERDRAW, ln_FirstId+ln_X, lp_PopItem )
else
AppendMenu( lh_Menu, MF_OWNERDRAW + MF_SEPARATOR, ln_FirstId+ln_X, lp_PopItem )
endif
Next && ln_X
EndWith
endif
Return lh_Menu
ENDPROC
PROCEDURE destroypopup
Local ln_I, ln_X, ls_MII, ln_Flags
Local lp_PopItem, lh_Bitmap, lp_Command
With This
If (.hPopMenu[1] != 0)
** Freeing memory allocated by popup item
Store 0 to lh_Bitmap, lp_Command, ln_Flags
For ln_I = ALen( .hPopMenu, 1 ) to 1 step -1
For ln_X = 0 to .nMenuCount[ ln_I ]
ls_MII = padr( BinToC( MENUITEMINFO_Size, '4rs' ) + BinToC( MIIM_DATA, '4rs' ), ;
MENUITEMINFO_Size, c0 )
If (GetMenuItemInfo( .hPopMenu[ ln_I ], ln_X, .T., @ls_MII ) > 0)
lp_PopItem = CToBin( substr( ls_MII, (DWORD_Size*8)+1, DWORD_Size ), '4rs' )
If ( lp_PopItem != 0)
CopyMem2Num( @lh_Bitmap, lp_PopItem+MAX_TEXTLEN+DWORD_Size, 4 )
CopyMem2Num( @ln_Flags, lp_PopItem+MAX_TEXTLEN+(DWORD_Size*2), DWORD_Size )
If (lh_Bitmap != 0) and (BitAnd( ln_Flags, myODF_HASALPHA ) == 0)
DeleteObject( lh_Bitmap )
endif
If (BitAnd( ln_Flags, myODF_SKIPFOR ) != 0)
CopyMem2Num( @lp_Command, lp_PopItem+MAX_TEXTLEN+(DWORD_Size*3), DWORD_Size )
If (lp_Command != 0)
HeapFree( .hHeap, 0, lp_Command )
endif
endif
HeapFree( .hHeap, 0, lp_PopItem )
endif
endif
Next && ln_X
DestroyMenu( .hPopMenu[ ln_I ] )
If !empty( .hMenuBrush[ ln_I ] )
DeleteObject( .hMenuBrush[ ln_I ] )
endif
Store 0 to .nMenuCount[ ln_I ], .hPopMenu[ ln_I ]
Next
If (VarType( .aGdipImage[ 1 ] ) == 'N' )
For ln_X = 1 to ALen( .aGdipImage, 1 )
If (.aGdipImage[ ln_X ] != 0)
GdipDisposeImage( .aGdipImage[ ln_X ] )
endif
Next
endif
Dimension .nMenuCount[1], .hPopMenu[1], .hDropMenu[1], .hMenuBrush[1], .aGdipImage[1]
Store 0 to .nMenuCount, .hPopMenu, .hMenuBrush, .hDropMenu, .aGdipImage
endif
EndWith
ENDPROC
PROCEDURE activatepopup
**********************************************
***
*** Popup Menu Class - OwnerDrawn Menu Library
*** Version 1.62.053
***
*** Author by: Herman Tan
*** Last update: September 3, 2008
***
**********************************************
LParameters to_Reff, tn_AddY
Local array la_Events[1]
Local ls_Point, ln_X, ln_Y, ln_Return, ll_Bind
With This
If (type( 'to_Reff' ) != 'O')
ls_Point = replicate( c0, POINT_Size )
GetCursorPos( @ls_Point )
else
ln_X = ObjToClient( to_Reff, OBJ_LEFT )
ln_Y = ObjToClient( to_Reff, OBJ_TOP ) + ObjToClient( to_Reff, OBJ_HEIGHT ) + ;
iif( (VarType( tn_AddY ) != 'N'), 0, tn_AddY )
ls_Point = BinToC( ln_X, '4rs' ) + BinToC( ln_Y, '4rs' )
ClientToScreen( .hWndParent, @ls_Point )
endif
ln_X = CToBin( substr( ls_Point, 1, DWORD_Size ), '4rs' )
ln_Y = CToBin( substr( ls_Point, 5, DWORD_Size ), '4rs' )
.BindMessages()
ln_Return = TrackPopupMenu( .hPopMenu, ;
TPM_LEFTALIGN + TPM_TOPALIGN + TPM_RETURNCMD, ;
ln_X, ln_Y, 0, .hWndParent, 0 )
If (ln_Return != 0)
ln_Return = (ln_Return - .nFirstId) + 1
endif
UnBindEvents( .hWndParent )
EndWith
Return ln_Return
ENDPROC
PROTECTED PROCEDURE popwndproc
**********************************************
***
*** Popup Menu Class - OwnerDrawn Menu Library
*** Version 1.62.053
***
*** Author by: Herman Tan
*** Last update: September 3, 2008
***
**********************************************
LParameters th_Wnd as Long, tn_Msg as Long, t_wParam as Long, t_lParam as Long
Do case
Case (tn_Msg == WM_INITMENU)
If (This.hMainMenu == t_wParam)
BindEvent( This.hWndParent, WM_ENTERIDLE, This, 'PopWndProc' )
With This
.GetParameterInfo()
If ( .lAnimate )
.lInitMenu = .T.
endif
If ( .lNonClient )
KillTimer( th_Wnd, IDT_NONCLIENT )
.lNonClient = .F.
endif
EndWith
Return 0
endif
Case (tn_Msg == WM_INITMENUPOPUP)
With This
If (t_wParam == .hSysMenu)
.hActivePopup = .hSysMenu
.nMenuPos = 0
else
.OnInitMenuPopup( th_Wnd, t_wParam, t_lParam )
endif
EndWith
Return 0
Case (tn_Msg == WM_UNINITMENUPOPUP)
If (This.hMainMenu != 0)
With This
If (.nCounter > 0)
KillTimer( .hWndParent, IDT_ENTERIDLE )
.nCounter = 0
endif
.OnUnInitMenuPopup( t_wParam )
EndWith
Return
endif
Case (tn_Msg == WM_MEASUREITEM)
This.OnMeasureMenuItem( th_Wnd, t_lParam )
Return .T.
Case (tn_Msg == WM_DRAWITEM)
If (This.hMainMenu != 0)
Local ln_MenuItemID, ln_MenuPos
ln_MenuItemID = 0
CopyMem2Num( @ln_MenuItemID, t_lParam+8, 4 )
ln_MenuPos = GetMenuPosFromID( This.hMainMenu, ln_MenuItemID )
If (ln_MenuPos == -1)
This.OnDrawMenuItem( t_lParam )
Return .T.
endif
else
This.OnDrawMenuItem( t_lParam )
Return .T.
endif
Case (tn_Msg == WM_ENTERIDLE)
If (t_wParam == MSGF_MENU)
Local ls_Rect, ln_Left, ln_Top
Local ln_Width, ln_Height, ln_AddX
With This
If ( .lFirst )
.lFirst = .F.
.OnMenuEnterIdle( t_lParam )
.hWndPopup = t_lParam
If ( .lInitMenu )
.lInitMenu = .F.
SetTimer( .hWndParent, IDT_ENTERIDLE, 110, PNULL )
endif
endif
ls_Rect = space( RECT_Size )
GetWindowRect( t_lParam, @ls_Rect )
ln_Left = CToBin( substr( ls_Rect, 1, DWORD_Size ), '4rs' )
If ( .lInitMenuPopup )
If (.hWndPopup != t_lParam)
ln_Top = CToBin( substr( ls_Rect, 5, DWORD_Size ), '4rs' ) + 2
ln_AddX = iif( ln_Left > .nLeftParent, 5, -2 )
ln_Left = ln_Left + ln_AddX
* .GetParameterInfo()
If ( .lMenuFade ) or !( .lAnimate ) or !( .lMouseSelected )
* (GetKeyState( VK_ENTER ) < 0) or (GetKeyState( VK_RIGHT ) < 0)
SetWindowPos( t_lParam, HWND_TOP, ln_Left, ln_Top, 0,0, ;
BitOr( SWP_NOSIZE, SWP_NOZORDER, SWP_NOACTIVATE, SWP_NOSENDCHANGING ))
else
ln_Width = (CToBin( substr( ls_Rect, 9, DWORD_Size ), '4rs' ) - ln_Left) + ln_AddX
ln_Height = (CToBin( substr( ls_Rect, 13, DWORD_Size ), '4rs' ) - ln_Top) + 2
SetWindowPos( t_lParam, HWND_TOP, ln_Left, ln_Top, 0,0, ;
BitOr( SWP_NOZORDER, SWP_NOACTIVATE, SWP_NOSENDCHANGING ))
MoveWindow( t_lParam, ln_Left, ln_Top, ln_Width, ln_Height, .F. )
endif
endif
.lInitMenuPopup = .F.
.lMouseSelected = .T.
endif
.nLeftParent = ln_Left
EndWith
Return 0
endif
Case (tn_Msg == WM_MENUSELECT)
Local lh_Menu, ln_wParamHi
lh_Menu = 0
ln_wParamHi = BitRShift( t_wParam, 16 )
With This
If !inlist( t_lParam, 0, .hMainMenu )
.lMouseSelected = (BitAnd( ln_wParamHi, MF_MOUSESELECT ) != 0)
For ln_I = 1 to ALen( .hPopMenu, 1 )
If (t_lParam == .hPopMenu[ ln_I ])
.nMenuPos = ln_I
lh_Menu = .hPopMenu[ ln_I ]
Exit
endif
Next
endif
If (VarType( po_Tooltip ) == 'O')
If !empty( .cItemText )
KillTimer( .hWndParent, IDT_TOOLTIPS )
.cItemText = ''
endif
If ( po_Tooltip.lActive )
po_Tooltip.ShowTooltip( .F. )
endif
If (lh_Menu != 0)
Local lc_Text, ls_Rect, ls_Point
Local ln_ItemId, ln_ItemPos
Local ln_Left, ln_Top, ln_Width
If (BitAnd( ln_wParamHi, MF_POPUP ) == 0) and ;
(BitAnd( ln_wParamHi, MF_SEPARATOR ) == 0) and ;
(BitAnd( ln_wParamHi, MF_DISABLED ) == 0) and ( .lMouseSelected )
ln_ItemPos = GetMenuPosFromID( t_lParam, BitAnd( t_wParam, 0xFFFF ))
* ls_Rect = space( RECT_Size )
* ln_Return = GetMenuItemRect( 0, t_lParam, ln_ItemPos, @ls_Rect )
* .nItemTextLeft = CToBin( substr( ls_Rect, 1, DWORD_Size ), '4rs' )
* .nItemTextTop = CToBin( substr( ls_Rect, 13, DWORD_Size ), '4rs' ) - 6
* ln_Width = CToBin( substr( ls_Rect, 9, DWORD_Size ), '4rs' ) - .nItemTextLeft
* .nItemTextLeft = .nItemTextLeft + int( ln_Width / 2 )
.cItemText = 'WM_MENUSELECT: ' + transform( t_lParam, '@0' ) + CR + ;
'Flags & Item ID: ' + transform( t_wParam, '@0' ) + CR + ;
'Item Pos: ' + transform( ln_ItemPos )
SetTimer( .hWndParent, IDT_TOOLTIPS, 500, PNULL )
endif
endif
endif
EndWith
Return 0
Case (tn_Msg == WM_MENUCHAR)
Return This.OnMenuChar( t_wParam, t_lParam )
Case (tn_Msg == WM_NCMOUSEMOVE)
With This
If (t_wParam == HTMENU)
.lOnMenuBar = .T.
.On_NCMouseMove( t_lParam )
else
.lOnMenuBar = .F.
If (.nMenuPos > 0)
DrawMenuBar( .hWndParent )
endif
.nMenuPos = 0
endif
EndWith
Return (This.nMenuPos != 0)
Case (tn_Msg == WM_SYSCOMMAND)
If (BitAnd( t_wParam, 0xFFF0 ) == SC_KEYMENU) and (t_lParam == 0)
** ALT key is pressed, no other characters followed
With This
If (.lSysCommand and .lOnMenuBar)
.lOnMenuBar = .F.
.nMenuPos = 0
endif
This.lSysCommand = .T.
If !( This.lOnMenuBar )
This.On_NCMouseMove( BitLShift( SysMetric( 9 ), 16 ) + 1 )
* PostMessage( th_Wnd, WM_NCMOUSEMOVE, HTMENU, BitLShift( SysMetric( 9 ), 16 ) + 1 )
endif
EndWith
Return 0
endif
Case (tn_Msg == WM_COMMAND)
If between( This.nMenuPos, 1, ALen( This.hPopMenu, 1 ))
UnBindEvents( This.hWndParent, WM_ENTERIDLE )
If !empty( This.cWebsite )
PostMessage( th_Wnd, WM_OPENWEB, 0, 0 )
else
PostMessage( th_Wnd, WM_DOCOMMAND, t_wParam, 0 )
endif
Return 0
endif
Case (tn_Msg == WM_DOCOMMAND)
With This
If !IsNull( .oParent )
.oParent.OnSelection( .nMenuPos, t_wParam )
else
OnSelection( .nMenuPos, t_wParam )
endif
.nMenuPos = 0
EndWith
Return 0
Case (tn_Msg == WM_OPENWEB)
ShellExecute( HWND_DESKTOP, 0, This.cWebsite, 0, 0, SW_SHOWNORMAL )
This.cWebsite = ''
This.nMenuPos = 0
Return 0
Case (tn_Msg == WM_TIMER)
Do case
Case (t_wParam == IDT_ENTERIDLE)
With This
If (.nCounter < 2)
.nCounter = .nCounter + 1
.OnMenuEnterIdle( .hWndPopup )
else
KillTimer( .hWndParent, IDT_ENTERIDLE )
.nCounter = 0
endif
EndWith
Return 0
Case (t_wParam == IDT_NONCLIENT)
Local ls_Point, ls_Rect
Local ln_X, ln_Y
With This
ls_Point = space( POINT_Size )
GetCursorPos( @ls_Point )
ln_X = CToBin( substr( ls_Point, 1, DWORD_Size ), '4rs' )
ln_Y = CToBin( substr( ls_Point, 5, DWORD_Size ), '4rs' )
.lNonClient = (WindowFromPoint( ln_X, ln_Y ) == th_Wnd)
If ( .lNonClient )
ls_Rect = space( RECT_Size )
GetClientRect( th_Wnd, @ls_Rect )
MapWindowPoints( th_Wnd, HWND_DESKTOP, @ls_Rect, 2 )
.lNonClient = (PtInRect( ls_Rect, ln_X, ln_Y ) == 0)
endif
If !( .lNonClient )
KillTimer( th_Wnd, IDT_NONCLIENT )
Store .F. to .lNonClient, .lOnMenuBar
DrawMenuBar( .hWndParent )
.nMenuPos = 0
endif
EndWith
Return 0
Case (t_wParam == IDT_TOOLTIPS)
Local ls_Point, ln_X, ln_Y
With This
KillTimer( .hWndParent, IDT_TOOLTIPS )
ls_Point = space( POINT_Size )
GetCursorPos( @ls_Point )
ln_X = CToBin( substr( ls_Point, 1, DWORD_Size ), '4rs' ) + 8
ln_Y = CToBin( substr( ls_Point, 5, DWORD_Size ), '4rs' ) + 8
po_Tooltip.SetTipText( .cItemText, .T., ln_X, ln_Y, .T., .T. )
.cItemText = ''
EndWith
* With This
* KillTimer( .hWndParent, IDT_TOOLTIPS )
* po_Tooltip.SetTipText( .cItemText, .T., ;
* .nItemTextLeft, .nItemTextTop, .T., .T. )
* .cItemText = ''
* EndWith
Return 0
EndCase
Case (tn_Msg == WM_SYSCOLORCHANGE)
With This
If (.nLeftColor == -1)
.SetLeftColor( -1 )
else
If !( .lThemed )
.nHiliteColor = .GetHiliteColor()
endif
endif
.nXMenuCheck = GetSystemMetrics( SM_CXMENUCHECK )
EndWith
Case (tn_Msg == WM_THEMECHANGED )
With This
If (.nLeftColor == -1)
.SetLeftColor( -1 )
else
If !( .lThemed )
.nHiliteColor = .GetHiliteColor()
endif
endif
.lThemeActive = (IsThemeActive() == 1)
.nXMenuCheck = GetSystemMetrics( SM_CXMENUCHECK )
EndWith
EndCase
Return CallWindowProc( This.pOrgProc, th_Wnd, tn_Msg, t_wParam, t_lParam )
ENDPROC
PROTECTED PROCEDURE onmeasuremenuitem
**********************************************
***
*** Popup Menu Class - OwnerDrawn Menu Library
*** Version 1.62.053
***
*** Author by: Herman Tan
*** Last update: September 3, 2008
***
**********************************************
LParameters th_Wnd as Long, tp_MIS as Long
** tp_MIS = pointer to MeasureItemStruct
Local lp_PopItem, lh_DC, lh_OldFont, ls_Size, lc_ItemText
Local ln_Len, ln_SizeX, ln_SizeY, ln_Flags, lnItemId
Local ls_MII
Store 0 to lp_PopItem, ln_Len, ln_Flags, ln_ItemId
With This
If (.nMenuPos != 0) and (.hActivePopup != .hSysMenu)
CopyMem2Num( @lp_PopItem, tp_MIS + (DWORD_Size*5), DWORD_Size )
CopyMem2Num( @ln_Len, lp_PopItem+MAX_TEXTLEN, DWORD_Size )
CopyMem2Num( @ln_Flags, lp_PopItem+MAX_TEXTLEN+(DWORD_Size*2), DWORD_Size )
If (ln_Len > 0)
lc_ItemText = space( MAX_TEXTLEN )
CopyMem( @lc_ItemText, lp_PopItem, ln_Len )
lc_ItemText = left( lc_ItemText, ln_Len )
endif
else
CopyMem2Num( @ln_ItemId, tp_MIS + (DWORD_Size*2), DWORD_Size )
ls_MII = padr( BinToC( MENUITEMINFO_Size, '4rs' ) + ;
BinToC( MIIM_FTYPE, '4rs' ), MENUITEMINFO_Size, c0 )
GetMenuItemInfo( .hSysMenu, ln_ItemId, .F., @ls_MII )
If (CToBin( substr( ls_MII, 9, 4 ), 'rs' ) != MFT_SEPARATOR)
lc_ItemText = replicate( c0, MAX_TEXTLEN )
ln_Len = GetMenuString( This.hSysMenu, ln_ItemId, @lc_ItemText, MAX_TEXTLEN, MF_BYCOMMAND )
If (at( _TAB, lc_ItemText ) > 0)
lc_ItemText = strtran( lc_ItemText, _TAB, ' ' )
lc_ItemText = left( lc_ItemText, at( c0, lc_ItemText )-1 )
else
lc_ItemText = left( lc_ItemText, at( c0, lc_ItemText )-1 )
If !empty( lc_ItemText )
lc_ItemText = lc_ItemText + space(8) + 'Alt-F10'
else
ln_Len = 0
endif
endif
endif
endif
If (ln_Len > 0)
lc_ItemText = strtran( lc_ItemText, '&', '' )
ln_Len = len( lc_ItemText )
lh_DC = GetDC( th_Wnd )
If (BitAnd( ln_Flags, myODF_WEBLINK ) != 0) and ;
(.hFontCustom != 0) and (.hFontCustomBold != 0)
If ( .lHiliteUseFontBold )
lh_OldFont = SelectObject( lh_DC, .hFontCustomBold )
else
lh_OldFont = SelectObject( lh_DC, .hFontCustom )
endif
else
If (.hActivePopup != .hSysMenu) and !( .lHiliteUseFontBold )
lh_OldFont = SelectObject( lh_DC, .hFont )
else
lh_OldFont = SelectObject( lh_DC, .hFontBold )
endif
endif
ls_Size = replicate( c0, POINT_Size )
GetTextExtentPoint32( lh_DC, lc_ItemText, ln_Len, @ls_Size )
SelectObject( lh_DC, lh_OldFont )
ReleaseDC( th_Wnd, lh_DC )
If .lUseGradient
ln_SizeX = CToBin( substr( ls_Size, 1, DWORD_Size ), '4rs' ) + ;
.nXMenuCheck + 24
else
ln_SizeX = CToBin( substr( ls_Size, 1, DWORD_Size ), '4rs' ) + ;
.nXMenuCheck + 20
endif
ln_SizeY = CToBin( substr( ls_Size, 5, DWORD_Size ), '4rs' ) + 7
else && Separator
ln_SizeX = 0
ln_SizeY = 5
endif
EndWith
CopyNum2Mem( tp_MIS + (DWORD_Size*3), ln_SizeX, DWORD_Size ) && Item Width
CopyNum2Mem( tp_MIS + (DWORD_Size*4), ln_SizeY, DWORD_Size ) && Item Height
ENDPROC
PROCEDURE createfontin
**********************************************
***
*** Popup Menu Class - OwnerDrawn Menu Library
*** Version 1.62.053
***
*** Author by: Herman Tan
*** Last update: September 3, 2008
***
**********************************************
Local ls_NCM, ls_MenuLogFont, ln_Pos
ls_NCM = padr( BinToC( NONCLIENTMETRICS_size, '4rs' ), NONCLIENTMETRICS_size, c0 )
SystemParametersInfoStr( SPI_GETNONCLIENTMETRICS, NONCLIENTMETRICS_size, @ls_NCM, 0 )
ln_Pos = (DWORD_Size * 6) + LOGFONT_Size + (DWORD_Size*2) + ;
LOGFONT_Size + (DWORD_Size*2) + 1
ls_MenuLogFont = substr( ls_NCM, ln_Pos, LOGFONT_Size )
Return CreateFontIndirect( ls_MenuLogFont )
ENDPROC
PROTECTED PROCEDURE ondrawmenuitem
**********************************************
***
*** Popup Menu Class - OwnerDrawn Menu Library
*** Version 1.62.053
***
*** Author by: Herman Tan
*** Last update: September 3, 2008
***
**********************************************
LParameters tp_DIS as Long
** tp_DIS = pointer to DrawItemStruct
#Define RR_CURVE 12
Local ln_ItemState, ln_ItemAction
Local ll_Disabled, ll_DisabledSelected, ll_IsArrowKey
Store 0 to ln_ItemState, ln_ItemAction
CopyMem2Num( @ln_ItemState, tp_DIS + (DWORD_Size*4), DWORD_Size ) && PopItem State
CopyMem2Num( @ln_ItemAction, tp_DIS + (DWORD_Size*3), DWORD_Size ) && PopItem Action
ll_Disabled = (BitAnd( ln_ItemState, ODS_DISABLED ) != 0)
If (BitAnd( ln_ItemState, ODS_SELECTED ) != 0)
ll_IsArrowKey = ( (GetKeyState( VK_UP ) < 0) or (GetKeyState( VK_DOWN ) < 0) or ;
(GetKeyState( VK_LEFT ) < 0) or (GetKeyState( VK_RIGHT ) < 0) )
ll_DisabledSelected = ll_IsArrowKey and ll_Disabled
endif
If ( ll_Disabled ) and (ln_ItemAction == ODA_SELECT) and ;
!( ll_DisabledSelected ) and !( This.lSelectedByKey )
Return
endif
Local lh_DC, lh_OldFont, lh_TempDC, lh_Bitmap, ls_ItemRect
Local lh_Brush, lh_Pen, lh_OldPen, lh_OldBrush, lh_OldBitmap
Local ln_OldTextColor, ln_OldBackMode, ln_TransColor
Local ln_Len, ln_AddX, ll_Selected, lc_ItemText
Local ln_Left, ln_Left2, ln_Top, ln_Right, ln_Bottom, ln_Width, ln_Height
Local ln_BmpLeft, ln_BmpTop, ln_Red, ln_Green, ln_Blue
Local ll_Default
Store 0 to lh_DC, lh_Bitmap, ln_Len, lp_PopItem, ln_Flags, ;
ln_Left, ln_Top, ln_Right, ln_Bottom
ll_Selected = (BitAnd( ln_ItemState, ODS_SELECTED ) != 0) and !( ll_Disabled )
CopyMem2Num( @lh_DC, tp_DIS + (DWORD_Size*6), DWORD_Size ) && PopItem hDC
lc_ItemText = space( MAX_TEXTLEN )
If (This.nMenuPos != 0) and (This.hActivePopup != This.hSysMenu)
CopyMem2Num( @lp_PopItem, tp_DIS + (DWORD_Size*11), DWORD_Size ) && PopItem Data
CopyMem2Num( @ln_Len, lp_PopItem+MAX_TEXTLEN, DWORD_Size )
CopyMem2Num( @lh_Bitmap, lp_PopItem+MAX_TEXTLEN+DWORD_Size, DWORD_Size )
CopyMem2Num( @ln_Flags, lp_PopItem+MAX_TEXTLEN+(DWORD_Size*2), DWORD_Size )
If (ln_Len > 0)
CopyMem( @lc_ItemText, lp_PopItem, ln_Len )
lc_ItemText = left( lc_ItemText, ln_Len )
If (ln_ItemAction == ODA_SELECT)
This.lSelectedByKey = ll_DisabledSelected
endif
endif
else
Local ln_ItemId, ls_MII
ln_ItemId = 0
CopyMem2Num( @ln_ItemId, tp_DIS + (DWORD_Size*2), DWORD_Size )
ls_MII = padr( BinToC( MENUITEMINFO_Size, '4rs' ) + ;
BinToC( BitOr( MIIM_FTYPE, MIIM_STATE ), '4rs' ), MENUITEMINFO_Size, c0 )
GetMenuItemInfo( This.hSysMenu, ln_ItemId, .F., @ls_MII )
If (CToBin( substr( ls_MII, 9, 4 ), 'rs' ) != MFT_SEPARATOR)
ll_Default = (BitAnd( CToBin( ;
substr( ls_MII, (DWORD_Size*3)+1, DWORD_Size ), '4rs' ), MFS_DEFAULT ) != 0)
ln_Len = GetMenuString( This.hSysMenu, ln_ItemId, @lc_ItemText, MAX_TEXTLEN, MF_BYCOMMAND )
lc_ItemText = left( lc_ItemText, ln_Len )
If (ln_ItemAction == ODA_SELECT)
This.lSelectedByKey = ll_DisabledSelected
endif
endif
endif
CopyMem2Num( @ln_Left, tp_DIS + (DWORD_Size*7), DWORD_Size ) && Rect.left
CopyMem2Num( @ln_Top, tp_DIS + (DWORD_Size*8), DWORD_Size ) && Rect.top
CopyMem2Num( @ln_Right, tp_DIS + (DWORD_Size*9), DWORD_Size ) && Rect.right
CopyMem2Num( @ln_Bottom, tp_DIS + (DWORD_Size*10), DWORD_Size ) && Rect.bottom
******************
this.ytranspa(lh_DC)
*********************************
** Set the appropriate foreground and background colors.
With This
If ( ll_Selected )
lh_Brush = CreateSolidBrush( .nHiliteColor )
else
If (.nLeftColor == -1)
lh_Brush = CreateSolidBrush( GetSysColor( COLOR_MENU ))
else
lh_Brush = CreateSolidBrush( .nLeftColor )
endif
endif
** Leave some space on the left part for check mark / bitmap
If ( .lUseGradient )
ln_AddX = .nXMenuCheck + 10
else
ln_AddX = .nXMenuCheck + 8
endif
ln_BmpLeft = ln_Left + (ln_AddX - 16) / 2
ln_BmpTop = ln_Top + (ln_Bottom - ln_Top - 16) / 2
ls_ItemRect = space( RECT_Size )
lh_OldBrush = SelectObject( lh_DC, lh_Brush )
If (ll_Selected or ll_DisabledSelected) and (ln_ItemAction == ODA_DRAWENTIRE) and ;
(.nHiliteStyle != ODHS_ALL)
If .lUseGradient
lh_OldPen = SelectObject( lh_DC, .hPenNull )
.HorzGradientFill( lh_DC, ln_Left, ln_Top, ;
ln_Left + ln_AddX, ln_Bottom, '.aStrLeftVertexColor' )
SelectObject( lh_DC, lh_OldPen )
else
If (ln_Len != 0) or (.nLeftColor != -1)
SetRect( @ls_ItemRect, ln_Left, ln_Top, ;
ln_Left + ln_AddX, ln_Bottom )
FillRect( lh_DC, ls_ItemRect, lh_Brush )
endif
endif
** Create brush for the right part
If ( ll_DisabledSelected )
lh_Brush = CreateSolidBrush( .nRightColor )
DeleteObject( SelectObject( lh_DC, lh_Brush ))
endif
else
If !( ll_Selected ) or ( ll_Disabled )
If !( ll_DisabledSelected )
** Draw the left part
If .lUseGradient
lh_OldPen = SelectObject( lh_DC, .hPenNull )
.HorzGradientFill( lh_DC, ln_Left, ln_Top, ;
ln_Left + ln_AddX, ln_Bottom, '.aStrLeftVertexColor' )
SelectObject( lh_DC, lh_OldPen )
else
If (ln_Len != 0) or (.nLeftColor != -1)
SetRect( @ls_ItemRect, ln_Left, ln_Top, ;
ln_Left + ln_AddX, ln_Bottom )
FillRect( lh_DC, ls_ItemRect, lh_Brush )
endif
endif
ln_Left = ln_Left + ln_AddX
endif
** Create brush for the right part
lh_Brush = CreateSolidBrush( .nRightColor )
DeleteObject( SelectObject( lh_DC, lh_Brush ))
endif
endif
If (ln_Len > 0) && Menu/Popup item
** Draw ItemText & Fill the rectangle
If (at( _TAB, lc_ItemText ) > 0)
lc_ItemText = strtran( lc_ItemText, _TAB, ' ' )
ln_Len = len( lc_ItemText )
endif
ln_OldBackMode = SetBkMode( lh_DC, TRANSPARENT )
If ( ll_Selected ) and (BitAnd( ln_Flags, myODF_WEBLINK ) != 0)
If ( .lHiliteUseFontBold )
lh_OldFont = SelectObject( lh_DC, .hFontCustomBold )
else
lh_OldFont = SelectObject( lh_DC, .hFontCustom )
endif
else
If ( ll_Default ) or (ll_Selected and .lHiliteUseFontBold)
lh_OldFont = SelectObject( lh_DC, .hFontBold )
else
lh_OldFont = SelectObject( lh_DC, .hFont )
endif
endif
If (ll_Selected or ll_DisabledSelected)
Local lh_PrevBrush, lh_Region
lh_OldPen = SelectObject( lh_DC, .hPenRect )
** Draw the rectangle using selected Pen & Brush on the DC
ln_Left2 = ln_Left
If (ll_Selected and .lGlassy)
lh_PrevBrush = SelectObject( lh_DC, GetStockObject( NULL_BRUSH ))
endif
If !inlist( .nHiliteStyle, ODHS_ALL, ODHS_ROUNDED )
If (lh_Bitmap != 0) or ((.hActivePopup == .hSysMenu) and ;
inlist( lc_ItemText, IDM_RESTORE, IDM_MINIMIZE, IDM_MAXIMIZE, IDM_CLOSE ))
If (BitAnd( .nHiliteStyle, ODHS_ROUNDED_BITMAP ) != 0)
ln_Left2 = (ln_Left + ln_AddX) - 1
If (ll_Selected and .lGlassy)
lh_Region = CreateRoundRectRgn( ln_Left, ln_Top, ln_Left2, ln_Bottom, ;
RR_CURVE, RR_CURVE )
If (lh_Region != 0)
SelectClipRgn( lh_DC, lh_Region )
.VertGradientFill( lh_DC, ln_Left, ln_Top, ln_Left2, ln_Bottom, ;
'.aStrItemVertexHilite' )
SelectClipRgn( lh_DC, 0 )
DeleteObject( lh_Region )
endif
endif
RoundRect( lh_DC, ln_Left, ln_Top, ln_Left2, ln_Bottom, ;
RR_CURVE, RR_CURVE )
ln_Left2 = ln_Left2 + 3
endif
else
If (BitAnd( .nHiliteStyle, ODHS_ROUNDED_BITMAP ) != 0) and ;
(BitAnd( .nHiliteStyle, ODHS_BITMAPONLY ) == 0)
ln_Left2 = (ln_Left + ln_AddX) - 1
If (ll_Selected and .lGlassy)
lh_Region = CreateRoundRectRgn( ln_Left, ln_Top, ln_Left2, ln_Bottom, ;
RR_CURVE, RR_CURVE )
If (lh_Region != 0)
SelectClipRgn( lh_DC, lh_Region )
.VertGradientFill( lh_DC, ln_Left, ln_Top, ln_Left2, ln_Bottom, ;
'.aStrItemVertexHilite' )
SelectClipRgn( lh_DC, 0 )
DeleteObject( lh_Region )
endif
endif
RoundRect( lh_DC, ln_Left, ln_Top, ln_Left2, ln_Bottom, ;
RR_CURVE, RR_CURVE )
ln_Left2 = ln_Left2 + 3
else
ln_Left2 = (ln_Left + ln_AddX) + 2
endif
endif
endif
*popupmenu.prg part 2/3
If (BitAnd( .nHiliteStyle, ODHS_ROUNDED ) != 0)
If (ll_Selected and .lGlassy)
lh_Region = CreateRoundRectRgn( ln_Left2, ln_Top, ln_Right+1, ln_Bottom+1, ;
RR_CURVE, RR_CURVE )
If (lh_Region != 0)
SelectClipRgn( lh_DC, lh_Region )
.VertGradientFill( lh_DC, ln_Left2, ln_Top, ln_Right, ln_Bottom, ;
'.aStrItemVertexHilite' )
SelectClipRgn( lh_DC, 0 )
DeleteObject( lh_Region )
endif
endif
RoundRect( lh_DC, ln_Left2, ln_Top, ln_Right, ln_Bottom, RR_CURVE, RR_CURVE )
else
If (ll_Selected and .lGlassy)
.VertGradientFill( lh_DC, ln_Left2, ln_Top, ln_Right, ln_Bottom, ;
'.aStrItemVertexHilite' )
endif
Rectangle( lh_DC, ln_Left2, ln_Top, ln_Right, ln_Bottom )
endif
If (ll_Selected and .lGlassy)
SelectObject( lh_DC, lh_PrevBrush )
endif
SelectObject( lh_DC, lh_OldPen )
ln_Left = ln_Left + ln_AddX + 7
else
** Fill the rectangle
SetRect( @ls_ItemRect, ln_Left, ln_Top, ln_Right, ln_Bottom )
FillRect( lh_DC, ls_ItemRect, lh_Brush )
ln_Left = ln_Left + 7
endif
If ( ll_Disabled )
ln_OldTextColor = SetTextColor( lh_DC, .nDisabledColor )
SetRect( @ls_ItemRect, ln_Left+1, ln_Top+4, ln_Right+1, ln_Bottom+1 )
DrawText( lh_DC, lc_ItemText, ln_Len, ls_ItemRect, DT_LEFT + DT_NOCLIP )
SetTextColor( lh_DC, .nDisabledColorShadow )
else
If ( ll_Selected )
ln_OldTextColor = SetTextColor( lh_DC, .nTextHiliteColor )
else
ln_OldTextColor = SetTextColor( lh_DC, .nTextColor )
endif
endif
** Draw item text
If ( ll_Selected ) and ( .lEnhancedHilite )
SetRect( @ls_ItemRect, ln_Left+1, ln_Top+3, ln_Right, ln_Bottom )
SetTextColor( lh_DC, .nTextShadowColor )
DrawText( lh_DC, lc_ItemText, ln_Len, ls_ItemRect, ;
DT_LEFT + DT_NOCLIP )
SetRect( @ls_ItemRect, ln_Left-1, ln_Top+2, ln_Right, ln_Bottom )
SetTextColor( lh_DC, .nTextHiliteColor )
DrawText( lh_DC, lc_ItemText, ln_Len, ls_ItemRect, ;
DT_LEFT + DT_NOCLIP )
else
SetRect( @ls_ItemRect, ln_Left, ln_Top+3, ln_Right, ln_Bottom )
DrawText( lh_DC, lc_ItemText, ln_Len, ls_ItemRect, ;
DT_LEFT + DT_NOCLIP )
endif
SelectObject( lh_DC, lh_OldFont )
SetBkMode( lh_DC, ln_OldBackMode )
SetTextColor( lh_DC, ln_OldTextColor )
else && Separator
** Draw the rectangle
SetRect( @ls_ItemRect, ln_Left, ln_Top, ln_Right, ln_Bottom )
FillRect( lh_DC, ls_ItemRect, lh_Brush )
ln_Height = ln_Top + ((ln_Bottom - ln_Top) / 2)
If !( .lUseGradient ) and ( .lFullRectLine ) and ;
(.nLeftColor == -1) and (.nRightColor == GetSysColor( COLOR_MENU ))
ln_Left = ln_Left - ln_AddX - 1
else
ln_Left = ln_Left + 7
endif
ln_Right = ln_Right - 1
** Draw separator (dark pen)
lh_OldPen = SelectObject( lh_DC, .hDarkPen )
MoveToEx( lh_DC, ln_Left, ln_Height, PNULL )
LineTo( lh_DC, ln_Right, ln_Height )
** Draw separator (light pen)
ln_Height = ln_Height + 1
SelectObject( lh_DC, .hLightPen )
MoveToEx( lh_DC, ln_Left, ln_Height, PNULL )
LineTo( lh_DC, ln_Right, ln_Height )
SelectObject( lh_DC, lh_OldPen )
endif
If (lh_Bitmap != 0) and (.hActivePopup != .hSysMenu)
Local lp_Image
** Draw the bitmap
If (BitAnd( ln_Flags, myODF_HASALPHA ) == 0) or ( ll_Disabled )
If (BitAnd( ln_Flags, myODF_HASALPHA ) != 0)
lp_Image = lh_Bitmap
GdipCreateHBITMAPFromBitmap( lp_Image, @lh_Bitmap, 0 )
endif
lh_TempDC = CreateCompatibleDC( lh_DC )
lh_OldBitmap = SelectObject( lh_TempDC, lh_Bitmap )
ls_Bitmap = replicate( c0, BITMAP_Size )
API_GetObject( lh_Bitmap, BITMAP_Size, @ls_Bitmap )
ln_Width = CToBin( substr( ls_Bitmap, (DWORD_Size*1)+1, DWORD_Size ), '4rs' )
ln_Height = CToBin( substr( ls_Bitmap, (DWORD_Size*2)+1, DWORD_Size ), '4rs' )
ln_TransColor = GetPixel( lh_TempDC, 0, 0 )
If ( ll_Disabled )
Local lh_WorkDC, lh_WorkBmp, lh_OldWorkBmp
Local ln_Color, ln_Red, ln_Green, ln_Blue
*** TODO: Use DIB for FAST bitmap manipulation!
lh_WorkDC = CreateCompatibleDC( lh_DC )
lh_WorkBmp = CreateCompatibleBitmap( lh_DC, ln_Width, ln_Height )
lh_OldWorkBmp = SelectObject( lh_WorkDC, lh_WorkBmp )
BitBlt( lh_WorkDC, 0, 0, ln_Width, ln_Height, lh_TempDC, 0,0, SRCCOPY )
For ln_X = 0 to ln_Width-1
For ln_Y = 0 to ln_Height-1
ln_Color = GetPixel( lh_WorkDC, ln_X, ln_Y )
If (ln_Color != ln_TransColor)
ln_Color = ((BitAnd( ln_Color, 0xFF ) + ;
BitRShift( BitAnd( ln_Color, 0xFF00 ), 8 ) + ;
BitRShift( BitAnd( ln_Color, 0xFF0000 ), 16 )) * 18) / 100
SetPixelV( lh_WorkDC, ln_X, ln_Y, ;
Rgb( ln_Color + .nRed, ln_Color + .nGreen, ln_Color + .nBlue ))
endif
Next
Next
TransparentBlt( lh_DC, ln_BmpLeft, ln_BmpTop, ln_Width, ln_Height, ;
lh_WorkDC, 0,0, ln_Width, ln_Height, ln_TransColor )
DeleteObject( SelectObject( lh_WorkDC, lh_OldWorkBmp ))
DeleteDC( lh_WorkDC )
else
TransparentBlt( lh_DC, ln_BmpLeft, ln_BmpTop, ln_Width, ln_Height, ;
lh_TempDC, 0,0, ln_Width, ln_Height, ln_TransColor )
endif
SelectObject( lh_TempDC, lh_OldBitmap )
DeleteDC( lh_TempDC )
If (BitAnd( ln_Flags, myODF_HASALPHA ) != 0)
DeleteObject( lh_Bitmap )
endif
else
Local lp_Graphics
Store 0 to ln_Width, ln_Height, lp_Graphics
GdipGetImageWidth( lh_Bitmap, @ln_Width )
GdipGetImageHeight( lh_Bitmap, @ln_Height )
GdipCreateFromHDC( lh_DC, @lp_Graphics )
GdipDrawImageRectI( lp_Graphics, lh_Bitmap, ;
ln_BmpLeft, ln_BmpTop, ln_Width, ln_Height )
* GdipDrawImageI( lp_Graphics, lh_Bitmap, ln_BmpLeft, ln_BmpTop )
GdipDeleteGraphics( lp_Graphics )
endif
else
If (This.hActivePopup == This.hSysMenu) and (ln_Len > 0) and ;
inlist( lc_ItemText, IDM_RESTORE, IDM_MINIMIZE, ;
IDM_MAXIMIZE, IDM_CLOSE )
If ( ll_Disabled )
ln_OldTextColor = SetTextColor( lh_DC, .nDisabledColorShadow )
else
ln_OldTextColor = SetTextColor( lh_DC, .nTextColor )
endif
ln_OldBackMode = SetBkMode( lh_DC, TRANSPARENT )
If (IDM_CLOSE $ lc_ItemText)
lh_OldFont = SelectObject( lh_DC, .hFontWebdingBold )
else
lh_OldFont = SelectObject( lh_DC, .hFontWebding )
endif
CopyMem2Num( @ln_Left, tp_DIS + (DWORD_Size*7), DWORD_Size ) && Rect.left
CopyMem2Num( @ln_Top, tp_DIS + (DWORD_Size*8), DWORD_Size ) && Rect.top
CopyMem2Num( @ln_Bottom, tp_DIS + (DWORD_Size*10), DWORD_Size ) && Rect.bottom
SetRect( @ls_ItemRect, ln_Left+3, ln_Top, (ln_Left+ln_AddX)-3, ln_Bottom )
lc_ItemText = ICase(lc_ItemText == IDM_MINIMIZE, chr( 48 ), ;
lc_ItemText == IDM_MAXIMIZE, chr( 49 ), ;
lc_ItemText == IDM_RESTORE, chr( 50 ), chr( 114 ))
DrawText( lh_DC, lc_ItemText, 1, ls_ItemRect, ;
DT_LEFT + DT_VCENTER + DT_SINGLELINE )
SelectObject( lh_DC, lh_OldFont )
SetBkMode( lh_DC, ln_OldBackMode )
SetTextColor( lh_DC, ln_OldTextColor )
endif
endif
If (ln_ItemAction == ODA_SELECT)
If (VarType( po_Tooltip ) == 'O')
If !empty( .cItemText )
KillTimer( .hWndParent, IDT_TOOLTIPS )
.cItemText = ''
endif
If ( po_Tooltip.lActive )
po_Tooltip.ShowTooltip( .F. )
endif
endif
If ( ll_Selected ) and (BitAnd( ln_Flags, myODF_WEBLINK ) != 0)
If !( ll_IsArrowKey )
.hOldCursor = SetCursor( .hHandCursor )
endif
.cWebsite = lc_ItemText
else
If !empty( .cWebsite )
.cWebsite = ''
endif
If (.hOldCursor != 0)
SetCursor( .hOldCursor )
.hOldCursor = 0
endif
endif
endif
EndWith
** Restore the original brush, font and colors.
DeleteObject( SelectObject( lh_DC, lh_OldBrush ))
ENDPROC
PROCEDURE onmenuenteridle
**********************************************
***
*** Popup Menu Class - OwnerDrawn Menu Library
*** Version 1.62.053
***
*** Author by: Herman Tan
*** Last update: September 3, 2008
***
**********************************************
LParameters th_WndPopup
Local lh_DC, ls_Rect, lh_OldBrush, lh_Pen, lh_OldPen
Local ln_Left, ln_Top, ln_Right, ln_Bottom
Local ln_ExStyle
** Make Floating Popup style
With This
Store 0 to ln_Left, ln_Top, ln_Right, ln_Bottom
ls_Rect = space( RECT_Size )
GetWindowRect( th_WndPopup, @ls_Rect )
ln_Left = CToBin( substr( ls_Rect, 1, DWORD_Size ), '4rs' )
ln_Top = CToBin( substr( ls_Rect, 5, DWORD_Size ), '4rs' )
lh_DC = GetDC( HWND_DESKTOP )
lh_OldBrush = SelectObject( lh_DC, GetStockObject( NULL_BRUSH ))
If (.nRightColor != -1)
lh_Pen = CreatePen( PS_SOLID, 1, .nRightColor )
else
lh_Pen = CreatePen( PS_SOLID, 1, GetSysColor( COLOR_MENU ))
endif
If !( .lThemeActive )
ln_Left = ln_Left + 3
ln_Right = ln_Left + .nLen - 3
If ( .lUseGradientPad )
lh_OldPen = SelectObject( lh_DC, .hPenPad )
else
lh_OldPen = SelectObject( lh_DC, lh_Pen )
endif
MoveToEx( lh_DC, ln_Left, ln_Top, PNULL )
LineTo( lh_DC, ln_Right, ln_Top )
ln_Top = ln_Top + 1
If ( .lUseGradientPad )
SelectObject( lh_DC, lh_Pen )
endif
MoveToEx( lh_DC, ln_Left, ln_Top, PNULL )
LineTo( lh_DC, ln_Right, ln_Top )
ln_Top = ln_Top + 1
ln_Right = CToBin( substr( ls_Rect, 9, DWORD_Size ), '4rs' ) - 3
MoveToEx( lh_DC, ln_Left, ln_Top, PNULL )
LineTo( lh_DC, ln_Right, ln_Top )
else
* ln_Left = ln_Left + 1
lh_OldPen = SelectObject( lh_DC, lh_Pen )
MoveToEx( lh_DC, ln_Left, ln_Top, PNULL )
LineTo( lh_DC, ln_Left + .nLen + 2, ln_Top )
endif
SelectObject( lh_DC, lh_OldPen )
SelectObject( lh_DC, lh_OldBrush )
ReleaseDC( HWND_DESKTOP, lh_DC )
DeleteObject( lh_Pen )
EndWith
ENDPROC
PROCEDURE horzgradientfill
**********************************************
***
*** Popup Menu Class - OwnerDrawn Menu Library
*** Version 1.62.053
***
*** Author by: Herman Tan
*** Last update: September 3, 2008
***
**********************************************
LParameters th_DC, tn_Left, tn_Top, tn_Right, tn_Bottom, ;
ta_StrVertexColor
Local ls_Vertex, ln_Width, ls_Rect
With This
ln_Width = int( (tn_Right - tn_Left) / 2 )
** Vertex 1
ls_Vertex = BinToC( tn_Left, '4rs' ) + BinToC( tn_Top, '4rs' ) + ;
evaluate( ta_StrVertexColor + '[1]' )
** Vertex 2
ls_Vertex = ls_Vertex + BinToC( tn_Left + ln_Width, '4rs' ) + ;
BinToC( tn_Bottom, '4rs' ) + evaluate( ta_StrVertexColor + '[2]' )
** Vertex 3
ls_Vertex = ls_Vertex + BinToC( tn_Left + ln_Width, '4rs' ) + ;
BinToC( tn_Top, '4rs' ) + evaluate( ta_StrVertexColor + '[3]' )
** Vertex 4
ls_Vertex = ls_Vertex + BinToC( tn_Right, '4rs' ) + BinToC( tn_Bottom, '4rs' ) + ;
evaluate( ta_StrVertexColor + '[4]' )
ls_Rect = BinToC( 0, '4rs' ) + BinToC( 1, '4rs' ) + ;
BinToC( 2, '4rs' ) + BinToC( 3, '4rs' )
GradientFill( th_DC, ls_Vertex,4, ls_Rect,2, GRADIENT_FILL_RECT_H )
EndWith
ENDPROC
PROCEDURE fillvertexcolor
LParameters tn_Color1, tn_Color2, tn_Color3, ta_StrVertexColor
Local ln_Red, ln_Green, ln_Blue, lc_Prop
With This
ln_Red = BitLShift( BitAnd( tn_Color1, 0xFF ), 8 )
ln_Green = BitAnd( tn_Color1, 0xFF00 )
ln_Blue = BitRShift( BitAnd( tn_Color1, 0xFF0000 ), 8 )
lc_Prop = ta_StrVertexColor + '[1]'
&lc_Prop = .Word( ln_Red ) + .Word( ln_Green ) + .Word( ln_Blue ) + w0
ln_Red = BitLShift( BitAnd( tn_Color2, 0xFF ), 8 )
ln_Green = BitAnd( tn_Color2, 0xFF00 )
ln_Blue = BitRShift( BitAnd( tn_Color2, 0xFF0000 ), 8 )
lc_Prop = ta_StrVertexColor + '[2]'
&lc_Prop = .Word( ln_Red ) + .Word( ln_Green ) + .Word( ln_Blue ) + w0
lc_Prop = ta_StrVertexColor + '[3]'
&lc_Prop = .Word( ln_Red ) + .Word( ln_Green ) + .Word( ln_Blue ) + w0
ln_Red = BitLShift( BitAnd( tn_Color3, 0xFF ), 8 )
ln_Green = BitAnd( tn_Color3, 0xFF00 )
ln_Blue = BitRShift( BitAnd( tn_Color3, 0xFF0000 ), 8 )
lc_Prop = ta_StrVertexColor + '[4]'
&lc_Prop = .Word( ln_Red ) + .Word( ln_Green ) + .Word( ln_Blue ) + w0
EndWith
ENDPROC
PROCEDURE word
LParameters tn_Num
Return chr(mod( tn_Num, 0x100 )) + chr(int( tn_Num / 0x100 ))
ENDPROC
PROCEDURE getbrightcolor
LParameters tn_Color, tn_Value, tn_Value2
Local ln_Red, ln_Green, ln_Blue
ln_Red = BitAnd( tn_Color, 0xFF )
ln_Green = BitRShift( BitAnd( tn_Color, 0xFF00 ), 8 )
ln_Blue = BitRShift( BitAnd( tn_Color, 0xFF0000 ), 16 )
If !empty( tn_Value2 ) and ;
(ln_Red >= 192) and (ln_Green >= 192) and (ln_Blue >= 192)
ln_Red = iif( ln_Red + tn_Value2 > MAX_RGB, MAX_RGB, ln_Red + tn_Value2 )
ln_Green = iif( ln_Green + tn_Value2 > MAX_RGB, MAX_RGB, ln_Green + tn_Value2 )
ln_Blue = iif( ln_Blue + tn_Value2 > MAX_RGB, MAX_RGB, ln_Blue + tn_Value2 )
else
ln_Red = iif( ln_Red + tn_Value > MAX_RGB, MAX_RGB, ln_Red + tn_Value )
ln_Green = iif( ln_Green + tn_Value > MAX_RGB, MAX_RGB, ln_Green + tn_Value )
ln_Blue = iif( ln_Blue + tn_Value > MAX_RGB, MAX_RGB, ln_Blue + tn_Value )
endif
Return Rgb( ln_Red, ln_Green, ln_Blue )
ENDPROC
PROCEDURE declare_dll
Declare Long CreateMenu in User32
Declare Long DrawMenuBar in User32 Long hWndMenu
Declare Long GetMenu in User32 Long hWndMenu
Declare Long GetSystemMenu in User32 Long hWndMain, Long bRevert
Declare Long SetMenu in User32 Long hWndMenu, Long hMenu
Declare Long CreatePopupMenu in User32
Declare Long IsMenu in User32 Long hMenu
Declare Long DestroyMenu in User32 Long hMenu
Declare Long AppendMenu in User32 ;
Long hMenu, Long uFlags, Long uIDNewItem, Long lpNewItem
Declare Short ModifyMenu in User32 ;
Long hMenu, Long nPosID, Long nFlags, Long nNewID, String lpNewID
Declare Long EnableMenuItem in User32 ;
Long hMenu, Long nItemID, Long nFlags
Declare Long GetMenuInfo in User32 Long hMenu, String @O_lpcMI
Declare Long SetMenuInfo in User32 Long hMenu, String @O_lpcMI
Declare Long GetMenuBarInfo in User32 ;
Long nhWnd, Long idObject, Long idItem, String @O_lpMBI
Declare Integer GetMenuString in User32 ;
Long hMenu, Long uIDItem, String @lpString, ;
Integer nMaxCount, Long uFlag
Declare Short GetMenuItemRect in User32 ;
Long hWndMenu, Long hMenu, Long nItem, String @lpItemRect
Declare Integer GetMenuItemCount in User32 Long hMenu
Declare Long GetMenuItemID in User32 Long hMenu, Long nPosID
Declare Long GetMenuItemInfo in User32 ;
Long hMenu, Long uItem, Long fByPosition, String @O_lpMII
Declare Short SetMenuItemInfo in User32 ;
Long hMenu, Long uItem, Long fByPosition, String lpMII
Declare Integer MenuItemFromPoint in User32 ;
Long nhWnd, Long hMenu, Long nX, Long nY
Declare Long GetMenuPosFromID in ShlwApi ;
Long hMenu, Long nID
Declare Long TrackPopupMenu in User32 ;
Long hMenu, Long uFlags, ;
Integer x, Integer y, Integer nReserved, ;
Long nhWnd, Long prcRect
** prcRect is ignored
Declare Long LoadImage in User32 ;
Long hInst, String lpszName, Long uType, ;
Integer cxDesired, Integer cyDesired, Long fuLoad
Declare Long HeapCreate in Kernel32 ;
Long flOptions, Long dwInitialSize, Long dwMaximumSize
Declare Long HeapDestroy in Kernel32 Long hHeap
Declare Long HeapAlloc in Kernel32 ;
Long hHeap, Long dwFlags, Long dwBytes
Declare Long HeapFree in Kernel32 ;
Long hHeap, Long dwFlags, Long lpHeap
Declare RtlMoveMemory in Kernel32 as CopyMem ;
String @O_lpDest, Long lpSource, Long nLength
Declare RtlMoveMemory in Kernel32 as CopyMem2Num ;
Long @O_lpDest, Long lpSource, Long nLength
Declare RtlMoveMemory in Kernel32 as Copy2Mem ;
Long lpDest, String @lpSource, Long nLength
Declare RtlMoveMemory in Kernel32 as CopyNum2Mem ;
Long lpDest, Long @lpSource, Long nLength
Declare Integer lstrlen in Kernel32 as GetStrLen ;
Long lpString
Declare Long GetCursorPos in User32 String @O_lpPoint
Declare Long GetWindowRect in User32 Long nhWnd, String @O_lpRect
Declare Long GetClientRect in User32 Long nhWnd, String @O_lpRect
Declare Long GetWindowLong in User32 Long nhWnd, Integer nIndex
Declare Long CallWindowProc in User32 ;
Long lpPrevWndFunc, Long nhWnd, Long uMsg, Long wParam, Long lParam
Declare Long GetDC in User32 Long nhWnd
Declare Long CreateCompatibleDC in GDI32 Long hDC
Declare Long CreateCompatibleBitmap in GDI32 ;
Long hDC, Long nWidth, Long nHeight
Declare Long GetWindowDC in User32 Long nhWnd
Declare Integer GetSystemMetrics in User32 Integer nIndex
Declare Long SelectObject in GDI32 Long hDC, Long hObject
Declare Integer ReleaseDC in User32 Long nhWnd, Long hDC
Declare Long DeleteDC in GDI32 Long hDC
Declare Long DeleteObject in GDI32 Long hDC
Declare Integer GetDeviceCaps in GDI32 Long hDC, Integer nIndex
Declare Integer GetObject in GDI32 as API_GetObject ;
Long hGDIobj, Integer nBufLen, String @O_lpvObject
Declare Long GetSysColor in User32 Integer nIndex
Declare Long GetSysColorBrush in User32 Integer nIndex
Declare Long SetTextColor in GDI32 Long hDC, Long crColor
Declare Long SetBkColor in GDI32 Long hDC, Long crColor
Declare Long CreateSolidBrush in GDI32 Long crColor
Declare Integer SetBkMode in GDI32 Long hDC, Integer iBkMode
Declare Long GetStockObject in GDI32 Integer fnObject
Declare Long CreatePatternBrush in GDI32 Long hBmp
Declare Long GdiSetBatchLimit in GDI32 Long dwLimit
Declare Long GetTextExtentPoint32 in GDI32 ;
Long hDC, String cString, Integer nStrLen, String @O_pSize
Declare Integer MulDiv in Kernel32 ;
Integer nNumber, Integer nNumerator, Integer nDenominator
Declare Integer FillRect in User32 ;
Long hDC, String @lpRect, Long hBrush
Declare Integer DrawText in User32 ;
Long hDC, String lpString, Integer nCount, ;
String @lpRect, Long uFormat
Declare Long ExtTextOut in GDI32 ;
Long hDC, Integer nX, Integer nY, ;
Long fuOptions, String @lsRect, String cText, ;
Long nTextLen, String @lpaDx
Declare Long DrawEdge in User32 ;
Long hDC, String @lpRect, Long nEdgeType, Long nBorderType
Declare Long CreatePen in GDI32 ;
Integer fnPenStyle, Integer nWidth, Long crColor
Declare Long MoveToEx in GDI32 ;
Long hDC, Integer nX, Integer nY, String @lpPoint
Declare Long LineTo in GDI32 ;
Long hDC, Integer nEndX, Integer nEndY
Declare Long Rectangle in GDI32 ;
Long hDC, Integer nLeftRect, Integer nTopRect, ;
Integer nRightRect, Integer nBottomRect
Declare Long RoundRect in GDI32 ;
Long hDC, Integer nLeftRect, Integer nTopRect, ;
Integer nRightRect, Integer nBottomRect, ;
Integer nWidthCurve, Integer nHeightCurve
Declare Long SetRect in User32 ;
String @O_lpRect, Integer nLeft, Integer nTop, ;
Integer nRight, Integer nBottom
Declare Long GradientFill in MsImg32 ;
Long hDC, String pVertex, Long dwNumVertex, ;
String pMesh, Long dwNumMesh, Long dwMode
Declare Long GetPixel in GDI32 ;
Long hDC, Integer nXPos, Integer nYPos
Declare Long SetPixelV in GDI32 ;
Long hDC, Integer nXPos, Integer nYPos, Long nColor
Declare Long TransparentBlt in MsImg32 ;
Long hdcDest, Integer nXDest, Integer nYDest, ;
Integer nWidthDest, Integer hHeightDest, ;
Long hdcSrc, Integer nXSrc, Integer nYSrc, ;
Integer nWidthSrc, Integer nHeightSrc, ;
Long crTransparent
Declare Long BitBlt in GDI32 ;
Long hdcDest, Integer nXDest, Integer nYDest, ;
Integer nWidthDest, Integer hHeightDest, ;
Long hdcSrc, Integer nXSrc, Integer nYSrc, ;
Long dwRop
Declare Long AlphaBlend in MsImg32 ;
Long hdcDest, Integer nXDest, Integer nYDest,;
Integer nWidthDest, Integer nHeightDest, ;
Integer hdcSrc, Integer nXSrc, Integer nYSrc, ;
Integer nWidthSrc, Integer nHeightSrc, ;
Integer blendFunction
Declare Long CreateFontIndirect in GDI32 String lpLogFont
Declare Long SystemParametersInfo in User32 ;
Long uiAction, Long uiParam, Long @O_pvParam, Long nUpdateWinIni
Declare Long SystemParametersInfo in User32 as SystemParametersInfoStr ;
Long uiAction, Long uiParam, String @O_pvParam, Long nUpdateWinIni
Declare Long SetTimer in User32 ;
Long nhWnd, Long nIDEvent, Long uElapse, Long lpTimerFunc
Declare Long KillTimer in User32 Long nhWnd, Long nIDEvent
Declare Long ClientToScreen in User32 Long nhWnd, String @O_lpPoint
Declare Long ScreenToClient in User32 Long nhWnd, String @O_lpPoint
Declare Long PostMessage in User32 ;
Long nhWnd, Long uMsg, Long wParam, Long lParam
Declare Long PostMessage in User32 as PostMessageStr ;
Long nhWnd, Long uMsg, Long wParam, String lParam
Declare Short GetKeyState in User32 Integer KeyCode
Declare Long SetWindowPos in User32 ;
Long nhWnd, Long hWndInsertAfter, ;
Integer nX, Integer nY, Integer nWidth, Integer nHeight, ;
Long uFlags
Declare Long WindowFromPoint in User32 Long nX, Long nY
Declare Integer MapWindowPoints in User32 ;
Long hWndFrom, Long hWndTo, String @O_cPoints, Long nPointCounts
Declare Long PtInRect in User32 ;
String @lpRect, Long nX, Long nY
Declare Long MoveWindow in User32 ;
Long hWnd, Integer nX, Integer nY, ;
Integer nWidth, Integer nHeight, Long bRepaint
Declare Long GetCursor in User32 as API_GetCursor
Declare Long SetCursor in User32 Long hCursor
Declare Long LoadCursor in User32 Long hInstance, Long nCursorID
Declare Integer ShellExecute in Shell32 ;
Long nhWnd, String lpAction, String lpFile, ;
String lpParams, String lpDirectory, Integer nShowCmd
Declare Integer MulDiv in Kernel32 ;
Integer nNumber, Integer nNumerator, Integer nDenominator
Declare Long CreateRoundRectRgn in GDI32 ;
Integer nLeftRect, Integer nTopRect, Integer nRightRect, Integer nBottomRect, ;
Integer nWidthEllipse, Integer nHeightEllipse
Declare Integer SelectClipRgn in GDI32 ;
Long hDC, Long hRegion
If ( This.lXP_Or_Higher )
Declare Long IsThemeActive in uxTheme
endif
**********************
&&added YB 27 april 2011
DECLARE INTEGER SetWindowLong IN user32;
INTEGER hWnd, INTEGER nIndex, INTEGER dwNewLong
DECLARE INTEGER SetLayeredWindowAttributes IN user32;
INTEGER hwnd, INTEGER crKey,;
SHORT bAlpha, INTEGER dwFlags
ENDPROC
PROCEDURE createpopupitem
LParameters tn_Items
If (type( 'tn_Items' ) == 'N') and (tn_Items > 0)
With This
Dimension .aPopupItem[ tn_Items ], .aPopupBmp[ tn_Items ], ;
.aPopupFlags[ tn_Items ], .aCmdSkipForItem[ tn_Items ]
Store '' to .aPopupItem, .aPopupBmp
.aPopupFlags = 0
EndWith
endif
ENDPROC
PROCEDURE setsubmenu
**********************************************
***
*** Popup Menu Class - OwnerDrawn Menu Library
*** Version 1.62.053
***
*** Author by: Herman Tan
*** Last update: September 3, 2008
***
**********************************************
LParameters tn_MenuPos, tn_MenuIndex
Local ls_MII
With This
If (tn_MenuIndex > 0)
ls_MII = BinToC( MENUITEMINFO_Size, '4rs' ) + BinToC( MIIM_SUBMENU, '4rs' ) + ;
replicate( c0, DWORD_Size*3 ) + BinToC( .hPopMenu[ tn_MenuIndex ], '4rs' ) + ;
replicate( c0, DWORD_Size*6 )
else
ls_MII = BinToC( MENUITEMINFO_Size, '4rs' ) + BinToC( MIIM_SUBMENU, '4rs' ) + ;
replicate( c0, DWORD_Size*3 ) + BinToC( 0, '4rs' ) + ;
replicate( c0, DWORD_Size*6 )
endif
SetMenuItemInfo( .hMainMenu, tn_MenuPos-1, .T., ls_MII )
DrawMenuBar( .hWndParent )
.nMainMenuItems = GetMenuItemCount( .hMainMenu )
EndWith
ENDPROC
PROCEDURE oninitmenupopup
**********************************************
***
*** Popup Menu Class - OwnerDrawn Menu Library
*** Version 1.62.053
***
*** Author by: Herman Tan
*** Last update: September 3, 2008
***
**********************************************
LParameters th_Wnd, th_Menu, t_lParam
Local ls_MBI, lh_DC, ls_MII, ls_Rect, ls_Size
Local lh_OldBrush, lh_OldPen, lh_OldFont, lp_MenuText
Local lh_PenRect, lh_PenShadow1, lh_PenShadow2
Local ln_SubLeft, ln_SubTop, ln_AddX, ln_AddY
Local ln_Left, ln_Right, ln_Top, ln_Bottom, ln_Len
Local ln_PopCounts, ln_Flags, lp_PopItem, lp_Command, lc_Command
Local lc_MenuText, lc_OldMenuText
Local ln_OldTextColor, ln_OldBackMode, ln_Shadow
Local lw_ItemText, ln_TextShadow
With This
If !empty( .cWebsite )
.cWebsite = ''
endif
If (.hOldCursor != 0)
SetCursor( .hOldCursor )
.hOldCursor = 0
endif
For ln_I = 1 to ALen( .hPopMenu, 1 )
If (th_Menu == .hPopMenu[ ln_I ])
.nMenuPos = ln_I
.hActivePopup = th_Menu
If (.nOSVer > 4)
If (.hMainMenu != 0)
If (.nMenuPos > .nMainMenuItems)
.lInitMenuPopup = .T.
.GetParameterInfo()
endif
else
If (.nMenuPos > 1)
.lInitMenuPopup = .T.
.GetParameterInfo()
endif
endif
endif
ln_PopCounts = GetMenuItemCount( th_Menu ) - 1
ln_Flags = 0
For ln_X = 0 to ln_PopCounts
ls_MII = padr( BinToC( MENUITEMINFO_Size, '4rs' ) + BinToC( MIIM_DATA, '4rs' ), ;
MENUITEMINFO_Size, c0 )
If (GetMenuItemInfo( th_Menu, ln_X, .T., @ls_MII ) > 0)
lp_PopItem = CToBin( substr( ls_MII, (DWORD_Size*8)+1, DWORD_Size ), '4rs' )
If ( lp_PopItem != 0)
CopyMem2Num( @ln_Flags, lp_PopItem+MAX_TEXTLEN+(DWORD_Size*2), DWORD_Size )
If (BitAnd( ln_Flags, myODF_SKIPFOR ) != 0)
CopyMem2Num( @lp_Command, lp_PopItem+MAX_TEXTLEN+(DWORD_Size*3), DWORD_Size )
lc_Command = space( MAX_TEXTLEN )
CopyMem( @lc_Command, lp_Command, GetStrLen( lp_Command ))
If evaluate( lc_Command )
EnableMenuItem( th_Menu, ln_X, MF_BYPOSITION + MFS_DISABLED )
else
EnableMenuItem( th_Menu, ln_X, MF_BYPOSITION + MF_ENABLED )
endif
endif
endif
endif
Next && ln_X
If (.hMainMenu != 0) and (.nMenuPos <= .nMainMenuItems)
.hDropMenu[ .nMenuPos ] = th_Menu
ls_Rect = space( RECT_Size )
GetWindowRect( .hWndParent, @ls_Rect )
ln_SubLeft = CToBin( substr( ls_Rect, 1, DWORD_Size ), '4rs' )
ln_SubTop = CToBin( substr( ls_Rect, 5, DWORD_Size ), '4rs' )
ls_MBI = padr( BinToC( MENUBARINFO_Size, '4rs' ), MENUBARINFO_Size, c0 )
GetMenuBarInfo( .hWndParent, OBJID_MENU, t_lParam+1, @ls_MBI )
ln_Left = CToBin( substr( ls_MBI, (DWORD_Size*1)+1, DWORD_Size ), '4rs' ) - ln_SubLeft
ln_Top = CToBin( substr( ls_MBI, (DWORD_Size*2)+1, DWORD_Size ), '4rs' ) - ln_SubTop
ln_Right = CToBin( substr( ls_MBI, (DWORD_Size*3)+1, DWORD_Size ), '4rs' ) - ln_SubLeft
ln_Bottom = CToBin( substr( ls_MBI, (DWORD_Size*4)+1, DWORD_Size ), '4rs' ) - ln_SubTop
lc_MenuText = space( MAX_TEXTLEN )
lp_MenuText = HeapAlloc( .hHeap, HEAP_ZERO_MEMORY, MAX_TEXTLEN )
ls_MII = BinToC( MENUITEMINFO_Size, '4rs' ) + BinToC( MIIM_STRING, '4rs' ) + ;
replicate( c0, DWORD_Size*7 ) + BinToC( lp_MenuText, '4rs' ) + ;
BinToC( MAX_TEXTLEN, '4rs' ) + dw0
GetMenuItemInfo( .hMainMenu, t_lParam, .T., @ls_MII )
ln_Len = CToBin( substr( ls_MII, (DWORD_Size*10)+1, DWORD_Size ), '4rs' )
CopyMem( @lc_MenuText, lp_MenuText, ln_Len )
HeapFree( .hHeap, 0, lp_MenuText )
lc_MenuText = left( lc_MenuText, ln_Len )
lc_OldMenuText = lc_MenuText
lc_MenuText = chrtran( left( lc_MenuText, ln_Len ), '&', '' )
ln_Len = len( lc_MenuText )
lh_DC = GetWindowDC( .hWndParent )
If ( .lUseGradientPad )
If !( .lThemeActive )
.VertGradientFill( lh_DC, ln_Left, ln_Top, ln_Right-2, ln_Bottom, ;
'.aStrPadVertexColor' )
else
.VertGradientFill( lh_DC, ln_Left, ln_Top, ln_Right-1, ln_Bottom, ;
'.aStrPadVertexColor' )
endif
lh_OldBrush = SelectObject( lh_DC, GetStockObject( NULL_BRUSH ))
else
If (.nRightColor != -1)
lh_Brush = CreateSolidBrush( .nRightColor )
else
lh_Brush = CreateSolidBrush( GetSysColor( COLOR_MENU ))
endif
lh_OldBrush = SelectObject( lh_DC, lh_Brush )
endif
ln_OldTextColor = SetTextColor( lh_DC, .nTextColor )
ln_OldBackMode = SetBkMode( lh_DC, TRANSPARENT )
lh_PenRect = CreatePen( PS_SOLID, 1, GetSysColor( COLOR_BTNSHADOW ))
lh_OldPen = SelectObject( lh_DC, lh_PenRect )
lh_OldFont = SelectObject( lh_DC, .hFont )
ls_Size = replicate( c0, POINT_Size )
GetTextExtentPoint32( lh_DC, lc_MenuText, ln_Len, @ls_Size )
ln_AddX = int( ((ln_Right - ln_Left) - ;
CToBin( substr( ls_Size, 1, DWORD_Size ), '4rs' )) / 2 )
ln_AddY = int( ((ln_Bottom - ln_Top) - ;
CToBin( substr( ls_Size, 5, DWORD_Size ), '4rs' )) / 2 )
If !( .lThemeActive )
If !( .lUseGradientPad )
SetRect( @ls_Rect, ln_Left+2, ln_Top+2, ln_Right-2, ln_Bottom+1 )
FillRect( lh_DC, ls_Rect, lh_Brush )
endif
SetRect( @ls_Rect, ln_Left, ln_Top, ln_Right, ln_Bottom+2 )
DrawEdge( lh_DC, ls_Rect, EDGE_RAISED, BF_RECT )
SetRect( @ls_Rect, ln_Left+2, ln_Top+2, ln_Right-2, ln_Bottom+3 )
DrawEdge( lh_DC, ls_Rect, BDR_RAISEDOUTER, BF_LEFT )
else
Rectangle( lh_DC, ln_Left, ln_Top, ln_Right, ln_Bottom+1 )
endif
DeleteObject( SelectObject( lh_DC, lh_OldPen ))
If ( .lEnhancedHilite ) and !( .lUseGradientPad )
If (.nRightColor == -1)
ln_TextShadow = .GetDarkColor( GetSysColor( COLOR_MENU ), 48 )
else
ln_TextShadow = .GetDarkColor( .nRightColor, 48 )
endif
SetRect( @ls_Rect, ln_Left+4, ln_Top+1, ln_Right, ln_Bottom )
SetTextColor( lh_DC, ln_TextShadow )
DrawText( lh_DC, lc_OldMenuText, -1, ls_Rect, DT_CENTER + DT_VCENTER + DT_SINGLELINE + DT_NOCLIP )
SetTextColor( lh_DC, .nTextColor )
endif
SetRect( @ls_Rect, ln_Left, ln_Top-1, ln_Right, ln_Bottom-2 )
DrawText( lh_DC, lc_OldMenuText, -1, ls_Rect, DT_CENTER + DT_VCENTER + DT_SINGLELINE + DT_NOCLIP )
.nLen = (ln_Right - 1) - (ln_Left + 1)
ln_Left = ln_Left + ln_AddX
ln_Top = ln_Top + ln_AddY
** Drop shadow line
* .GetParameterInfo()
If ( .lShadow ) and ( !( .lAnimate ) or .lMenuFade )
If (.nBarColor == -1)
ln_Shadow = .GetDarkColor( GetSysColor( COLOR_BTNSHADOW ), 16 )
lh_PenShadow1 = CreatePen( PS_SOLID, 1, ln_Shadow )
ln_Shadow = .GetBrightColor( ln_Shadow, 44 )
lh_PenShadow2 = CreatePen( PS_SOLID, 3, ln_Shadow )
else
ln_Shadow = .GetDarkColor( .nBarColor, 80 )
lh_PenShadow1 = CreatePen( PS_SOLID, 1, ln_Shadow )
ln_Shadow = .GetBrightColor( ln_Shadow, 44 )
lh_PenShadow2 = CreatePen( PS_SOLID, 3, ln_Shadow )
endif
SelectObject( lh_DC, lh_PenShadow2 )
.nRight = ln_Right + 1
.nTop = ln_Top + ln_AddY - 2
.nBottom = ln_Bottom - 2
MoveToEx( lh_DC, .nRight, .nTop, PNULL )
LineTo( lh_DC, .nRight, .nBottom )
DeleteObject( SelectObject( lh_DC, lh_PenShadow1 ))
.nRight = .nRight - 1
MoveToEx( lh_DC, .nRight, .nTop+1, PNULL )
LineTo( lh_DC, .nRight, .nBottom )
DeleteObject( SelectObject( lh_DC, lh_OldPen ))
endif
SelectObject( lh_DC, lh_OldFont )
SelectObject( lh_DC, lh_OldBrush )
SetBkMode( lh_DC, ln_OldBackMode )
SetTextColor( lh_DC, ln_OldTextColor )
ReleaseDC( .hWndParent, lh_DC )
If !( .lUseGradientPad )
DeleteObject( lh_Brush )
endif
.lFirst = .T.
endif
Exit
endif
Next
EndWith
ENDPROC
PROCEDURE bindmessages
**********************************************
***
*** Popup Menu Class - OwnerDrawn Menu Library
*** Version 1.62.053
***
*** Author by: Herman Tan
*** Last update: September 3, 2008
***
**********************************************
With This
.pOrgProc = GetWindowLong( .hWndParent, GWL_WNDPROC )
If (.hMainMenu != 0)
BindEvent( .hWndParent, WM_INITMENU, This, 'PopWndProc' )
BindEvent( .hWndParent, WM_NCMOUSEMOVE, This, 'PopWndProc' )
BindEvent( .hWndParent, WM_SYSCOMMAND, This, 'PopWndProc' )
BindEvent( .hWndParent, WM_SYSCOLORCHANGE, This, 'PopWndProc' )
BindEvent( .hWndParent, WM_COMMAND, This, 'PopWndProc' )
BindEvent( .hWndParent, WM_DOCOMMAND, This, 'PopWndProc' )
BindEvent( .hWndParent, WM_OPENWEB, This, 'PopWndProc' )
If ( .lXP_Or_Higher )
BindEvent( .hWndParent, WM_THEMECHANGED, This, 'PopWndProc' )
endif
else
BindEvent( .hWndParent, WM_ENTERIDLE, This, 'PopWndProc' )
endif
BindEvent( .hWndParent, WM_INITMENUPOPUP, This, 'PopWndProc' )
BindEvent( .hWndParent, WM_UNINITMENUPOPUP, This, 'PopWndProc' )
BindEvent( .hWndParent, WM_MENUCHAR, This, 'PopWndProc' )
BindEvent( .hWndParent, WM_MENUSELECT, This, 'PopWndProc' )
BindEvent( .hWndParent, WM_MEASUREITEM, This, 'PopWndProc' )
BindEvent( .hWndParent, WM_DRAWITEM, This, 'PopWndProc' )
BindEvent( .hWndParent, WM_TIMER, This, 'PopWndProc' )
EndWith
ENDPROC
*popupmenu.prg part3/3
PROCEDURE onmenuchar
***
*** Popup Menu Class - OwnerDrawn Menu Library
*** Version 1.62.053
***
*** Author by: Herman Tan
*** Last update: September 3, 2008
***
LParameters tn_PopupKey, th_Menu
Local ln_Return, lc_Key, lc_UpperKey, lc_MenuText, ln_Len
Local lp_ItemData, ln_State, ls_TempMII, ls_MII, ln_I, ln_MenuCount
ln_Return = 0
lc_Key = '&' + chr( BitAnd( tn_PopupKey, 0xFF ))
lc_UpperKey = upper( lc_Key )
lp_ItemData = 0
ls_TempMII = padr( BinToC( MENUITEMINFO_Size, '4rs' ) + BinToC( MIIM_DATA + MIIM_STATE, '4rs' ), ;
MENUITEMINFO_Size, c0 )
For ln_I = 0 to GetMenuItemCount( th_Menu ) - 1
ls_MII = ls_TempMII
GetMenuItemInfo( th_Menu, ln_I, .T., @ls_MII )
ln_State = CToBin( substr( ls_MII, (DWORD_Size*3)+1, DWORD_Size ), '4rs' )
If (BitAnd( ln_State, MFS_DISABLED ) == 0)
lp_ItemData = CToBin( substr( ls_MII, (DWORD_Size*8)+1, DWORD_Size ), '4rs' )
ln_Len = GetStrLen( lp_ItemData )
lc_MenuText = replicate( c0, ln_Len+2 ) && 2 additional bytes for buffer
CopyMem( @lc_MenuText, lp_ItemData, ln_Len )
If (lc_Key $ lc_MenuText) or (lc_UpperKey $ lc_MenuText)
ln_Return = BitLShift( MNC_EXECUTE, 16 ) + ln_I
Exit
endif
endif
Next
Return ln_Return
ENDPROC
PROCEDURE setleftcolor
LParameters tn_Color
Local ln_Color, ln_Color1, ln_Color2
With This
.nLeftColor = tn_Color
If (tn_Color == -1)
tn_Color = .GetBrightColor( GetSysColor( COLOR_ACTIVECAPTION ), 8 )
endif
ln_Color1 = .GetBrightColor( tn_Color, 132, 100 )
ln_Color2 = .GetBrightColor( tn_Color, 64, 48 )
.FillVertexColor( ln_Color1, ln_Color2, tn_Color, '.aStrLeftVertexColor' )
ln_Color = .GetBrightColor( tn_Color, 20 )
ln_Color1 = .GetBrightColor( ln_Color, 132, 104 )
ln_Color2 = .GetBrightColor( ln_Color, 62, 40 )
.FillVertexColor( ln_Color1, ln_Color2, ln_Color, '.aStrPadVertexColor' )
If (.hPenPad != 0)
DeleteObject( .hPenPad )
endif
.hPenPad = CreatePen( PS_SOLID, 1, tn_Color )
.nRed = (BitAnd( tn_Color, 0xFF ) * 42) / 100
.nGreen = (BitRShift( BitAnd( tn_Color, 0xFF00 ), 8 ) * 42) / 100
.nBlue = (BitRShift( BitAnd( tn_Color, 0xFF0000 ), 16 ) * 42) / 100
If !( .lThemed )
.nHiliteColor = .GetHiliteColor()
.nTextShadowColor = .GetDarkColor( .nHiliteColor, 60 )
ln_Color = .GetBrightColor( .nHiliteColor, 80 )
ln_Color1 = .GetDarkColor( .nHiliteColor, 24 )
ln_Color2 = .GetDarkColor( .nHiliteColor, 40 )
.FillVertexColor2( ln_Color, ln_Color1, ln_Color2, .nHiliteColor, '.aStrItemVertexHilite' )
endif
EndWith
ENDPROC
PROCEDURE setsubpopup
LParameters th_Popup, tn_MenuPos, tn_MenuIndex
Local ls_MII
With This
ls_MII = BinToC( MENUITEMINFO_Size, '4rs' ) + BinToC( MIIM_SUBMENU, '4rs' ) + ;
replicate( c0, DWORD_Size*3 ) + BinToC( .hPopMenu[ tn_MenuIndex ], '4rs' ) + ;
replicate( c0, DWORD_Size*6 )
SetMenuItemInfo( th_Popup, tn_MenuPos-1, .T., ls_MII )
DrawMenuBar( .hWndParent )
EndWith
ENDPROC
PROCEDURE onuninitmenupopup
**********************************************
***
*** Popup Menu Class - OwnerDrawn Menu Library
*** Version 1.62.053
***
*** Author by: Herman Tan
*** Last update: September 3, 2008
***
**********************************************
LParameters th_Menu
Local lh_Pen, lh_OldPen, lh_DC, ll_EscKey, ln_Coord
Local ls_Rect, ln_Width, ln_Right, ln_Left
With This
ll_EscKey = (GetKeyState( VK_ESCAPE ) < 0)
For ln_I = 1 to .nMainMenuItems
If (th_Menu == .hPopMenu[ ln_I ]) and (.hDropMenu[ ln_I ] != 0)
If ( .lShadow )
** Erase shadow line
lh_DC = GetWindowDC( .hWndParent )
If (.nBarColor == -1)
If ( .lXP_Or_Higher )
lh_Pen = CreatePen( PS_SOLID, 3, GetSysColor( COLOR_MENUBAR ))
else
lh_Pen = CreatePen( PS_SOLID, 3, GetSysColor( COLOR_MENU ))
endif
else
lh_Pen = CreatePen( PS_SOLID, 3, .nBarColor )
endif
lh_OldPen = SelectObject( lh_DC, lh_Pen )
.nRight = .nRight + 1
MoveToEx( lh_DC, .nRight, .nTop-1, PNULL )
LineTo( lh_DC, .nRight, .nBottom )
DeleteObject( SelectObject( lh_DC, lh_OldPen ))
ReleaseDC( .hWndParent, lh_DC )
endif
.hDropMenu[ ln_I ] = 0
If ll_EscKey
ls_Rect = space( RECT_Size )
GetClientRect( .hWndParent, @ls_Rect )
ln_Left = CToBin( substr( ls_Rect, 1, DWORD_Size ), '4rs' )
ln_Right = CToBin( substr( ls_Rect, 9, DWORD_Size ), '4rs' ) + 1
ln_Width = (ln_Right - ln_Left) - (SysMetric(3) * 2)
ln_Coord = BitAnd( .nCoordinate, 0xFFFF0000 ) + ln_Width
PostMessage( .hWndParent, WM_NCLBUTTONDOWN, HTMENU, ln_Coord )
PostMessage( .hWndParent, WM_NCLBUTTONUP, HTMENU, ln_Coord )
.nMenuPos = 0
endif
Exit
endif
Next && ln_I
EndWith
ENDPROC
PROCEDURE getdarkcolor
LParameters tn_Color, tn_Value
Local ln_Red, ln_Green, ln_Blue
ln_Red = BitAnd( tn_Color, 0xFF )
ln_Green = BitRShift( BitAnd( tn_Color, 0xFF00 ), 8 )
ln_Blue = BitRShift( BitAnd( tn_Color, 0xFF0000 ), 16 )
ln_Red = iif( ln_Red - tn_Value < 0, 0, ln_Red - tn_Value )
ln_Green = iif( ln_Green - tn_Value < 0, 0, ln_Green - tn_Value )
ln_Blue = iif( ln_Blue - tn_Value < 0, 0, ln_Blue - tn_Value )
Return Rgb( ln_Red, ln_Green, ln_Blue )
ENDPROC
PROCEDURE gethilitecolor
Local ln_Color1, ln_Color2
Local ln_Red, ln_Green, ln_Blue
Local ln_Red1, ln_Green1, ln_Blue1
Local ln_Red2, ln_Green2, ln_Blue2
With This
ln_Color1 = GetSysColor( COLOR_WINDOW )
If (.nLeftColor == -1)
ln_Color2 = GetSysColor( COLOR_HIGHLIGHT )
else
ln_Color2 = .GetBrightColor( .nLeftColor, 36, 20 )
endif
If (.hPenRect != 0)
DeleteObject( .hPenRect )
endif
.hPenRect = CreatePen( PS_SOLID, 1, ln_Color2 )
EndWith
ln_Red1 = BitAnd( ln_Color1, 0xFF )
ln_Green1 = BitRShift( BitAnd( ln_Color1, 0xFF00 ), 8 )
ln_Blue1 = BitRShift( BitAnd( ln_Color1, 0xFF0000 ), 16 )
ln_Red2 = BitAnd( ln_Color2, 0xFF )
ln_Green2 = BitRShift( BitAnd( ln_Color2, 0xFF00 ), 8 )
ln_Blue2 = BitRShift( BitAnd( ln_Color2, 0xFF0000 ), 16 )
* ln_Red = int( ((ln_Red1 * 7) / 10) + ((ln_Red2 * 3) / 10) )
* ln_Green = int( ((ln_Green1 * 7) / 10) + ((ln_Green2 * 3) / 10) )
* ln_Blue = int( ((ln_Blue1 * 7) / 10) + ((ln_Blue2 * 3) / 10) )
ln_Red = int( ((ln_Red1 * 7.2) / 10) + ((ln_Red2 * 3) / 10) )
ln_Green = int( ((ln_Green1 * 7.2) / 10) + ((ln_Green2 * 3) / 10) )
ln_Blue = int( ((ln_Blue1 * 7.2) / 10) + ((ln_Blue2 * 3) / 10) )
If (ln_Red > MAX_RGB)
ln_Red = MAX_RGB
endif
If (ln_Green > MAX_RGB)
ln_Green = MAX_RGB
endif
If (ln_Blue > MAX_RGB)
ln_Blue = MAX_RGB
endif
Return Rgb( ln_Red, ln_Green, ln_Blue )
ENDPROC
PROCEDURE vertgradientfill
**********************************************
***
*** Popup Menu Class - OwnerDrawn Menu Library
*** Version 1.62.053
***
*** Author by: Herman Tan
*** Last update: September 3, 2008
***
**********************************************
LParameters th_DC, tn_Left, tn_Top, tn_Right, tn_Bottom, ;
ta_StrVertexColor
Local ls_Vertex, ln_Height, ls_Rect
With This
ln_Height = int( (tn_Bottom - tn_Top) / 2 )
** Vertex 1
ls_Vertex = BinToC( tn_Left, '4rs' ) + BinToC( tn_Top, '4rs' ) + ;
evaluate( ta_StrVertexColor + '[1]' )
** Vertex 2
ls_Vertex = ls_Vertex + BinToC( tn_Right, '4rs' ) + ;
BinToC( tn_Top + ln_Height, '4rs' ) + evaluate( ta_StrVertexColor + '[2]' )
** Vertex 3
ls_Vertex = ls_Vertex + BinToC( tn_Left, '4rs' ) + ;
BinToC( tn_Top + ln_Height, '4rs' ) + evaluate( ta_StrVertexColor + '[3]' )
** Vertex 4
ls_Vertex = ls_Vertex + BinToC( tn_Right, '4rs' ) + BinToC( tn_Bottom, '4rs' ) + ;
evaluate( ta_StrVertexColor + '[4]' )
ls_Rect = BinToC( 0, '4rs' ) + BinToC( 1, '4rs' ) + ;
BinToC( 2, '4rs' ) + BinToC( 3, '4rs' )
GradientFill( th_DC, ls_Vertex,4, ls_Rect,2, GRADIENT_FILL_RECT_V )
EndWith
ENDPROC
PROCEDURE setrightcolor
LParameters tn_Color, tl_UseSystemColor
With This
.nRightColor = tn_Color
If tl_UseSystemColor
.nDisabledColor = GetSysColor( COLOR_BTNHIGHLIGHT )
.nDisabledColorShadow = GetSysColor( COLOR_BTNSHADOW )
else
.nDisabledColor = .GetBrightColor( tn_Color, 40 )
.nDisabledColorShadow = .GetDarkColor( tn_Color, 64 )
endif
If (.hDarkPen != 0)
DeleteObject( .hDarkPen )
endif
If (.hLightPen != 0)
DeleteObject( .hLightPen )
endif
.hDarkPen = CreatePen( PS_SOLID, 1, .nDisabledColorShadow )
.hLightPen = CreatePen( PS_SOLID, 1, .nDisabledColor )
EndWith
ENDPROC
PROCEDURE setmenubarcolor
**********************************************
***
*** Popup Menu Class - OwnerDrawn Menu Library
*** Version 1.62.053
***
*** Author by: Herman Tan
*** Last update: September 3, 2008
***
**********************************************
LParameters tn_Color
Local ls_MI
If (VarType( tn_Color ) == 'N')
With This
If (.hBarBrush != 0)
DeleteObject( .hBarBrush )
.hBarBrush = 0
endif
If (tn_Color != -1)
If ( .lUseGradientBar )
Local lh_DC, lh_TempDC, lh_Bitmap, lh_OldBitmap, lh_OldPen
Local ln_Height
lh_DC = GetWindowDC( HWND_DESKTOP )
ln_Height = SysMetric(20) + SysMetric(4)
lh_TempDC = CreateCompatibleDC( lh_DC )
lh_Bitmap = CreateCompatibleBitmap( lh_DC, 8, ln_Height )
lh_OldBitmap = SelectObject( lh_TempDC, lh_Bitmap )
* lh_OldPen = SelectObject( lh_TempDC, .hPenNull )
If ( .lThemed )
.VertGradientFill( lh_TempDC, 0, 0, 8, ln_Height, '.aStrPadVertexHilite' )
else
.VertGradientFill( lh_TempDC, 0, 0, 8, ln_Height, '.aStrPadVertexColor' )
endif
* SelectObject( lh_TempDC, lh_OldPen )
SelectObject( lh_TempDC, lh_OldBitmap )
.hBarBrush = CreatePatternBrush( lh_Bitmap )
DeleteObject( lh_Bitmap )
DeleteDC( lh_TempDC )
ReleaseDC( .hWndParent, lh_DC )
else
.hBarBrush = CreateSolidBrush( tn_Color )
endif
endif
.nBarColor = tn_Color
ls_MI = BinToC( MENUINFO_Size, '4rs' ) + BinToC( MIM_BACKGROUND, '4rs' ) + ;
dw0 + dw0 + BinToC( .hBarBrush, '4rs' ) + dw0 + dw0
SetMenuInfo( .hMainMenu, ls_MI )
DrawMenuBar( .hWndParent )
EndWith
endif
ENDPROC
PROCEDURE enablepopupitem
LParameters tn_PopupIndex, tn_ItemPos
EnableMenuItem( This.hPopMenu[ tn_PopupIndex ], tn_ItemPos-1, ;
MF_BYPOSITION + MF_ENABLED )
ENDPROC
PROCEDURE disablepopupitem
LParameters tn_PopupIndex, tn_ItemPos
EnableMenuItem( This.hPopMenu[ tn_PopupIndex ], tn_ItemPos-1, ;
MF_BYPOSITION + MFS_DISABLED )
ENDPROC
PROCEDURE lthemed_assign
LParameters vNewVal
Local ln_Color, ln_Color1, ln_Color2
With This
.lThemed = m.vNewVal
If ( .lThemed )
.nHiliteColor = ODHC_Office2003
ln_Color = .GetDarkColor( ODHC_Office2003, 40 )
ln_Color1 = .GetBrightColor( ln_Color, 70, 56 )
ln_Color2 = .GetBrightColor( ln_Color, 24, 16 )
.FillVertexColor( ln_Color1, ln_Color2, ln_Color, '.aStrPadVertexHilite' )
If (.hPenRect != 0)
DeleteObject( .hPenRect )
endif
.hPenRect = CreatePen( PS_SOLID, 1, .GetDarkColor( ODHC_Office2003, 112 ))
else
.nHiliteColor = .GetHiliteColor()
endif
.nTextShadowColor = .GetDarkColor( .nHiliteColor, 60 )
ln_Color = .GetBrightColor( .nHiliteColor, 80 )
ln_Color1 = .GetDarkColor( .nHiliteColor, 24 )
ln_Color2 = .GetDarkColor( .nHiliteColor, 40 )
* ln_Color3 = .GetBrightColor( .nHiliteColor, 8 )
.FillVertexColor2( ln_Color, ln_Color1, ln_Color2, .nHiliteColor, '.aStrItemVertexHilite' )
EndWith
ENDPROC
PROTECTED PROCEDURE on_ncmousemove
**********************************************
***
*** Popup Menu Class - OwnerDrawn Menu Library
*** Version 1.62.053
***
*** Author by: Herman Tan
*** Last update: September 3, 2008
***
**********************************************
LParameters tn_Coordinate
Local ln_X, ln_Y, ln_MenuPos
Local ls_MBI, lh_DC, ls_MII, ls_Rect, ls_Size
Local lh_Pen, lh_OldBrush, lh_OldPen, lh_OldFont, lp_MenuText
Local ln_Left, ln_Right, ln_Top, ln_Bottom, ln_SubLeft, ln_SubTop, ;
ln_Len, ln_PopCounts
Local lc_MenuText, ln_OldTextColor, ln_OldBackMode, ln_Color
ln_X = BitAnd( tn_Coordinate, 0xFFFF )
ln_Y = BitRShift( tn_Coordinate, 16 )
With This
ln_MenuPos = MenuItemFromPoint( .hWndParent, .hMainMenu, ln_X, ln_Y ) + 1
If ((ln_MenuPos == 0) and (.nMenuPos == 0) and .lSysCommand)
ln_MenuPos = 1
endif
If (ln_MenuPos > 0) and ((ln_MenuPos != .nMenuPos) or (.hActivePopup != 0))
.hActivePopup = 0
If (ln_MenuPos > 0) and (.nMenuPos < 1) and .lSysCommand
.lSysCommand = .F.
endif
If (ln_MenuPos != .nMenuPos) and (.nMenuPos > 0)
DrawMenuBar( .hWndParent )
.nMenuPos = 0
endif
lc_MenuText = space( MAX_TEXTLEN )
lp_MenuText = HeapAlloc( .hHeap, HEAP_ZERO_MEMORY, MAX_TEXTLEN )
ls_MII = BinToC( MENUITEMINFO_Size, '4rs' ) + BinToC( MIIM_STRING + MIIM_STATE, '4rs' ) + ;
replicate( c0, DWORD_Size*7 ) + BinToC( lp_MenuText, '4rs' ) + ;
BinToC( MAX_TEXTLEN, '4rs' ) + dw0
GetMenuItemInfo( .hMainMenu, ln_MenuPos-1, .T., @ls_MII )
ln_State = CToBin( substr( ls_MII, (DWORD_Size*3)+1, DWORD_Size ), '4rs' )
ln_Len = CToBin( substr( ls_MII, (DWORD_Size*10)+1, DWORD_Size ), '4rs' )
CopyMem( @lc_MenuText, lp_MenuText, ln_Len )
HeapFree( .hHeap, 0, lp_MenuText )
If !empty( lc_MenuText ) and (BitAnd( ln_State, MFS_DISABLED ) == 0)
.nCoordinate = tn_Coordinate
ls_Rect = space( 16 )
GetWindowRect( .hWndParent, @ls_Rect )
ln_SubLeft = CToBin( substr( ls_Rect, 1, DWORD_Size ), '4rs' )
ln_SubTop = CToBin( substr( ls_Rect, 5, DWORD_Size ), '4rs' )
ls_MBI = padr( BinToC( MENUBARINFO_Size, '4rs' ), MENUBARINFO_Size, c0 )
GetMenuBarInfo( .hWndParent, OBJID_MENU, ln_MenuPos, @ls_MBI )
ln_Left = CToBin( substr( ls_MBI, (DWORD_Size*1)+1, DWORD_Size ), '4rs' ) - ln_SubLeft
ln_Top = CToBin( substr( ls_MBI, (DWORD_Size*2)+1, DWORD_Size ), '4rs' ) - ln_SubTop
ln_Right = CToBin( substr( ls_MBI, (DWORD_Size*3)+1, DWORD_Size ), '4rs' ) - ln_SubLeft
ln_Bottom = CToBin( substr( ls_MBI, (DWORD_Size*4)+1, DWORD_Size ), '4rs' ) - ln_SubTop
.cMenuText = left( lc_MenuText, ln_Len )
lc_MenuText = chrtran( .cMenuText, '&', '' )
ln_len = len( lc_MenuText )
lh_DC = GetWindowDC( .hWndParent )
lh_OldFont = SelectObject( lh_DC, .hFont )
ln_OldTextColor = SetTextColor( lh_DC, .nTextHiliteColor )
ln_OldBackMode = SetBkMode( lh_DC, TRANSPARENT )
ls_Size = replicate( c0, POINT_Size )
GetTextExtentPoint32( lh_DC, lc_MenuText, ln_Len, @ls_Size )
lc_MenuText = .cMenuText
ln_len = len( lc_MenuText )
If .lThemed
.VertGradientFill( lh_DC, ln_Left, ln_Top, ln_Right-1, ln_Bottom, ;
'.aStrPadVertexHilite' )
lh_OldBrush = SelectObject( lh_DC, GetStockObject( NULL_BRUSH ))
else
If ( .lGlassy )
.VertGradientFill( lh_DC, ln_Left, ln_Top, ln_Right, ln_Bottom, ;
'.aStrItemVertexHilite' )
lh_OldBrush = SelectObject( lh_DC, GetStockObject( NULL_BRUSH ))
else
lh_OldBrush = SelectObject( lh_DC, CreateSolidBrush( .nHiliteColor ))
endif
endif
lh_Pen = CreatePen( PS_SOLID, 1, GetSysColor( COLOR_BTNSHADOW ))
lh_OldPen = SelectObject( lh_DC, lh_Pen )
Rectangle( lh_DC, ln_Left, ln_Top, ln_Right, ln_Bottom )
SetRect( @ls_Rect, ln_Left, ln_Top, ln_Right, ln_Bottom-1 )
DrawText( lh_DC, lc_MenuText, -1, ls_Rect, ;
DT_CENTER + DT_VCENTER + DT_SINGLELINE + DT_NOCLIP )
DeleteObject( SelectObject( lh_DC, lh_OldPen ))
If ( .lThemed )
SelectObject( lh_DC, lh_OldBrush )
else
DeleteObject( SelectObject( lh_DC, lh_OldBrush ))
endif
SetBkMode( lh_DC, ln_OldBackMode )
SetTextColor( lh_DC, ln_OldTextColor )
SelectObject( lh_DC, lh_OldFont )
ReleaseDC( .hWndParent, lh_DC )
If !( .lNonClient ) and !( .lSysCommand )
.lNonClient = .T.
SetTimer( .hWndParent, IDT_NONCLIENT, 100, PNULL )
endif
else
If (.lNonClient )
KillTimer( .hWndParent, IDT_NONCLIENT )
.lNonClient = .F.
endif
.lSysCommand = .F.
ln_MenuPos = 0
endif
else
If ( .lSysCommand )
.lSysCommand = .F.
ln_MenuPos = 0
endif
If ((ln_MenuPos == 0) and (.nMenuPos > 0))
If (.lNonClient )
KillTimer( .hWndParent, IDT_NONCLIENT )
.lNonClient = .F.
endif
DrawMenuBar( .hWndParent )
.nMenuPos = 0
endif
endif
.nMenuPos = ln_MenuPos
EndWith
ENDPROC
PROCEDURE getparameterinfo
Local ln_Shadow, ln_MenuFade, lc_Animation
Store 0 to ln_Shadow, ln_MenuFade
lc_Animation = padr( chr(8), 8, c0 )
SystemParametersInfo( SPI_GETDROPSHADOW, 0, @ln_Shadow, 0 )
SystemParametersInfo( SPI_GETMENUFADE, 0, @ln_MenuFade, 0 )
SystemParametersInfoStr( SPI_GETANIMATION, 8, @lc_Animation, 0)
With This
.lShadow = (ln_Shadow == 1)
.lMenuFade = (ln_MenuFade == 1)
.lAnimate = (CToBin( substr( lc_Animation, 5, DWORD_Size ), '4rs' ) == 1)
EndWith
ENDPROC
PROCEDURE createpad
LParameters tc_MenuName, to_Reff
Local ln_I, ln_Counts
Local lc_MenuName, lc_PadName, lc_PopupName, lc_Key, lc_Command
With This
If (VarType( to_Reff ) == 'O')
.lInTopLevel = !IsNull( to_Reff ) and ;
((to_Reff.ShowWindow == VFP_SW_ASTOPLEVEL) or to_Reff.Desktop)
endif
If empty( tc_MenuName )
.cMenuName = 'OD_MENU'
else
.cMenuName = upper( tc_MenuName )
endif
If ( .lInTopLevel )
Define menu (.cMenuName) in (to_Reff.Name) bar
else
Set SysMenu off
Define menu (.cMenuName) bar
endif
lc_MenuName = .cMenuName
ln_Counts = ALen( .aMenuPad, 1 )
Dimension .aPadDisabled[ ln_Counts ]
.aPadDisabled = .F.
For ln_I = 1 to ln_Counts
lc_PadName = 'Pad_' + transform( ln_I )
lc_PopupName = 'Popup_' + transform( ln_I )
Define pad (lc_PadName) of (lc_MenuName) prompt .aMenuPad[ ln_I, 1 ]
On pad (lc_PadName) of (lc_MenuName) activate popup (lc_PopupName)
If !empty( .aMenuPad[ ln_I, 2 ] )
lc_Key = 'Alt+' + .aMenuPad[ ln_I, 2 ]
lc_Command = 'PostMessage( ' + transform( .hWndParent ) + ', ' + ;
transform( WM_SYSCOMMAND ) + ', ' + transform( SC_KEYMENU ) + ', ' + ;
transform( asc( .aMenuPad[ ln_I, 2 ] )) + ' )'
On key label &lc_Key &lc_Command
endif
Next
Activate menu (.cMenuName) nowait
DoEvents Force
If (.hMainMenu == 0)
.hMainMenu = GetMenu( .hWndParent )
If ( .lSysMenu_OD )
Local ls_Rect, ln_Left, ln_Top, ln_Right, ln_Bottom
Local ln_Width, ln_Height
.hSysMenu = GetSystemMenu( _VFP.hWnd, 0 )
If (.hSysMenu != 0)
For ln_X = 0 to GetMenuItemCount( .hSysMenu )
ls_MII = padr( BinToC( MENUITEMINFO_Size, '4rs' ) + ;
BinToC( MIIM_FTYPE, '4rs' ), MENUITEMINFO_Size, c0 )
GetMenuItemInfo( .hSysMenu, ln_X, .T., @ls_MII )
ln_MenuType = CToBin( substr( ls_MII, (DWORD_Size*2)+1, 4 ), 'rs' )
ln_MenuType = BitOr( ln_MenuType, MF_OWNERDRAW )
ls_MII = left( ls_MII, (DWORD_Size*2)) + BinToC( ln_MenuType, '4rs' ) + ;
substr( ls_MII, (DWORD_Size*3)+1 )
SetMenuItemInfo( .hSysMenu, ln_X, .T., ls_MII )
Next
endif
DrawMenuBar( .hWndParent )
endif
endif
EndWith
ENDPROC
PROCEDURE disablemainmenu
Local ln_I
With This
For ln_I = 0 to .nMainMenuItems-1
EnableMenuItem( .hMainMenu, ln_I, MF_BYPOSITION + MFS_DISABLED )
Next
DrawMenuBar( .hWndParent )
UnBindEvents( .hWndParent )
BindEvent( .hWndParent, WM_INITMENU, This, 'PopWndProc' )
BindEvent( .hWndParent, WM_INITMENUPOPUP, This, 'PopWndProc' )
BindEvent( .hWndParent, WM_MEASUREITEM, This, 'PopWndProc' )
BindEvent( .hWndParent, WM_DRAWITEM, This, 'PopWndProc' )
EndWith
ENDPROC
PROCEDURE enablemainmenu
Local ln_I
With This
UnBindEvents( .hWndParent )
.BindMessages()
For ln_I = 0 to .nMainMenuItems-1
If !( .aPadDisabled[ ln_I + 1 ] )
EnableMenuItem( .hMainMenu, ln_I, MF_BYPOSITION + MF_ENABLED )
endif
Next
DrawMenuBar( .hWndParent )
EndWith
ENDPROC
PROCEDURE clear_dll
Clear DLLs CreateMenu, GetMenu, GetSystemMenu, SetMenu, CreatePopupMenu, IsMenu, ;
DestroyMenu, AppendMenu, ModifyMenu, EnableMenuItem, GetMenuInfo, SetMenuInfo, ;
GetMenuBarInfo, GetMenuItemCount, GetMenuItemID, GetMenuItemInfo, GetMenuString, ;
SetMenuItemInfo, TrackPopupMenu, DrawMenuBar, MenuItemFromPoint, GetMenuItemRect, ;
GetMenuPosFromID
Clear DLLs LoadImage, HeapCreate, HeapDestroy, HeapAlloc, HeapFree, ;
CopyMem, CopyMem2Num, Copy2Mem, CopyNum2Mem, ;
GetCursorPos, GetWindowRect, GetClientRect, GetStrLen, ;
GetWindowLong, CallWindowProc, ClientToScreen, ScreenToClient, ;
PostMessage, PostMessageStr, GetKeyState, SetWindowPos, MoveWindow, ;
WindowFromPoint, MapWindowPoints, PtInRect
Clear DLLs GetDC, CreateCompatibleDC, GetWindowDC, GetSystemMetrics, ;
SelectObject, ReleaseDC, DeleteDC, DeleteObject, GetDeviceCaps, ;
API_GetObject, GetSysColor, SetTextColor, SetBkColor, CreateSolidBrush, ;
SetBkMode, GetStockObject, CreateCompatibleBitmap, AlphaBlend, BitBlt, ;
GetSysColorBrush, CreatePatternBrush, GdiSetBatchLimit
Clear DLLs GetTextExtentPoint32, MulDiv, FillRect, DrawText, CreatePen, ;
MoveToEx, LineTo, Rectangle, RoundRect, SetRect, GradientFill, DrawEdge, ;
GetPixel, SetPixelV, TransparentBlt, CreateFontIndirect, ;
SystemParametersInfo, SystemParametersInfoStr, SetTimer, KillTimer
Clear DLLs API_GetCursor, SetCursor, LoadCursor, ShellExecute, MulDiv, ;
CreateRoundRectRgn, SelectClipRgn
If ( This.lXP_Or_Higher )
Clear DLLs IsThemeActive
endif
ENDPROC
PROCEDURE disablemenupad
LParameters tn_PadPos
EnableMenuItem( This.hMainMenu, tn_PadPos-1, MF_BYPOSITION + MFS_DISABLED )
DrawMenuBar( .hWndParent )
This.aPadDisabled[ tn_PadPos ] = .T.
ENDPROC
PROCEDURE enablemenupad
LParameters tn_PadPos
EnableMenuItem( This.hMainMenu, tn_PadPos-1, MF_BYPOSITION + MF_ENABLED )
DrawMenuBar( .hWndParent )
This.aPadDisabled[ tn_PadPos ] = .F.
ENDPROC
PROCEDURE createcustomfont
**********************************************
***
*** Popup Menu Class - OwnerDrawn Menu Library
*** Version 1.62.053
***
*** Author by: Herman Tan
*** Last update: September 3, 2008
***
**********************************************
LParameters tl_Bold, tl_Italic, tl_Underline, tc_FontName, tn_AddSize
Local ls_NCM, ls_MenuLogFont, ls_CustomFont, ln_Pos
ls_NCM = padr( BinToC( NONCLIENTMETRICS_size, '4rs' ), NONCLIENTMETRICS_size, c0 )
SystemParametersInfoStr( SPI_GETNONCLIENTMETRICS, NONCLIENTMETRICS_size, @ls_NCM, 0 )
ln_Pos = (DWORD_Size * 6) + LOGFONT_Size + (DWORD_Size*2) + ;
LOGFONT_Size + (DWORD_Size*2) + 1
ls_MenuLogFont = substr( ls_NCM, ln_Pos, LOGFONT_Size )
If empty( tc_FontName )
ls_CustomFont = left( ls_MenuLogFont, DWORD_Size*4 ) + ;
BinToC( iif( tl_Bold, FW_BOLD, FW_NORMAL ), '4rs' ) + ;
iif( tl_Italic, c1, c0 ) + iif( tl_Underline, c1, c0 ) + ;
substr( ls_MenuLogFont, 23 )
else
If (VarType( tn_AddSize ) == 'N') and (tn_AddSize > 0)
Local lh_DC, ln_Size
ln_Size = CToBin( left( ls_MenuLogFont, 4 ), '4rs' )
lh_DC = GetDC( HWND_DESKTOP )
ln_Size = (-MulDiv( ln_Size, 72, GetDeviceCaps( lh_DC, LOGPIXELSY ))) + tn_AddSize
ln_Size = -MulDiv( ln_Size, GetDeviceCaps( lh_DC, LOGPIXELSY ), 72 )
ReleaseDC( HWND_DESKTOP, lh_DC )
ls_CustomFont = BinToC( ln_Size, '4rs' ) + substr( ls_MenuLogFont, 5, DWORD_Size*3 )
else
ls_CustomFont = left( ls_MenuLogFont, DWORD_Size*4 )
endif
ls_CustomFont = ls_CustomFont + ;
BinToC( iif( tl_Bold, FW_BOLD, FW_NORMAL ), '4rs' ) + ;
iif( tl_Italic, c1, c0 ) + iif( tl_Underline, c1, c0 ) + ;
substr( ls_MenuLogFont, 23, BYTE_Size*6 ) + padr( tc_FontName, LF_FACESIZE, c0 )
endif
Return CreateFontIndirect( ls_CustomFont )
ENDPROC
PROCEDURE gdiplus_start
Local lp_Token, ls_GdipStartupInput
Declare Long GdiplusStartup in GdiPlus.dll ;
Long @O_pToken, String @Input, Long @O_Output
Declare Long GdiplusShutdown in GdiPlus.dll Long pToken
Declare Long GdipDisposeImage in GdiPlus.dll Long pImage
Declare Long GdipCreateFromHDC in GdiPlus.DLL Long hDC, Long @O_pGraphics
Declare Long GdipDeleteGraphics in GdiPlus.DLL Long pGraphics
Declare Long GdipLoadImageFromFile in GdiPlus.dll ;
String FileName, Long @O_pImage
Declare Long GdipDrawImageI in GdiPlus.DLL ;
Long pGraphics, Long pImage, Integer nX, Integer nY
Declare Long GdipDrawImageRectI in GdiPlus.dll ;
Long pGraphics, Long pImage, ;
Integer nX, Integer nY, Integer nWidth, Integer nHeight
Declare Long GdipGetImageWidth in GdiPlus.dll ;
Long pImage, Long @O_nWidth
Declare Long GdipGetImageHeight in GdiPlus.dll ;
Long pImage, Long @O_nHeight
Declare Long GdipCreateHBITMAPFromBitmap in GdiPlus.dll ;
Long pImage, Long @O_hBitmap, Long nARGB
Declare Long GdipGetImagePixelFormat in GdiPlus.dll ;
Long pImage, Long @O_PixelFormat
lp_Token = 0
ls_GdipStartupInput = c1 + replicate( c0, 15 )
GdiplusStartup( @lp_Token, @ls_GdipStartupInput, 0 )
This.pToken = lp_Token
This.aGdipImage[ 1 ] = 0
ENDPROC
PROCEDURE gdiplus_end
GdiplusShutdown( This.pToken )
This.pToken = 0
Clear DLLs GdiplusStartup, GdiplusShutdown, GdipDisposeImage, ;
GdipCreateFromHDC, GdipDeleteGraphics, GdipLoadImageFromFile, ;
GdipDrawImageI, GdipDrawImageRectI, GdipGetImageWidth, ;
GdipGetImageHeight, GdipCreateHBITMAPFromBitmap, GdipGetImagePixelFormat
ENDPROC
PROCEDURE lusegradient_assign
LPARAMETERS vNewVal
This.lUseGradient = m.vNewVal
This.lFullRectLine = !( m.vNewVal )
ENDPROC
PROCEDURE fillvertexcolor2
LParameters tn_Color1, tn_Color2, tn_Color3, tn_Color4, ta_StrVertexColor
Local ln_Red, ln_Green, ln_Blue, lc_Prop
With This
ln_Red = BitLShift( BitAnd( tn_Color1, 0xFF ), 8 )
ln_Green = BitAnd( tn_Color1, 0xFF00 )
ln_Blue = BitRShift( BitAnd( tn_Color1, 0xFF0000 ), 8 )
lc_Prop = ta_StrVertexColor + '[1]'
&lc_Prop = .Word( ln_Red ) + .Word( ln_Green ) + .Word( ln_Blue ) + w0
ln_Red = BitLShift( BitAnd( tn_Color2, 0xFF ), 8 )
ln_Green = BitAnd( tn_Color2, 0xFF00 )
ln_Blue = BitRShift( BitAnd( tn_Color2, 0xFF0000 ), 8 )
lc_Prop = ta_StrVertexColor + '[2]'
&lc_Prop = .Word( ln_Red ) + .Word( ln_Green ) + .Word( ln_Blue ) + w0
ln_Red = BitLShift( BitAnd( tn_Color3, 0xFF ), 8 )
ln_Green = BitAnd( tn_Color3, 0xFF00 )
ln_Blue = BitRShift( BitAnd( tn_Color3, 0xFF0000 ), 8 )
lc_Prop = ta_StrVertexColor + '[3]'
&lc_Prop = .Word( ln_Red ) + .Word( ln_Green ) + .Word( ln_Blue ) + w0
ln_Red = BitLShift( BitAnd( tn_Color4, 0xFF ), 8 )
ln_Green = BitAnd( tn_Color4, 0xFF00 )
ln_Blue = BitRShift( BitAnd( tn_Color4, 0xFF0000 ), 8 )
lc_Prop = ta_StrVertexColor + '[4]'
&lc_Prop = .Word( ln_Red ) + .Word( ln_Green ) + .Word( ln_Blue ) + w0
EndWith
ENDPROC
PROCEDURE ytranspa
lparameters lh_DC
&&added by YB 27 april 2011
if this.ytrans=.f.
return .f.
endi
***********
DECLARE INTEGER WindowFromDC IN user32 INTEGER hDC
*hDC [in] Handle to the device context from which a handle to the associated window is to be retrieved.
*The return value is a handle to the window associated with the specified DC. If no window is associated
*with the specified DC, the return value is NULL.
this.yhwnd=WindowFromDC(lh_DC)
******************************************************
#DEFINE LWA_COLORKEY 1
#DEFINE LWA_ALPHA 2
#DEFINE GWL_EXSTYLE -20
#DEFINE WS_EX_LAYERED 0x80000
LOCAL nExStyle, nRgb, nAlpha, nFlags
nExStyle = GetWindowLong(this.yHWnd, GWL_EXSTYLE)
nExStyle = BITOR(nExStyle, WS_EX_LAYERED)
= SetWindowLong(this.yHWnd, GWL_EXSTYLE, nExStyle)
if empty(this.ntranspa)
this.ntranspa=180
endi
= SetLayeredWindowAttributes(this.yHWnd, 0, this.ntranspa,LWA_ALPHA) &&LWA_COLORKEY+
* = SetLayeredWindowAttributes(this.yHWnd, rgb(239,239,239), 255,LWA_COLORKEY+LWA_ALPHA)
********************
ENDPROC
PROCEDURE Init
**********************************************
***
*** Popup Menu Class - OwnerDrawn Menu Library
*** Version 1.62.053
***
*** Author by: Herman Tan
*** Last update: September 3, 2008
***
**********************************************
LParameters tn_HeapSize
Local array la_DLLs[1]
Local ln_Result
ln_Result = ADlls( la_DLLs )
If (ln_Result != 0)
ln_Result = AScan( la_DLLs, 'CreatePopupMenu', 1, 0, 0, 8 )
endif
With This
.lWinXP = WIN_XP
.lXP_Or_Higher = XP_OR_HIGHER
If (ln_Result == 0)
.Declare_DLL()
else
.lClearDLL = .F.
endif
If (.hHeap == 0)
If empty( tn_HeapSize )
.hHeap = HeapCreate( HEAP_GENERATE_EXCEPTIONS, 0x4000, 0 )
else
.hHeap = HeapCreate( HEAP_GENERATE_EXCEPTIONS, tn_HeapSize, 0 )
endif
If (.hHeap == 0)
MessageBox( 'Heap Memory cannot be created !! ', 16, ' *** ATTENTION ***' )
If ( .lClearDLL )
.Clear_DLL()
endif
Return .F.
endif
endif
.hPopMenu = 0
.nOSVer = val( OS( 3 ))
.hFont = .CreateFontIn()
.hFontCustom = .CreateCustomFont( .F., .F., .T. )
.hFontCustomBold = .CreateCustomFont( .T., .F., .T. )
.hFontBold = .CreateCustomFont( .T., .F., .F. )
.hFontWebding = .CreateCustomFont( .F., .F., .F., 'Webdings', 1 )
.hFontWebdingBold = .CreateCustomFont( .T., .F., .F., 'Webdings', 1 )
.hPenNull = CreatePen( PS_NULL, 0, 0 )
.hHandCursor = LoadCursor( PNULL, IDC_HAND )
Store GetSysColor( COLOR_MENUTEXT ) to .nTextColor, .nTextHiliteColor
** Left brush gradient color
.SetLeftColor( -1 )
* .SetLeftColor( Rgb( 180, 48, 36 ) )
** Right brush color
.SetRightColor( GetSysColor( COLOR_MENU ), .T. )
If ( .lThemed )
.nHiliteColor = ODHC_Office2003
ln_Color = .GetDarkColor( ODHC_Office2003, 40 )
ln_Color1 = .GetBrightColor( ln_Color, 70, 56 )
ln_Color2 = .GetBrightColor( ln_Color, 24, 16 )
.FillVertexColor( ln_Color1, ln_Color2, ln_Color, '.aStrPadVertexHilite' )
.hPenRect = CreatePen( PS_SOLID, 1, .GetDarkColor( ODHC_Office2003, 112 ))
endif
If ( .lXP_Or_Higher )
.lThemeActive = (IsThemeActive() == 1)
endif
.nXMenuCheck = GetSystemMetrics( SM_CXMENUCHECK )
EndWith
ENDPROC
PROCEDURE Destroy
With This
If ( .lNonClient )
KillTimer( .hWndParent, IDT_NONCLIENT )
.lNonClient = .F.
endif
If !empty( .cItemText )
KillTimer( .hWndParent, IDT_TOOLTIPS )
endif
If (VarType( po_Tooltip ) == 'O') and ( po_Tooltip.lActive )
po_Tooltip.ShowTooltip( .F. )
endif
UnBindEvents( This.hWndParent )
.DestroyPopup()
If (.hFont != 0)
DeleteObject( .hFont )
endif
If (.hFontCustom != 0)
DeleteObject( .hFontCustom )
endif
If (.hFontCustomBold != 0)
DeleteObject( .hFontCustomBold )
endif
If (.hFontBold != 0)
DeleteObject( .hFontBold )
endif
If (.hFontWebding != 0)
DeleteObject( .hFontWebding )
endif
If (.hFontWebdingBold != 0)
DeleteObject( .hFontWebdingBold )
endif
If (.hDarkPen != 0)
DeleteObject( .hDarkPen )
endif
If (.hLightPen != 0)
DeleteObject( .hLightPen )
endif
If (.hPenNull != 0)
DeleteObject( .hPenNull )
endif
If (.hPenPad != 0)
DeleteObject( .hPenPad )
endif
If (.hBarBrush != 0)
DeleteObject( .hBarBrush )
endif
If (.hPenRect != 0)
DeleteObject( .hPenRect )
endif
If (.hHeap != 0)
HeapDestroy( .hHeap )
endif
If (.hMainMenu != 0)
If (.hSysMenu != 0)
GetSystemMenu( _VFP.hWnd, 1 )
endif
Release menus (.cMenuName) extended
If (_VFP.StartMode == VFP_START_IDE) and !( .lInTopLevel )
Set SysMenu on
endif
For ln_I = 1 to ALen( .aMenuPad, 1 )
If !empty( .aMenuPad[ ln_I, 2 ] )
lc_Key = 'Alt+' + .aMenuPad[ ln_I, 2 ]
On key label &lc_Key
endif
Next
endif
If (.pToken != 0)
.Gdiplus_End()
endif
If ( .lClearDLL )
.Clear_DLL()
endif
EndWith
ENDPROC
ENDDEFINE
*
*-- EndDefine: popupmenu
*Endcode
*3)*-this is the first demo with a contextuel transparent menu on a top level form
*can change colors(left,right),transparency (better from 80-255) or disable it.
*Name this as :yownerdrawn0.prg
*Begin code
Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
Publi yform
yform=Newobject("ownerDrawn_menus")
yform.Show
Read Events
Return
*
Define Class ownerDrawn_menus As Form
Height = 397
Width = 495
ShowWindow = 2
AutoCenter = .T.
Picture = "ciel1.jpg"
Caption = "Popup using BindEvent"
FontName = "HELTERSKELTER"
FontSize = 10
MaxButton = .F.
MinButton = .F.
MinHeight = 100
MinWidth = 200
WindowType = 1
*-- XML Metadata for customizable properties
_MemberData = [<VFPData><memberdata name="omenu" type="property" display="oMenu"/><memberdata name="isbound" type="property" display="IsBound"/><memberdata name="onselection" type="method" display="OnSelection"/></VFPData>]
omenu = .Null.
isbound = .F.
xnleftcolor = (Rgb(0,255,0))
xnrightcolor = (Rgb(255,255,0))
Name = "Form1"
Add Object label1 As Label With ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "", ;
Height = 17, ;
Left = 12, ;
Top = 125, ;
Width = 192, ;
Name = "Label1"
Add Object check1 As Checkbox With ;
Top = 307, ;
Left = 166, ;
Height = 20, ;
Width = 160, ;
FontBold = .T., ;
FontSize = 11, ;
AutoSize = .T., ;
Alignment = 0, ;
BackStyle = 1, ;
Caption = "Menu Transparency", ;
Value = 1, ;
ForeColor = Rgb(255,255,255), ;
BackColor = Rgb(0,0,160), ;
Name = "Check1"
Add Object command1 As CommandButton With ;
Top = 292, ;
Left = 70, ;
Height = 27, ;
Width = 84, ;
Caption = "nLeftrColor", ;
MousePointer = 15, ;
Name = "Command1"
Add Object command2 As CommandButton With ;
Top = 321, ;
Left = 71, ;
Height = 27, ;
Width = 84, ;
Caption = "nRightColor", ;
MousePointer = 15, ;
Name = "Command2"
Add Object spinner1 As Spinner With ;
Height = 24, ;
Increment = 10.00, ;
KeyboardHighValue = 255, ;
KeyboardLowValue = 0, ;
Left = 74, ;
SpinnerHighValue = 255.00, ;
SpinnerLowValue = 0.00, ;
Top = 360, ;
Width = 85, ;
Value = 180, ;
Name = "Spinner1"
Add Object label2 As Label With ;
AutoSize = .T., ;
BackStyle = 1, ;
Caption = "transparency (0-255)", ;
Height = 17, ;
Left = 164, ;
Top = 362, ;
Width = 116, ;
Name = "Label2"
Add Object command3 As CommandButton With ;
Top = 360, ;
Left = 12, ;
Height = 25, ;
Width = 48, ;
Caption = "Picture..", ;
MousePointer = 15, ;
Name = "Command3"
Add Object label3 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 10, ;
BackStyle = 1, ;
Caption = "Click here or rightclick anywhere on form", ;
Height = 18, ;
Left = 108, ;
MousePointer = 15, ;
Top = 12, ;
Width = 265, ;
ForeColor = Rgb(255,255,0), ;
BackColor = Rgb(255,128,0), ;
Name = "Label3"
Procedure onselection
Lparameters tn_MenuPos, tn_ItemId
If Between(tn_MenuPos,1,10)
Messagebox( 'WM_COMMAND: ' + Transform( tn_MenuPos ) + ' ' + Transform( tn_ItemId )+"---> Make some actions here...",0+32+4096,"",1500)
Endi
Endproc
Procedure yshowpopup
Local lo_Popup As popupmenu Of OwnerDrawn_Menu
Local ln_Result
gnbre=Adir(gabase,Home(4)+'Bitmaps\Outline\Redmask\*.bmp')
Set Proc To Locfile('popupmenu.prg') AddI
lo_Popup = Newobject( 'PopupMenu') &&,' OwnerDrawn_Menu' )
release proc 'popupmenu'
DoDefault()
With lo_Popup
.nleftColor=Thisform.xnleftcolor
.nRightColor=Thisform.xnrightcolor
.setleftcolor(.nleftColor)
.nTranspa=Thisform.spinner1.Value
If Thisform.isbound
.lClearDLL = .F.
Else
.lClearDLL = .T.
Endif
.hWndParent = This.HWnd
If Thisform.check1.Value=1
.ytrans=.T.
Else
.ytrans=.F.
Endi
.CreatePopupItem( 10 )
.aPopupItem[1] = 'Open Document'
.aPopupItem[2] = 'Testing Menu'
.aPopupItem[3] = 'yTesting '
.aPopupItem[4] = 'data'
.aPopupItem[5] = 'cursors'
.aPopupItem[6] = 'graphics'
.aPopupItem[7] = 'softs'
.aPopupItem[8] = 'documents'
.aPopupItem[9] = 'Help'
.aPopupItem[10] = 'others'
For i=1 To 10
.aPopupBmp[i] =Home(4)+'Bitmaps\Outline\Redmask\'+ gabase(i,1)
Endfor
.CreatePopup( 11 )
.lUseGradient = .T.
ln_Result = .ActivatePopup()
If (ln_Result != 0)
This.onselection( ln_Result , .aPopupItem[ ln_Result ])
Endif
Endwith
lo_Popup = Null
This.Cls
Endproc
Procedure Destroy
If Thisform.isbound
Thisform.cmdUnBind.Click()
Endif
Endproc
Procedure KeyPress
Lparameters nKeyCode, nShiftAltCtrl
If (nKeyCode == 27)
Thisform.Release()
Endif
Endproc
Procedure Unload
Clear Dlls
Release Popup All
Release Pad All Of _Msysmenu
Endproc
Procedure RightClick
Thisform.yshowpopup()
Endproc
Procedure command1.Click
Thisform.xnleftcolor=Getcolor()
Endproc
Procedure command2.Click
Thisform.xnrightcolor=Getcolor()
Endproc
Procedure label2.RightClick
Thisform.yshowpopup()
Endproc
Procedure command3.Click
Thisform.Picture=Getpict()
Endproc
Procedure command3.RightClick
Thisform.yshowpopup()
Endproc
Procedure label3.Click
Thisform.yshowpopup()
Endproc
Procedure Destroy
Clea Events
Endproc
Enddefine
*
*-- EndDefine:
*Endcode
*4)*-this creates a demo top level o form with menu+contextuel menus and settings
*all cosmetics of the class----name this as : yownerdrawn1.prg
*can bind the main form menu.unbid it to run the contextuel menu.
*Begin code
publi m.yrep
m.yrep=addbs(justpath(sys(16,1)))
set defa to (yrep)
publi yform
yform=Newobject("asup")
yform.show
read events
return
*
DEFINE CLASS asup AS form
Top = 7
Left = 185
Height = 529
Width = 419
ShowWindow = 2
Picture = "ciel1.jpg"
Caption = "Menu & Popup using BindEvent"
MaxButton = .F.
MinButton = .F.
MinHeight = 100
MinWidth = 200
WindowType = 1
BackColor = RGB(0,255,0)
*-- XML Metadata for customizable properties
_memberdata = ""
omenu = .NULL.
isbound = .F.
narea = 1
nstyle = 0
ltoplevel = .F.
Name = "Form1"
ADD OBJECT label1 AS label WITH ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "Right click on the bottom area", ;
Height = 17, ;
Left = 13, ;
Top = 317, ;
Width = 164, ;
TabIndex = 14, ;
Name = "Label1"
ADD OBJECT cmdbind AS commandbutton WITH ;
Top = 132, ;
Left = 60, ;
Height = 27, ;
Width = 119, ;
Anchor = 26, ;
Caption = "Bind Main Menu", ;
TabIndex = 1, ;
Name = "cmdBind"
ADD OBJECT cmdunbind AS commandbutton WITH ;
Top = 132, ;
Left = 208, ;
Height = 27, ;
Width = 119, ;
Anchor = 26, ;
Caption = "UnBind Main Menu", ;
Enabled = .F., ;
TabIndex = 2, ;
Name = "cmdUnBind"
ADD OBJECT label2 AS label WITH ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "Right click on the top area", ;
Height = 17, ;
Left = 122, ;
Top = 111, ;
Width = 143, ;
TabIndex = 15, ;
Name = "Label2"
ADD OBJECT command1 AS commandbutton WITH ;
Top = 273, ;
Left = 15, ;
Height = 27, ;
Width = 150, ;
Caption = "Popup below this button", ;
TabIndex = 13, ;
Name = "Command1"
ADD OBJECT chkgradpad AS checkbox WITH ;
Top = 173, ;
Left = 132, ;
Height = 17, ;
Width = 41, ;
Alignment = 0, ;
Caption = "NO", ;
Value = .F., ;
Enabled = .F., ;
TabIndex = 3, ;
Name = "chkGradPad"
ADD OBJECT lblgradpad AS label WITH ;
Caption = "Gradient Menupad", ;
Enabled = .F., ;
Height = 17, ;
Left = 15, ;
Top = 174, ;
Width = 103, ;
TabIndex = 16, ;
Name = "lblGradPad"
ADD OBJECT chkbarcolor AS checkbox WITH ;
Top = 192, ;
Left = 132, ;
Height = 17, ;
Width = 41, ;
Alignment = 0, ;
Caption = "NO", ;
Value = .F., ;
Enabled = .F., ;
TabIndex = 4, ;
Name = "chkBarColor"
ADD OBJECT lblbarcolor AS label WITH ;
Caption = "Color on Menubar", ;
Enabled = .F., ;
Height = 17, ;
Left = 15, ;
Top = 193, ;
Width = 100, ;
TabIndex = 17, ;
Name = "lblBarColor"
ADD OBJECT shape1 AS shape WITH ;
Top = 171, ;
Left = 188, ;
Height = 143, ;
Width = 218, ;
SpecialEffect = 0, ;
Name = "Shape1"
ADD OBJECT label3 AS label WITH ;
Caption = " Item Highlighter ", ;
Height = 17, ;
Left = 193, ;
Top = 164, ;
Width = 95, ;
TabIndex = 18, ;
Name = "Label3"
ADD OBJECT label4 AS label WITH ;
AutoSize = .T., ;
Caption = "Rounded", ;
Height = 17, ;
Left = 293, ;
Top = 182, ;
Width = 53, ;
TabIndex = 19, ;
Name = "Label4"
ADD OBJECT label5 AS label WITH ;
AutoSize = .T., ;
Caption = "Bitmap Only", ;
Height = 17, ;
Left = 278, ;
Top = 204, ;
Width = 68, ;
TabIndex = 20, ;
Name = "Label5"
ADD OBJECT label6 AS label WITH ;
AutoSize = .T., ;
Caption = "Rounded on Bitmap", ;
Height = 17, ;
Left = 234, ;
Top = 226, ;
Width = 112, ;
TabIndex = 21, ;
Name = "Label6"
ADD OBJECT chkrounded AS checkbox WITH ;
Top = 181, ;
Left = 352, ;
Height = 17, ;
Width = 41, ;
Alignment = 0, ;
Caption = "NO", ;
Value = .F., ;
TabIndex = 7, ;
Name = "chkRounded"
ADD OBJECT chkbmponly AS checkbox WITH ;
Top = 203, ;
Left = 352, ;
Height = 17, ;
Width = 41, ;
Alignment = 0, ;
Caption = "NO", ;
Value = .F., ;
TabIndex = 8, ;
Name = "chkBmpOnly"
ADD OBJECT chkroundedonbmp AS checkbox WITH ;
Top = 225, ;
Left = 352, ;
Height = 17, ;
Width = 41, ;
Alignment = 0, ;
Caption = "NO", ;
Value = .F., ;
TabIndex = 9, ;
Name = "chkRoundedOnBmp"
ADD OBJECT chkoffice2003 AS checkbox WITH ;
Top = 219, ;
Left = 132, ;
Height = 17, ;
Width = 41, ;
Alignment = 0, ;
Caption = "NO", ;
Value = .F., ;
TabIndex = 5, ;
Name = "chkOffice2003"
ADD OBJECT lbloffice2003 AS label WITH ;
Caption = "Office 2003 Themed", ;
Height = 17, ;
Left = 15, ;
Top = 220, ;
Width = 113, ;
TabIndex = 22, ;
Name = "lblOffice2003"
ADD OBJECT chkgradleft AS checkbox WITH ;
Top = 239, ;
Left = 132, ;
Height = 17, ;
Width = 41, ;
Alignment = 0, ;
Caption = "YES", ;
Value = .T., ;
TabIndex = 6, ;
Name = "chkGradLeft"
ADD OBJECT lbl_gradleft AS label WITH ;
Caption = "Gradient Left Side", ;
Height = 17, ;
Left = 15, ;
Top = 240, ;
Width = 100, ;
TabIndex = 23, ;
Name = "lbl_GradLeft"
ADD OBJECT label7 AS label WITH ;
AutoSize = .T., ;
Caption = "Enhance Text (Shadowed)", ;
Height = 17, ;
Left = 200, ;
Top = 268, ;
Width = 146, ;
TabIndex = 24, ;
Name = "Label7"
ADD OBJECT chkenhanced AS checkbox WITH ;
Top = 267, ;
Left = 352, ;
Height = 17, ;
Width = 41, ;
Alignment = 0, ;
Caption = "NO", ;
Value = .F., ;
TabIndex = 11, ;
Name = "chkEnhanced"
ADD OBJECT label8 AS label WITH ;
AutoSize = .T., ;
Caption = "Glassy Look", ;
Height = 17, ;
Left = 276, ;
Top = 290, ;
Width = 70, ;
TabIndex = 26, ;
Name = "Label8"
ADD OBJECT chkglassy AS checkbox WITH ;
Top = 289, ;
Left = 352, ;
Height = 17, ;
Width = 41, ;
Alignment = 0, ;
Caption = "NO", ;
Value = .F., ;
TabIndex = 12, ;
Name = "chkGlassy"
ADD OBJECT label9 AS label WITH ;
AutoSize = .T., ;
Caption = "Bold ItemText", ;
Height = 17, ;
Left = 270, ;
Top = 247, ;
Width = 76, ;
TabIndex = 25, ;
Name = "Label9"
ADD OBJECT chkbold AS checkbox WITH ;
Top = 246, ;
Left = 352, ;
Height = 17, ;
Width = 41, ;
Alignment = 0, ;
Caption = "NO", ;
Value = .F., ;
TabIndex = 10, ;
Name = "chkBold"
ADD OBJECT check1 AS checkbox WITH ;
Top = 96, ;
Left = 168, ;
Height = 17, ;
Width = 93, ;
AutoSize = .T., ;
Alignment = 0, ;
Caption = "Transparency", ;
Value = 1, ;
BackColor = RGB(255,128,64), ;
Name = "Check1"
PROCEDURE onselection
LParameters tn_MenuPos, tn_ItemId
With ThisForm.oMenu
Do case
Case (tn_MenuPos == 1) and (tn_ItemId == 1001)
.DisablePopupItem( tn_MenuPos, 1 )
.EnablePopupItem( tn_MenuPos, 2 )
Case (tn_MenuPos == 1) and (tn_ItemId == 1002)
.DisablePopupItem( tn_MenuPos, 2 )
.EnablePopupItem( tn_MenuPos, 1 )
Otherwise
Wait 'WM_DOCOMMAND: ' + transform( tn_MenuPos ) + ' ' + ;
transform( tn_ItemId ) window nowait
EndCase
EndWith
ENDPROC
PROCEDURE showpopup
LParameters tn_LeftColor, tl_UseSystemColor, to_Reff, tl_UseRightColor
#Define FIRST_ITEMID 11
#Define FIRST_SUBITEMID FIRST_ITEMID + 20
Local lo_Popup as PopupMenu &&of OwnerDrawn_Menu
Local ln_Result, ln_Color
Local lh_Popup, lh_Wnd
With ThisForm
If ( .IsBound ) and !IsNull( .oMenu ) and ;
(upper( .oMenu.cMenuName ) != '_MSYSMENU') and ( .lTopLevel )
UnBindEvents( .oMenu.hWndParent )
lh_Wnd = GetWindowLong( .hWnd, GW_CHILD )
else
lh_Wnd = .hWnd
endif
EndWith
set proc to locfile("popupmenu.prg") addi
lo_Popup = NewObject('PopupMenu') && , 'OwnerDrawn_Menu', '', 1024 )
release proc "popupmenu"
With lo_Popup
If ( ThisForm.IsBound ) or (VarType( po_Menu ) == 'O')
.lClearDLL = .F.
else
.lClearDLL = .T.
endif
if thisform.check1.value=1
.ytrans=.t.
else
.ytrans=.f.
endi
.hWndParent = lh_Wnd
.lUseGradient = ThisForm.chkGradLeft.Value
.nHiliteStyle = ThisForm.nStyle
.lEnhancedHilite = ThisForm.chkEnhanced.Value
.lHiliteUseFontBold = ThisForm.chkBold.Value
.lGlassy = ThisForm.chkGlassy.Value
.lThemed = ThisForm.chkOffice2003.Value
If (VarType( po_Menu ) == 'O')
.nTextHiliteColor = po_Menu.nTextHiliteColor
endif
ln_Color = iif( tl_UseSystemColor, GetSysColor( tn_LeftColor ), tn_LeftColor )
If (VarType( tn_LeftColor ) == 'N')
.SetLeftColor( ln_Color )
endif
If ( tl_UseRightColor )
.SetRightColor( .GetBrightColor( ln_Color, 112 ), .F. )
endif
.CreatePopupItem( 6 )
.aPopupItem[1] = '1.Open Document'
.aPopupItem[2] = '2.Testing Sub Popup '
.aPopupItem[3] = '3.Help'
.aPopupItem[4] = '4.Open Document'
.aPopupItem[5] = '5.Testing Sub Popup '
.aPopupItem[6] = '6.Help'
.aPopupBmp[1] = home(4) + 'Bitmaps\Outline\Redmask\Doc.BMP'
.aPopupBmp[4] = home(4) + 'Bitmaps\Outline\Redmask\Hlp.BMP'
lh_Popup = .CreatePopup( FIRST_ITEMID )
.CreatePopupItem( 6 )
.aPopupItem[1] = 'Sub Popup 1'
.aPopupItem[2] = 'Sub Popup 2'
.aPopupItem[3] = 'Sub Popup 3'
.aPopupItem[4] = 'Sub Popup 4'
.aPopupItem[5] = 'Sub Popup 5'
.aPopupItem[6] = 'Sub Popup 6'
.aPopupBmp[1] = home(4) + 'Bitmaps\Outline\Redmask\Doc.BMP'
.aPopupBmp[2] = home(4) + 'Bitmaps\Outline\Redmask\Hlp.BMP'
.aPopupBmp[3] = home(4) + 'Bitmaps\Outline\Redmask\Explorer.BMP'
.aPopupBmp[4] = home(4) + 'Bitmaps\Outline\Redmask\Doc.BMP'
.aPopupBmp[5] = home(4) + 'Bitmaps\Outline\Redmask\Hlp.BMP'
.aPopupBmp[6] = home(4) + 'Bitmaps\Outline\Redmask\Explorer.BMP'
.CreatePopup( FIRST_SUBITEMID, 2 )
.SetSubPopup( lh_Popup, 2, 2 )
.DisablePopupItem( 2, 1 )
.DisablePopupItem( 2, 2 )
.nFirstId = FIRST_ITEMID
If (VarType( to_Reff ) == 'O')
ln_Result = .ActivatePopup( to_Reff, 1 )
else
ln_Result = .ActivatePopup()
endif
EndWith
lo_Popup = Null
With ThisForm
If ( .IsBound ) and !IsNull( .oMenu ) and ;
(upper( .oMenu.cMenuName ) != '_MSYSMENU') and ( .lTopLevel )
.oMenu.BindMessages()
endif
EndWith
Return ln_Result
ENDPROC
PROCEDURE sethilitestyle
Local ln_Style
With This
ln_Style = 0
If ( .chkRounded.Value )
ln_Style = ln_Style + ODHS_ROUNDED
endif
If ( .chkBmpOnly.Value )
ln_Style = ln_Style + ODHS_BITMAPONLY
endif
If ( .chkRoundedOnBmp.Value )
ln_Style = ln_Style + ODHS_ROUNDED_BITMAP
endif
.nStyle = ln_Style
EndWith
If (VarType( po_Menu ) == 'O')
po_Menu.nHiliteStyle = ln_Style
else
If !IsNull( ThisForm.oMenu )
ThisForm.oMenu.nHiliteStyle = ln_Style
endif
endif
ENDPROC
PROCEDURE Load
ThisForm.lTopLevel = ((ThisForm.ShowWindow == VFP_SW_ASTOPLEVEL) or ThisForm.Desktop)
If ( ThisForm.lTopLevel ) and (VarType( po_Menu ) == 'O')
MessageBox( 'This sample form is a Top-Level / Desktop' + CR + ;
'and should not be call from MainMenu', ;
MB_ICONINFORMATION, ' *** ATTENTION ***', 10000 )
Return .F.
endif
ENDPROC
PROCEDURE MouseUp
LPARAMETERS nButton, nShift, nXCoord, nYCoord
Local ln_AreaHeight
With This
ln_AreaHeight = (.Height / 2)
.nArea = iif( nYCoord <= ln_AreaHeight, 1, 0 )
EndWith
ENDPROC
PROCEDURE RightClick
Local ln_Result
With ThisForm
If (.nArea == 1)
ln_Result = .ShowPopup( COLOR_3DDKSHADOW, .T. )
else
ln_Result = .ShowPopup()
endif
EndWith
If (ln_Result != 0)
Wait 'Selected Id: ' + transform( ln_Result ) window nowait
endif
ENDPROC
PROCEDURE Unload
If (VarType( po_Menu ) == 'U')
Clear Dlls
Clear class PopupMenu
Release popup all
endif
ENDPROC
PROCEDURE KeyPress
LPARAMETERS nKeyCode, nShiftAltCtrl
If (nKeyCode == VK_ESCAPE)
ThisForm.Release()
endif
ENDPROC
PROCEDURE Destroy
With ThisForm
If ( .IsBound )
If !IsNull( .oMenu )
UnBindEvents( .oMenu.hWndParent )
.oMenu = Null
If !((ThisForm.ShowWindow == VFP_SW_ASTOPLEVEL) or ThisForm.Desktop)
Set SysMenu to default
endif
endif
endif
EndWith
clea events
ENDPROC
PROCEDURE label1.MouseUp
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.Parent.MouseUp( nButton, nShift, nXCoord, nYCoord )
ENDPROC
PROCEDURE label1.RightClick
This.Parent.RightClick()
ENDPROC
PROCEDURE cmdbind.Click
Local lh_Popup, lh_Popup2
Local ln_PopupIndex, ln_SubPopupIndex, ln_ItemPos
With ThisForm
set proc to locfile("popupmenu.prg") addi
.oMenu = NewObject('PopupMenu')
release proc "popupmenu"
.IsBound = .T.
With .oMenu
.Gdiplus_Start() && Initialize GDI+
If (upper( .cMenuName ) != '_MSYSMENU') and ( ThisForm.lTopLevel )
.hWndParent = ThisForm.hWnd
else
.hWndParent = _VFP.hWnd
endif
** Set menu properties
.lUseGradient = ThisForm.chkGradLeft.Value
****************
.ytrans=.t. &&ytransparency
.ntranspa=150 &&can adapt here 80-255
***************
.lUseGradientPad = ThisForm.chkGradPad.Value
.lFullRectLine = .F.
.lThemed = ThisForm.chkOffice2003.Value
.nHiliteStyle = ThisForm.nStyle
.lEnhancedHilite = ThisForm.chkEnhanced.Value
.lGlassy = ThisForm.chkGlassy.Value
* .SetLeftColor( .GetBrightColor( GetSysColor( COLOR_ACTIVECAPTION ), 12 ))
.SetRightColor( GetSysColor( COLOR_WINDOW ), .F. )
* .SetRightColor( GetSysColor( COLOR_MENU ), .T. )
.oParent = ThisForm
** Create Main Menu Pad
Dimension .aMenuPad[ 2, 2 ]
.aMenuPad[ 1, 1 ] = 'MyMenu \<1'
.aMenuPad[ 1, 2 ] = '1' && Key is Alt+1
.aMenuPad[ 2, 1 ] = 'MyMenu \<2'
.aMenuPad[ 2, 2 ] = '2' && Key is Alt+2
If ( ThisForm.lTopLevel )
.cMenuName = 'myODMenu'
ThisForm.Height = ThisForm.Height + SysMetric( 20 )
.CreatePad( .cMenuName, ThisForm )
ThisForm.Closable = .F.
else
.CreatePad()
endif
** Popup Index = 1
.CreatePopupItem( 3 )
.aPopupItem[1] = 'Disable &this item'
.aPopupItem[2] = '&Enable first item'
.aPopupItem[3] = 'Testing Menu #&3'
.aPopupBmp[1] = home(4) + 'Bitmaps\Outline\Redmask\Doc.BMP'
ln_PopupIndex = 1
ln_ItemPos = 2
.CreatePopup( 1001, ln_PopupIndex )
.DisablePopupItem( ln_PopupIndex, ln_ItemPos )
** Popup Index = 2
.CreatePopupItem( 6 )
.aPopupItem[1] = 'Open Document'
.aPopupItem[2] = 'Testing Menu'
.aPopupItem[3] = 'SubPopup #1 '
.aPopupItem[5] = 'Help'
.aPopupItem[6] = 'SubPopup #2 '
.aPopupBmp[1] = home(4) + 'Bitmaps\Outline\Redmask\Doc.BMP'
.aPopupBmp[5] = home(4) + 'Bitmaps\Outline\Redmask\Hlp.BMP'
lh_Popup = .CreatePopup( 2001, 2 )
.DisablePopupItem( 2, 6 )
** Popup Index = 3 (Sub popup)
.CreatePopupItem( 5 )
.aPopupItem[1] = 'SubPopup #1 - 1'
.aPopupItem[2] = 'SubPopup #1 - 2'
.aPopupItem[3] = 'SubPopup #1 - 3'
.aPopupItem[5] = 'SubPopup 2nd level '
ln_SubPopupIndex = 3
ln_ItemPos = 3 && Parent Popup item position to be modify
lh_Popup2 = .CreatePopup( 2201, ln_SubPopupIndex )
.SetSubPopup( lh_Popup, ln_ItemPos, ln_SubPopupIndex )
** Popup Index = 4 (Sub popup)
.CreatePopupItem( 3 )
.aPopupItem[1] = 'SubPopup #2 - 1'
.aPopupItem[2] = 'SubPopup #2 - 2'
.aPopupItem[3] = 'SubPopup #2 - 3'
ln_SubPopupIndex = 4
ln_ItemPos = 6
.CreatePopup( 2401, ln_SubPopupIndex )
.SetSubPopup( lh_Popup, ln_ItemPos, ln_SubPopupIndex )
** Popup Index = 5 (Sub popup 2nd level)
.CreatePopupItem( 3 )
.aPopupItem[1] = 'SubPopup 2nd level #1 - 1'
.aPopupItem[2] = 'SubPopup 2nd level #1 - 2'
.aPopupItem[3] = 'SubPopup 2nd level #1 - 3'
.CreatePopup( 2221, 5 )
.SetSubPopup( lh_Popup2, 5, 5 )
** Set Submenu to MainMenu
.SetSubmenu( 1, 1 )
.SetSubmenu( 2, 2 )
.BindMessages()
If ThisForm.chkBarColor.Value
.SetMenuBarColor( .GetBrightColor( GetSysColor( COLOR_ACTIVECAPTION ), 108 ))
If ( ThisForm.lTopLevel )
.DisableMainMenu()
.EnableMainMenu()
endif
endif
Activate menu (.cMenuName) nowait && refresh menubar
EndWith
Store .T. to .cmdUnBind.Enabled, .chkBarColor.Enabled, .lblBarColor.Enabled, ;
.chkGradPad.Enabled, .lblGradPad.Enabled
EndWith
This.Enabled = .F.
ENDPROC
PROCEDURE cmdbind.Init
This.Visible = (VarType( po_Menu ) == 'U')
ENDPROC
PROCEDURE cmdunbind.Init
This.Visible = (VarType( po_Menu ) == 'U')
ENDPROC
PROCEDURE cmdunbind.Click
With ThisForm
If !IsNull( .oMenu )
UnBindEvents( .oMenu.hWndParent )
.oMenu = Null
If (.ShowWindow == VFP_SW_ASTOPLEVEL) or ( .Desktop )
.Height = .Height - SysMetric( 20 )
.Closable = .T.
else
Set SysMenu to default
endif
.IsBound = .F.
endif
.cmdBind.Enabled = .T.
Store .F. to .chkBarColor.Enabled, .lblBarColor.Enabled, ;
.chkGradPad.Enabled, .lblGradPad.Enabled
EndWith
This.Enabled = .F.
ENDPROC
PROCEDURE label2.MouseUp
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.Parent.MouseUp( nButton, nShift, nXCoord, nYCoord )
ENDPROC
PROCEDURE label2.RightClick
This.Parent.RightClick()
ENDPROC
PROCEDURE command1.Click
Local ln_Result
ln_Result = ThisForm.ShowPopup( 0x478F7B, .F., This )
If (ln_Result != 0)
Wait 'Selected Id: ' + transform( ln_Result ) window nowait
endif
ENDPROC
PROCEDURE chkgradpad.Valid
With This
.Caption = iif( .Value, 'YES', 'NO' )
If (VarType( po_Menu ) == 'O')
po_Menu.lUseGradientPad = .Value
else
If !IsNull( ThisForm.oMenu )
ThisForm.oMenu.lUseGradientPad = .Value
endif
endif
EndWith
ENDPROC
PROCEDURE chkgradpad.Init
With This
.Enabled = (VarType( po_Menu ) == 'O')
If ( .Enabled )
.Value = po_Menu.lUseGradientPad
.Caption = iif( .Value, 'YES', 'NO' )
endif
EndWith
ENDPROC
PROCEDURE lblgradpad.Init
This.Enabled = (VarType( po_Menu ) == 'O')
ENDPROC
PROCEDURE chkbarcolor.Valid
This.Caption = iif( This.Value, 'YES', 'NO' )
If (VarType( po_Menu ) == 'O')
With po_Menu
If This.Value
.SetMenuBarColor( .GetBrightColor( GetSysColor( COLOR_ACTIVECAPTION ), 108 ))
else
.SetMenuBarColor( -1 ) && reset menubar color
endif
EndWith
else
With ThisForm
If !IsNull( .oMenu )
With .oMenu
If This.Value
.SetMenuBarColor( .GetBrightColor( GetSysColor( COLOR_ACTIVECAPTION ), 108 ))
else
.SetMenuBarColor( -1 ) && reset menubar color
endif
EndWith
endif
EndWith
endif
ENDPROC
PROCEDURE chkbarcolor.Init
With This
.Enabled = (VarType( po_Menu ) == 'O')
If ( .Enabled )
.Value = (po_Menu.nBarColor != -1)
.Caption = iif( .Value, 'YES', 'NO' )
endif
EndWith
ENDPROC
PROCEDURE lblbarcolor.Init
This.Enabled = (VarType( po_Menu ) == 'O')
ENDPROC
PROCEDURE chkrounded.Valid
This.Caption = iif( This.Value, 'YES', 'NO' )
ThisForm.SetHiliteStyle()
ENDPROC
PROCEDURE chkrounded.Init
If (VarType( po_Menu ) == 'O')
ThisForm.nStyle = po_Menu.nHiliteStyle
With This
.Value = (BitAnd( po_Menu.nHiliteStyle, ODHS_ROUNDED ) != 0)
.Caption = iif( .Value, 'YES', 'NO' )
EndWith
endif
ENDPROC
PROCEDURE chkbmponly.Valid
This.Caption = iif( This.Value, 'YES', 'NO' )
ThisForm.SetHiliteStyle()
ENDPROC
PROCEDURE chkbmponly.Init
If (VarType( po_Menu ) == 'O')
With This
.Value = (BitAnd( po_Menu.nHiliteStyle, ODHS_BITMAPONLY ) != 0)
.Caption = iif( .Value, 'YES', 'NO' )
EndWith
endif
ENDPROC
PROCEDURE chkroundedonbmp.Valid
This.Caption = iif( This.Value, 'YES', 'NO' )
ThisForm.SetHiliteStyle()
ENDPROC
PROCEDURE chkroundedonbmp.Init
If (VarType( po_Menu ) == 'O')
With This
.Value = (BitAnd( po_Menu.nHiliteStyle, ODHS_ROUNDED_BITMAP ) != 0)
.Caption = iif( .Value, 'YES', 'NO' )
EndWith
endif
ENDPROC
PROCEDURE chkoffice2003.Init
If (VarType( po_Menu ) == 'O')
With This
.Value = po_Menu.lThemed
.Caption = iif( .Value, 'YES', 'NO' )
EndWith
endif
ENDPROC
PROCEDURE chkoffice2003.Valid
With This
.Caption = iif( .Value, 'YES', 'NO' )
If (VarType( po_Menu ) == 'O')
po_Menu.lThemed = .Value
else
If !IsNull( ThisForm.oMenu )
ThisForm.oMenu.lThemed = .Value
endif
endif
EndWith
ENDPROC
PROCEDURE chkgradleft.Valid
With This
.Caption = iif( .Value, 'YES', 'NO' )
If (VarType( po_Menu ) == 'O')
po_Menu.lUseGradient = .Value
else
If !IsNull( ThisForm.oMenu )
ThisForm.oMenu.lUseGradient = .Value
endif
endif
EndWith
ENDPROC
PROCEDURE chkgradleft.Init
If (VarType( po_Menu ) == 'O')
With This
.Value = po_Menu.lUseGradient
.Caption = iif( .Value, 'YES', 'NO' )
EndWith
endif
ENDPROC
PROCEDURE chkenhanced.Valid
With This
.Caption = iif( .Value, 'YES', 'NO' )
Do case
Case (VarType( po_Menu ) == 'O')
po_Menu.lEnhancedHilite = .Value
Case (VarType( ThisForm.oMenu ) == 'O')
ThisForm.oMenu.lEnhancedHilite = .Value
EndCase
EndWith
ENDPROC
PROCEDURE chkenhanced.Init
If (VarType( po_Menu ) == 'O')
With This
.Value = po_Menu.lEnhancedHilite
.Caption = iif( .Value, 'YES', 'NO' )
EndWith
endif
ENDPROC
PROCEDURE chkglassy.Init
If (VarType( po_Menu ) == 'O')
With This
.Value = po_Menu.lGlassy
.Caption = iif( .Value, 'YES', 'NO' )
EndWith
endif
ENDPROC
PROCEDURE chkglassy.Valid
With This
.Caption = iif( .Value, 'YES', 'NO' )
Do case
Case (VarType( po_Menu ) == 'O')
po_Menu.lGlassy = .Value
Case (VarType( ThisForm.oMenu ) == 'O')
ThisForm.oMenu.lGlassy = .Value
EndCase
EndWith
ENDPROC
PROCEDURE chkbold.Init
If (VarType( po_Menu ) == 'O')
With This
.Value = po_Menu.lHiliteUseFontBold
.Caption = iif( .Value, 'YES', 'NO' )
EndWith
endif
ENDPROC
PROCEDURE chkbold.Valid
With This
.Caption = iif( .Value, 'YES', 'NO' )
Do case
Case (VarType( po_Menu ) == 'O')
po_Menu.lHiliteUseFontBold = .Value
Case (VarType( ThisForm.oMenu ) == 'O')
ThisForm.oMenu.lHiliteUseFontBold = .Value
EndCase
EndWith
ENDPROC
PROCEDURE check1.InteractiveChange
try
thisform.omenu.ytrans=! thisform.omenu.ytrans
catch
endtry
ENDPROC
ENDDEFINE
*
*-- EndDefine: asup
*encode
Download this image and save as "ciel1.jpg" .its used in the 2 codes above as background.
can download the zip-run the yownerdrawn0.prg ,yownerdrawn1.prg
Some related links
http://www.codeproject.com/Articles/7073/How-to-create-owner-drawn-menus-Step-by-Step
http://www.codeproject.com/Articles/8715/Owner-drawn-menus-in-two-lines-of-code