romfast/comun
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
837b455687b74afa791bc3374fdf802928f5cb23
comun/utile/ctl32/outlooknavbar.vc2

1660 lines
55 KiB
Plaintext
Raw Blame History

*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
*--------------------------------------------------------------------------------------------------------------------------------------------------------
*< FOXBIN2PRG: Version="1.21" SourceFile="outlooknavbar.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
*
*
DEFINE CLASS outlooknavbar AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="PanelVertical" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Title" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="OverflowPanel" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="ShrinkButton" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Panel" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Splitter" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Panes" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: beforechangeselectedbutton
*m: buttonclicked && Occurs when a button is clicked.
*m: changetheme && Occurs when theme change.
*m: changeviewmode && Change control state (shrunk or not).
*m: inainte_de_showless
*m: inainte_de_showmore
*m: initthemedcontrol
*m: rearrangebuttons && Internal to the class. Rearrange buttons to show in correctly order and position.
*m: repositioncontrols && Reposition all controls inside OutlookNavBar to avoid bugs if height is changed at design time.
*m: selectedbutton_assign && Internal to the class. Occurs when SelectedButton property is changed.
*m: showless && Internal to the class. Show less buttons in the panel.
*m: showmore && Internal to the class. Show more buttons in the panel.
*m: updatepane && Change the specified pane properties: Caption, Picture16, Picture24 and HotKey.
*m: viewmodechanged && Occurs when the control was shrunk.
*p: displayshrinkbutton && Specify if Shrink button will be displayed or not.
*p: maxshowedbuttons && Maximum number of buttons displayed in the panel.
*p: mnushowlesstext && The text that is displayed in the "Show less" shortcut menu item.
*p: mnushowmoretext && The text that is displayed in the "Show more" shortcut menu item.
*p: mnuthemestext && The text that is displayed in the "Themes" shortcut menu item.
*p: selectedbutton && Internal to the class. The number of selected button.
*p: showedbuttons && Internal to the class. The number of showed buttons.
*p: targetformname && Internal to the class. Name of the target form where the toolbar will be docked.
*p: version && OutlookNavBar version.
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
PROTECTED Init,version
*<PropValue>
Anchor = 7
BackColor = 255,255,255
displayshrinkbutton = .T.
Height = 400
maxshowedbuttons = 5
mnushowlesstext = Mai putine
mnushowmoretext = Mai multe
mnuthemestext = Themes...
Name = "outlooknavbar"
selectedbutton = 0
showedbuttons = 0
targetformname = ("")
version = 3.5.0
Width = 200
_memberdata = <VFPData>
<memberdata name="buttonclicked" type="method" display="ButtonClicked"/>
<memberdata name="changetheme" type="method" display="ChangeTheme"/>
<memberdata name="maxshowedbuttons" type="property" display="MaxShowedButtons"/>
<memberdata name="mnushowlesstext" type="property" display="MnuShowLessText"/>
<memberdata name="mnushowmoretext" type="property" display="MnuShowMoreText"/>
<memberdata name="mnuthemestext" type="property" display="MnuThemesText"/>
<memberdata name="rearrangebuttons" type="method" display="ReArrangeButtons"/>
<memberdata name="selectedbutton" type="property" display="SelectedButton"/>
<memberdata name="selectedbutton_assign" type="method" display="SelectedButton_Assign"/>
<memberdata name="showedbuttons" type="property" display="ShowedButtons"/>
<memberdata name="showless" type="method" display="ShowLess"/>
<memberdata name="showmore" type="method" display="ShowMore"/>
<memberdata name="version" type="property" display="Version"/>
<memberdata name="viewmodechanged" type="method" display="ViewModeChanged"/>
<memberdata name="changeviewmode" type="method" display="ChangeViewMode"/>
<memberdata name="updatepane" type="method" display="UpdatePane"/>
<memberdata name="displayshrinkbutton" type="property" display="DisplayShrinkButton"/>
<memberdata name="beforechangeselectedbutton" type="method" display="BeforeChangeSelectedButton"/>
<memberdata name="initthemedcontrol" type="method" display="InitThemedControl"/>
<memberdata name="targetformname" type="property" display="TargetFormName"/>
<memberdata name="repositioncontrols" type="method" display="RepositionControls"/>
</VFPData>
*</PropValue>
ADD OBJECT 'OverflowPanel' AS overflowpanel WITH ;
Anchor = 14, ;
Left = 1, ;
Name = "OverflowPanel", ;
Top = 368, ;
Width = 198, ;
MENUBUTTON.imgPicture.Name = "imgPicture", ;
MENUBUTTON.Name = "MENUBUTTON", ;
MENUBUTTON.shpTransparent.Name = "shpTransparent"
*< END OBJECT: ClassLib="outlooknavbar.vcx" BaseClass="container" />
ADD OBJECT 'Panel' AS panel WITH ;
Height = 0, ;
Left = 1, ;
Name = "Panel", ;
Top = 368
*< END OBJECT: ClassLib="outlooknavbar.vcx" BaseClass="container" />
ADD OBJECT 'PanelVertical' AS panelvertical WITH ;
Left = 2, ;
Name = "PanelVertical", ;
Top = 29, ;
lblCaption.Name = "lblCaption"
*< END OBJECT: ClassLib="outlooknavbar.vcx" BaseClass="control" />
ADD OBJECT 'Panes' AS panes WITH ;
Anchor = 11, ;
ErasePage = .T., ;
Height = 332, ;
Left = 1, ;
Name = "Panes", ;
Top = 28
*< END OBJECT: ClassLib="outlooknavbar.vcx" BaseClass="pageframe" />
ADD OBJECT 'ShrinkButton' AS shrinkbutton WITH ;
Anchor = 9, ;
Left = 176, ;
Name = "ShrinkButton", ;
Top = 5
*< END OBJECT: ClassLib="outlooknavbar.vcx" BaseClass="control" />
ADD OBJECT 'Splitter' AS splitterhorizontal WITH ;
Left = 1, ;
Name = "Splitter", ;
objectabove = This.Parent.Panes, ;
objectbelow = This.Parent.Panel, ;
Top = 360, ;
imgBackground.Name = "imgBackground", ;
imgGripper.Name = "imgGripper"
*< END OBJECT: ClassLib="outlooknavbar.vcx" BaseClass="control" />
ADD OBJECT 'Title' AS title WITH ;
Name = "Title", ;
Top = 0, ;
imgBackground.Name = "imgBackground", ;
lblCaption.Name = "lblCaption"
*< END OBJECT: ClassLib="outlooknavbar.vcx" BaseClass="control" />
PROCEDURE beforechangeselectedbutton
Lparameters lnOldValue, lnNewValue
ENDPROC
PROCEDURE buttonclicked && Occurs when a button is clicked.
Lparameters lnNumber, lcCaption, lcPicture24
ENDPROC
PROCEDURE changetheme && Occurs when theme change.
This.BorderColor = _Screen.ThemesManager.GetMember("OutlookNavBar.BorderColor")
ENDPROC
PROCEDURE changeviewmode && Change control state (shrunk or not).
This.ShrinkButton.ChangeViewMode()
ENDPROC
PROCEDURE inainte_de_showless
ENDPROC
PROCEDURE inainte_de_showmore
ENDPROC
PROTECTED PROCEDURE Init
With Thisform
.LockScreen = .T.
.ShowTips = .T.
Local loPane
If .BaseClass=="Form"
.MinHeight = This.Height + 4
.MinWidth = This.Width + 4
*
* Special action for forms
For Each loPane In This.Panes.Pages
With loPane
This.UpdatePane(.PageOrder,.Caption,;
.Picture16,.Picture24,.HotKey)
Endwith
Endfor
*
Else
* Special action for toolbars
For Each loPane In This.Panes.Pages
If This.ShowedButtons<This.MaxShowedButtons
This.ShowMore()
Else
This.ReArrangeButtons()
Endif
Endfor
*
Endif
loPane = Null
With This
.InitThemedControl()
.ShrinkButton.Visible = .DisplayShrinkButton
With .Splitter
.ZOrder(0)
.Moved()
This.SelectedButton = 1
Endwith
Endwith
.LockScreen = .F.
Endwith
ENDPROC
HIDDEN PROCEDURE initthemedcontrol
If Not Vartype(_Screen.ThemesManager)=="O"
_Screen.Newobject("ThemesManager","ThemesManager",Forcepath('ThemedControls.vcx', Justpath(This.ClassLibrary)))
Endif
This.ChangeTheme()
ENDPROC
PROCEDURE rearrangebuttons && Internal to the class. Rearrange buttons to show in correctly order and position.
With This.OverflowPanel
Local lnLeft, lnMaxShowedButtons, lnControlCount, lnControl, llVisible
With .Menubutton
lnLeft = .Left
lnMaxShowedButtons = Int(.Left / .Width)
Endwith
lnControlCount = .ControlCount
For lnControl=lnControlCount To 2 Step -1
With .Controls(lnControl)
llVisible = .F.
If .Order > This.ShowedButtons
If lnControl <= (This.ShowedButtons + lnMaxShowedButtons + 1)
lnLeft = lnLeft - .Width
.Anchor = 0
.Left = lnLeft
.Anchor = 9
llVisible = .T.
Endif
Endif
.Visible = llVisible
Endwith
Endfor
Endwith
ENDPROC
PROCEDURE repositioncontrols && Reposition all controls inside OutlookNavBar to avoid bugs if height is changed at design time.
* To avoid bugs when OutlookNavBar is resized at design time.
If Not This.OverflowPanel.Top == (This.Height - (This.OverflowPanel.Height + 1))
Local lnAnchor
*
With This.OverflowPanel
lnAnchor = .Anchor
.Anchor = 0
.Top = This.Height - (.Height + 1)
.Anchor = lnAnchor
.ZOrder(0)
Endwith
*
With This.Panes
lnAnchor = .Anchor
.Anchor = 0
.Height = This.OverflowPanel.Top - This.Splitter.Height - .Top
.Anchor = lnAnchor
Endwith
*
With This.Panel
lnAnchor = .Anchor
.Anchor = 0
.Top = This.OverflowPanel.Top
.Anchor = lnAnchor
Endwith
*
With This.Splitter
lnAnchor = .Anchor
.Anchor = 0
.Top = This.OverflowPanel.Top - .Height
.Anchor = lnAnchor
Endwith
Endif
ENDPROC
HIDDEN PROCEDURE selectedbutton_assign && Internal to the class. Occurs when SelectedButton property is changed.
Lparameters vNewVal
If Between(m.vNewVal,1,This.Panes.PageCount)
With This
Local lnOldSelectedButton, lcTitle, lcPicture24
lnOldSelectedButton = .SelectedButton
If .BeforeChangeSelectedButton(lnOldSelectedButton, m.vNewVal)
.SelectedButton = m.vNewVal
With .Panel
If lnOldSelectedButton>0 And ;
Type(".Controls(lnOldSelectedButton)")=="O"
.Controls(lnOldSelectedButton).ChangeBackground()
Endif
.Controls(m.vNewVal).ChangeBackground()
lcTitle = .Controls(m.vNewVal).GetCaption()
lcPicture24 = .Controls(m.vNewVal).imgPicture.Picture
Endwith
With .OverflowPanel
If lnOldSelectedButton>0 And ;
Type(".Controls(lnOldSelectedButton+1)")=="O"
.Controls(lnOldSelectedButton+1).ChangeBackground()
Endif
.Controls(m.vNewVal+1).ChangeBackground()
Endwith
.Title.Caption = lcTitle
.PanelVertical.Caption = lcTitle
.Panes.ActivePage = m.vNewVal
.ButtonClicked(m.vNewVal,lcTitle,lcPicture24)
Endif
Endwith
Endif
ENDPROC
PROCEDURE showless && Internal to the class. Show less buttons in the panel.
this.inainte_de_showless()
With This.Splitter
.Top = .Top + .Steps
Endwith
ENDPROC
PROCEDURE showmore && Internal to the class. Show more buttons in the panel.
this.inainte_de_showmore()
With This.Splitter
.Top = .Top - .Steps
Endwith
ENDPROC
PROCEDURE updatepane && Change the specified pane properties: Caption, Picture16, Picture24 and HotKey.
Lparameters lnPane, lcCaption, lcPicture16, lcPicture24, lcHotKey
With This
With .Panes.Pages(lnPane)
.Caption = lcCaption
.Picture16 = lcPicture16
.Picture24 = lcPicture24
Endwith
With .Panel.Controls(lnPane)
.SetCaption(lcCaption, lcHotKey)
.imgPicture.Picture = lcPicture24
Endwith
With .OverflowPanel.Controls(lnPane+1)
.SetAll("ToolTipText",lcCaption)
.imgPicture.Picture = lcPicture16
Endwith
If lnPane==.SelectedButton
.SelectedButton = lnPane
Endif
Endwith
ENDPROC
PROCEDURE viewmodechanged && Occurs when the control was shrunk.
Lparameters llShrunk
ENDPROC
PROCEDURE OverflowPanel.MENUBUTTON.fillmenu
Local lnOption, ;
loThemes, ;
lnTheme, ;
lcName, ;
lcBar, ;
lcInheritWindowsThemeText
lnOption = DoDefault()
*!* Define Bar (lnOption) Of ShortcutMenu Prompt '\-'
*!* lnOption = lnOption + 1
*!* With _Screen.ThemesManager
*!* lcInheritWindowsThemeText = Strtran(.InheritWindowsThemeText,"\<","")
*!* Define Bar (lnOption) Of ShortcutMenu Prompt lcInheritWindowsThemeText
*!* On Selection Bar (lnOption) Of ShortcutMenu ;
*!* _Screen.ThemesManager.InheritWindowsTheme = !_Screen.ThemesManager.InheritWindowsTheme
*!* Set Mark Of Bar lnOption Of ShortcutMenu To .InheritWindowsTheme
*!* Endwith
*!* lnOption = lnOption + 1
*!* Define Bar (lnOption) Of ShortcutMenu Prompt '\-'
*!* loThemes = _Screen.ThemesManager.Themes
*!* For lnTheme = 1 To loThemes.Count
*!* lcName = loThemes.GetKey(lnTheme)
*!* Define Bar (lnOption + lnTheme) Of ShortcutMenu Prompt lcName ;
*!* Style Iif(_Screen.ThemesManager.ActiveTheme = lnTheme, 'B', '')
*!* lcBar = Transform(lnOption)
*!* On Selection Bar (lnOption + lnTheme) Of ShortcutMenu ;
*!* _Screen.ThemesManager.SetActiveTheme(Bar() - &lcBar)
*!* Next lnTheme
*lnOption = lnOption + lnTheme
Return lnOption
ENDPROC
PROCEDURE Panes.Resize
With This
.Parent.PanelVertical.Height = .Height - 1
Endwith
ENDPROC
PROCEDURE ShrinkButton.buttonclicked
Lparameters llShrunk
With This.Parent
If llShrunk
This.OldWidth = .Width
This.OldAnchor = .Anchor
.Anchor = 0
.Width = 33
.Anchor = 7
.Panes.SetAll("Visible",.F.)
.Panes.Visible = .F.
Else
.Anchor = 0
.Width = This.OldWidth
.Anchor = This.OldAnchor
.Panes.SetAll("Visible",.T.)
.Panes.Visible = .T.
Endif
.ReArrangeButtons()
.ViewModeChanged(llShrunk)
Endwith
ENDPROC
PROCEDURE Splitter.splittermoved
With This.Parent
.ShowedButtons = Int(.Panel.Height/32)
.ReArrangeButtons()
This.ObjectAboveMinSize = .OverflowPanel.Top - ;
(Min(.MaxShowedButtons,.Panes.PageCount)*32) - ;
(This.Height - 1) - ;
.Panes.Top
Endwith
ENDPROC
ENDDEFINE
DEFINE CLASS overflowpanel AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="MenuButton" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: addbutton && Add a new button to panel.
*m: changetheme && Occurs when theme change.
*m: initthemedcontrol
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
*<PropValue>
BorderWidth = 0
Height = 31
Name = "overflowpanel"
Width = 198
_memberdata = <VFPData>
<memberdata name="addbutton" type="method" display="AddButton"/>
<memberdata name="changetheme" type="method" display="ChangeTheme"/>
<memberdata name="initthemedcontrol" type="method" display="InitThemedControl"/>
</VFPData>
*</PropValue>
ADD OBJECT 'MenuButton' AS overflowpanelbutton WITH ;
Anchor = 9, ;
Left = 177, ;
Name = "MenuButton", ;
Top = 0, ;
imgPicture.Name = "imgPicture", ;
shpTransparent.Name = "shpTransparent"
*< END OBJECT: ClassLib="outlooknavbar.vcx" BaseClass="container" />
PROCEDURE addbutton && Add a new button to panel.
Lparameters lcCaption, lcPicture
With This
Local lnControlCount
lnControlCount = .ControlCount + 1
.Newobject("Button"+Alltrim(Str(lnControlCount - 1)),;
"OverflowPanelButton",This.ClassLibrary,,;
lcCaption,lcPicture)
Endwith
ENDPROC
PROCEDURE changetheme && Occurs when theme change.
With _Screen.ThemesManager
This.Picture = .GetMember("OverflowPanel.Background.Picture")
This.MenuButton.imgPicture.Picture = .GetMember("OverflowPanel.MenuButton.Picture")
Endwith
ENDPROC
PROCEDURE Init
This.InitThemedControl()
ENDPROC
HIDDEN PROCEDURE initthemedcontrol
If Not Vartype(_Screen.ThemesManager)=="O"
_Screen.Newobject("ThemesManager","ThemesManager",Forcepath('ThemedControls.vcx', Justpath(This.ClassLibrary)))
Endif
This.ChangeTheme()
ENDPROC
ENDDEFINE
DEFINE CLASS overflowpanelbutton AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="imgPicture" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="shpTransparent" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: changebackground && Change button's background image.
*m: changeselectedbutton && Change selected button.
*m: changetheme && Occurs when theme change.
*m: fillmenu
*m: initthemedcontrol
*p: imgfocusednotselected && Path and name of the button's image displayed when button is focused and not selected.
*p: imgfocusedselected && Path and name of the button's image displayed when button is focused and selected.
*p: imgnotfocusedselected && Path and name of the button's image displayed when button is not focused and selected.
*p: order && Button position in OverflowPanel.
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
HIDDEN imgfocusednotselected,imgfocusedselected,imgnotfocusedselected
PROTECTED Init
*<PropValue>
BackStyle = 0
BorderWidth = 0
Height = 31
imgfocusednotselected = .F.
imgfocusedselected = .F.
imgnotfocusedselected = .F.
Name = "overflowpanelbutton"
order = 0
Width = 22
_memberdata = <VFPData>
<memberdata name="changebackground" type="method" display="ChangeBackground"/>
<memberdata name="changeselectedbutton" type="method" display="ChangeSelectedButton"/>
<memberdata name="changetheme" type="method" display="ChangeTheme"/>
<memberdata name="imgfocusednotselected" type="property" display="ImgFocusedNotSelected"/>
<memberdata name="imgfocusedselected" type="property" display="ImgFocusedSelected"/>
<memberdata name="imgnotfocusedselected" type="property" display="ImgNotFocusedSelected"/>
<memberdata name="order" type="property" display="Order"/>
<memberdata name="initthemedcontrol" type="method" display="InitThemedControl"/>
<memberdata name="fillmenu" type="method" display="FillMenu"/>
</VFPData>
*</PropValue>
ADD OBJECT 'imgPicture' AS image WITH ;
BackStyle = 0, ;
Height = 16, ;
Left = 3, ;
MousePointer = 15, ;
Name = "imgPicture", ;
Stretch = 1, ;
Top = 7, ;
Width = 16
*< END OBJECT: BaseClass="image" />
ADD OBJECT 'shpTransparent' AS shape WITH ;
Anchor = 15, ;
BackStyle = 0, ;
BorderStyle = 0, ;
Height = 31, ;
Left = 0, ;
MousePointer = 15, ;
Name = "shpTransparent", ;
Top = 0, ;
Width = 22
*< END OBJECT: BaseClass="shape" />
PROCEDURE changebackground && Change button's background image.
Lparameters llGotFocus
#Define lnFocused 8
#Define lnNotFocused 16
#Define lnSelected 32
#Define lnNotSelected 64
Local llSelected, lnState, lcImage
With This
llSelected = (.Order>0 And .Order==.Parent.Parent.SelectedButton)
lnState = (Iif(llGotFocus,lnFocused,lnNotFocused) + ;
Iif(llSelected,lnSelected,lnNotSelected))
Do Case
Case lnState = (lnFocused + lnSelected)
lcImage = .ImgFocusedSelected
Case lnState = (lnFocused + lnNotSelected)
lcImage = .ImgFocusedNotSelected
Case lnState = (lnNotFocused + lnSelected)
lcImage = .ImgNotFocusedSelected
Otherwise
lcImage = ""
Endcase
.BackStyle = Iif(Empty(lcImage),0,1)
.Picture = lcImage
Endwith
ENDPROC
PROCEDURE changeselectedbutton && Change selected button.
If Upper(This.Name)=="MENUBUTTON"
Local lnButtonCount
lnButtonCount = This.Parent.ControlCount - 1
If lnButtonCount > 0
Local loBar
loBar = This.Parent.Parent
*
* Workaround to show menu in correct coordinates when
* OutlookNavBar is in a ToolBar.
If Upper(Thisform.BaseClass)=="TOOLBAR"
If Not Empty(loBar.TargetFormName)
Local lcTargetFormName, lcOlderFormName
lcTargetFormName = Upper(loBar.TargetFormName)
lcOlderFormName = Thisform.Name
If lcTargetFormName=="SCREEN"
Activate Screen
Else
Activate Window (lcTargetFormName)
Endif
Endif
Endif
*
Local lnRow, lnCol
lnRow = Mrow()
lnCol = Mcol()
Define Popup ShortcutMenu From lnRow, lnCol Margin SHORTCUT
This.FillMenu()
Activate Popup ShortcutMenu
Release Popups ShortcutMenu Extended
loBar = Null
If Vartype(lcOlderFormName)=="C"
Activate Window (lcOlderFormName)
Endif
Endif
Else
This.Parent.Parent.Selectedbutton = This.Order
Endif
ENDPROC
PROCEDURE changetheme && Occurs when theme change.
With _Screen.ThemesManager
This.ImgFocusedSelected = .GetMember("OverflowPanelButton.FocusedSelected.Picture")
This.ImgFocusedNotSelected = .GetMember("OverflowPanelButton.FocusedNotSelected.Picture")
This.ImgNotFocusedSelected = .GetMember("OverflowPanelButton.NotFocusedSelected.Picture")
This.ChangeBackground(.F.)
Endwith
ENDPROC
PROCEDURE fillmenu
Local lnButtonCount, loBar, lnOption
Local llUpDisabled, lcUpText, lcUpPicture
Local llDownDisabled, lcDownText, lcDownPicture
lnButtonCount = This.Parent.ControlCount - 1
loBar = This.Parent.Parent
lnOption = 1
llUpDisabled = (loBar.Showedbuttons>Min(lnButtonCount,loBar.MaxShowedbuttons))
lcUpText = Iif(llUpDisabled,"\","") + loBar.mnuShowMoreText
lcUpPicture = _Screen.ThemesManager.GetMember("ShortcutMenu.Up."+Iif(llUpDisabled,"Disabled","Enabled")+".Picture")
Define Bar (lnOption) Of ShortcutMenu Prompt (lcUpText) Picture (lcUpPicture)
On Selection Bar (lnOption) Of ShortcutMenu loBar.ShowMore()
lnOption = lnOption + 1
llDownDisabled = (loBar.Showedbuttons=0)
lcDownText = Iif(llDownDisabled,"\","") + loBar.mnuShowLessText
lcDownPicture = _Screen.ThemesManager.GetMember("ShortcutMenu.Down."+Iif(llDownDisabled,"Disabled","Enabled")+".Picture")
Define Bar (lnOption) Of ShortcutMenu Prompt (lcDownText) Picture (lcDownPicture)
On Selection Bar (lnOption) Of ShortcutMenu loBar.ShowLess()
lnOption = lnOption + 1
Define Bar (lnOption) Of ShortcutMenu Prompt "\-"
Local laMenu[lnButtonCount, 2]
laMenu=""
Local loButton
For Each loButton In This.Parent.Controls
With loButton
If Upper(.Class) == Upper("OverflowPanelButton") And .Name <> This.Name
laMenu[.Order, 1] = .imgPicture.ToolTipText
laMenu[.Order, 2] = .imgPicture.Picture
Endif
Endwith
Endfor
loButton = Null
Local lnMenuItem, lcBar
For lnMenuItem=1 To Alen(laMenu,1)
Define Bar (lnOption+lnMenuItem) Of ShortcutMenu Prompt (laMenu[lnMenuItem, 1]) ;
Style (Iif(lnMenuItem=loBar.Selectedbutton,"B","")) ;
Picture (laMenu[lnMenuItem, 2])
lcBar = Transform(lnOption)
On Selection Bar (lnOption+lnMenuItem) Of ShortcutMenu loBar.Selectedbutton=Bar()-&lcBar
Endfor
loBar = Null
Return lnOption+lnMenuItem
ENDPROC
PROTECTED PROCEDURE Init
Lparameters lcToolTipText, lcPicture
With This
If Not Upper(.Name)=="MENUBUTTON"
.Order = (.TabIndex - 1)
.Top = 0
.SetAll("ToolTipText",lcToolTipText)
.imgPicture.Picture = lcPicture
Endif
.InitThemedControl()
Endwith
ENDPROC
HIDDEN PROCEDURE initthemedcontrol
If Not Vartype(_Screen.ThemesManager)=="O"
_Screen.Newobject("ThemesManager","ThemesManager",Forcepath('ThemedControls.vcx', Justpath(This.ClassLibrary)))
Endif
This.ChangeTheme()
ENDPROC
PROCEDURE shpTransparent.Click
This.Parent.ChangeSelectedButton()
ENDPROC
PROCEDURE shpTransparent.MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
This.Parent.ChangeBackground(.T.)
ENDPROC
PROCEDURE shpTransparent.MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.Parent.ChangeBackground(.F.)
ENDPROC
ENDDEFINE
DEFINE CLASS pane AS page
*< CLASSDATA: Baseclass="page" Timestamp="" Scale="Pixels" Uniqueid="" />
*<DefinedPropArrayMethod>
*m: hotkey_assign
*p: hotkey && Specify the letter contained in the caption that will be used as a HotKey.
*p: picture16 && 16x16 image displayed in the panel buttons.
*p: picture24 && 24x24 image displayed in the panel buttons.
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
PROTECTED Destroy,Init
*<PropValue>
BackColor = 255,255,255
Caption = "Page1"
Height = 136
hotkey = ("")
Name = "pane"
picture16 = ("")
picture24 = ("")
Width = 136
_memberdata = <VFPData>
<memberdata name="picture16" type="property" display="Picture16" script="Local aControl[1]&#xA;If Aselobj(aControl) = 0&#xA; If Aselobj(aControl, 1) = 0&#xA; Return&#xA; Endif&#xA;Endif&#xA;aControl[1].Picture16 = Getpict()&#xA;Return"/>
<memberdata name="picture24" type="property" display="Picture24" script="Local aControl[1]&#xA;If Aselobj(aControl) = 0&#xA; If Aselobj(aControl, 1) = 0&#xA; Return&#xA; Endif&#xA;Endif&#xA;aControl[1].Picture16 = Getpict()&#xA;Return"/>
<memberdata name="hotkey" type="property" display="HotKey"/>
<memberdata name="hotkey_assign" type="method" display="HotKey_Assign"/>
</VFPData>
*</PropValue>
PROTECTED PROCEDURE Destroy
Try
With This.Parent.Parent
.Splitter.Anchor = 0
* Remove all buttons in all panels
Local lnButton
m.lnButton = "BUTTON"+Transform(This.PageOrder)
.Panel.RemoveObject(m.lnButton)
.OverflowPanel.RemoveObject(m.lnButton)
*
If This.PageOrder<=.ShowedButtons
If .ShowedButtons>0
.ShowLess()
Endif
Else
.ReArrangeButtons()
Endif
.Splitter.Anchor = 14
Endwith
Catch
Endtry
ENDPROC
HIDDEN PROCEDURE hotkey_assign
Lparameters vNewVal
If Not Vartype(m.vNewVal)=="C"
m.vNewVal = ""
Endif
This.HotKey = m.vNewVal
ENDPROC
PROTECTED PROCEDURE Init
With This.Parent.Parent
* Add a button to all panels
.Panel.AddButton(This.Caption, This.HotKey, This.Picture24)
.OverflowPanel.AddButton(This.Caption, This.Picture16)
*
If Not Upper(Thisform.BaseClass)=="TOOLBAR" Or ;
This.Parent.Initialised = .T.
.Splitter.Anchor = 0
If .ShowedButtons<.MaxShowedButtons
.ShowMore()
Else
.ReArrangeButtons()
Endif
.Splitter.Anchor = 14
Endif
Endwith
ENDPROC
ENDDEFINE
DEFINE CLASS panel AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*<DefinedPropArrayMethod>
*m: addbutton && Add a new button to panel.
*m: changetheme && Occurs when theme change.
*m: initthemedcontrol
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
PROTECTED Init
*<PropValue>
BorderWidth = 0
Height = 32
Name = "panel"
Width = 198
_memberdata = <VFPData>
<memberdata name="addbutton" type="method" display="AddButton"/>
<memberdata name="changetheme" type="method" display="ChangeTheme"/>
<memberdata name="initthemedcontrol" type="method" display="InitThemedControl"/>
</VFPData>
*</PropValue>
PROCEDURE addbutton && Add a new button to panel.
Lparameters lcCaption, lcHotKey, lcPicture
With This
.Newobject("Button"+Alltrim(Str(.ControlCount + 1)),;
"PanelButton",This.ClassLibrary,,;
lcCaption,lcHotKey,lcPicture)
Endwith
ENDPROC
PROCEDURE changetheme && Occurs when theme change.
This.Picture = _Screen.ThemesManager.GetMember("Panel.Background.Picture")
ENDPROC
PROTECTED PROCEDURE Init
This.InitThemedControl()
ENDPROC
HIDDEN PROCEDURE initthemedcontrol
If Not Vartype(_Screen.ThemesManager)=="O"
_Screen.Newobject("ThemesManager","ThemesManager",Forcepath('ThemedControls.vcx', Justpath(This.ClassLibrary)))
Endif
This.ChangeTheme()
ENDPROC
ENDDEFINE
DEFINE CLASS panelbutton AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="cmdHotKey" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="lblCaption" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="imgPicture" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="shpTransparent" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: changebackground && Change button's background image.
*m: changeselectedbutton && Change selected button.
*m: changetheme && Occurs when theme change.
*m: getcaption && Return the panel button's caption without the hot key.
*m: initthemedcontrol
*m: setcaption && Set the Caption and HotKey panel button's properties.
*p: imgfocusednotselected && Path and name of the button's image displayed when button is focused and not selected.
*p: imgfocusedselected && Path and name of the button's image displayed when button is focused and selected.
*p: imgnotfocusedselected && Path and name of the button's image displayed when button is not focused and selected.
*p: lblnotselectedcolor && Color of the button's caption when not selected.
*p: lblselectedcolor && Color of the button's caption when selected.
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
HIDDEN imgfocusednotselected,imgfocusedselected,imgnotfocusedselected,lblnotselectedcolor,lblselectedcolor
PROTECTED Init
*<PropValue>
BackStyle = 0
BorderWidth = 0
Height = 32
imgfocusednotselected = .F.
imgfocusedselected = .F.
imgnotfocusedselected = .F.
lblnotselectedcolor = .F.
lblselectedcolor = .F.
Name = "panelbutton"
Width = 198
_memberdata = <VFPData>
<memberdata name="changebackground" type="method" display="ChangeBackground"/>
<memberdata name="changeselectedbutton" type="method" display="ChangeSelectedButton"/>
<memberdata name="changetheme" type="method" display="ChangeTheme"/>
<memberdata name="imgfocusednotselected" type="property" display="ImgFocusedNotSelected"/>
<memberdata name="imgfocusedselected" type="property" display="ImgFocusedSelected"/>
<memberdata name="imgnotfocusedselected" type="property" display="ImgNotFocusedSelected"/>
<memberdata name="lblnotselectedcolor" type="property" display="LblNotSelectedColor"/>
<memberdata name="lblselectedcolor" type="property" display="LblSelectedColor"/>
<memberdata name="initthemedcontrol" type="method" display="InitThemedControl"/>
<memberdata name="setcaption" type="method" display="SetCaption"/>
<memberdata name="getcaption" type="method" display="GetCaption"/>
</VFPData>
*</PropValue>
ADD OBJECT 'cmdHotKey' AS commandbutton WITH ;
Anchor = 15, ;
Caption = "", ;
Height = 29, ;
Left = 1, ;
Name = "cmdHotKey", ;
Style = 1, ;
TabIndex = 1, ;
TabStop = .F., ;
Top = 2, ;
Width = 196
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'imgPicture' AS image WITH ;
BackStyle = 0, ;
Enabled = .F., ;
Height = 24, ;
Left = 4, ;
MousePointer = 15, ;
Name = "imgPicture", ;
Top = 4, ;
Width = 24
*< END OBJECT: BaseClass="image" />
ADD OBJECT 'lblCaption' AS label WITH ;
Anchor = 10, ;
BackStyle = 0, ;
Caption = "", ;
Enabled = .F., ;
FontBold = .T., ;
Height = 17, ;
Left = 35, ;
MousePointer = 15, ;
Name = "lblCaption", ;
TabIndex = 2, ;
Top = 7, ;
Width = 159
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'shpTransparent' AS shape WITH ;
Anchor = 15, ;
BackStyle = 0, ;
BorderStyle = 0, ;
Height = 32, ;
MousePointer = 15, ;
Name = "shpTransparent", ;
Width = 198
*< END OBJECT: BaseClass="shape" />
PROCEDURE changebackground && Change button's background image.
Lparameters llGotFocus
#Define lnFocused 8
#Define lnNotFocused 16
#Define lnSelected 32
#Define lnNotSelected 64
Local lnState, lcImage, lnColor
With This
lnState = (Iif(llGotFocus,lnFocused,lnNotFocused) + ;
Iif(.Parent.Parent.SelectedButton==.TabIndex,lnSelected,lnNotSelected))
Do Case
Case lnState = (lnFocused + lnSelected)
lcImage = .ImgFocusedSelected
lnColor = .LblSelectedColor
Case lnState = (lnFocused + lnNotSelected)
lcImage = .ImgFocusedNotSelected
lnColor = .LblNotSelectedColor
Case lnState = (lnNotFocused + lnSelected)
lcImage = .ImgNotFocusedSelected
lnColor = .LblSelectedColor
Otherwise
lcImage = ""
lnColor = .LblNotSelectedColor
Endcase
.BackStyle = Iif(Empty(lcImage),0,1)
.Picture = lcImage
.lblCaption.ForeColor = lnColor
Endwith
ENDPROC
PROCEDURE changeselectedbutton && Change selected button.
This.Parent.Parent.SelectedButton = This.TabIndex
ENDPROC
PROCEDURE changetheme && Occurs when theme change.
With _Screen.ThemesManager
This.ImgFocusedSelected = .GetMember("PanelButton.FocusedSelected.Picture")
This.ImgFocusedNotSelected = .GetMember("PanelButton.FocusedNotSelected.Picture")
This.ImgNotFocusedSelected = .GetMember("PanelButton.NotFocusedSelected.Picture")
This.LblSelectedColor = .GetMember("PanelButton.Selected.FontColor")
This.LblNotSelectedColor = .GetMember("PanelButton.NotSelected.FontColor")
This.ChangeBackground(.F.)
Endwith
ENDPROC
PROCEDURE getcaption && Return the panel button's caption without the hot key.
Return Strtran(This.lblCaption.Caption,"\<","")
ENDPROC
PROTECTED PROCEDURE Init
Lparameters lcCaption, lcHotKey, lcPicture
With This
.Anchor = 0
.Left = 0
.Top = ((.TabIndex*(.Height))-.Height)
.Anchor = 10
.SetCaption(lcCaption, lcHotKey)
.imgPicture.Picture = lcPicture
.InitThemedControl()
.Visible = .T.
Endwith
ENDPROC
HIDDEN PROCEDURE initthemedcontrol
If Not Vartype(_Screen.ThemesManager)=="O"
_Screen.Newobject("ThemesManager","ThemesManager",Forcepath('ThemedControls.vcx', Justpath(This.ClassLibrary)))
Endif
This.ChangeTheme()
ENDPROC
PROCEDURE setcaption && Set the Caption and HotKey panel button's properties.
Lparameters lcCaption, lcHotKey
With This
If Not Empty(Evl(lcHotKey,"")) And ;
Upper(Thisform.BaseClass)=="FORM"
Local lnPos
lnPos = At(lcHotKey,lcCaption,1)
If lnPos>0
lcCaption = Stuff(lcCaption,lnPos,0,"\<")
lcHotKey = "\<" + lcHotKey
Endif
Endif
.lblCaption.Caption = lcCaption
.cmdHotKey.Caption = lcHotKey
Endwith
ENDPROC
PROCEDURE cmdHotKey.Click
This.Parent.ChangeSelectedButton()
Keyboard '{DNARROW}'
Local lcWindow
lcWindow = Mwindow()
Mouse At Mrow(lcWindow), Mcol(lcWindow) Window (lcWindow)
ENDPROC
PROCEDURE shpTransparent.Click
This.Parent.ChangeSelectedButton()
ENDPROC
PROCEDURE shpTransparent.MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
This.Parent.ChangeBackground(.T.)
ENDPROC
PROCEDURE shpTransparent.MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.Parent.ChangeBackground(.F.)
ENDPROC
ENDDEFINE
DEFINE CLASS panelvertical 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="lblCaption" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: caption_access
*m: caption_assign
*m: changetheme && Occurs when theme change.
*m: initthemedcontrol
*p: caption && Specifies the text displayed in an object's caption.
*p: focusedbackcolor && Specifies the backcolor when panel is focused.
*p: notfocusedbackcolor && Specifies the backcolor when panel isn't focused.
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
PROTECTED Init,MouseEnter,MouseLeave
*<PropValue>
BorderWidth = 0
caption = ("")
focusedbackcolor = .F.
Height = 331
Name = "panelvertical"
notfocusedbackcolor = .F.
Width = 30
_memberdata = <VFPData>
<memberdata name="changetheme" type="method" display="ChangeTheme"/>
<memberdata name="focusedbackcolor" type="property" display="FocusedBackcolor"/>
<memberdata name="notfocusedbackcolor" type="property" display="NotFocusedBackcolor"/>
<memberdata name="caption_access" type="method" display="Caption_Access"/>
<memberdata name="caption_assign" type="method" display="Caption_Assign"/>
<memberdata name="caption" type="property" display="Caption"/>
<memberdata name="initthemedcontrol" type="method" display="InitThemedControl"/>
</VFPData>
*</PropValue>
ADD OBJECT 'lblCaption' AS label WITH ;
BackStyle = 0, ;
Caption = "", ;
FontBold = .T., ;
FontSize = 14, ;
Height = 325, ;
Left = 3, ;
Name = "lblCaption", ;
Rotation = 90, ;
Top = 3, ;
Width = 23
*< END OBJECT: BaseClass="label" />
PROCEDURE caption_access
Return This.lblCaption.Caption
ENDPROC
PROCEDURE caption_assign
Lparameters vNewVal
This.lblCaption.Caption = m.vNewVal
ENDPROC
PROCEDURE changetheme && Occurs when theme change.
With _Screen.ThemesManager
This.FocusedBackcolor = .GetMember("PanelVertical.Focused.BackColor")
This.NotFocusedBackcolor = .GetMember("PanelVertical.NotFocused.BackColor")
This.lblCaption.ForeColor = .GetMember("PanelVertical.FontColor")
This.BackColor = This.NotFocusedBackcolor
Endwith
ENDPROC
PROTECTED PROCEDURE Init
This.InitThemedControl()
ENDPROC
HIDDEN PROCEDURE initthemedcontrol
If Not Vartype(_Screen.ThemesManager)=="O"
_Screen.Newobject("ThemesManager","ThemesManager",Forcepath('ThemedControls.vcx', Justpath(This.ClassLibrary)))
Endif
This.ChangeTheme()
ENDPROC
PROTECTED PROCEDURE MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
This.BackColor = This.FocusedBackcolor
ENDPROC
PROTECTED PROCEDURE MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.BackColor = This.NotFocusedBackcolor
ENDPROC
PROCEDURE Resize
This.lblCaption.Height = This.Height - 6
ENDPROC
PROCEDURE lblCaption.MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
This.Parent.BackColor = This.Parent.FocusedBackcolor
ENDPROC
PROCEDURE lblCaption.MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.Parent.BackColor = This.Parent.NotFocusedBackcolor
ENDPROC
ENDDEFINE
DEFINE CLASS panes AS pageframe
*< CLASSDATA: Baseclass="pageframe" Timestamp="" Scale="Pixels" Uniqueid="" />
*<DefinedPropArrayMethod>
*m: pagecount_assign
*p: initialised && Specify if the control was initialised or not.
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
*<PropValue>
ActivePage = 0
BorderWidth = 0
ErasePage = .T.
Height = 332
initialised = .F.
MemberClass = "pane"
MemberClassLibrary = outlooknavbar.vcx
Name = "panes"
SpecialEffect = 2
Tabs = .F.
Themes = .F.
Width = 198
_memberdata = <VFPData>
<memberdata name="initialised" type="property" display="Initialised"/>
<memberdata name="pagecount_assign" type="method" display="PageCount_Assign"/>
</VFPData>
*</PropValue>
PROCEDURE Init
This.Initialised = .T.
If This.PageCount = 0
This.Parent.RepositionControls()
Endif
ENDPROC
HIDDEN PROCEDURE pagecount_assign
Lparameters vNewVal
If This.PageCount = 0
This.Parent.RepositionControls()
Endif
With This
.PageCount = m.vNewVal
*
Do Case
Case .PageCount==0
.Parent.SelectedButton = 0
Case .Parent.SelectedButton > .PageCount
.Parent.SelectedButton = 1
Otherwise
With .Parent
.SelectedButton = .SelectedButton
Endwith
Endcase
Endwith
ENDPROC
ENDDEFINE
DEFINE CLASS shrinkbutton AS control
*< CLASSDATA: Baseclass="control" Timestamp="" Scale="Pixels" Uniqueid="" />
*<DefinedPropArrayMethod>
*m: buttonclicked && Occurs when button is clicked.
*m: changebackground && Change button's background image.
*m: changetheme && Occurs when theme change.
*m: changeviewmode && Change button state (shrunk or not).
*m: initthemedcontrol
*m: shrunk_assign
*p: imgfocusednotshrunk && Path and name of the button's image displayed when button is focused and not shrunk.
*p: imgfocusedshrunk && Path and name of the button's image displayed when button is focused and shrunk.
*p: imgnotfocusednotshrunk && Path and name of the button's image displayed when button is not focused and not shrunk.
*p: imgnotfocusedshrunk && Path and name of the button's image displayed when button is not focused and shrunk.
*p: oldanchor
*p: oldwidth
*p: shrunk && Specifies if the button was shrunk or not.
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
HIDDEN imgfocusednotshrunk,imgfocusedshrunk,imgnotfocusednotshrunk,imgnotfocusedshrunk,shrunk
PROTECTED Click,Init
*<PropValue>
BorderWidth = 0
Height = 18
imgfocusednotshrunk = .F.
imgfocusedshrunk = .F.
imgnotfocusednotshrunk = .F.
imgnotfocusedshrunk = .F.
MousePointer = 15
Name = "shrinkbutton"
oldanchor = 0
oldwidth = 0
shrunk = .F.
Width = 18
_memberdata = <VFPData>
<memberdata name="buttonclicked" type="method" display="ButtonClicked"/>
<memberdata name="changebackground" type="method" display="ChangeBackground"/>
<memberdata name="changetheme" type="method" display="ChangeTheme"/>
<memberdata name="imgfocusednotshrunk" type="property" display="ImgFocusedNotShrunk"/>
<memberdata name="imgfocusedshrunk" type="property" display="ImgFocusedShrunk"/>
<memberdata name="imgnotfocusednotshrunk" type="property" display="ImgNotFocusedNotShrunk"/>
<memberdata name="imgnotfocusedshrunk" type="property" display="ImgNotFocusedShrunk"/>
<memberdata name="shrunk" type="property" display="Shrunk"/>
<memberdata name="shrunk_assign" type="method" display="Shrunk_Assign"/>
<memberdata name="changeviewmode" type="method" display="ChangeViewMode"/>
<memberdata name="oldanchor" type="property" display="OldAnchor"/>
<memberdata name="oldwidth" type="property" display="OldWidth"/>
<memberdata name="initthemedcontrol" type="method" display="InitThemedControl"/>
</VFPData>
*</PropValue>
PROCEDURE buttonclicked && Occurs when button is clicked.
Lparameters llShrunk
ENDPROC
HIDDEN PROCEDURE changebackground && Change button's background image.
Lparameters llGotFocus
#Define lnFocused 8
#Define lnNotFocused 16
#Define lnShrunk 32
#Define lnNotShrunk 64
Local lnState, lcImage, lnColor
With This
lnState = (Iif(llGotFocus,lnFocused,lnNotFocused) + ;
Iif(.Shrunk,lnShrunk,lnNotShrunk))
Do Case
Case lnState = (lnFocused + lnShrunk)
lcImage = .ImgFocusedShrunk
Case lnState = (lnFocused + lnNotShrunk)
lcImage = .ImgFocusedNotShrunk
Case lnState = (lnNotFocused + lnShrunk)
lcImage = .ImgNotFocusedShrunk
Case lnState = (lnNotFocused + lnNotShrunk)
lcImage = .ImgNotFocusedNotShrunk
Otherwise
lcImage = ""
Endcase
.Picture = lcImage
Endwith
ENDPROC
PROCEDURE changetheme && Occurs when theme change.
With _Screen.ThemesManager
This.ImgFocusedShrunk = .GetMember("ShrinkButton.FocusedShrunk.Picture")
This.ImgFocusedNotShrunk = .GetMember("ShrinkButton.FocusedNotShrunk.Picture")
This.ImgNotFocusedShrunk = .GetMember("ShrinkButton.NotFocusedShrunk.Picture")
This.ImgNotFocusedNotShrunk = .GetMember("ShrinkButton.NotFocusedNotShrunk.Picture")
This.ChangeBackground(.F.)
Endwith
ENDPROC
PROCEDURE changeviewmode && Change button state (shrunk or not).
This.Shrunk = Not This.Shrunk
ENDPROC
PROTECTED PROCEDURE Click
This.ChangeViewMode()
ENDPROC
PROTECTED PROCEDURE Init
This.InitThemedControl()
ENDPROC
HIDDEN PROCEDURE initthemedcontrol
If Not Vartype(_Screen.ThemesManager)=="O"
_Screen.Newobject("ThemesManager","ThemesManager",Forcepath('ThemedControls.vcx', Justpath(This.ClassLibrary)))
Endif
This.ChangeTheme()
ENDPROC
PROCEDURE MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
This.ChangeBackground(.T.)
ENDPROC
PROCEDURE MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.ChangeBackground(.F.)
ENDPROC
HIDDEN PROCEDURE shrunk_assign
Lparameters vNewVal
This.Shrunk = m.vNewVal
This.ChangeBackground(.F.)
This.ButtonClicked(m.vNewVal)
ENDPROC
ENDDEFINE
DEFINE CLASS splitterhorizontal 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="imgBackground" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="imgGripper" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: changetheme && Occurs when theme change.
*m: getreference && Evaluate the content of the string passed as a parameter and return the object if the content evaluates to an object.
*m: initthemedcontrol
*m: objectabove_access
*m: objectbelow_access
*m: splittermoved && Occurs after splitter is moved.
*p: objectabove && Object placed above the splitter.
*p: objectaboveminsize && Specifies the minimum height that ObjectAbove can be resized to.
*p: objectbelow && Object placed below the splitter.
*p: objectbelowminsize && Specifies the minimum height that ObjectBelow can be resized to.
*p: steps && Minimum mumber of pixels that Splitter will move when mouse moves.
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
PROTECTED Destroy,Init
*<PropValue>
BorderWidth = 0
Height = 8
MousePointer = 7
Name = "splitterhorizontal"
objectabove = .F.
objectaboveminsize = 32
objectbelow = .F.
objectbelowminsize = 0
steps = 32
TabStop = .F.
Width = 198
_memberdata = <VFPData>
<memberdata name="changetheme" type="method" display="ChangeTheme"/>
<memberdata name="getreference" type="method" display="GetReference"/>
<memberdata name="objectabove" type="property" display="ObjectAbove"/>
<memberdata name="objectaboveminsize" type="property" display="ObjectAboveMinSize"/>
<memberdata name="objectabove_access" type="method" display="ObjectAbove_Access"/>
<memberdata name="objectbelow" type="property" display="ObjectBelow"/>
<memberdata name="objectbelowminsize" type="property" display="ObjectBelowMinSize"/>
<memberdata name="objectbelow_access" type="method" display="ObjectBelow_Access"/>
<memberdata name="splittermoved" type="method" display="SplitterMoved"/>
<memberdata name="steps" type="property" display="Steps"/>
<memberdata name="initthemedcontrol" type="method" display="InitThemedControl"/>
</VFPData>
*</PropValue>
ADD OBJECT 'imgBackground' AS image WITH ;
Anchor = 15, ;
Height = 8, ;
MousePointer = 7, ;
Name = "imgBackground", ;
Stretch = 2, ;
Width = 198
*< END OBJECT: BaseClass="image" />
ADD OBJECT 'imgGripper' AS image WITH ;
Anchor = 768, ;
BackStyle = 0, ;
Height = 8, ;
Left = 81, ;
MousePointer = 7, ;
Name = "imgGripper", ;
Width = 35
*< END OBJECT: BaseClass="image" />
PROCEDURE changetheme && Occurs when theme change.
With _Screen.ThemesManager
This.imgBackground.Picture = .GetMember("Splitter.Background.Picture")
This.imgGripper.Picture = .GetMember("Splitter.Gripper.Picture")
Endwith
ENDPROC
PROTECTED PROCEDURE Destroy
*========================================================
* Release object references
*========================================================
With This
.ObjectAbove = Null
.ObjectBelow = Null
Endwith
ENDPROC
HIDDEN PROCEDURE getreference && Evaluate the content of the string passed as a parameter and return the object if the content evaluates to an object.
*========================================================
* Returns an object reference
*========================================================
Lparameter toReference
Do Case
Case Vartype(m.toReference) == "X"
Return m.toReference
Case Vartype(m.toReference) == "O"
Return m.toReference
Case Vartype(m.toReference) == "C"
Return Evaluate(m.toReference)
Otherwise
Error 107
Endcase
ENDPROC
PROTECTED PROCEDURE Init
*========================================================
* Setup the visual appearance and initial position to
* make anchor work correctly
*========================================================
With This
If Vartype(.ObjectAbove)=="O" And Vartype(.ObjectBelow)="O"
This.InitThemedControl()
Else
Messagebox("You must specify Object Above and ObjectBelow properties correctly.",16,"Error")
Return .F.
Endif
Endwith
ENDPROC
HIDDEN PROCEDURE initthemedcontrol
If Not Vartype(_Screen.ThemesManager)=="O"
_Screen.Newobject("ThemesManager","ThemesManager",Forcepath('ThemedControls.vcx', Justpath(This.ClassLibrary)))
Endif
This.ChangeTheme()
ENDPROC
PROCEDURE MouseMove
*========================================================
* Move the bar around while the button is pressed
*========================================================
Lparameters nButton, nShift, nXCoord, nYCoord
If nButton == 1
With This
Local lnTop, lnStep
lnTop = Min(Max(nYCoord,.ObjectAbove.Top+.ObjectAboveMinSize-Iif(.Steps==1,0,.Steps)),;
.ObjectBelow.Top+.ObjectBelow.Height-.ObjectBelowMinSize-.Height)
With .ObjectBelow
lnStep = Mod(Max(.Height+.Top-lnTop-This.Height,0),This.Steps)
Endwith
.Anchor = 0
.Top = lnTop+lnStep
.Anchor = 14
Endwith
Endif
ENDPROC
PROCEDURE Moved
*========================================================
* Whenever this container is moved around, we resize the
* two surrounding controls
*========================================================
Try
With This
With .ObjectAbove
.Anchor = 0
.Move(.Left,.Top,.Width,This.Top-.Top)
.Anchor = 11
Endwith
With .ObjectBelow
.Anchor = 0
.Move(.Left,This.Top+This.Height,.Width,Max(.Height+.Top-This.Top-This.Height,0))
.Anchor = 14
Endwith
.Anchor = 0
.SplitterMoved()
.Anchor = 14
Endwith
Catch
Endtry
ENDPROC
HIDDEN PROCEDURE objectabove_access
Return This.GetReference(This.ObjectAbove)
ENDPROC
HIDDEN PROCEDURE objectbelow_access
Return This.GetReference(This.ObjectBelow)
ENDPROC
PROCEDURE splittermoved && Occurs after splitter is moved.
ENDPROC
PROCEDURE imgBackground.MouseMove
Lparameters nButton, nShift, nXCoord, nYCoord
This.Parent.MouseMove(nButton, nShift, nXCoord, nYCoord)
ENDPROC
PROCEDURE imgGripper.MouseMove
Lparameters nButton, nShift, nXCoord, nYCoord
This.Parent.MouseMove(nButton, nShift, nXCoord, nYCoord)
ENDPROC
ENDDEFINE
DEFINE CLASS title 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="imgBackground" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="lblCaption" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: caption_assign
*m: changetheme && Occurs when theme change.
*m: fontname_assign
*m: initthemedcontrol
*p: caption && Specifies the text displayed in an object's caption.
*p: fontname && Specifies the name of the font used to display text.
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
PROTECTED Init
*<PropValue>
Anchor = 11
BackStyle = 0
caption = .F.
fontname = Arial
Height = 28
Name = "title"
Width = 200
_memberdata = <VFPData>
<memberdata name="changetheme" type="method" display="ChangeTheme"/>
<memberdata name="caption" type="property" display="Caption"/>
<memberdata name="caption_assign" type="method" display="Caption_Assign"/>
<memberdata name="fontname" type="property" display="FontName"/>
<memberdata name="fontname_assign" type="method" display="FontName_Assign"/>
<memberdata name="initthemedcontrol" type="method" display="InitThemedControl"/>
</VFPData>
*</PropValue>
ADD OBJECT 'imgBackground' AS image WITH ;
Anchor = 15, ;
Height = 26, ;
Left = 1, ;
Name = "imgBackground", ;
Stretch = 2, ;
Top = 1, ;
Width = 198
*< END OBJECT: BaseClass="image" />
ADD OBJECT 'lblCaption' AS label WITH ;
Anchor = 11, ;
BackStyle = 0, ;
Caption = "Navigation title", ;
FontBold = .T., ;
FontSize = 12, ;
Height = 21, ;
Left = 7, ;
Name = "lblCaption", ;
Top = 3, ;
Width = 165
*< END OBJECT: BaseClass="label" />
HIDDEN PROCEDURE caption_assign
Lparameters vNewVal
With This
Store m.vNewVal To .Caption, .lblCaption.Caption
Endwith
ENDPROC
PROCEDURE changetheme && Occurs when theme change.
With _Screen.ThemesManager
This.BorderColor = .GetMember("Title.BorderColor")
This.imgBackground.Left = .GetMember("Title.Background.Left")
This.imgBackground.Width = This.Width - This.imgBackground.Left - 1
This.imgBackground.Picture = .GetMember("Title.Background.Picture")
This.imgBackground.Anchor = 0
This.imgBackground.Anchor = 15
This.lblCaption.ForeColor = .GetMember("Title.FontColor")
Endwith
ENDPROC
PROCEDURE fontname_assign
Lparameters vNewVal
Store m.vNewVal To This.FontName, ;
This.lblCaption.FontName
ENDPROC
PROTECTED PROCEDURE Init
This.InitThemedControl()
ENDPROC
HIDDEN PROCEDURE initthemedcontrol
If Not Vartype(_Screen.ThemesManager)=="O"
_Screen.Newobject("ThemesManager","ThemesManager",Forcepath('ThemedControls.vcx', Justpath(This.ClassLibrary)))
Endif
This.ChangeTheme()
ENDPROC
ENDDEFINE
Reference in New Issue View Git Blame Copy Permalink