VFP 愛用者社區

[sheuok]

請教如何改變 SYSMENU 的顏色? 謝謝!

[sheuok]

或許可用以下的Api設定,如已知答案的請不吝告知,謝謝!
Declare Integer GetActiveWindow In Win32API
Declare Integer GetMenu In user32 Integer HWnd
Declare Integer SetMenuInfo In user32 Integer hmenu, MENUINFO @mi
Declare Integer GetMenuInfo In user32 Integer hmenu, MENUINFO @mi
*Private Type MENUINFO
* cbSize As Long
* fMask As Long
* dwStyle As Long
* cyMax As Long
* hbrBack As Long
* dwContextHelpID As Long
* dwMenuData As Long
*End Type
uc_hwnd=getactivewindow() &&Thisform.HWnd
uc_menuh=getmenu(uc_hwnd) &&-取得Menu的Handle


尚在研究 MENUINFO 的資料結構中.....

[sheuok]

以下為修改VFP的_msysmenu的背景色所寫的測試程序,但會有Bug
請狐友能提供意見!,謝謝大家!

Public frm
frm = Createobject(”Tform”)
frm.Visible = .T.
Define Class tform As Form
Protected hwindow, hmenu, hpopup, hsyspopup
AutoCenter=.T.
ShowWindow=2 ＆＆ this is important
Add Object cmd As cmd1 With Caption=”執行”,Left=100, Top=100,Width=80,Height=40
Procedure Load
This.Declare
Procedure Init
Store 0 To This.hwindow, This.hmenu,；
THIS.hpopup, This.hsyspopup
Procedure Destroy
* DestroyMenu is recursive, which means
* it destroys the menu including all submenus
= destroymenu(This.hmenu)
Procedure Activate
If This.hwindow = 0
This.initmenu()
Endif
Procedure initmenu
#Define mf_string 0
This.hwindow = getfocus()
This.hsyspopup = getsystemmenu(This.hwindow, 0)
This.hpopup = createmenu()
= appendmenu(This.hpopup, mf_string, 1, ”Option ＆1”)
= appendmenu(This.hpopup, mf_string, 1, ”Option ＆2”)
= appendmenu(This.hpopup, mf_string, 1, ”Option ＆3”)
This.hmenu = createmenu()
This.addmenuitem(This.hmenu, 0, ”＆Form”, This.hpopup)
This.addmenuitem(This.hmenu, 1, ”＆System”, This.hsyspopup)
= setmenu(This.hwindow, This.hmenu)
Procedure addmenuitem(hmenu, lnposition, lccaption, lnpopup)
*| typedef struct tagMENUITEMINFO {
*| UINT cbSize； 0:4
*| UINT fMask； 4:4
*| UINT fType； 8:4
*| UINT fState； 12:4
*| UINT wID； 16:4
*| HMENU hSubMenu； 20:4
*| HBITMAP hbmpChecked； 24:4
*| HBITMAP hbmpUnchecked； 28:4
*| ULONG_PTR dwItemData； 32:4
*| LPTSTR dwTypeData； 36:4
*| UINT cch； 40:4
*| HBITMAP hbmpItem； 44:4
*| } MENUITEMINFO, *LPMENUITEMINFO； total = 48 bytes
#Define menuiteminfo_size 48
#Define mft_string 0
#Define miim_state 1
#Define miim_id 2
#Define miim_submenu 4
#Define miim_type 16
#Define mfs_enabled 0
Local lcmask, lciteminfo, locaption
locaption = Createobject(”PChar”, lccaption)
lcmask = miim_state + miim_id + miim_type + miim_submenu
* fill MENUITEMINFO structure
lciteminfo =；
num2dword(menuiteminfo_size) +；
num2dword(lcmask) +；
num2dword(mft_string) +；
num2dword(mfs_enabled) +；
num2dword(lnposition) +；
num2dword(lnpopup) +；
num2dword(0) +；
num2dword(0) +；
num2dword(0) +；
num2dword(locaption.getaddr()) +；
num2dword(Len(lccaption)) +；
num2dword(0)
= insertmenuitem(hmenu, lnposition, 1, @lciteminfo)
Return
Procedure Declare
Declare Integer GetFocus In user32
Declare Integer CreateMenu In user32
Declare Integer CreatePopupMenu In user32
Declare Integer DestroyMenu In user32 Integer hMenu
Declare Integer SetMenu In user32；
INTEGER hWindow, Integer hMenu
Declare Integer GetSystemMenu In user32；
INTEGER hWindow, Integer bRevert
Declare Integer AppendMenu In user32；
INTEGER hMenu, Integer uFlags,；
INTEGER uIDNewItem, String @lpNewItem
Declare Integer InsertMenuItem In user32；
INTEGER hMenu, Integer uItem,；
INTEGER fByPosition, String @lpmii
Enddefine
Define Class pchar As Session
Protected Hmem
Procedure Init(lcstring)
This.Hmem = 0
This.setvalue(lcstring)
Procedure Destroy
This.releasestring
Function getaddr
Return This.Hmem
Function getvalue
Local lnsize, lcbuffer
lnsize = This.getallocsize()
lcbuffer = Space(lnsize)
If This.Hmem <> 0
Declare RtlMoveMemory In kernel32 As MemToStr；
STRING @, Integer, Integer
= memtostr(@lcbuffer, This.Hmem, lnsize)
Endif
Return lcbuffer
Function getallocsize
Declare Integer GlobalSize In kernel32 Integer Hmem
Return Iif(This.Hmem=0, 0, globalsize(This.Hmem))
Procedure setvalue(lcstring)
#Define gmem_fixed 0
This.releasestring
Declare Integer GlobalAlloc In kernel32 Integer, Integer
Declare RtlMoveMemory In kernel32 As StrToMem；
INTEGER, String @, Integer
Local lnsize
lcstring = lcstring + Chr(0)
lnsize = Len(lcstring)
This.Hmem = globalalloc(gmem_fixed, lnsize)
If This.Hmem <> 0
= strtomem(This.Hmem, @lcstring, lnsize)
Endif
Procedure releasestring
If This.Hmem <> 0
Declare Integer GlobalFree In kernel32 Integer
= globalfree (This.Hmem)
This.Hmem = 0
Endif
Enddefine
Define Class cmd1 As CommandButton ＆＆-按此按鈕改變_msysmenu的背景色
Procedure Click
Declare Integer GetActiveWindow In Win32API
Declare Integer GetMenu In user32 Integer HWnd
Declare Integer GetSystemMenu In user32 Integer HWnd ,Integer @bRevert
Declare Integer CreateSolidBrush In gdi32 Integer crColor
Declare Integer DrawMenuBar In user32 Integer HWnd
Declare Integer SetMenuInfo In user32 Integer hmenu, MENUINFO @mi
Declare Integer GetMenuInfo In user32 Integer hmenu, MENUINFO @mi
Declare Integer CreateSolidBrush In gdi32 Long crColor
*menuinfo_styles
mns_nocheck = 0x80000000
mns_modeless = 0x40000000
mns_dragdrop = 0x20000000
mns_autodismiss = 0x10000000
mns_notifybypos = 0x8000000
mns_checkorbmp =0x4000000

