Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Shortcut menu style
Message
De
08/07/2005 00:16:41
 
 
À
06/07/2005 08:26:04
Information générale
Forum:
Visual FoxPro
Catégorie:
Gestionnaire de menu & Menus
Versions des environnements
Visual FoxPro:
VFP 9
OS:
Windows XP SP2
Divers
Thread ID:
01028608
Message ID:
01030264
Vues:
19
Thanks Herman. I have copied the code and will examine this weekend.

The reason I'm interested id that I too am trying to imitate the win2003 effects with menu's in VFP with just purt vfp code. At the moment I can create simple menu's and popups in win2003 style - you know with th eblue bar on the left and bitmaps and orangeish highlights.

I have sampled Command Bars and that stuff is great. I just want to do it my way and in pure VFP.

>Hi Bernard
>
>>Great work Herman. And all that in pure VFP code?
>>
>
>Thanks :)
>Yes. The "VFP9_OwnerDraw.jpg" is 100% VFP code
>
>
>>How about an article as Malcolm suggests or some code samples?
>>
>
>I don't know how to start, and this will be a long one. Right now it's about 1300 lines of code (including spaces & comments). It's not even finish yet, still lack many features.
>My problem is, sometimes I know what I wanted to say but I don't know what to write/describe in English.
>
>I can't give you the whole sample because it must be working altogether. But I'll show you a small part of the basic things.
>
>
>*** The caller for PopupMenu (RightClick event)
>Local array la_PopItem[6]
>Local lo_Popup as PopupMenu of OwnerDrawn_Menu
>Local ln_Result
>
>la_PopItem[1] = 'Testing Menu #&1'
>la_PopItem[2] = 'Testing Menu #&2'
>la_PopItem[3] = ''
>la_PopItem[4] = 'Testing Menu #&3'
>la_PopItem[5] = 'Testing Menu #&4'
>la_PopItem[6] = 'Testing Menu #&5'
>
>lo_Popup = NewObject( 'PopupMenu', 'OwnerDrawn_Menu' )
>With lo_Popup
>   .lClearDLL = .F.
>   .hWndParent = _VFP.hWnd
>   .CreatePopup( @la_PopItem, 11 )  && first PopupId = 11
>   Store .T. to .lUseGradient, .lUseGradientHilite
>   Store !This.IsBound to .lBind, .lUnBind
>   ln_Result = .ActivatePopup()
>
>   If (ln_Result != 0)
>     ** Popup selected, do the process...
>   endif
>   .oPopTimer = Null
>EndWith
>lo_Popup = Null
>
>***********************
>
>*** Part of ActivatePopup method - PopupMenu class of OwnerDrawn_Menu
>Local ls_Point, ln_X, ln_Y, ln_Return
>
>ls_Point = replicate( c0, POINT_Size )
>GetCursorPos( @ls_Point )
>With This
>   ln_X = .Buff2Num( ls_Point, 1 )
>   ln_Y = .Buff2Num( ls_Point, 5 )
>
>   If .lBind
>      BindEvent( .hWndParent, WM_MEASUREITEM, This, 'PopWndProc' )
>      BindEvent( .hWndParent, WM_DRAWITEM, This, 'PopWndProc' )
>      BindEvent( .hWndParent, WM_INITMENUPOPUP, This, 'PopWndProc' )
>      BindEvent( .hWndParent, WM_UNINITMENUPOPUP, This, 'PopWndProc' )
>      ** Bind to more messages
>   endif
>
>   .nMenuPos = -1  && No menu pos for shortcut menu
>   .nOrgProc = GetWindowLong( .hWndParent, GWL_WNDPROC )
>   ln_Return = TrackPopupMenu( .hPopMenu[1], ;
>      TPM_LEFTALIGN + TPM_TOPALIGN + TPM_RETURNCMD, ;
>      ln_X, ln_Y, 0, .hWndParent, 0 )
>
>   If (ln_Return != 0)
>      ln_Return = (ln_Return - .nFirstId) + 1
>   endif
>
>   If .lUnBind
>      UnBindEvents( .hWndParent )
>   endif
>EndWith
>
>Return ln_Return
>
>***********************
>
>*** Part of PopWndProc method - PopupMenu class of OwnerDrawn_Menu
>LParameters th_Wnd as Long, tn_Msg as Long, t_wParam as Long, t_lParam as Long
>
>Do case
>   Case (tn_Msg == WM_MEASUREITEM)
>      If (t_wParam == 0)   && sent by menu
>         This.OnMeasureMenuItem( th_Wnd, t_lParam )
>         Return .T.
>      endif
>
>   Case (tn_Msg == WM_DRAWITEM)
>      If (t_wParam == 0)   && sent by menu
>         This.OnDrawMenuItem( t_lParam )
>         Return .T.
>      endif
>
>   Case (tn_Msg == WM_INITMENUPOPUP)
>      This.OnInitMenuPopup( t_wParam, t_lParam )
>
>   Case (tn_Msg == WM_UNINITMENUPOPUP)
>      This.OnUnInitMenuPopup( t_wParam )
>
>   ** Case other messages
>EndCase
>
>Return CallWindowProc( This.nOrgProc, th_Wnd, tn_Msg, t_wParam, t_lParam )
>
>
>Regards
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform