*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
*--------------------------------------------------------------------------------------------------------------------------------------------------------
*< FOXBIN2PRG: Version="1.21" SourceFile="menutool.vcx" CPID="936" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
*
*
DEFINE CLASS _menuinfo AS custom && ²Ëµ¥À¸Ä¿¶ÔÏó
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
*
*p: ccommand && Ö´ÐÐÃüÁî
*p: cenabled && Enabled ±í´ïʽ
*p: ckey && µ±Ç°½Úµã Key
*p: cmessage && ²Ëµ¥ÌáʾÐÅÏ¢
*p: cparentkey && ¸¸Ç× Key£¬ÎÞÔòΪ ""
*p: cpicture && ²Ëµ¥ÏîͼƬ
*p: ctitle && ²Ëµ¥±êÌâ
*p: ctitle2 && ³ÌÐòʵ¼ÊʹÓÃµÄ Title
*p: hmenu && Èç¹ûÊÇÒ»¸ö×Ӳ˵¥£¬±£´æ×Ӳ˵¥µÄ¾ä±ú
*p: hmsk && ÑÚÂëµØÖ·
*p: hparent && ¸¸²Ëµ¥¾ä±ú
*p: hpic && ͼ±êµØÖ·
*p: lenabled && ±£´æ Evaluate(clEnabled) ״̬
*p: naddress && ²Ëµ¥À¸Ä¿µÄÄÚ´æµØÖ·
*p: nflags && ²Ëµ¥±ê¼Ç
*p: nheight && ÏîÄ¿¸ß¶È
*p: nindex && ÎïÀíË÷ÒýÏîÄ¿ºÅ
*p: nwidth && ÏîÄ¿¿í¶È
*p: orefmenu && Ö¸ÏòÁíÒ»¸öÔ¤¶¨Òå²Ëµ¥²Ëµ¥
*
*
ccommand =
cenabled =
ckey =
cmessage = .NULL.
cparentkey =
cpicture =
ctitle =
ctitle2 =
hmenu = 0
hmsk = 0
hparent = 0
hpic = 0
lenabled = .F.
naddress = 0
Name = "_menuinfo"
nflags = 0
nheight = 0
nindex = 0
nwidth = 0
orefmenu = .NULL.
Width = 17
*
ENDDEFINE
DEFINE CLASS iconcollection AS custom && ͼ±ê¾ä±úÊÕ¼¯
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
#INCLUDE "win32api.h"
*
*m: declare_dlls
*m: getimage && ·µ»ØÍ¼ÐÎÎļþÔÚÄÚ´æÖеľä±ú
*m: loadimage
*m: newimage && ж¨ÒåÒ»¸öͼÐÎÎļþÃû±ú
*
*
Name = "iconcollection"
Width = 17
*
PROCEDURE declare_dlls
Declare Long GetFileAttributes In "Kernel32" ;
String lpFileName
Declare Long LoadImage In "User32" ;
Long hInst, String lpszName, Long uType, ;
Long cxDesired, Long cyDesired, Long fuLoad
ENDPROC
PROCEDURE getimage && ·µ»ØÍ¼ÐÎÎļþÔÚÄÚ´æÖеľä±ú
LPARAMETERS tcImageFile
Private lnIndex
Local lnIndex
If Not PemStatus(This, "aIconCollection", 5) ;
Or Not PemStatus(This, "nIconCollection", 5)
This.AddProperty("aIconCollection[1, 2]")
This.aIconCollection[1, 1] = "" && ÎļþÃû
This.aIconCollection[1, 2] = 0 && ÄÚ´æ¾ä±ú
This.AddProperty("nIconCollection", 0)
EndIf
*-- µ¹Ðò
For lnIndex = This.nIconCollection To 1 Step -1
If This.aIconCollection[m.lnIndex, 1] == Upper(m.tcImageFile)
Return This.aIconCollection[m.lnIndex, 2]
EndIf
EndFor
Return 0
ENDPROC
PROCEDURE Init
If Not PemStatus(_Screen, This.Class, 5)
This.Declare_Dlls()
_Screen.AddProperty(This.Class, .T.)
EndIf
ENDPROC
PROCEDURE loadimage
LPARAMETERS tcPicture
Private lhImage, lcExt, lcString, llDelete
Local lhImage, lcExt, lcString, llDelete
If Vartype(m.tcPicture) <> "C" ;
Or Empty(m.tcPicture) ;
Or Not File(m.tcPicture)
Return 0
EndIf
*-- ¼ì²éÎļþÊÇ·ñ±»°üº¬½ø EXE ÎļþÖÐ
llDelete = .F.
If GetFileAttributes(m.tcPicture) = -1
lcFileVal = FileToStr(m.tcPicture)
tcPicture = Addbs(Sys(2023)) + JustFname(m.tcPicture)
StrToFile(m.lcFileVal, m.tcPicture)
If GetFileAttributes(m.tcPicture) = -1
Return 0
EndIf
llDelete = .T.
EndIf
lhImage = 0
lcExt = Upper(JustExt(m.tcPicture))
Do Case
Case m.lcExt == "BMP"
lhImage = This.GetImage(m.tcPicture)
If m.lhImage = 0
lhImage = LoadImage(0, m.tcPicture, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
This.NewImage(m.tcPicture, m.lhImage)
EndIf
Case m.lcExt == "MSK"
lhImage = This.GetImage(m.tcPicture)
If m.lhImage = 0
m.lhImage = LoadImage(0, m.tcPicture, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
This.NewImage(m.tcPicture, m.lhImage)
EndIf
Case m.lcExt == "ICO"
lhImage = This.GetImage(m.tcPicture)
If m.lhImage = 0
lhImage = LoadImage(0, m.tcPicture, IMAGE_ICON, 0, 0, LR_LOADFROMFILE)
This.NewImage(m.tcPicture, m.lhImage)
EndIf
Otherwise
*-- ´ý´¦Àí
EndCase
If m.llDelete
Erase (m.tcPicture)
EndIf
Return m.lhImage
ENDPROC
PROCEDURE newimage && ж¨ÒåÒ»¸öͼÐÎÎļþÃû±ú
LPARAMETERS tcImageFile, tnHandle
Private lnIndex
Local lnIndex
If Not PemStatus(This, "aIconCollection", 5) ;
Or Not PemStatus(This, "nIconCollection", 5)
This.AddProperty("aIconCollection[1, 2]")
This.aIconCollection[1, 1] = "" && ÎļþÃû
This.aIconCollection[1, 2] = 0 && ÄÚ´æ¾ä±ú
This.AddProperty("nIconCollection", 0)
EndIf
If m.tnHandle = 0
Return
EndIf
This.nIconCollection = Max(This.nIconCollection + 1, 1)
Dimension This.aIconCollection[This.nIconCollection, 2]
This.aIconCollection[This.nIconCollection, 1] = Upper(m.tcImageFile)
This.aIconCollection[This.nIconCollection, 2] = m.tnHandle
ENDPROC
ENDDEFINE
DEFINE CLASS popmenu AS custom && ÓO¼üµ_3ö²Ëµ¥
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
#INCLUDE "win32api.h"
*
*m: about && 1OÓÚ±_Aà
*m: add && Ií¼Ó²Ëµ¥Iî¡£LPARAMETERS tcParentKey, tcKey, tcTitle, tcCommand, tcPicture, tvEnabled, tnAddFlag
*m: additem && Ií¼Ó²Ëµ¥Iî: tnId, tcCaption, tcCommand, tlEnabled, tnAddFlag. 0x20 »»ÁD, 0x08 Check¡£
*m: bindevents
*m: b_drawmenuitem
*m: b_measuremenuitem
*m: b_menuchar
*m: callback_proc
*m: clear && Çå3ý×éºI¿ò»òÁD±í¿ò¿O¼_ÖDµÄÄÚEÝ¡£
*m: createcontext && ´´½¨ÓëÖ¸IòÁíO»¸ö²Ëµ¥Áª½Ó
*m: createmenus
*m: declare_dlls
*m: destroymenus && Iú»U²Ëµ¥
*m: drawgradualrect && Ö¸¶¨ÇoÓòºóÓAÖ¸¶¨ÑOÉ«»æÖÆ¡£¿Éѡˮƽ»ò´1Ö±¡£
*m: draw_bar && »²à±ßIo
*m: draw_image && »Í¼Iñ
*m: draw_selected && »æÖÆÑ¡¶¨
*m: draw_separator
*m: draw_text && »Îı_Ço
*m: gethalfcolor && E¡Á½É«Ö®¼äµÄ°ëÉ«µ÷
*m: gethwnd && »ñE¡´°¿Ú_ä±ú
*m: get_rect_num && ´Ó Rect ½á11ÖD·µ»OEýÖµ¡£Eç1ûÖ¸¶¨Á˵OÖ·²ÎEý£¬Ôò½á1û±»±£´æµ½µOÖ·²ÎEýÖD¡£
*m: get_rect_str && ´«µÝ Left, Top, Right, Bottom Ëĸö²ÎEý£¬·µ»O RECT ½á11ÑùµÄ×Ö·û´®¡£
*m: inititems && 3oE¼»_A¸Ä¿DÅI¢
*m: modifymenus && D_¸Ä²Ëµ¥µÄ Enabled ×´I¬
*m: newitem && »ñE¡O»¸öA¸Ä¿¶ÔIó
*m: setmessage && ÉèÖA²Ëµ¥Iî×´I¬A¸IáE_DÅI¢£¬µÚ¶_²ÎÖ¸ÎïAí²Ëµ¥IîµÄDòºÅ£¬E±E¡E1ÓA×î½üIí¼ÓµÄ²Ëµ¥¡£
*m: setpicture && ÉèÖA²Ëµ¥IîµÄͼƬ£¬µÚ¶_²ÎÖ¸ÎïAí²Ëµ¥IîDòºÅ£¬E±E¡E1ÓA×î½üIí¼ÓµÄ²Ëµ¥¡£
*m: show && IÔE_²Ëµ¥ÔÚÖ¸¶¨µÄ x,y ×o±êÍ⣬Eç1ûδָ¶¨£¬½«ÔÚµ±Ç°Eó±êλÖAIÔE_¡£
*m: showby && Ö¸¶¨±íµ¥µÄÄ3¸ö¶ÔI󣬽«ÔÚ¸A¶ÔIóµÄI·½µ_3ö²Ëµ¥¡£
*m: transparentblta && See win32Api TransparentBlt
*p: classlibraryroot && AàÔE¼Â·_¶Aû
*p: hmenu && Ö÷²Ëµ¥µÄ²Ëµ¥_ä±ú
*p: lownerdraw && EÇ·ñE1ÓA×Ô»æ²Ëµ¥£¬Eç1û .F. ºöÂÔËùÓD»æÖÆEôDÔ¡¢²ÎEý×öΪ±ê×¼ Windows ²Ëµ¥¡£
*p: lselectedenabled && (¶ÁD´) Ö»¶Ô Enabled = .T. µÄ²Ëµ¥Iî½oDD»æÖÆÑ¡¶¨¿ò
*p: lshareicons && (¶Á¶¨) EÇ·ñE1ÓA1²Iíͼ±ê¿â£¬Eç1û´ËֵΪ .T.£¬Í¼±ê¿â»á±»O»Ö±±£3Ö£¬OÔ±ÜAâÖO¸´¶ÁE¡¡£Eç´ËֵΪ .F.£¬ÔòΪA¿¸öEµAý´´½¨µ¥¶Aͼ±êË÷Oý¿â¡£(µ÷EÔ×´I¬ÇëÉèΪ .F.)
*p: nbarfillcolor1 && EµÉ«Iî3ä²Ëµ¥²à±ßA¸»òOß½¥±äE±£¬ÉèÖAIî3äÉ«»òOß½¥±äµÄÆdE¼É«¡£
*p: nbarfillcolor2 && EµÉ«Iî3ä²Ëµ¥²à±ßA¸»òOß½¥±äE±£¬ÉèÖAIî3äÉ«»òOß½¥±äµÄ½áEoÉ«¡£
*p: nbarstyle && (¶ÁD´) ²à±ßA¸ÑùE½¡£0=Î_,1=EµÉ«Iî3ä,2=ˮƽ1ý¶É,3=´1Ö±1ý¶É
*p: nbarwidth && (¶ÁD´) ²à±ßA¸¿í¶E
*p: nhwnd && ´°¿Ú_ä±ú
*p: nimageleft && (¶ÁD´) ͼ±êÇoÓòµÄ×ó±ß_à
*p: nitemheight && (¶ÁD´) ×îD¡²Ëµ¥Iî¸ß¶E£¬µ±ÖµD¡ÓÚµEÓÚ 0 E±£¬×Ô¶_¼ÆËa¡£
*p: nitemwidth && (¶ÁD´) ×îD¡²Ëµ¥Iî¿í¶E£¬µ±´ËÖµD¡ÓÚµEÓÚ 0 E±£¬ ×Ô¶_¼ÆËa¡£
*p: nmaxlen && ¼Ç¼×î3¤Îı_µÄ3¤¶E£¬ÔÚÄÚ´æ·ÖÅäµOÖ·ÓAµ½´ËÖµ¡£
*p: nmenubackcolor && (¶ÁD´) ÉèÖA²Ëµ¥±3_°É«£¬´ËÖµD¡ÓÚ0E±E¡IµÍ3ÉèÖA
*p: nmenuheight && (Ö»¶Á) Ö÷IÔE_²Ëµ¥¸ß¶E
*p: nmenuwidth && (Ö»¶Á) Ö÷IÔE_²Ëµ¥¿í¶E
*p: nreturn && ·µ»OÖµ·½E½¡£0=Ë÷Oý,1 = cKey, 3 = A¸Ä¿Îı_, 4=¶ÔIó
*p: nselectedbackcolor && (¶ÁD´) µ±Ç°Ñ¡¶¨IîµÄ±3_°É«£¬´ËÖµD¡ÓÚ 0 E±E¡IµÍ3ÉèÖA
*p: nselectedbordercolor && (¶ÁD´) Ñ¡¶¨_ODεı߿òÉ«£¬´ËÖµD¡ÓÚ 0 E±E¡IµÍ3ÉèÖA
*p: nselectedforecolor && (¶ÁD´) Ñ¡¶¨IîµÄǰ_°É«£¬´ËÖµD¡ÓÚ 0 E±E¡IµÍ3ÉèÖA¡£
*p: nselectedimagestyle && (¶ÁD´) Ñ¡¶¨Í¼±êµÄÑùE½ 0=Î_, 1=Í1Æd,2=µ¥¶AÑ¡¶¨
*p: nselectedroundx && (¶ÁD´) ÍÖÔ²_ODÎÑ¡¶¨¿òµÄÔ²½Ç¿í¶E
*p: nselectedroundy && (¶ÁD´) ÍÖÔ²_ODÎÑ¡¶¨¿òµÄÔ²½Ç¸ß¶E
*p: nselectedstyle && Ñ¡ÖDIo·ç¸ñ 0=±ê×¼±3_°, 1=_ODοòÑ¡¶¨¿ò,2=ÍÖԲѡ¶¨¿ò,3=Í1ÆdÑ¡¶¨¿ò,4=°¼IÂÑ¡¶¨¿ò
*p: ntextleft && ÉèÖAÎı_ÇoµÄ×ó±ß_à
*p: ntextmargin && Îı_ÇoÄÚÎı_µÄµÄËo½oÖµ
*p: ocollections && A¸Ä¿×ܼ_ºI£¬CreateItems E±Ö¸Iò¸÷¸öA¸Ä¿¡£´´½¨Íê3ɺóIú»U¡£
*p: oitems && ²Ëµ¥A¸Ä¿¼_ºI£¬±£´æ¸÷¸öA¸Ä¿¶ÔIó
*p: oreficons && Ö¸Iòͼ±êEO¼_Æ÷
*p: pproc && ½o3IÖ¸Oë
*
HIDDEN nhwnd,nmaxlen,nmenuheight,nmenuwidth,ocollections,oitems,oreficons,pproc
*
classlibraryroot = ""
Height = 17
hmenu = 0
lownerdraw = .F.
lselectedenabled = .F.
lshareicons = .T.
Name = "popmenu"
nbarfillcolor1 = -1
nbarfillcolor2 = -1
nbarstyle = 0
nbarwidth = 19
nhwnd = 0
nimageleft = 0
nitemheight = 0
nitemwidth = 0
nmaxlen = 256
nmenubackcolor = -1
nmenuheight = 0
nmenuwidth = 0
nreturn = 0
nselectedbackcolor = -1
nselectedbordercolor = -1
nselectedforecolor = -1
nselectedimagestyle = 0
nselectedroundx = 12
nselectedroundy = 12
nselectedstyle = 0
ntextleft = 20
ntextmargin = 2
ocollections = Ö¸Iò¸÷¸ö²Ëµ¥¼_ºI
oitems =
oreficons = .NULL.
pproc = 0
Width = 17
*
PROCEDURE about && 1OÓÚ±_Aà
**********************************************
***
*** Popup Menu Class
*** Version
***
*** Author by: Ê©Áè·å
*** Create date: 2008.05.29
*** Last update: 2008.06.04
***
**********************************************
***
*** Èç¹ûËüȷʵ¶ÔÄúÓÐËù°ïÖú£¬²¢ÇÒÄãÒ²·Ç³£Ï²»¶£¬Äú¿ÉÒÔͨ¹ýÍøÉÏ»ã¿îÂÔ±íÄúµÄÐÄÒ⣬ÈÃÎÒÃÇÔÚÐÁÀÍÖÆ×÷Öеõ½ÐÀο, лл¡£
***
*** ÒøÐÐÕ˺Å
*** Öйú¹¤ÉÌÒøÐУº 9558 8014 0810 5404 077
*** Öйú½¨ÉèÒøÐУº 4367 4218 3350 0044 031
*** ¿ª»§ÈË£ºÊ©Áè·å
***
*** ÔÞÖú½ð¶î²»ÏÞ£¬Ö»×÷¶ÔÎÒÃÇŬÁ¦µÄÈϿɡ£
***
*** ÎÒÃǵÄÍøÖ·£ºhttp://xykjsoft.blog.163.com
***
***
*** ²âÊÔ»·¾³£ºWindows 2000¡¢Windows XP
*** ¿ª·¢ÓïÑÔ£ºVfp9 SP2
***
ENDPROC
PROCEDURE add && Ií¼Ó²Ëµ¥Iî¡£LPARAMETERS tcParentKey, tcKey, tcTitle, tcCommand, tcPicture, tvEnabled, tnAddFlag
LPARAMETERS tcParentKey, tcKey, tcTitle, tcCommand, tcPicture, tvEnabled, tnAddFlag
*-- tvParentKey ¸¸Ç× Key
*-- tcKey ²Ëµ¥ Id
*-- tcCaption ²Ëµ¥±êÌâ
*-- tcCommand ²Ëµ¥½á¹û£¬Ö´ÐÐÃüÁî´®
*-- tvEnabled ²Ëµ¥ Enalbed ״̬£¬¿ÉÒÔÊÇÂß¼Á¢¼´Öµ»òÕßÂß¼Ðͱí´ïʽ
*-- tnAddFlag Óû§Ìí¼ÓµÄ×Ô¶¨Òå Id
*!* Ìí¼ÓÒ»¸ö²Ëµ¥Ïî, tnAddFlag = 0x00 ±ê×¼²Ëµ¥Ï0x20 = »»Áв˵¥Ïî, 0x08 = Check¡£
Private loItem, lcParentKey, lcKey, loParent
Local loItem, lcParentKey, lcKey, loParent
loItem = This.NewItem()
If Not VarType(m.tcParentKey) = "C"
MessageBox("ÇëÖ¸¶¨¸¸À¸Ä¿ Key£¬Èç²»ÐèÒªÇëʹÓÿÕ×Ö·û´®¡£", 16, "PopMenu.Add")
Return m.loItem
EndIf
If Not VarType(m.tcKey) = "C"
MessageBox("ÇëÖ¸¶¨ÐÂÀ¸Ä¿ Key£¬Èç²»ÐèÒªÇëʹÓÿÕ×Ö·û´®¡£", 16, "PopMenu.Add")
Return m.loItem
EndIf
lcParentKey = Alltrim(m.tcParentKey)
lcKey = Iif(Empty(m.tcKey), Sys(2015), Alltrim(m.tcKey))
If This.oItems.GetKey(m.lcKey) > 0
MessageBox("Ö¸¶¨µÄÀ¸Ä¿ Key ¼º¾´æÔÚ£¬ÇëΪÀ¸Ä¿Ö¸¶¨²»Í¬ Key¡£", 16, "PopMenu.Add")
Return m.loItem
EndIf
If Not Empty(m.tcParentKey) ;
And Not This.oItems.GetKey(m.tcParentKey) > 0
MessageBox("Ö¸¶¨µÄ¸¸À¸Ä¿ Key ²»´æÔÚ£¬Çë¼ì²é¸¸À¸Ä¿µÄ Key Öµ¡£", 16, "PopMenu.Add")
Return m.loItem
EndIf
*-- ¼ÓÈ뼯ºÏ
This.oItems.Add(m.loItem, m.lcKey)
loItem.cKey = m.lcKey
loItem.cParentKey = m.lcParentKey
loItem.nIndex = This.oItems.Count
loItem.cTitle = Transform(m.tcTitle)
loItem.cCommand = Iif(Vartype(m.tcCommand) = "C", m.tcCommand, "")
loItem.cPicture = Iif(Vartype(m.tcPicture) = "C", m.tcPicture, "")
loItem.cEnabled = Iif(PCount() >= 6, Transform(m.tvEnabled), "")
loItem.nFlags = Iif(Vartype(m.tnAddFlag) = "N", m.tnAddFlag, 0)
loItem.nWidth = This.nItemWidth
loItem.nHeight = This.nItemHeight
If Not Empty(m.lcParentKey)
loParent = This.oItems.Item(This.oItems.GetKey(m.lcParentKey))
loParent.nFlags = BitOr(loParent.nFlags, MF_POPUP)
EndIf
*-- Êý¾ÝÓз¢Éú±ä»¯£¬Çå³ýÐÅÏ¢
This.nMenuWidth = 0
This.nMenuHeight = 0
This.DestroyMenus()
Return m.loItem
ENDPROC
PROCEDURE additem && Ií¼Ó²Ëµ¥Iî: tnId, tcCaption, tcCommand, tlEnabled, tnAddFlag. 0x20 »»ÁD, 0x08 Check¡£
LPARAMETERS tcCaption, tcCommand, tvEnabled, tnAddFlag
Return This.Add("", "", m.tcCaption, m.tcCommand, "", Iif(PCount()>=3, m.tvEnabled, ""), m.tnAddFlag)
ENDPROC
HIDDEN PROCEDURE bindevents
Lparameters tlBindevent
If This.pProc = 0
This.pProc = GetWindowLong(This.nHwnd, GWL_WNDPROC)
EndIf
If m.tlBindevent = .T.
BindEvent(This.nHwnd, WM_MEASUREITEM, This, "CallBack_Proc")
BindEvent(This.nHwnd, WM_DRAWITEM, This, "CallBack_Proc")
BindEvent(This.nHwnd, WM_MENUCHAR, This, "CallBack_Proc")
Else
UnBindEvent(This.nHwnd, WM_MENUCHAR)
UnBindEvent(This.nHwnd, WM_MEASUREITEM)
UnBindEvent(This.nHwnd, WM_DRAWITEM)
EndIf
ENDPROC
HIDDEN PROCEDURE b_drawmenuitem
LPARAMETERS tplParam
** tplParam = pointer to DrawItemStruct
Private lhDestDC, lhOldDC, lhDC, lpItem, lnItemState, lnItemId, loItem
Private lnRectLeft, lnRectTop, lnRectRight, lnRectBottom
Private lnTxtLeft, lnTxtTop, lnTxtRight, lnTxtBottom, lnColor
Private lnBmpLeft, lnBmpTop, lnBmpRight, lnBmpBottom
Private lcRect, lhTmp, lhBrush, llSelect, llEnabled, lcTitle
Local lhDestDC, lhOldDC, lhDC, lpItem, lnItemState, lnItemId, loItem
Local lnRectLeft, lnRectTop, lnRectRight, lnRectBottom
Local lnTxtLeft, lnTxtTop, lnTxtRight, lnTxtBottom, lnColor
Local lnBmpLeft, lnBmpTop, lnBmpRight, lnBmpBottom
Local lcRect, lhTmp, lhBrush, llSelect, llEnabled, lcTitle
Store 0 to lpItem, lhDC, lnItemState, lnItemId
*-- È¡»Ø½á¹¹ÐÅÏ¢
CopyMem2NumA(@m.lpItem, m.tplParam + DWORD_SIZE * 11, DWORD_SIZE) && PopItem Data
CopyMem2NumA(@m.lnItemState, m.tplParam + DWORD_SIZE * 4, DWORD_SIZE) && PopItem State
CopyMem2NumA(@m.lhDestDC, m.tplParam + DWORD_SIZE * 6, DWORD_SIZE) && PopItem hDC
*-- È¡»Ø¼¯ºÏϱê
CopyMem2NumA(@m.lnItemId, m.lpItem + This.nMaxLen, DWORD_SIZE)
If Not Between(m.lnItemId, 1, This.oCollections.Count)
Return
EndIf
loItem = This.oCollections.Item(m.lnItemId)
lcTitle = loItem.cTitle2
*-- È¡»æÍ¼ÇøÓò½á¹¹
Store 0 To lnRectLeft, lnRectTop, lnRectRight, lnRectBottom
lcRect = Replicate(Chr(0), DWORD_SIZE * 4)
CopyMem2StrA(@m.lcRect, m.tplParam + DWORD_SIZE * 7, DWORD_SIZE * 4)
This.Get_Rect_Num(m.lcRect, @m.lnRectLeft, @m.lnRectTop, @m.lnRectRight, @m.lnRectBottom)
llEnabled = BitAnd(m.lnItemState, ODS_DISABLED ) = 0
llSelected = BitAnd(m.lnItemState, ODS_SELECTED) <> 0
*-- ͼ±ê½á¹¹
lnBmpLeft = m.lnRectLeft + This.nImageLeft
lnBmpTop = m.lnRectTop
lnBmpRight = m.lnBmpLeft + (m.lnRectBottom - lnRectTop) && ¸ß¶È»òÕß²à±ßÀ¸µÄ¿í¶È
lnBmpBottom = m.lnRectBottom
*-- ÎÄ×ֽṹ
lnTxtLeft = m.lnRectLeft + This.nTextLeft
lnTxtTop = m.lnRectTop
lnTxtRight = m.lnRectRight
lnTxtBottom = m.lnRectBottom
*============ ½áÊø×¼±¸
*============ ²½Öè 1/3£º»æÖÆÍ¼ÐÎ
*--
*-- ´´½¨¼æÈÝÉ豸±ÜÃâÉÁ˸, vfp ʵÔÚÌ«ÂýÌ«ÂýÁË
*--
lhTmp = CreateCompatibleBitmap(m.lhDestDC, m.lnRectRight, m.lnRectBottom)
lhDC = CreateCompatibleDC(m.lhDestDC)
lhOldDC = SelectObject(m.lhDC, m.lhTmp)
DeleteObject(m.lhTmp)
BitBlt(m.lhDC, m.lnRectLeft, m.lnRectTop, m.lnRectRight, m.lnRectBottom, ;
m.lhDestDC, m.lnRectLeft, m.lnRectTop, SRCCOPY)
*-- Çå¿ÕÖØ»²Ëµ¥±³¾°
SetBkMode(m.lhDC, TRANSPARENT)
If This.nMenuBackColor < 0
lhBrush = CreateSolidBrush(GetSysColor(COLOR_MENU))
Else
lhBrush = CreateSolidBrush(This.nMenuBackColor)
EndIf
FillRect(m.lhDC, m.lcRect, m.lhBrush)
DeleteObject(m.lhBrush)
*-- ÏÈ»²Ëµ¥Ïî·Ö¸ôÌõ£¬±ÜÃâÆÆ»µ²à±ßÀ¸
If Empty(m.lcTitle)
This.Draw_Separator(m.lhDC, m.lnRectLeft, m.lnRectTop, m.lnRectRight, m.lnRectBottom)
EndIf
*-- »²à±ßÀ¸£¬¿í¶È
If This.nBarStyle > 0
This.Draw_Bar(m.lhDC, m.loItem, m.lnRectLeft, m.lnRectTop, m.lnRectLeft + This.nBarWidth, m.lnRectBottom)
EndIf
*-- »²Ëµ¥Ñ¡¶¨Ð§¹û
If m.llSelected
This.Draw_Selected(m.lhDC, m.loItem, m.llEnabled, m.lnRectLeft, m.lnRectTop, m.lnRectRight, m.lnRectBottom, m.lnBmpLeft, m.lnTxtLeft)
EndIf
*-- ÏȻλͼ£¬±ÜÃâÒòΪ»ÎÄ×ÖʱÉèÖñ³¾°É«Ó°Ïì͸ʱ×ÅÉ«
If (loItem.hPic <> 0)
This.Draw_Image(m.lhDC, m.loItem, m.llEnabled, m.lnBmpLeft, m.lnBmpTop, m.lnBmpRight, m.lnBmpBottom)
EndIf
*============ ²½Öè 2/3£ºÍ¼ÏñÍê³É»æÖÆ£¬¿½»ØÖ÷ DC
BitBlt(lhDestDC, lnRectLeft, lnRectTop, lnRectRight, lnRectBottom, ;
lhDC, lnRectLeft, lnRectTop, SRCCOPY)
SelectObject(lhDC, lhOldDC)
DeleteDC(lhDC)
lhDC = lhDestDC
*============ ²½Öè 3/3£º»æÖÆÎÄ×Ö
*-- ÉèÖÃ͸Ã÷ģʽ
SetBkMode(lhDC, TRANSPARENT)
*-- »²Ëµ¥ÏîÄÚÈÝ
If Not Empty(m.lcTitle)
*-- »Êó±êËùÔÚÏîµÄ±³Ó°
If m.llSelected
If m.llEnabled
lnColor = Iif(This.nSelectedForeColor = -1, GetSysColor(COLOR_HIGHLIGHTTEXT), This.nSelectedForeColor)
This.Draw_Text(lhDC, m.lcTitle, lnColor, lnTxtLeft, lnTxtTop, lnTxtRight, lnTxtBottom)
Else
If This.lSelectedEnabled = .T.
This.Draw_Text(lhDC, m.lcTitle, GetSysColor(COLOR_HIGHLIGHTTEXT), lnTxtLeft + 1, lnTxtTop + 2, lnTxtRight, lnTxtBottom)
This.Draw_Text(lhDC, m.lcTitle, GetSysColor(COLOR_GRAYTEXT), lnTxtLeft, lnTxtTop, lnTxtRight, lnTxtBottom)
Else
This.Draw_Text(lhDC, m.lcTitle, GetSysColor(COLOR_GRAYTEXT), lnTxtLeft, lnTxtTop, lnTxtRight, lnTxtBottom)
EndIf
EndIf
Else
*-- »ÆäËûÏîÎÄ×Ö
If m.llEnabled
This.Draw_Text(lhDC, m.lcTitle, GetSysColor(COLOR_MENUTEXT), lnTxtLeft, lnTxtTop, lnTxtRight, lnTxtBottom)
Else
This.Draw_Text(lhDC, m.lcTitle, GetSysColor(COLOR_HIGHLIGHTTEXT), lnTxtLeft + 1, lnTxtTop + 2, lnTxtRight, lnTxtBottom)
This.Draw_Text(lhDC, m.lcTitle, GetSysColor(COLOR_GRAYTEXT), lnTxtLeft, lnTxtTop, lnTxtRight, lnTxtBottom)
EndIf
EndIf
EndIf
If m.llSelected
If Not Empty(loItem.cMessage)
Set Message To loItem.cMessage
Else
Set Message To
EndIf
EndIf
ENDPROC
HIDDEN PROCEDURE b_measuremenuitem
LPARAMETERS thWnd, tplParam
** tplParam = pointer to MeasureItemStruct
*--
*-- дÈë²Ëµ¥¸ß¶ÈÓë¿í¶È
*--
Private lpItem, lnItemId, loItem
Private lpItem, lnItemId, loItem
Store 0 to lpItem, lnItemId
*-- È¡»Ø¼¯ºÏϱê
CopyMem2NumA(@m.lpItem, m.tplParam + DWORD_SIZE * 5, DWORD_SIZE)
CopyMem2NumA(@m.lnItemId, m.lpItem + This.nMaxLen, DWORD_SIZE)
If Between(m.lnItemId, 1, This.oCollections.Count)
loItem = This.oCollections.Item(m.lnItemId)
CopyNum2MemA(m.tplParam + (DWORD_SIZE * 3), loItem.nWidth, DWORD_SIZE)
CopyNum2MemA(m.tplParam + (DWORD_SIZE * 4), loItem.nHeight, DWORD_SIZE)
EndIf
ENDPROC
HIDDEN PROCEDURE b_menuchar
ENDPROC
HIDDEN PROCEDURE callback_proc
LParameters thWnd, tnMsg, tpwParam, tplParam
Private lcChr, lhMenu, loMenuItem, lnIndex
Local lcChr, lhMenu, loMenuItem, lnIndex
Do Case
Case (m.tnMsg == WM_MEASUREITEM)
This.b_MeasureMenuItem(m.thWnd, m.tplParam)
Return .T.
Case (m.tnMsg == WM_DRAWITEM)
This.b_DrawMenuItem(m.tplParam)
Return .T.
Case (m.tnMsg == WM_MENUCHAR)
*-- ×ÊÁÏÀ´Ô´
*-- http://msdn.microsoft.com/en-us/library/ms646349(VS.85).aspx
*--
lhMenu = m.tplParam
lcChr = "&" + Upper(Chr(BitAnd(m.tpwParam, 0xFF)))
lnIndex = 0
For Each loMenuItem In This.oCollections
If m.lhMenu = loMenuItem.hParent
If lcChr $ Upper(loMenuItem.cTitle2)
If loMenuItem.lEnabled
Return BitLShift(MNC_EXECUTE, 16 ) + m.lnIndex
Else
Exit For
EndIf
EndIf
m.lnIndex = m.lnIndex + 1
EndIf
EndFor
Return 0
EndCase
Return CallWindowProc(This.pProc, m.thWnd, m.tnMsg, m.twParam, m.tlParam)
ENDPROC
PROCEDURE clear && Çå3ý×éºI¿ò»òÁD±í¿ò¿O¼_ÖDµÄÄÚEÝ¡£
This.DestroyMenus()
This.oItems = NewObject("Collection")
This.oCollections = NewObject("Collection")
ENDPROC
PROCEDURE createcontext && ´´½¨ÓëÖ¸IòÁíO»¸ö²Ëµ¥Áª½Ó
LPARAMETERS tvItem, toPopMenu
Local loItem, lnItem
loItem = NULL
If Vartype(toPopMenu) <> "O" ;
Or Not toPopMenu.Class == This.Class ;
Or toPopMenu = This
Messagebox("´´½¨²Ëµ¥ÁªÏµÊ§°Ü£¡ÇëÖ¸¶¨ÁíÒ»¸ö PopMenu ʵÀý¶ÔÏó£¡", 16, "PopMenu.CreateContext")
Return .F.
EndIf
Do Case
Case Vartype(tvItem) = "C"
lnItem = This.oItems.GetKey(m.tvItem)
If lnItem > 0
loItem = This.oItems.Item(m.lnItem)
EndIf
Case Vartype(tvItem) = "O" And PemStatus(m.tvItem, "oRefMenu", 5)
loItem = m.tvItem
EndCase
If IsNull(loItem)
Messagebox("´´½¨²Ëµ¥ÁªÏµÊ§°Ü£¡ÇëÖ¸¶¨Ò»¸öÀ¸Ä¿¶ÔÏó»òÕßÀ¸Ä¿ KEY £¡", 16, "PopMenu.CreateContext")
Return .F.
Else
loItem.nFlags = MF_POPUP
loItem.oRefMenu = m.toPopMenu
EndIf
Return .T.
ENDPROC
PROCEDURE createmenus
LPARAMETERS toCollection, thMenu
Private loItem, loParent, loPopMenu, lnFlags, lcTitle, lcEnabled, llEnabled, lnAddress
Local loItem, loParent, loPopMenu, lnFlags, lcTitle, lcEnabled, llEnabled, lnAddress
If This.nMenuWidth = 0 Or This.nMenuHeight = 0
If Not This.InitItems()
MessageBox("³õʼ»¯Ê§°Ü£¡", 16, "PopMenu.CreateMenus")
Return NULL
EndIf
EndIf
For Each loItem In This.oItems
toCollection.Add(m.loItem)
loItem.hParent = m.thMenu
loItem.lEnabled = .T.
loPopMenu = NULL
lcTitle = Left(loItem.cTitle2, This.nMaxLen)
lnFlags = loItem.nFlags
If Empty(m.lcTitle)
lnFlags = BitOr(m.lnFlags, MF_SEPARATOR)
EndIf
If Not Empty(loItem.cEnabled)
If Type("Evaluate(loItem.cEnabled)") = "L" ;
And Evaluate(loItem.cEnabled) = .F.
loItem.lEnabled = .F.
lnFlags = BitOr(m.lnFlags, BitOr(MF_GRAYED, MF_DISABLED))
EndIf
EndIf
lnFlags = BitOr(m.lnFlags, Iif(This.lOwnerDraw, MF_OWNERDRAW, MF_BYCOMMAND))
*-- ¼ìЧÉÏÏÂÎÄÁªÏµ²Ëµ¥
If Not IsNull(loItem.oRefMenu)
Do Case
Case Vartype(loItem.oRefMenu) <> "O"
Case IsNull(loItem.oRefMenu)
Case Not loItem.oRefMenu.Class == This.Class
Otherwise
loPopMenu = loItem.oRefMenu
EndCase
EndIf
If Vartype(m.loPopMenu) = "O"
lnFlags = Bitor(m.lnFlags, MF_POPUP)
EndIf
*-- ÉêÇëÓë¸´ÖÆÐÅÏ¢µ½ÄÚ´æ
lnAddress = LocalAlloc(LPTR, This.nMaxLen + DWORD_SIZE)
loItem.nAddress = m.lnAddress
CopyStr2MemA(loItem.nAddress, m.lcTitle, Len(m.lcTitle))
CopyNum2MemA(loItem.nAddress + This.nMaxLen, toCollection.Count, 4)
If Vartype(This.oRefIcons) = "O" And Not IsNull(This.oRefIcons)
*-- ÔØÈëͼ±ê
loItem.hPic = This.oRefIcons.LoadImage(loItem.cPicture)
If Upper(Right(loItem.cPicture, 4)) = ".BMP"
*-- ÔØÈëλͼÑÚÂë
loItem.hMsk = This.oRefIcons.LoadImage(ForceExt(loItem.cPicture, "msk"))
EndIf
EndIf
If Not Empty(loItem.cParentKey)
*-- È¡¸¸Ç×½Úµã
loParent = This.oItems.Item(This.oItems.GetKey(loItem.cParentKey))
If loParent.hMenu = 0
*-- Òì³£³ö´í
Loop
EndIf
Else
loParent = NULL
EndIf
*-- ÕâÊÇÒ»¸ö×Ӳ˵¥Ïî
If Bittest(m.lnFlags, 4) Or Not IsNull(loItem.oRefMenu)
loItem.hMenu = CreatePopupMenu()
If IsNull(m.loParent)
AppendMenu(m.thMenu, m.lnFlags, loItem.hMenu, m.lnAddress)
Else
loItem.hParent = m.loParent.hMenu
AppendMenu(m.loParent.hMenu, m.lnFlags, loItem.hMenu, m.lnAddress)
EndIf
*-- Ö¸ÏòÁíÒ»¸ö²Ëµ¥£¬´´½¨Áª½Ó²Ëµ¥
If Vartype(m.loPopMenu) = "O"
loPopMenu.CreateMenus(m.toCollection, loItem.hMenu)
EndIf
Else
If IsNull(m.loParent)
AppendMenu(m.thMenu, m.lnFlags, WM_USER + toCollection.Count, m.lnAddress)
Else
loItem.hParent = m.loParent.hMenu
AppendMenu(loParent.hMenu, m.lnFlags, WM_USER + toCollection.Count, m.lnAddress)
EndIf
EndIf
EndFor
Return .T.
ENDPROC
PROCEDURE declare_dlls
Declare Long SetForegroundWindow In "User32" ;
Long hwnd
Declare Long GetCursorPos In "User32" ;
String @lpPoint
Declare Long GetActiveWindow In "User32"
Declare Long GetWindowLong In "User32" ;
Long nhWnd, Long nIndex
Declare Long GetDC in "User32" ;
Long nhWnd
Declare Long GetSysColor In "User32" ;
Long nIndex
Declare Long GetSystemMetrics In "User32" ;
Long nIndex
Declare Long GetIconInfo In "User32";
Long hIcon, String @ piconinfo
Declare Long ClientToScreen In "User32" ;
Long nhWnd, String @lpPoint
Declare Long CallWindowProc In "User32" ;
Long lpPrevWndFunc, Long nhWnd, Long uMsg, Long wParam, Long lParam
Declare Long ReleaseDC In "User32" ;
Long nhWnd, Long hDC
Declare Long DrawText In "User32" ;
Long hDC, String lpString, Long nCount, ;
String @lpRect, Long uFormat
Declare Long DrawEdge In "User32" ;
Long hDC, String @lpRect, Long Edge, Long grfFlags
Declare Long DrawState In "User32" ;
Long hdc, Long hbr, Long lpOutputFunc, Long lData, ;
Long wData, Long x, Long y, Long cx, Long cy, Long fuFlags
Declare Long DrawIconEx In "User32" ;
Long hdc, Long xLeft, Long yTop, Long hIcon, ;
Long cxWidth, Long cyWidth, Long istepIfAniCur, ;
Long hbrFlickerFreeDraw, Long diFlags
Declare Long CreatePopupMenu In "User32"
Declare Long TrackPopupMenu In "User32" ;
Long hMenu, Long uFlags, Long x, Long y, ;
Long nReserved, Long hWnd, String @prcRect
Declare Long DestroyMenu In "User32" ;
Long hMenu
Declare Long AppendMenu In "User32" ;
Long hMenu, Long uFlags, Long uIDNewItem, Long lpNewItem
Declare Long ModifyMenu In "User32" ;
Long hmenu, Long uItem, Long fuFlags, Long idNewItem, Long lpszNewItem
Declare Long LocalAlloc In "Kernel32" ;
Long uFlags, Long dwBytes
Declare Long RtlMoveMemory In "Kernel32" As CopyMem2StrA ;
String @lpDest, Long lpSource, Long nLength
Declare Long RtlMoveMemory In "Kernel32" As CopyStr2MemA ;
Long lpDest, String @lpSource, Long nLength
Declare Long RtlMoveMemory In "Kernel32" As CopyMem2NumA ;
Long @lpDest, Long lpSource, Long nLength
Declare Long RtlMoveMemory In "Kernel32" As CopyNum2MemA ;
Long lpDest, Long @lpSource, Long nLength
Declare Long GetDeviceCaps In "Gdi32" ;
Long hDC, Long nIndex
Declare Long GetPixel In "Gdi32" ;
Long hDC, Long nXPos, Long nYPos
Declare Long GetTextExtentPoint32 In "Gdi32" ;
Long hDC, String cString, Long nStrLen, String @pSize
Declare Long CreateCompatibleDC In "Gdi32" ;
Long hDC
Declare Long CreateCompatibleBitmap In "Gdi32" ;
Long hdc, Long nWidth, Long nHeight
Declare Long CreateSolidBrush In "Gdi32" ;
Long crColor
Declare Long CreatePen In "Gdi32" ;
Long fnPenStyle, Long nWidth, Long crColor
Declare Long DeleteDC In "Gdi32" ;
Long hDC
Declare Long DeleteObject In "Gdi32" ;
Long hDC
Declare Long GetObject In "Gdi32" As GetObjectA ;
Long hGDIobj, Long nBufLen, String @lpvObject
Declare Long SelectObject In "Gdi32" ;
Long hDC, Long hObject
Declare Long SetTextColor In "Gdi32" ;
Long hDC, Long crColor
Declare Long SetBkColor In "Gdi32" ;
Long hDC, Long crColor
Declare Long SetBkMode In "Gdi32" ;
Long hDC, Long iBkMode
Declare Long MoveToEx In "Gdi32" ;
Long hDC, Long nX, Long nY, String @lpPoint
Declare Long LineTo In "Gdi32" ;
Long hDC, Long nEndX, Long nEndY
Declare Long FillRect In "User32" ;
Long hDC, String @lpRect, Long hBrush
Declare Long Rectangle In "Gdi32" ;
Long hDC, Long nLeftRect, Long nTopRect, ;
Long nRightRect, Long nBottomRect
Declare Long RoundRect In "Gdi32" ;
Long hdc, Long nLeftRect, Long nTopRect, Long nRightRect, ;
Long nBottomRect, Long nWidth, Long nHeight
Declare Long BitBlt In "Gdi32" ;
Long hdcDest, Long x, Long y, Long nWidth, Long nHeight, ;
Long pSrcDC, Long xSrc, Long ySrc, Long dwRop
Declare Long TransparentBlt In "MsImg32" ;
Long hdcDest, Long nXDest, Long nYDest, ;
Long nWidthDest, Long hHeightDest, ;
Long hdcSrc, Long nXSrc, Long nYSrc, ;
Long nWidthSrc, Long nHeightSrc, ;
Long crTransparent
ENDPROC
PROCEDURE Destroy
This.Clear()
ENDPROC
HIDDEN PROCEDURE destroymenus && Iú»U²Ëµ¥
Private loItem
Local loItem
If This.hMenu <> 0
*-- Ïú»Ù×Ӳ˵¥
If Vartype(This.oCollections) = "O"
For Each loItem In This.oCollections
If loItem.hMenu <> 0
DestroyMenu(loItem.hMenu)
loItem.hMenu = 0
EndIf
*-- Ïú»ÙͼÐÎÄÚ´æ
EndFor
EndIf
*-- Ïú»ÙÖ÷²Ëµ¥
DestroyMenu(This.hMenu)
This.hMenu = 0
EndIf
ENDPROC
HIDDEN PROCEDURE drawgradualrect && Ö¸¶¨ÇoÓòºóÓAÖ¸¶¨ÑOÉ«»æÖÆ¡£¿Éѡˮƽ»ò´1Ö±¡£
LPARAMETERS thDC, tnLeft, tnTop, tnRight, tnBottom, tnColor1, tnColor2, tnType, tnRate
* thDc É豸¾ä±ú
* tnLeft »æÖÆÇøÓòµÄ×ó×ø±ê
* tnTop »æÖÆÇøÓòµÄ¶¥×ø±ê
* tnRight »æÖÆÇøÓòµÄÓÒ×ø±ê
* tnBottom »æÖÆÇøÓòµÄµ××ø±ê
* tnColor1 Æðʼ½¥±äÉ«
* tnColor2 ½áÊø½¥±äÉ«
* tnType »áÖÆÀàÐÍ 0 ˮƽ»æÖÆ£¬1 ´¹Ö±»æÖÆ
Private lnStartR, lnStartG, lnStartB, lnRed, lnGreen, lnBlue, lnNowR, lnNowG, lnNowB
Private lnIndex, lnCount, lhOldPen, lhPen, lnAdd, lnRate
Local lnStartR, lnStartG, lnStartB, lnRed, lnGreen, lnBlue, lnNowR, lnNowG, lnNowB
Local lnIndex, lnCount, lhOldPen, lhPen, lnAdd, lnRate
*-- ˮƽ¹ý¶ÉÉ«
lnStartR = BitAnd(m.tnColor1, 0x0000FF)
lnStartG = BitRShift(BitAnd(m.tnColor1, 0x00FF00), 8)
lnStartB = BitRShift(BitAnd(m.tnColor1, 0xFF0000), 16)
lnRed = lnStartR - BitAnd(m.tnColor2, 0x0000FF)
lnGreen = lnStartG - BitRShift(BitAnd(m.tnColor2, 0x00FF00), 8)
lnBlue = lnStartB - BitRShift(BitAnd(m.tnColor2, 0xFF0000), 16)
*- Èç¹ûÓд«µÝ tnRate£¬Ôò°´´Ë±È½Ï¼ÆË㣬ÓÃÓÚÖ»»ÕûÌõ½¥±äÖеÄijһ¶Î¾Ö²¿
If Vartype(m.tnRate) = "N"
lnAdd = 0
lnRate = m.tnRate
lnIndex = Iif(tnType = 0, tnLeft, tnTop)
lnCount = Iif(tnType = 0, tnRight, tnBottom)
Else
lnIndex = 0
lnAdd = Iif(tnType = 0, tnLeft, tnTop)
lnCount = Iif(tnType = 0, tnRight - tnLeft, tnBottom - tnTop)
lnRate = lnCount - lnIndex
EndIf
lnIndex = lnIndex
lnCount = lnCount
For lnIndex = lnIndex To lnCount
lnNowR = m.lnStartR - Ceiling(lnIndex / lnRate * m.lnRed)
lnNowG = m.lnStartG - Ceiling(lnIndex / lnRate * m.lnGreen)
lnNowB = m.lnStartB - Ceiling(lnIndex / lnRate * m.lnBlue)
lhPen = CreatePen(PS_SOLID, 1, Rgb(m.lnNowR, m.lnNowG, m.lnNowB))
lhOldPen = SelectObject(m.thDC, m.lhPen)
If tnType = 0
*-- ˮƽ»æÖÆ
MoveToEx(m.thDC, lnAdd + m.lnIndex - 1, m.tnTop, 0)
LineTo(m.thDC, lnAdd + m.lnIndex - 1, m.tnBottom)
Else
*-- ´¹Ö±»æÖÆ
MoveToEx(m.thDC, m.tnLeft, lnAdd + m.lnIndex - 1, 0)
LineTo(m.thDC, m.tnRight, lnAdd + m.lnIndex - 1)
EndIf
DeleteObject(m.lhPen)
SelectObject(thDC, lhOldPen)
EndFor
ENDPROC
HIDDEN PROCEDURE draw_bar && »²à±ßIo
LPARAMETERS thDC, toItem, tnLeft, tnTop, tnRight, tnBottom
Private lcRect, lhBrush, lnFillColor1, lnFillColor2
Local lcRect, lhBrush, lnFillColor1, lnFillColor2
lnFillColor1 = Iif(This.nBarFillColor1 < 0, GetSysColor(COLOR_ACTIVECAPTION), This.nBarFillColor1)
lnFillColor2 = Iif(This.nBarFillColor2 < 0, GetSysColor(COLOR_GRADIENTACTIVECAPTION), This.nBarFillColor2)
*-- »²à±ßÀ¸
Do Case
Case This.nBarStyle = 0
*-- ÎÞ²à±ßÀ¸
Case This.nBarStyle = 1
*-- ʵɫÌî³ä²à±ßÀ¸
lcRect = This.Get_Rect_Str(tnLeft, tnTop, tnRight, tnBottom)
lhBrush = CreateSolidBrush(m.lnFillColor1)
FillRect(m.thDC, m.lcRect, m.lhBrush)
DeleteObject(m.lhBrush)
Case This.nBarStyle = 2
*-- ˮƽ¹ý¶ÉÉ«
This.DrawGradualRect(m.thDC, tnLeft, tnTop, tnRight, tnBottom, m.lnFillColor1, m.lnFillColor2, 0)
Case This.nBarStyle = 3
*-- ´¹Ö±¹ý¶ÉÉ«
If This.nMenuHeight > 0
This.DrawGradualRect(thDC, tnLeft, tnTop, tnRight, tnBottom, lnFillColor2, lnFillColor1, 1, This.nMenuHeight)
EndIf
Case This.nBarStyle = 4
*-- ²à±ßÀ¸Ìùͼ
EndCase
ENDPROC
HIDDEN PROCEDURE draw_image && »Í¼Iñ
LPARAMETERS thDC, toItem, tlEnabled, tnLeft, tnTop, tnRight, tnBottom
*-- ·½·¨¶þ£¬Ö±½ÓÓà DrawState »æÖÆ
Private lcExt, lhPic, lhMsk, lnLeft, lnTop, lnWidth, lnHeight, lsBitmap, lnBmpW, lnBmpH
Private lhMskDC, lhBmpDC, lhOldBmp, lhOldMsk, lhTmp
Local lExt, lhMsk, lcEXt, lnLeft, lnTop, lnWidth, lnHeight, lsBitmap, lnBmpW, lnBmpH
Local lhMskDC, lhBmpDC, lhOldBmp, lhOldMsk, lhTmp
Store 0 To lhMskDC, lhBmpDC, lhOldBmp, lhOldMsk, lhTmp
lcExt = Upper(JustExt(toItem.cPicture))
lhPic = toItem.hPic
lhMsk = toItem.hMsk
If m.lhPic = 0
Return
EndIf
*-- ¼ÆËãͼ±êÖÃÖÐλÖÃ
lnWidth = 16
lnHeight = 16
lnLeft = tnLeft + Int((tnRight - tnLeft - lnWidth) / 2)
lnTop = tnTop + Int((tnBottom - tnTop - lnHeight) / 2)
Do Case
Case lcExt == "BMP"
*!* lsBitmap = Replicate(Chr(0), BITMAP_SIZE)
*!* GetObjectA(lhPic, BITMAP_SIZE, @lsBitmap)
*!* lnBmpW = CToBin(Substr(lsBitmap, (DWORD_SIZE * 1) + 1, 4), "4Rs")
*!* lnBmpH = CToBin(Substr(lsBitmap, (DWORD_SIZE * 2) + 1, 4), "4Rs")
*-- ʧЧÏîͼƬ±ä°µµÄ´¦Àí
If Not tlEnabled
*-- ´´½¨¼æÈÝÉ豸£¬Ð´ÈëʧЧͼºóÔÙ¿½»Ø£¬ºÚÉ«×öΪ͸Ã÷É«
If lhMsk <> 0
lhPic = lhMsk
EndIf
lhBmpDc = CreateCompatibleDC(thDC)
lhTmp = CreateCompatibleBitmap(thDC, lnWidth, lnHeight)
lhOldBmp = SelectObject(lhBmpDc, lhTmp)
DrawState(lhBmpDC, 0, 0, lhPic, 0, 0, 0, lnWidth, lnHeight, DST_BITMAP + DSS_DISABLED)
TransparentBlt(thDC, lnLeft, lnTop, lnWidth, lnHeight, ;
lhBmpDc, 0, 0, lnWidth, lnHeight, Rgb(0, 0, 0))
DeleteObject(lhTmp)
SelectObject(lhBmpDc, lhOldBmp)
DeleteDC(lhBmpDc)
Return
EndIf
*-- ͸Ã÷ÔÀí (ÑÚͼ And ±³¾°Í¼) Or (ÑÚͼ Xor ͼÏó)
*-- Õý³£Í¼Æ¬µÄÏÔʾ´¦Àí
If m.lhMsk = 0
*-- BMP ÎÞÑÚÂ룬ʹÓÃͼ±ê 0, 0 ×ø±êµÄÉ«²Êµã×öΪ͸Ã÷É«
lhBmpDc = CreateCompatibleDC(thDC)
lhOldBmp = SelectObject(lhBmpDc, lhPic)
*-- ȡͼ±ê 0, 0 ×ø±ê×öΪ͸Ã÷µã
TransparentBlt(thDC, lnLeft, lnTop, lnWidth, lnHeight, ;
lhBmpDc, 0, 0, lnWidth-1, lnHeight-1, GetPixel(lhBmpDc, 0, 0))
Else
*-- BMP ÓÐÑÚÂëͼƬ£¬½øÐÐ͸Ã÷»¯´¦Àí
*-- ʹÓúڰ×ÑÚÂë͸Ã÷ÔÀí (ÑÚͼ Xor ͼÏó) Or (ÑÚͼ And ±³¾°Í¼)
lhBmpDC = CreateCompatibleDC(thDc)
lhMskDC = CreateCompatibleDC(thDc)
SelectObject(lhBmpDC, lhPic)
SelectObject(lhMskDC, lhMsk)
*-- ±³¾°ÎªºÚ£¬Ç°¾°Îª°×£¬½«ÑÚÂëÓëͼÏóÏà"Óë"£¬´ÓͼÏóÖÐÈ¥µô MSK Öеİ×É«²¿·Ý
SetBkColor(lhBmpDC, Rgb(0,0,0))
SetTextColor(lhBmpDC, Rgb(255,255,255))
BitBlt(lhBmpDC, 0, 0, lnWidth, lnHeight, lhMskDC, 0, 0, SRCAND)
*-- ·´×ªºÚ°×£¬½«ÑÚÂëλͼÓë±³¾°½øÐС°Ó롱ÔËË㣬´Ó±³¾°È¥µô MSK ÖеĺÚÉ«²¿·Ý
SetBkColor(thDC, Rgb(255,255,255))
SetTextColor(thDC, Rgb(0,0,0))
BitBlt(thDC, lnLeft, lnTop, lnWidth, lnHeight, lhMskDC, 0, 0, SRCAND)
*-- ½«Í¼ÏóÓë±³¾°½øÐС°»ò¡±ÔËË㣬»òÔËË㣺Á½Í¼ºÚÉ«ÇøÓò¶¼±»±£Áô
BitBlt(thDC, lnLeft, lnTop, lnWidth, lnHeight, lhBmpDC, 0, 0, SRCPAINT)
EndIf
If lhBmpDc <> 0
If lhOldBmp <> 0
SelectObject(lhBmpDc, lhOldBmp)
EndIf
DeleteDC(lhBmpDc)
EndIf
If lhMskDc <> 0
If lhOldMsk <> 0
SelectObject(lhMskDc, lhOldMsk)
EndIf
DeleteDC(lhMskDc)
EndIf
Case lcExt == "ICO"
If tlEnabled
DrawIconEx(thDC, lnLeft, lnTop, lhPic, lnWidth, lnHeight, 0, 0, DI_NORMAL)
Return
EndIf
lsBitmap = Replicate(Chr(0), ICONINFO_SIZE)
GetIconInfo(lhPic, @lsBitmap)
lnBmpW = CToBin(Substr(lsBitmap, 5, 4), "4Rs") * 2
lnBmpH = CToBin(Substr(lsBitmap, 9, 4), "4Rs") * 2
lhBmpDc = CreateCompatibleDC(thDC)
lhTmp = CreateCompatibleBitmap(thDC, lnBmpW, lnBmpH)
lnOldBmp = SelectObject(lhBmpDc, lhTmp)
DeleteObject(lhTmp)
If tlEnabled
DrawState(lhBmpDc, 0, 0, lhPic, 0, 0, 0, lnBmpW, lnBmpH, DST_ICON)
Else
DrawState(lhBmpDc, 0, 0, lhPic, 0, 0, 0, lnBmpW, lnBmpH, DST_ICON + DSS_DISABLED)
EndIf
TransparentBlt(thDC, lnLeft, lnTop, lnWidth, lnHeight, ;
lhBmpDc, 0, 0, lnBmpW, lnBmpH, Rgb(0, 0, 0))
SelectObject(lhBmpDc, lhOldBmp)
DeleteDC(lhBmpDc)
Otherwise
*!* *-- ³¢ÊÔÓà DrawState ÊÇ·ñ¿ÉÏÔʾ
*!* If Not tlEnabled
*!* DrawState(thDC, 0, 0, lhPic, 0, tnLeft, tnTop, lnWidth, lnHeight, DST_BITMAP + DSS_DISABLED)
*!* Else
*!* DrawState(thDC, 0, 0, lhPic, 0, tnLeft, tnTop, lnWidth, lnHeight, DST_BITMAP)
*!* EndIf
EndCase
ENDPROC
HIDDEN PROCEDURE draw_selected && »æÖÆÑ¡¶¨
LPARAMETERS thDC, toItem, tlEnabled, tnLeft, tnTop, tnRight, tnBottom, tnBmpLeft, tnTxtLeft
*-- tnLeft Çø¿é×ó±ß¾à
*-- tnTop Çø¿é¶¥±ß¾à
*-- tnWidth Çø¿é¸ß¶È
*-- tnHeight Çø¿é¿í¶È
*-- tnBmpLeft λͼ×ó±ß¾à
*-- tnTxtLeft Îı¾Ðµ±ß¾à
Private lcTmpRect, llImage, lnColor, lnPen, lhBrush, lhOldPen, lhOldBrush, lnLeft, lnBmpRight, lnFillColor, lnColor1, lnColor2
Local lcTmpRect, llImage, lnColor, lnPen, lhBrush, lhOldPen, lhOldBrush, lnLeft, lnBmpRight, lnFillColor, lnColor1, lnColor2
If This.lSelectedEnabled And Not tlEnabled
Return
EndIf
llImage = toItem.hPic <> 0
*-- ¾ØÐÎÑ¡¶¨Ê±£¬Èç¹ûûÓÐÖ¸¶¨±³¾°É«£¬È¡±ß¿òÉ«µ½²Ëµ¥±³¾°¹ý¶ÉÉ«
If This.nSelectedBackColor < 0
lnColor1 = Iif(This.nSelectedBorderColor < 0, GetSysColor(COLOR_HIGHLIGHT), This.nSelectedBorderColor)
lnColor2 = Iif(This.nMenuBackColor < 0, GetSysColor(COLOR_MENU), This.nMenuBackColor)
lnFillColor = This.GetHalfColor(lnColor1, lnColor2, 80)
Else
lnFillColor = This.nSelectedBackColor
EndIf
*!* If This.nMenuBackColor < 0
*!* lnFillColor = This.GetHalfColor(GetSysColor(COLOR_HIGHLIGHT), GetSysColor(COLOR_MENU), 80)
*!* Else
*!* lnFillColor = This.GetHalfColor(GetSysColor(COLOR_HIGHLIGHT), This.nMenuBackColor, 80)
*!* EndIf
*!* Else
*!* lnFillColor = This.nSelectedBackColor
*!* EndIf
*-- ÉèÖÃĬÈÏ×ó±ß¾à
lnLeft = Min(tnBmpLeft, tnTxtLeft)
lnBmpRight = tnBmpLeft + (m.tnBottom-m.tnTop)
*-- »æÖÆÍ¼±êÇø
If llImage And This.nSelectedImageStyle > 0
lnLeft = tnTxtLeft
*-- ͼ±êÐèÒªÓÐ×Ô¼ºµÄ»æÍ¼·ç¸ñʱ
Do Case
Case InList(This.nSelectedImageStyle, 1, 2)
*-- ¾ØÐÎÑ¡¶¨¿ò¡¢ÍÖԲѡ¶¨¿ò
lnColor = Iif(This.nSelectedBorderColor < 0, GetSysColor(COLOR_HIGHLIGHT), This.nSelectedBorderColor)
lhPen = CreatePen(PS_SOLID, 1, lnColor)
lnOldPen = SelectObject(thDC, lhPen)
lhBrush = CreateSolidBrush(lnFillColor)
lhOldBrush = SelectObject(thDC, lhBrush)
If This.nSelectedImageStyle = 1
*-- ¾ØÐÎ
Rectangle(thDc, tnBmpLeft, tnTop, lnBmpRight, tnBottom)
Else
*-- Ô²½Ç
RoundRect(thDc, tnBmpLeft, tnTop, lnBmpRight, tnBottom, This.nSelectedRoundX, This.nSelectedRoundY)
EndIf
DeleteObject(lhPen)
DeleteObject(lhBrush)
SelectObject(thDc, lhOldPen)
SelectObject(thDc, lhOldBrush)
Case InList(This.nSelectedImageStyle, 3, 4)
*-- ͹ÆðÑ¡¶¨¿ò¡¢°¼ÏÂÑ¡¶¨¿ò
If This.nSelectedBackColor > -1
*-- ÊÇ·ñÐèÒªÌî³ä±³¾°
lnColor = Iif(This.nSelectedBackColor < 0, GetSysColor(COLOR_HIGHLIGHT), This.nSelectedBackColor)
lhBrush = CreateSolidBrush(lnColor)
lcTmpRect = This.Get_Rect_Str(tnBmpLeft, tnTop, lnBmpRight, tnBottom)
FillRect(thDC, lcTmpRect, lhBrush)
If llImage And This.nSelectedImageStyle = 2
lcTmpRect = This.Get_Rect_Str(tnBmpLeft, tnTop, lnBmpRight, tnBottom)
FillRect(thDC, lcTmpRect, lhBrush)
EndIf
DeleteObject(m.lhBrush)
EndIf
lcTmpRect = This.Get_Rect_Str(tnBmpLeft, tnTop, lnBmpRight, tnBottom)
If This.nSelectedImageStyle = 3
DrawEdge(thDC, lcTmpRect, BDR_RAISEDINNER, BF_RECT)
Else
DrawEdge(thDC, lcTmpRect, BDR_SUNKENOUTER, BF_RECT)
EndIf
Otherwise
EndCase
EndIf
*-- »æÖÆÎı¾Çø
Do Case
Case This.nSelectedStyle = 0
*-- ±ê׼ѡ¶¨
lnColor = Iif(This.nSelectedBackColor < 0, GetSysColor(COLOR_HIGHLIGHT), This.nSelectedBackColor)
lhBrush = CreateSolidBrush(lnColor)
lcTmpRect = This.Get_Rect_Str(lnLeft, tnTop, tnRight, tnBottom)
FillRect(thDC, lcTmpRect, lhBrush)
If llImage And This.nSelectedImageStyle = 2
lcTmpRect = This.Get_Rect_Str(lnLeft, tnTop, lnBmpRight, tnBottom)
FillRect(thDC, lcTmpRect, lhBrush)
EndIf
DeleteObject(m.lhBrush)
Case InList(This.nSelectedStyle, 1, 2)
*-- ¾ØÐÎÑ¡¶¨¿ò¡¢ÍÖԲѡ¶¨¿ò
lnColor = Iif(This.nSelectedBorderColor = -1, GetSysColor(COLOR_HIGHLIGHT), This.nSelectedBorderColor)
lhPen = CreatePen(PS_SOLID, 1, lnColor)
lnOldPen = SelectObject(thDC, lhPen)
lhBrush = CreateSolidBrush(lnFillColor)
lhOldBrush = SelectObject(thDC, lhBrush)
If This.nSelectedStyle = 1
*-- ¾ØÐÎ
Rectangle(thDc, lnLeft, tnTop, tnRight, tnBottom)
Else
*-- Ô²½Ç
RoundRect(thDc, lnLeft, tnTop, tnRight, tnBottom, This.nSelectedRoundX, This.nSelectedRoundY)
EndIf
DeleteObject(lhPen)
DeleteObject(lhBrush)
SelectObject(thDc, lhOldPen)
SelectObject(thDc, lhOldBrush)
Case InList(This.nSelectedStyle, 3, 4)
*-- ͹ÆðÑ¡¶¨¿ò¡¢°¼ÏÂÑ¡¶¨¿ò
If This.nSelectedBackColor > 0
*-- ÊÇ·ñÐèÒªÌî³ä±³¾°
lnColor = Iif(This.nSelectedBackColor = -1, GetSysColor(COLOR_HIGHLIGHT), This.nSelectedBackColor)
lhBrush = CreateSolidBrush(lnColor)
lcTmpRect = This.Get_Rect_Str(lnLeft, tnTop, tnRight, tnBottom)
FillRect(thDC, lcTmpRect, lhBrush)
If llImage And This.nSelectedImageStyle = 2
lcTmpRect = This.Get_Rect_Str(lnLeft, tnTop, tnRight, tnBottom)
FillRect(thDC, lcTmpRect, lhBrush)
EndIf
DeleteObject(m.lhBrush)
EndIf
lcTmpRect = This.Get_Rect_Str(lnLeft, tnTop, tnRight, tnBottom)
If This.nSelectedStyle = 3
DrawEdge(thDC, lcTmpRect, BDR_RAISEDINNER, BF_RECT)
Else
DrawEdge(thDC, lcTmpRect, BDR_SUNKENOUTER, BF_RECT)
EndIf
Otherwise
EndCase
ENDPROC
HIDDEN PROCEDURE draw_separator
LPARAMETERS thDC, tnLeft, tnTop, tnRight, tnBottom
Private lcRect
Local lcRect
lcRect = This.Get_Rect_Str(tnLeft, tnTop + 2, tnRight, tnBottom)
DrawEdge(m.thDC, lcRect, EDGE_ETCHED, BF_TOP)
ENDPROC
HIDDEN PROCEDURE draw_text && »Îı_Ço
LPARAMETERS thDC, tcText, tnColor, tnLeft, tnTop, tnRight, tnBottom
Private lcRect, lnOldHdc, lhPen
Local lcRect, lnOldHdc, lhPen
lcRect = This.Get_Rect_Str(m.tnLeft + This.nTextMargin, m.tnTop, m.tnRight, m.tnBottom)
SetTextColor(m.thDC, m.tnColor)
DrawText(m.thDC, m.tcText, Len(m.tcText), m.lcRect, DT_SINGLELINE + DT_LEFT + DT_VCENTER)
ENDPROC
HIDDEN PROCEDURE gethalfcolor && E¡Á½É«Ö®¼äµÄ°ëÉ«µ÷
LPARAMETERS tnColor1, tnColor2, tnRate
* thDc É豸¾ä±ú
* tnColor1 Æðʼ½¥±äÉ«
* tnColor2 ½áÊø½¥±äÉ«
* tnRate °ëÉ«µ÷µÄ±ÈÂÊ
Private lnStartR, lnStartG, lnStartB, lnRed, lnGreen, lnBlue, lnNowR, lnNowG, lnNowB
Local lnStartR, lnStartG, lnStartB, lnRed, lnGreen, lnBlue, lnNowR, lnNowG, lnNowB
lnStartR = BitAnd(m.tnColor1, 0x0000FF)
lnStartG = BitRShift(BitAnd(m.tnColor1, 0x00FF00), 8)
lnStartB = BitRShift(BitAnd(m.tnColor1, 0xFF0000), 16)
lnRed = lnStartR - BitAnd(m.tnColor2, 0x0000FF)
lnGreen = lnStartG - BitRShift(BitAnd(m.tnColor2, 0x00FF00), 8)
lnBlue = lnStartB - BitRShift(BitAnd(m.tnColor2, 0xFF0000), 16)
Return Rgb(lnStartR - lnRed / 100 * tnRate, ;
lnStartG - lnGreen / 100 * tnRate, ;
lnStartB - lnBlue / 100 * tnRate)
ENDPROC
HIDDEN PROCEDURE gethwnd && »ñE¡´°¿Ú_ä±ú
If This.nHwnd = 0
Do Case
Case Type("_Screen.ActiveForm.Hwnd") = "N"
This.nHwnd = _Screen.ActiveForm.Hwnd
Case _Screen.Visible
This.nHwnd = _Screen.Hwnd
Otherwise
This.nHwnd = GetActiveWindow()
EndCase
EndIf
Return This.nHwnd
ENDPROC
HIDDEN PROCEDURE get_rect_num && ´Ó Rect ½á11ÖD·µ»OEýÖµ¡£Eç1ûÖ¸¶¨Á˵OÖ·²ÎEý£¬Ôò½á1û±»±£´æµ½µOÖ·²ÎEýÖD¡£
LPARAMETERS tcRect, tnRefLeft, tnRefTop, tnRefRight, tnRefBottom
tnRefLeft = CToBin(Substr(m.tcRect, DWORD_SIZE * 0 + 1, DWORD_SIZE), "4rs")
tnRefTop = CToBin(Substr(m.tcRect, DWORD_SIZE * 1 + 1, DWORD_SIZE), "4rs")
tnRefRight = CToBin(Substr(m.tcRect, DWORD_SIZE * 2 + 1, DWORD_SIZE), "4rs")
tnRefBottom = CToBin(Substr(m.tcRect, DWORD_SIZE * 3 + 1, DWORD_SIZE), "4rs")
ENDPROC
HIDDEN PROCEDURE get_rect_str && ´«µÝ Left, Top, Right, Bottom Ëĸö²ÎEý£¬·µ»O RECT ½á11ÑùµÄ×Ö·û´®¡£
LPARAMETERS m.tnLeft, tnTop, tnRight, tnBottom
Return BinToC(m.tnLeft, "4rs") ;
+ BinToC(m.tnTop, "4rs") ;
+ BinToC(m.tnRight, "4rs") ;
+ BinToC(m.tnBottom, "4rs")
ENDPROC
PROCEDURE Init
Private lcClass, lcClassLibrary, lcRetClassLibrary
Local lcClass, lcClassLibrary, lcRetClassLibrary
If Not PemStatus(_Screen, This.Class, 5)
This.Declare_Dlls()
_Screen.AddProperty(This.Class, .T.)
EndIf
lcClass = This.Class
lcClassLibrary = This.ClassLibrary
lcRetClassLibrary = m.lcClassLibrary
Do While Not Empty(m.lcClassLibrary)
lcClass = GetPem(m.lcClass, "ParentClass")
lcClassLibrary = GetPem(m.lcClass, "ClassLibrary")
If Not Empty(m.lcClassLibrary)
m.lcRetClassLibrary = m.lcClassLibrary
EndIf
EndDo
This.ClassLibraryRoot = m.lcRetClassLibrary
If This.lShareIcons = .T.
If Not PemStatus(_Screen, "oRefIcons", 5) Or Not Type("_Screen.oRefIcons.Name") = "C"
_Screen.AddProperty("oRefIcons", NULL)
_Screen.oRefIcons = NewObject("IconCollection", This.ClassLibraryRoot)
EndIf
This.oRefIcons = _Screen.oRefIcons
Else
This.oRefIcons = NewObject("IconCollection", This.ClassLibraryRoot)
EndIf
This.oItems = NewObject("Collection")
ENDPROC
HIDDEN PROCEDURE inititems && 3oE¼»_A¸Ä¿DÅI¢
*-- ¼ÆËã×î´ó×Ö·û³¤¶È
*-- ¼ÆËã¸÷¸öÀ¸Ä¿ËùÐè¿í¸ß
Private lhWnd, lhDC, loItem, lcTitle, lsSize, lnMaxH, lnMaxW, lnValH, lnValW
Local lhWnd, loItem, loItem, lcTitle, lhDC, lsSize, lnMaxH, lnMaxW, lnValH, lnValW
lhWnd = This.GetHwnd()
lhDC = GetDC(m.lhWnd)
If m.lhDC = 0
Return .F.
EndIf
Store 0 To lnMaxH, lnMaxW, lnValH, lnValW
For Each loItem In This.oItems
*-- У¶Ô
lcTitle = loItem.cTitle
lcTitle = Strtran(m.lcTitle, "\<", "&")
lcTitle = Iif(m.lcTitle == "\-", "", m.lcTitle)
loItem.cTitle2 = m.lcTitle
loItem.cMessage = Iif(IsNull(loItem.cMessage), Strtran(m.lcTitle, "&", ""), loItem.cMessage)
loItem.cEnabled = Transform(loItem.cEnabled)
*-- ¼ÆËãÎı¾¿í¶È
lsSize = Replicate(Chr(0), POINT_SIZE)
GetTextExtentPoint32(m.lhDC, m.lcTitle, Len(m.lcTitle), @m.lsSize)
*-- ´¦ÀíÀ¸Ä¿¸ß¶È
Do Case
Case Empty(m.lcTitle)
loItem.nHeight = 5
Case loItem.nHeight > 0
*-- ʹÓüºÓи߶È
Otherwise
loItem.nHeight = CToBin(Substr(m.lsSize, 5, DWORD_SIZE), "4rs") + 7
EndCase
*-- ´¦ÀíÀ¸Ä¿¿í¶È
Do Case
Case loItem.nWidth > 0
*-- ʹÓÃ×Ô¶¨Òå¿í¶È
Otherwise
loItem.nWidth = CToBin(Substr(m.lsSize, 1, DWORD_SIZE), "4rs") ;
+ GetSystemMetrics(SM_CXMENUCHECK) + loItem.nHeight + This.nTextMargin ;
+ Max(0, Min(This.nImageLeft, This.nTextLeft))
EndCase
If Not Empty(loItem.cParentKey)
Loop
EndIf
If BitTest(loItem.nFlags, 5)
lnMaxW = m.lnMaxW + 20 + m.lnValW
lnMaxH = Max(m.lnMaxH, m.lnValH)
lnValW = 0
lnValH = 0
EndIf
lnValW = Max(m.lnValW, loItem.nWidth)
lnValH = m.lnValH + loItem.nHeight
EndFor
This.nMenuWidth = m.lnMaxW + m.lnValW
This.nMenuHeight = Max(m.lnValH, m.lnMaxH)
ReleaseDC(m.lhWnd, m.lhDC)
Return .T.
ENDPROC
PROCEDURE modifymenus && D_¸Ä²Ëµ¥µÄ Enabled ×´I¬
Private loItem, lnItem, lnIndex, lhMenu, lnFlags
Local loItem, lnItem, lnIndex, lhMenu, lnFlags
If Not Vartype(This.oCollections) = "O" ;
Or IsNull(This.oCollections)
Return
EndIf
For lnIndex = 1 To This.oCollections.Count
loItem = This.oCollections.Item(m.lnIndex)
If Vartype(m.loItem) <> "O" Or IsNull(m.loItem)
Loop
EndIf
If Empty(loItem.cEnabled)
Loop
EndIf
If Not Type("Evaluate(loItem.cEnabled)") = "L"
Loop
EndIf
lnFlags = loItem.nFlags
lnItem = WM_USER + m.lnIndex
lhMenu = Iif(loItem.hMenu = 0, This.hMenu, loItem.hMenu)
If Evaluate(loItem.cEnabled) = .F.
loItem.lEnabled = .F.
lnFlags = BitOr(lnFlags, BitOr(MF_GRAYED, MF_DISABLED))
Else
loItem.lEnabled = .T.
lnFlags = BitAnd(lnFlags, BitAnd(MF_GRAYED, MF_DISABLED))
EndIf
lnFlags = BitOr(m.lnFlags, Iif(This.lOwnerDraw, MF_OWNERDRAW, MF_BYCOMMAND))
ModifyMenu(m.lhMenu, m.lnItem, lnFlags, m.lnItem, loItem.nAddress)
EndFor
ENDPROC
HIDDEN PROCEDURE newitem && »ñE¡O»¸öA¸Ä¿¶ÔIó
Private loItem
Local loItem
Return NewObject("_MenuInfo", This.ClassLibraryRoot)
loItem = NewObject("Custom")
loItem.AddProperty("cKey", "") && À¸Ä¿ Key
loItem.AddProperty("cParentKey", "") && ¸¸À¸Ä¿ Key
loItem.AddProperty("nIndex", 0) && 챐
loItem.AddProperty("nAddress", 0) && À¸Ä¿µØÖ·
loItem.AddProperty("cTitle", "") && À¸Ä¿Îı¾
loItem.AddProperty("cTitle2", "") && ±»¸ñʽ»¯´¦ÀíºóµÄÀ¸Ä¿Îı¾
loItem.AddProperty("cCommand", "") && ÃüÁî¹Ø¼ü×Ö
loItem.AddProperty("cEnabled", "") && Enabled ±í´ïʽ
loItem.AddProperty("cPicture", "") && ͼ±ê
loItem.AddProperty("cMessage", NULL) && ÐÅÏ¢Ìáʾ
loItem.AddProperty("hParent", 0) && ¸¸Ç×¾ä±ú
loItem.AddProperty("hMenu", 0) && Èç¹ûÊÇ×Ӳ˵¥£¬±£´æ²Ëµ¥¾ä±ú
loItem.AddProperty("hMsk", 0) && ͼ±êÑÚÂë¾ä±ú
loItem.AddProperty("hPic", 0) && ͼ±ê¾ä±ú
loItem.AddProperty("nFlags", 0) && uFlags
loItem.AddProperty("nHeight", 0) && À¸Ä¿¸ß¶È
loItem.AddProperty("nWidth", 0) && À¸Ä¿¿í¶È
Return m.loItem
ENDPROC
PROCEDURE setmessage && ÉèÖA²Ëµ¥Iî×´I¬A¸IáE_DÅI¢£¬µÚ¶_²ÎÖ¸ÎïAí²Ëµ¥IîµÄDòºÅ£¬E±E¡E1ÓA×î½üIí¼ÓµÄ²Ëµ¥¡£
LPARAMETERS tcMessage, tnOrder
Private lnOrder
Local lnOrder
If Vartype(m.tnOrder) = "N"
lnOrder = m.tnOrder
Else
lnOrder = This.oItems.Count
EndIf
If Not BetWeen(m.lnOrder, 1, This.oItems.Count)
MessageBox("Ö¸¶¨µÄË÷ÒýºÅ³¬¹ý²Ëµ¥ÏîÄ¿ºÅ£¡", 16, "PopMenu.SetMessage")
Return
EndIf
This.oItems.Item(m.lnOrder).cMessage = m.tcMessage
ENDPROC
PROCEDURE setpicture && ÉèÖA²Ëµ¥IîµÄͼƬ£¬µÚ¶_²ÎÖ¸ÎïAí²Ëµ¥IîDòºÅ£¬E±E¡E1ÓA×î½üIí¼ÓµÄ²Ëµ¥¡£
LPARAMETERS tcPicFile, tnOrder
Private lnOrder
Local lnOrder
If Vartype(m.tnOrder) = "N"
lnOrder = m.tnOrder
Else
lnOrder = This.oItems.Count
EndIf
If Not BetWeen(lnOrder, 1, This.oItems.Count)
MessageBox("Ö¸¶¨µÄË÷ÒýºÅ³¬¹ý²Ëµ¥ÏîÄ¿ºÅ£¡", 16, "PopMenu.SetPicture")
Return
EndIf
This.oItems.Item(m.lnOrder).cPicture = m.tcPicFile
ENDPROC
PROCEDURE show && IÔE_²Ëµ¥ÔÚÖ¸¶¨µÄ x,y ×o±êÍ⣬Eç1ûδָ¶¨£¬½«ÔÚµ±Ç°Eó±êλÖAIÔE_¡£
Lparameters tnX, tnY, tlAbsolute, tuFlags
*!* ËùÓDÔ¤¶¨OåµÄ¿OÖÆ²Ëµ¥IO²_ÍEÇIµÍ3²Ëµ¥£©µÄIDºÅ±ODë´óÓÚ 0xF000¡£Eç1ûÄ3¸öÓ¦ÓA3IDòOªIí¼ÓIµÍ3²Ëµ¥£¬
*!* ÆäIµÍ3²Ëµ¥µÄ ID ºÅ±ODëD¡ÓÚF000¡£¡±
*-- tnX x ×ù±ê
*-- tnY y ×ù±ê
*-- tlAbsolute ´Ë×ù±êEÇ·ñ_o¶Ô×o±ê
*-- tuFlags ×Ô¶¨Oå TrackPopmenuEx uFlags
Private lcPoint, lnX, lnY, lnFlags, lnReturn, loItem
Local lcPoint, lnX, lnY, lnFlags, lnReturn, loItem
This.GetHwnd()
If This.nHwnd = 0
Messagebox("3oE¼»_E§°Ü£¡", 16, "PopMenu.ShowBy")
Return Null
Endif
If Pcount() >= 2
*-- ÔÚÖ¸¶¨×o±êµ_3ö
lnX = Iif(Vartype(m.tnX) = "N", m.tnX, 0)
lnY = Iif(Vartype(m.tnY) = "N", m.tnY, 0)
If Not m.tlAbsolute
*-- ´Ë×ù±êEÇIà¶ÔÆÁĻֵ
lcPoint = Replicate(Chr(0), DWORD_SIZE * 2)
ClientToScreen(This.nHwnd, @lcPoint)
lnX = lnX + CToBin(Left(m.lcPoint, DWORD_SIZE), "4rs")
lnY = lnY + CToBin(Right(m.lcPoint, DWORD_SIZE), "4rs")
Endif
Else
*-- E¡Eó±êµ±Ç°Î»ÖA
lcPoint = Replicate(Chr(0), DWORD_SIZE * 2)
GetCursorPos(@m.lcPoint)
lnX = CToBin(Left(m.lcPoint, DWORD_SIZE), "4rs")
lnY = CToBin(Right(m.lcPoint, DWORD_SIZE), "4rs")
Endif
***
*** ¿ªE¼´´½¨
***
If This.hMenu <> 0
*-- ²Ëµ¥¼º´´½¨£¬D_¸Ä²Ëµ¥IîÄÚEÝ
This.ModifyMenus()
Else
*-- ²Ëµ¥Î´´´½¨£¬´´½¨²Ëµ¥
This.oCollections = Null
This.oCollections = Newobject("Collection")
This.hMenu = CreatePopupMenu()
This.CreateMenus(This.oCollections, This.hMenu)
Endif
*
This.BindEvents(.T.)
*-- µ_3ö·½E½
If Vartype(m.tuFlags) = "N"
lnFlags = Bitor(m.tuFlags, TPM_RETURNCMD)
Else
lnFlags = TPM_LEFTALIGN + TPM_TOPALIGN + TPM_RETURNCMD
Endif
SetForegroundWindow(This.nHwnd)
lnReturn = TrackPopupMenu(This.hMenu, m.lnFlags, Max(m.lnX, 0), Max(m.lnY, 0), 0, This.nHwnd, Null)
This.BindEvents(.F.)
If m.lnReturn > 0
lnReturn = m.lnReturn - WM_USER
loItem = This.oCollections.Item(m.lnReturn)
lcCommand = loItem.cCommand
If Not Empty(m.lcCommand)
&lcCommand
Endif
*!* If Not Empty(m.lcCommand)
*!* If Version(5) >= 900
*!* ExecScript(m.lcCommand)
*!* Else
*!* &lcCommand
*!* EndIf
*!* EndIf
Do Case
Case This.nReturn = 0
*-- Ë÷Oý
Return loItem.nIndex
Case This.nReturn = 1
*-- cKey
Return loItem.cKey
Case This.nReturn = 2
*-- A¸Ä¿Îı_
Return loItem.cTitle
Case This.nReturn = 3
*-- ¶ÔIó
Return m.loItem
Otherwise
Return Null
Endcase
Else
Return Null
Endif
ENDPROC
PROCEDURE showby && Ö¸¶¨±íµ¥µÄÄ3¸ö¶ÔI󣬽«ÔÚ¸A¶ÔIóµÄI·½µ_3ö²Ëµ¥¡£
LPARAMETERS toObject, tnAddX, tnAddY
Private loForm, lcBaseClass, lcPoint, lnTop, lnLeft, luFlags
Local loForm, lcBaseClass, lcPoint, lnTop, lnLeft, luFlags
If This.nMaxLen = 0
If Not This.InitMenu()
MessageBox("³õʼ»¯Ê§°Ü£¡", 16, "PopMenu.ShowBy")
Return
EndIf
EndIf
loForm = toObject
lcBaseClass = Upper(toObject.BaseClass)
Do While Not InList(m.lcBaseClass, "FORM", "TOOLBAR")
loForm = loForm.Parent
lcBaseClass = Upper(loForm.BaseClass)
EndDo
lcPoint = BinToC(ObjToClient(m.toObject, 2), "4rs") + BinToC(ObjToClient(m.toObject, 1), "4rs")
ClientToScreen(loForm.Hwnd, @m.lcPoint)
lnLeft = CToBin(Left(m.lcPoint, 4), "4rs")
lnTop = CToBin(Right(m.lcPoint, 4), "4rs")
If Vartype(m.tnAddX) = "N"
lnLeft = m.lnLeft + m.tnAddX
EndIf
If Vartype(m.tnAddY) = "N"
lnTop = m.lnTop + m.tnAddY
EndIf
*-- ¼ì²éÆÁÄ»·¶Î§
If m.lnLeft + This.nMenuWidth + 17 >= Sysmetric(1)
luFlags = TPM_RIGHTALIGN
lnLeft = m.lnLeft + m.toObject.Width
If m.lnLeft + This.nMenuWidth + 17 >= Sysmetric(1)
lnLeft = Sysmetric(1)
EndIf
Else
luFlags = TPM_LEFTALIGN
EndIf
If m.lnTop + This.nMenuHeight + 62 > Sysmetric(2)
luFlags = BitOr(m.luFlags, TPM_BOTTOMALIGN)
m.lnTop = CToBin(Right(m.lcPoint, 4), "4rs") - toObject.Height
Else
luFlags = BitOr(m.luFlags, TPM_TOPALIGN)
EndIf
Return This.Show(m.lnLeft, m.lnTop + m.toObject.Height, .T., m.luFlags)
ENDPROC
PROCEDURE transparentblta && See win32Api TransparentBlt
LPARAMETERS hdcDest, nXOriginDest, nYOriginDest, nHeightDest, ;
hdcSrc, nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc, crTransparent
*!* HDC hdcDest // Ä¿±êDC
*!* int nXOriginDest // Ä¿±êXÆ«ÒÆ
*!* int nYOriginDest // Ä¿±êYÆ«ÒÆ
*!* int nWidthDest // Ä¿±ê¿í¶È
*!* int nHeightDest // Ä¿±ê¸ß¶È
*!* HDC hdcSrc // Ô´DC
*!* int nXOriginSrc // Ô´XÆðµã
*!* int nYOriginSrc // Ô´YÆðµã
*!* int nWidthSrc // Ô´¿í¶È
*!* int nHeightSrc // Ô´¸ß¶È
*!* UINT crTransparent // ͸Ã÷É«,COLORREFÀàÐÍ
*!* HBITMAP hOldImageBMP, hImageBMP = CreateCompatibleBitmap(hdcDest, nWidthDest, nHeightDest); // ´´½¨¼æÈÝλͼ
*!* HBITMAP hOldMaskBMP, hMaskBMP = CreateBitmap(nWidthDest, nHeightDest, 1, 1, NULL); // ´´½¨µ¥É«ÑÚÂëλͼ
*!* HDC hImageDC = CreateCompatibleDC(hdcDest);
*!* HDC hMaskDC = CreateCompatibleDC(hdcDest);
*!* hOldImageBMP = (HBITMAP)SelectObject(hImageDC, hImageBMP);
*!* hOldMaskBMP = (HBITMAP)SelectObject(hMaskDC, hMaskBMP);
*!* // ½«Ô´DCÖеÄλͼ¿½±´µ½ÁÙʱDCÖÐ
*!* if (nWidthDest == nWidthSrc && nHeightDest == nHeightSrc)
*!* BitBlt(hImageDC, 0, 0, nWidthDest, nHeightDest, hdcSrc, nXOriginSrc, nYOriginSrc, SRCCOPY);
*!* else
*!* StretchBlt(hImageDC, 0, 0, nWidthDest, nHeightDest,
*!* hdcSrc, nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc, SRCCOPY);
*!* // ÉèÖÃ͸Ã÷É«
*!* SetBkColor(hImageDC, crTransparent);
*!* // Éú³É͸Ã÷ÇøÓòΪ°×É«£¬ÆäËüÇøÓòΪºÚÉ«µÄÑÚÂëλͼ
*!* BitBlt(hMaskDC, 0, 0, nWidthDest, nHeightDest, hImageDC, 0, 0, SRCCOPY);
*!* // Éú³É͸Ã÷ÇøÓòΪºÚÉ«£¬ÆäËüÇøÓò±£³Ö²»±äµÄλͼ
*!* SetBkColor(hImageDC, RGB(0,0,0));
*!* SetTextColor(hImageDC, RGB(255,255,255));
*!* BitBlt(hImageDC, 0, 0, nWidthDest, nHeightDest, hMaskDC, 0, 0, SRCAND);
*!* // ͸Ã÷²¿·Ö±£³ÖÆÁÄ»²»±ä£¬ÆäËü²¿·Ö±ä³ÉºÚÉ«
*!* SetBkColor(hdcDest,RGB(255,255,255));
*!* SetTextColor(hdcDest,RGB(0,0,0));
*!* BitBlt(hdcDest, nXOriginDest, nYOriginDest, nWidthDest, nHeightDest, hMaskDC, 0, 0, SRCAND);
*!* // "»ò"ÔËËã,Éú³É×îÖÕЧ¹û
*!* BitBlt(hdcDest, nXOriginDest, nYOriginDest, nWidthDest, nHeightDest, hImageDC, 0, 0, SRCPAINT);
*!* // ÇåÀí¡¢»Ö¸´
*!* SelectObject(hImageDC, hOldImageBMP);
*!* DeleteDC(hImageDC);
*!* SelectObject(hMaskDC, hOldMaskBMP);
*!* DeleteDC(hMaskDC);
*!* DeleteObject(hImageBMP);
*!* DeleteObject(hMaskBMP);
*!* }
ENDPROC
ENDDEFINE
DEFINE CLASS tooltipex AS control
*< CLASSDATA: Baseclass="control" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="Label1" UniqueID="" Timestamp="" />
#INCLUDE "win32api.h"
*
*m: about
*m: addcontrol && ¶ÔÒ»¸ö±íµ¥¿Ø¼þÌí¼ÓÌáʾ
*m: addmessage && Ìí¼ÓÒ»¸ö¶ÔÏóÐÅÏ¢£¬ÔÚ»ñµÃ½¹µãÓëʧȥ½¹µãʱ£¬ÏÔʾÐÅÏ¢¡£
*m: b_gotfocus && °ó¶¨µ½¶ÔÏó GotFocus ʼþ
*m: createtrackwindow
*m: declare_dlls
*m: getstructvalue
*m: hide && ͨ¹ýÉèÖà Visible ÊôÐÔΪ¡°¼Ù¡±(.F.)£¬Òþ²ØÒ»¸ö±íµ¥£¬±íµ¥¼¯»ò¹¤¾ßÀ¸¡£
*m: show && ÔÚÖ¸¶¨¿Ø¼þÉÏÏÔʾ¿Ø¼þÌáʾ¡£Show(oObject, ctipText, nIcon, title)¡£nIcon ȡֵ 0 ÎÞͼ±ê£¬1=ÐÅÏ¢, 2=¾¯¸æ,3=´íÎó
*m: track && ¸ú×ÙÊó±êÏÔʾÌáʾ
*m: updatetrackwindow && ¸üд°¿ÚÐÅÏ¢
*p: cstruct && Éϴνṹֵ
*p: htrack && ¸ú×ÙÌáʾµÄ´°¿Ú¾ä±ú
*p: labsolute && ²»×Ô¶¯µ÷ÕûÐÅÏ¢µÄµ¯³öλÖã¨Ê¼ÖÕÔÚÏ·½ÏÔʾ£¿£©
*p: lalwaystip && Êó±êλÓڿؼþÉÏ·½Ê±£¬ÊÇ·ñ×ÜÊÇÏÔʾÌáʾ(ûÓÃ)¡£
*p: lballoon && ÊÇ·ñʹÓÃÆøÅÝÌáʾ
*p: lcentertip && ÊÇ·ñÔڿؼþµÄÖмäÏÔʾÌáʾ
*p: lclose && ¹Ø±Õ°´Å¥
*p: lnofade && ·ÇµÈëµ³ö£¬»¬³öЧ¹û£¿
*p: naddress && µØÖ·¼¯ºÏµÄÊý×éϱê
*p: naddx && ÌáʾλÖÃµÄ X ÖáÔöÁ¿Öµ¡£
*p: naddy && ÌáʾλÖà µÄY ÖáÔöÁ¿Öµ
*p: nalign && Ö¸Ã÷µ± Show ÖÐδ˵Ã÷ʱ£¬Ìáʾ³öÏÖÔڿؼþµÄʲôλÖá£1=ÉÏ×ó£¬2= ÉÏÖУ¬3=ÉÏÓÒ£¬4=ÖÐ×ó£¬5=ÖÐÖУ¬6=ÖÐÓÒ£¬7=ÏÂ×ó£¬8=ÏÂÖУ¬9=ÏÂÓÒ¡£Ä¬ÈÏÖµ 7.
*p: nbackcolor && ÌáʾÐÅÏ¢µÄ±³¾°É«
*p: ndelaytime && Ìáʾ×Ô¶¯ÏûʧµÄºÁÃëÊý£¬Èç¹ûΪ 0 Ôò²»»áÏûʧ¡£
*p: ndwstyle && ³õʼ»òÕßĬÈϵÄÌáʾ´°¿ÚµÄ DwStyle £¬Èç¹û´ËֵСÓÚ0£¬ÔòĬÈÏΪ TTS_NOPREFIX + TTS_USEVISUALSTYLE
*p: nforecolor && ÌáʾÐÅÏ¢µÄǰ¾°É«
*p: nmaxwidth && ÌáʾÐÅÏ¢µÄ×î´ó¿í¶È
*p: oreftimer && Ö¸ÏòÒþ²ØÌáʾµÄ¼ÆÊ±Æ÷
*p: paddress && ÄÚ´æµØÖ·
*a: aaddress[1,0]
*
HIDDEN aaddress,htrack,naddress,oreftimer,paddress
*
cstruct =
Height = 17
htrack = 0
labsolute = .F.
lalwaystip = .F.
lballoon = .F.
lcentertip = .F.
lclose = .F.
lnofade = .F.
naddress = 0
naddx = 0
naddy = 0
nalign = 7
Name = "tooltipex"
nbackcolor = -1
ndelaytime = 4000
ndwstyle = -1
nforecolor = -1
nmaxwidth = -1
oreftimer =
paddress = 0
Visible = .F.
Width = 65
*
ADD OBJECT 'Label1' AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "ToolTipEx", ;
Height = 16, ;
Left = 6, ;
Name = "Label1", ;
Top = 2
*< END OBJECT: BaseClass="label" />
PROCEDURE about
**********************************************
***
*** ToolTipEx Class
*** Version
***
*** Author by: Ê©Áè·å
*** Create date: 2008.06.15
*** Last update:
***
**********************************************
***
*** Èç¹ûËüȷʵ¶ÔÄúÓÐËù°ïÖú£¬²¢ÇÒÄãÒ²·Ç³£Ï²»¶£¬Äú¿ÉÒÔͨ¹ýÍøÉÏ»ã¿îÂÔ±íÄúµÄÐÄÒ⣬ÈÃÎÒÃÇÔÚÐÁÀÍÖÆ×÷Öеõ½ÐÀο, лл¡£
***
*** ÒøÐÐÕ˺Å
*** Öйú¹¤ÉÌÒøÐУº 9558 8014 0810 5404 077
*** Öйú½¨ÉèÒøÐУº 4367 4218 3350 0044 031
*** ¿ª»§ÈË£ºÊ©Áè·å
***
*** ÔÞÖú½ð¶î²»ÏÞ£¬Ö»×÷¶ÔÎÒÃÇŬÁ¦µÄÈϿɡ£
***
*** ÎÒÃǵÄÍøÖ·£ºhttp://xykjsoft.blog.163.com
***
***
*** ²âÊÔ»·¾³£ºWindows 2000¡¢Windows XP
*** ¿ª·¢ÓïÑÔ£ºVfp9 SP2
***
*!* typedef struct tagTOOLINFO{
*!* UINT cbSize; 4
*!* UINT uFlags; 4
*!* HWND hwnd; 4
*!* UINT_PTR uId; 4
*!* RECT Rect; 4*4
*!* HINSTANCE hinst; 4
*!* LPTSTR lpszText; 4
*!* #if (_WIN32_IE >= 0x0300)
*!* LPARAM lParam; 4
*!* #endif
*!* #if (_WIN32_WINNT >= 0x0501)
*!* void *lpReserved; 4
*!* #endif
*!* #if (_WIN32_WINNT >= 0x0600)
*!* HBITMAP hbmp; 4
*!* #endif
*!* } TOOLINFO, NEAR *PTOOLINFO, *LPTOOLINFO
ENDPROC
PROCEDURE addcontrol && ¶ÔÒ»¸ö±íµ¥¿Ø¼þÌí¼ÓÌáʾ
LPARAMETERS toObject, tcTipText
*!* Private loForm, lpRect, lnLeft, lnTop, lnRight, lnBottom, lhInst, lcTipText, lpszText, lnFlags
*!* Local loForm, lpRect, lnLeft, lnTop, lnRight, lnBottom, lhInst, lcTipText, lpszText, lnFlags
*!* If This.hTip = 0
*!* Return .F.
*!* EndIf
*!* If Not VarType(m.toObject) = "O" Or IsNull(m.toObject)
*!* Messagebox("ÇëÖ¸¶¨Ò»¸öÄ¿±ê¶ÔÏó£¡", 16, "ToolTipEx.AddControl")
*!* Return .F.
*!* EndIf
*!* loForm = toObject
*!* Do While Not InList(Upper(loForm.BaseClass), "FORM", "TOOLBAR")
*!* loForm = loForm.Parent
*!* EndDo
*!* *!* lpPoint = Replicate(Chr(0), POINT_SIZE)
*!* *!* ClientToScreen(ThisForm.Hwnd, @lpPoint)
*!* lpRect = Replicate(Chr(0), RECT_SIZE)
*!* GetClientRect(loForm.hWnd, @lpRect)
*!* lnLeft = CToBin(Substr(lpRect, 1, 4), "4rs") + ObjToClient(toObject, 2)
*!* lnTop = CToBin(Substr(lpRect, 5, 4), "4rs") + ObjToClient(toObject, 1)
*!* lnRight = lnLeft + toObject.Width
*!* lnBottom = lnTop + toObject.Height
*!* * lpRect = BinToC(m.lnLeft, "4rs") + BinToC(m.lnTop, "4rs") + BinToC(m.lnRight, "4rs") + BinToC(m.lnBottom, "4rs")
*!* lpRect = BinToC(0, "4rs") + BinToC(0, "4rs") + BinToC(ThisForm.Width, "4rs") + BinToC(ThisForm.Height, "4rs")
*!* ? lnLeft, lnTop, lnRight, lnBottom
*!* * lpRect = BinToC(0, "4rs") + BinToC(0, "4rs") + BinToC(ThisForm.Width, "4rs") + BinToC(ThisForm.Height, "4rs")
*!* lhInst = GetWindowLong(loForm.hWnd, GWL_HINSTANCE)
*!* lcTipText = Iif(VarType(m.tcTipText) = "C", m.tcTipText, toObject.ToolTipText)
*!* lpszText = LocalAlloc(LPTR, Len(m.lcTipText))
*!* CopyStr2MemA(m.lpszText, m.lcTipText, Len(m.lcTipText))
*!* *-- ¼Ç¼ÄÚ´æµØÖ·£¬Í˳öʱÏú»Ù
*!* This.nAddress = This.nAddress + 1
*!* Dimension This.aAddress[This.nAddress]
*!* This.aAddress[This.nAddress] = m.lpszText
*!* * TTF_SUBCLASS ĬÈÏ×ÓÀà
*!* * TTF_TRACK Ö¸Ã÷λÖÃ
*!* * TTF_TRANSPARENT ͸Ã÷£¿
*!* *-- ½á¹¹
*!* lnFlags = TTF_IDISHWND + TTF_SUBCLASS + TTF_TRANSPARENT
*!* lnFlags = Iif(This.lCenterTip, lnFlags + TTF_CENTERTIP , m.lnFlags)
*!* lcStruct = BinToC(m.lnFlags, "4rs") ; && uFlags
*!* + BinToC(loForm.hWnd, "4rs") ; && hWnd
*!* + BinToC(loForm.hWnd, "4rs") ; && uId
*!* + BinToC(m.lhInst, "4rs") ; && hInst
*!* + m.lpRect ; && Rect
*!* + BinToC(m.lpszText, "4rs") ; && lpszText
*!* + BinToC(0, "4rs") && lPara
*!* lcStruct = BinToC(Len(m.lcStruct) + 4, "4rs") + m.lcStruct
*!* ? SendMessage2c(This.hTip, TTM_ADDTOOLA, 0, m.lcStruct)
ENDPROC
PROCEDURE addmessage && Ìí¼ÓÒ»¸ö¶ÔÏóÐÅÏ¢£¬ÔÚ»ñµÃ½¹µãÓëʧȥ½¹µãʱ£¬ÏÔʾÐÅÏ¢¡£
LPARAMETERS toObject, tcTipText, tnIcon, tcTitle
If VarType(m.toObject) = "O" And Not IsNull(m.toObject)
toObject.AddProperty("cTipText", Iif(VarType(m.tcTipText) = "C", m.tcTipText, ""))
toObject.AddProperty("nIcon", Iif(VarType(m.tnIcon) = "N", m.tnIcon, 0))
toObject.AddProperty("cTitle", Iif(VarType(m.tcTitle) = "C", m.tcTitle, ""))
BindEvent(toObject, "GotFocus", This, "b_GotFocus")
BindEvent(toObject, "LostFocus", This, "Hide")
EndIf
ENDPROC
PROCEDURE b_gotfocus && °ó¶¨µ½¶ÔÏó GotFocus ʼþ
Private loObject, laArray
Local loObject, laArray
Dimension laArray[1]
AEvents(laArray, 0)
This.Show(laArray[1] ;
, Iif(Empty(laArray[1].cTipText), laArray[1].ToolTipText, laArray[1].cTipText) ;
, laArray[1].nIcon, laArray[1].cTitle)
ENDPROC
PROCEDURE createtrackwindow
Private lnStyle, lnDwStyle
Local lnStyle, lnDwStyle
If This.hTrack <> 0
DestroyWindow(This.hTrack)
EndIf
* WS_EX_TOPMOST + WS_EX_LAYERED + WS_POPUP
lnStyle = WS_EX_TOPMOST
* lnStyle = Bitxor(Bitor(lnStyle, WS_BORDER), WS_BORDER)
lnDwStyle = Iif(This.nDwStyle >= 0, This.nDwStyle, TTS_NOPREFIX + TTS_USEVISUALSTYLE)
lnDwStyle = Iif(This.lClose, BitOr(m.lnDwStyle, TTS_CLOSE), m.lnDwStyle)
lnDwStyle = Iif(This.lNoFade, BitOr(m.lnDwStyle, TTS_NOFADE), m.lnDwStyle)
lnDwStyle = Iif(This.lBalloon, BitOr(m.lnDwStyle, TTS_BALLOON), m.lnDwStyle)
lnDwStyle = Iif(This.lAlwaysTip, BitOr(m.lnDwStyle, TTS_ALWAYSTIP), m.lnDwStyle)
lnDwStyle = Bitxor(Bitor(m.lnDwStyle, WS_BORDER), WS_BORDER)
This.hTrack = CreateWindowEx ;
(m.lnStyle, "tooltips_class32", "", m.lnDwStyle, ;
CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, 0, 0)
If This.hTrack = 0
Messagebox("´´½¨ÌáʾÐÅÏ¢´°¿Úʧ°Ü£¡", 16, "ToolTipEx.CreateTrackWindow")
Return
EndIf
If This.nForeColor > -1
SendMessage2n(This.hTrack, TTM_SETTIPTEXTCOLOR, This.nForeColor, 0)
EndIf
If This.nBackColor > -1
SendMessage2n(This.hTrack, TTM_SETTIPBKCOLOR, This.nBackColor, 0)
EndIf
* TTM_SETTIPBKCOLOR
ENDPROC
PROCEDURE declare_dlls
Declare Long SendMessage In "User32" As SendMessage2n ;
Long hWnd, Long nMsg, Long wParam, Long lParam
Declare Long SendMessage In "User32" As SendMessage2c;
Long hWnd, Long nMsg, Long wParam, String lParam
Declare Long GetWindowLong In "User32" ;
Long hWnd, Long nIndex
Declare Integer LocalAlloc In "Kernel32" ;
Long uFlags, Long dwBytes
Declare Integer LocalFree In "Kernel32" ;
Long hlocMem
Declare Integer RtlMoveMemory In "Kernel32" As CopyStr2MemA ;
Long lpDest, String @lpSource, Long nLength
Declare Long CreateWindowEx In "User32" ;
Long dwExStyle, String lpClassName, String lpWindowName, ;
Long dwStyle, Long x, Long y, Long nWidth, Long nHeight, ;
Long hWndParent, Long hMenu, Long hInstance, Long lpParam
Declare Long DestroyWindow In "User32" ;
Long hWnd
Declare Long ClientToScreen In "User32" ;
Long hWnd, String @lpPoint
Declare Long GetClientRect In "User32" ;
Long hWnd, String @lpRect
Declare Long GetWindowLong In "User32" ;
Long hWnd, Long nIndex
Declare Long SetWindowLong In "User32" ;
Long hWnd, Long nIndex, Long dwNewLong
Declare Integer GetCursorPos In "User32" ;
String @lpPoint
* InitCommonControls() library "comctl32.dll"
* InitCommonControls
ENDPROC
PROCEDURE Destroy
If This.hTrack <> 0
DestroyWindow(This.hTrack)
EndIf
If This.pAddress <> 0
LocalFree(This.pAddress)
EndIf
UnBindEvent(_Screen, "Moved", This, "Hide")
ENDPROC
PROCEDURE getstructvalue
LPARAMETERS tcText
Private lcTipText, lnFlags, lsStruct
Local lcTipText, lnFlags, lsStruct
*-- ·ÖÅäÄÚ´æ¿Õ¼ä
lcTipText = Strtran(Transform(m.tcText), "\n", CRLF) + Chr(0)
If This.pAddress <> 0
LocalFree(This.pAddress)
EndIf
This.pAddress = LocalAlloc(LPTR, Len(m.lcTipText))
CopyStr2MemA(This.pAddress, m.lcTipText, Len(m.lcTipText))
* TTF_SUBCLASS ĬÈÏ×ÓÀà
* TTF_TRACK Ö¸Ã÷λÖÃ
* TTF_TRANSPARENT ͸Ã÷£¿
*-- ½á¹¹
lnFlags = TTF_SUBCLASS + TTF_TRANSPARENT + TTF_TRACK
lnFlags = Iif(This.lAbsolute, BitOr(m.lnFlags, TTF_ABSOLUTE), m.lnFlags)
lnFlags = Iif(This.lCenterTip, BitOr(lnFlags, TTF_CENTERTIP), m.lnFlags)
lsStruct = BinToC(m.lnFlags, "4rs") ; && uFlags
+ BinToC(ThisForm.Hwnd, "4rs") ; && hWnd
+ BinToC(0, "4rs") ; && uId
+ BinToC(0, "4rs") ; && hInst
+ Replicate(Chr(0), 16) ; && Rect
+ BinToC(This.pAddress, "4rs") ; && lpszText
+ BinToC(0, "4rs") && lPara
lsStruct = BinToC(Len(m.lsStruct) + 4, "4rs") + m.lsStruct
Return m.lsStruct
ENDPROC
PROCEDURE hide && ͨ¹ýÉèÖà Visible ÊôÐÔΪ¡°¼Ù¡±(.F.)£¬Òþ²ØÒ»¸ö±íµ¥£¬±íµ¥¼¯»ò¹¤¾ßÀ¸¡£
LPARAMETERS tnHwnd, tnMsg, tnWparam, tnLparam
If This.hTrack <> 0
DestroyWindow(This.hTrack)
EndIf
This.hTrack = 0
This.oRefTimer.Enabled = .F.
This.cStruct = "HIDE"
UnBindEvent(ThisForm.Hwnd, WM_LBUTTONDOWN)
*!* If PCount() = 4
*!* Declare Integer CallWindowProc In "User32" ;
*!* Long lpPrevWndFunc, Long nhWnd, Long uMsg, Long wParam, Long lParam
*!*
*!* Return CallWindowProc(This.pProc, tnHwnd, tnMsg, tnWparam, tnLparam)
*!* EndIf
ENDPROC
PROCEDURE Init
If Not PemStatus(_Screen, This.Class, 5)
This.Declare_Dlls()
_Screen.AddProperty(This.Class, .T.)
EndIf
This.CreateTrackWindow()
If This.hTrack <> 0
This.oRefTimer = NewObject("Timer")
This.oRefTimer.Interval = This.nDelayTime
BindEvent(This.oRefTimer, "Timer", This, "Hide")
BindEvent(ThisForm, "Moved", This, "Hide", 1)
BindEvent(ThisForm, "Resize", This, "Hide", 1)
BindEvent(_Screen, "Moved", This, "Hide", 1)
EndIf
ENDPROC
PROCEDURE show && ÔÚÖ¸¶¨¿Ø¼þÉÏÏÔʾ¿Ø¼þÌáʾ¡£Show(oObject, ctipText, nIcon, title)¡£nIcon ȡֵ 0 ÎÞͼ±ê£¬1=ÐÅÏ¢, 2=¾¯¸æ,3=´íÎó
LPARAMETERS toObject, tcTipText, tnIcon, tcTitle, tnAlign
Private loForm, lsPoint, lnLeft, lnTop, lnParam, lcTipText, lsStruct, lnAlign
Local loForm, lsPoint, lnLeft, lnTop, lnParam, lcTipText, lsStruct, lnAlign
This.CreateTrackWindow()
If This.hTrack = 0
Return
EndIf
lnAlign = Iif(VarType(m.tnAlign) = "N", m.tnAlign, This.nAlign)
lsPoint = Replicate(Chr(0), POINT_SIZE)
If VarType(m.toObject) = "O" And Not IsNull(m.toObject)
loForm = m.toObject
Do While Not InList(Upper(loForm.BaseClass), "FORM", "TOOLBAR")
loForm = loForm.Parent
EndDo
*-- È·¶¨¿Ø¼þÏà¶ÔÓÚ±íµ¥µÄ×ø±ê
ClientToScreen(loForm.Hwnd, @lsPoint)
lnLeft = CToBin(Left(m.lsPoint, 4), "4rs") + ObjToClient(m.toObject, 2)
lnTop = CToBin(Right(m.lsPoint, 4), "4rs") + ObjToClient(m.toObject, 1)
Do Case
*-- ˮƽ¾ÓÉÏ
Case m.lnAlign = 1 && ×ó
*--
Case m.lnAlign = 2 && ÖÐ
lnLeft = m.lnLeft + ObjToClient(m.toObject, 3) / 2
Case m.lnAlign = 3 && ÓÒ
lnLeft = m.lnLeft + ObjToClient(m.toObject, 3)
*-- ˮƽ¾ÓÖÐ
Case m.lnAlign = 4 && ×ó
lnTop = m.lnTop + toObject.Height / 2
Case m.lnAlign = 5 && ÖÐ
lnTop = m.lnTop + toObject.Height / 2
lnLeft = m.lnLeft + ObjToClient(m.toObject, 3) / 2
Case m.lnAlign = 6 && ÓÒ
lnTop = m.lnTop + toObject.Height / 2
lnLeft = m.lnLeft + ObjToClient(m.toObject, 3)
*-- ˮƽ¾ÓÏÂ
Case m.lnAlign = 7 && ×ó
lnTop = m.lnTop + toObject.Height
Case m.lnAlign = 8 && ÖÐ
lnTop = m.lnTop + toObject.Height
lnLeft = m.lnLeft + ObjToClient(m.toObject, 3) / 2
Case m.lnAlign = 9 && ÓÒ
lnTop = m.lnTop + toObject.Height
lnLeft = m.lnLeft + ObjToClient(m.toObject, 3)
EndCase
lnLeft = m.lnLeft + This.nAddX
lnTop = m.lnTop + This.nAddY
Else
*-- È¡Êó±êµ±Ç°Î»ÖÃ
GetCursorPos(@m.lsPoint)
lnLeft = CToBin(Left(m.lsPoint, DWORD_SIZE), "4rs")
lnTop = CToBin(Right(m.lsPoint, DWORD_SIZE), "4rs")
EndIf
lnParam = lnLeft + BitLShift(m.lnTop, 16)
*-- »ñÈ¡ÐÅÏ¢½á¹¹
lsStruct = This.GetStructValue(m.tcTipText)
SendMessage2n(This.hTrack, TTM_TRACKPOSITION, 0, m.lnParam)
SendMessage2c(This.hTrack, TTM_ADDTOOLA, 0, m.lsStruct)
If VarType(m.tnIcon) = "N" And VarType(m.tcTitle) = "C"
SendMessage2c(This.hTrack, TTM_SETTITLEA, m.tnIcon, m.tcTitle)
EndIf
SendMessage2c(This.hTrack, TTM_TRACKACTIVATE, 1, m.lsStruct)
BindEvent(ThisForm.Hwnd, WM_LBUTTONDOWN, This, "Hide")
This.oRefTimer.Enabled = .T.
ENDPROC
PROCEDURE track && ¸ú×ÙÊó±êÏÔʾÌáʾ
LPARAMETERS tcTipText, tnIcon, tcTitle
Private lsPoint, lnLeft, lnTop, lnParam, lnFlags, lsStruct
Local lsPoint, lnLeft, lnTop, lnParam, lnFlags, lsStruct
If This.cStruct == "HIDE"
This.cStruct = ""
Return
EndIf
If This.hTrack = 0
This.CreateTrackWindow()
EndIf
If This.hTrack = 0
Return
EndIf
*-- È¡Êó±êµ±Ç°Î»ÖÃ
lsPoint = Replicate(Chr(0), POINT_SIZE)
GetCursorPos(@m.lsPoint)
lnLeft = CToBin(Left(m.lsPoint, DWORD_SIZE), "4rs") + 16
lnTop = CToBin(Right(m.lsPoint, DWORD_SIZE), "4rs") + 16
lnParam = lnLeft + BitLShift(m.lnTop, 16)
lsStruct = This.GetStructValue(m.tcTipText)
If VarType(m.tnIcon) = "N" And VarType(m.tcTitle) = "C"
SendMessage2c(This.hTrack, TTM_SETTITLEA, m.tnIcon, m.tcTitle)
Else
SendMessage2c(This.hTrack, TTM_SETTITLEA, 0, "")
EndIf
SendMessage2n(This.hTrack, TTM_TRACKPOSITION, 0, m.lnParam)
If Not Empty(This.cStruct)
SendMessage2c(This.hTrack, TTM_UPDATETIPTEXTA, 0, m.lsStruct)
Else
SendMessage2c(This.hTrack, TTM_ADDTOOLA, 0, m.lsStruct)
SendMessage2c(This.hTrack, TTM_TRACKACTIVATE, 1, m.lsStruct)
EndIf
This.oRefTimer.Enabled = .T.
This.cStruct = m.lsStruct
ENDPROC
HIDDEN PROCEDURE updatetrackwindow && ¸üд°¿ÚÐÅÏ¢
Local lnStyle
lnStyle = GetWindowLong(This.hTrack, GWL_STYLE)
SetWindowLong(This.hTrack, GWL_STYLE, m.lnStyle)
*!* IF ( This.CloseButton )
*!* m.nStyle = BITOR( m.nStyle, TTS_CLOSE )
*!* ELSE
*!* m.nStyle = BITAND( m.nStyle, BITNOT( TTS_CLOSE ))
*!* ENDIF
ENDPROC
PROCEDURE Label1.Init
Return .F.
ENDPROC
ENDDEFINE