mim_maxheight = 0x1
mim_background = 0x2
mim_helpid = 0x4
mim_menudata = 0x8
mim_style = 0x10
mim_applytosubmenus = 0x80000000

****
*Private Type MENUINFO
* cbSize As Long
* fMask As Long
* dwStyle As Long
* cyMax As Long
* hbrBack As Long
* dwContextHelpID As Long
* dwMenuData As Long
*End Type
uc_hwnd=_vfp.HWnd ＆＆getactivewindow() ＆＆Thisform.HWnd
uc_menuh=getmenu(uc_hwnd)
**顯示各類型的hwnd及menuhandle的值
Messagebox(Padl(”Thisform.hwnd=”,20,” ”)+Ltrim(Str(getactivewindow()))+Chr(13)+Padl(”_Screen.hwnd=”,20,” ”)+Ltrim(Str(_Screen.HWnd))+Chr(13)+Padl(”_Vfp.hwnd=”,20,” ”)+Ltrim(Str(_vfp.HWnd))+Chr(13)+Chr(13)+Padl(”Thisform.menuh=”,20,” ”)+Ltrim(Str(getmenu(Thisform.HWnd)))+Chr(13)+Padl(”_Screen.menuh=”,20,” ”)+Ltrim(Str(getmenu(_Screen.HWnd)))+Chr(13)+Padl(”_Vfp.menuh=”,20,” ”)+Ltrim(Str(getmenu(_vfp.HWnd))))
uc_len=28
uc_fmask=mim_background+mim_applytosubmenus
uc_dwstyle=mns_autodismiss
uc_cymax=0 ＆＆-此值如何設定?
uc_hbrback=createsolidbrush(Rgb(128,110,120))
uc_dwcontexthelpid=0 ＆＆-此值如何設定?
uc_dwmenudata=0 ＆＆-此值如何設定?
menuinfo=num2dword(uc_len)+num2dword(uc_fmask)+num2dword(uc_dwstyle) ;
+num2dword(uc_cymax)+num2dword(uc_hbrback)+num2dword(uc_dwcontexthelpid)+num2dword(uc_dwmenudata)
=setmenuinfo(uc_menuh,@menuinfo) ＆＆-此行會出現Bug但原因?
Enddefine

Function num2dword(lnvalue)
#Define m0 0x0000100
#Define m1 0x0010000
#Define m2 0x1000000
If lnvalue < 0
lnvalue = 0x100000000 + lnvalue
Endif
Local b0, b1, b2, b3
b3 = Int(lnvalue/m2)
b2 = Int((lnvalue - b3*m2)/m1)
b1 = Int((lnvalue - b3*m2 - b2*m1)/m0)
b0 = Mod(lnvalue, m0)
Return Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)

[sheuok]

以下為VB修改Menu背景色的範例(用VB6測試OK)

請先自行在Form中先用 [功能表編輯器] 建立一個 Menu

Private Enum MENUINFO_STYLES
MNS_NOCHECK = ＆H80000000
MNS_MODELESS = ＆H40000000
MNS_DRAGDROP = ＆H20000000
MNS_AUTODISMISS = ＆H10000000
MNS_NOTIFYBYPOS = ＆H8000000
MNS_CHECKORBMP = ＆H4000000
End Enum

Private Enum MENUINFO_MASKS
MIM_MAXHEIGHT = ＆H1
MIM_BACKGROUND = ＆H2
MIM_HELPID = ＆H4
MIM_MENUDATA = ＆H8
MIM_STYLE = ＆H10
MIM_APPLYTOSUBMENUS = ＆H80000000
End Enum

Private Type MENUINFO
cbSize As Long
fMask As MENUINFO_MASKS
dwStyle As MENUINFO_STYLES
cyMax As Long
hbrBack As Long
dwContextHelpID As Long
dwMenuData As Long
End Type

Private Declare Function GetMenuInfo Lib ”user32” (ByVal hMenu As Long, mi As MENUINFO) As Long
Private Declare Function SetMenuInfo Lib ”user32” (ByVal hMenu As Long, mi As MENUINFO) As Long
Private Declare Function GetMenu Lib ”user32” (ByVal hwnd As Long) As Long
Private Declare Function CreateSolidBrush Lib ”gdi32” (ByVal crColor As Long) As Long

Private Sub Form_Load()
Dim MyMenu As MENUINFO
MyMenu.cbSize = Len(MyMenu)
MyMenu.fMask = MIM_BACKGROUND Or MIM_APPLYTOSUBMENUS
MyMenu.hbrBack = CreateSolidBrush(vbRed)
SetMenuInfo GetMenu(Me.hwnd), MyMenu
End Sub

[sheuok]

可修改VFP的_Msysmenu的背景顏色的程序(已完成!需要的狐友請取用!)

Declare Integer GetMenu In user32 Integer HWnd
Declare Integer CreateSolidBrush In gdi32 Integer crColor
Declare Integer DrawMenuBar In user32 Integer HWnd
Declare Integer SetMenuInfo In user32 Integer hmenu, string @mi
Declare Integer CreateSolidBrush In gdi32 Long crColor
****
*menuinfo_styles
mns_nocheck = 0x80000000
mns_modeless = 0x40000000
mns_dragdrop = 0x20000000
mns_autodismiss = 0x10000000
mns_notifybypos = 0x8000000
mns_checkorbmp =0x4000000

mim_maxheight = 0x1
mim_background = 0x2
mim_helpid = 0x4
mim_menudata = 0x8
mim_style = 0x10
mim_applytosubmenus = 0x80000000
****
*Private Type MENUINFO
* cbSize As Long
* fMask As Long
* dwStyle As Long
* cyMax As Long
* hbrBack As Long
* dwContextHelpID As Long
* dwMenuData As Long
*End Type
uc_hwnd=_vfp.HWnd
uc_menuh=getmenu(uc_hwnd)
*Messagebox(Padl("Thisform.hwnd=",20," ")+Ltrim(Str(getactivewindow()))+Chr(13)+Padl("_Screen.hwnd=",20," ")+Ltrim(Str(_Screen.HWnd))+Chr(13)+Padl("_Vfp.hwnd=",20," ")+Ltrim(Str(_vfp.HWnd))+Chr(13)+Chr(13)+Padl("Thisform.menuh=",20," ")+Ltrim(Str(getmenu(Thisform.HWnd)))+Chr(13)+Padl("_Screen.menuh=",20," ")+Ltrim(Str(getmenu(_Screen.HWnd)))+Chr(13)+Padl("_Vfp.menuh=",20," ")+Ltrim(Str(uc_menuh)))
uc_fmask=mim_background &&+mim_applytosubmenus
uc_dwstyle=mns_nocheck
uc_cymax=0
uc_hbrback=createsolidbrush(Rgb(255,0,0)) &&-此行為背景色的設定
uc_dwcontexthelpid=0
uc_dwmenudata=0
uc_len=28
menuinfo=num2dword(uc_len)+num2dword(uc_fmask)+num2dword(uc_dwstyle)+num2dword(uc_cymax)+num2dword(uc_hbrback)+num2dword(uc_dwcontexthelpid)+num2dword(uc_dwmenudata)
=setmenuinfo(uc_menuh,@menuinfo)
=drawmenubar(uc_hwnd)