romfast/comun
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
15e13cc333291f73b5152941b8911fc3274b2a8f
comun/utile/ctl32/themedcontrols.vc2

1103 lines
35 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="themedcontrols.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
*
*
DEFINE CLASS themedbutton AS button OF "buttons.vcx"
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*<PropValue>
Name = "themedbutton"
imgBackgroundLeft.Name = "imgBackgroundLeft"
imgBackgroundMiddle.Name = "imgBackgroundMiddle"
imgBackgroundRight.Name = "imgBackgroundRight"
CMDFOCUS.Name = "CMDFOCUS"
SHPMOUSEHANDLER.Name = "SHPMOUSEHANDLER"
imgIcon.Name = "imgIcon"
LBLCAPTION.Name = "LBLCAPTION"
*</PropValue>
ENDDEFINE
DEFINE CLASS themedcontainer AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*<DefinedPropArrayMethod>
*m: changetheme && Occurs when theme change.
*m: initthemedcontrol
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
PROTECTED Init
*<PropValue>
Anchor = 15
BackColor = 255,255,255
Height = 400
Name = "themedcontainer"
Width = 250
_memberdata = <VFPData>
<memberdata name="changetheme" type="method" display="ChangeTheme"/>
<memberdata name="initthemedcontrol" type="method" display="InitThemedControl"/>
</VFPData>
*</PropValue>
PROCEDURE changetheme && Occurs when theme change.
With _Screen.ThemesManager
This.BorderColor = .GetMember("Container.BorderColor")
Endwith
ENDPROC
PROTECTED PROCEDURE Init
This.InitThemedControl()
ENDPROC
HIDDEN PROCEDURE initthemedcontrol
If Not Vartype(_Screen.ThemesManager)=="O"
_Screen.Newobject("ThemesManager","ThemesManager",This.ClassLibrary)
Endif
This.ChangeTheme()
ENDPROC
ENDDEFINE
DEFINE CLASS themedexplorerbar AS explorerbar OF "explorerbar.vcx"
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*<PropValue>
Name = "themedexplorerbar"
imgBackground.Name = "imgBackground"
ctl32_scrollbar.ctlTextBox.Name = "ctlTextBox"
ctl32_scrollbar.lblname.Name = "lblname"
ctl32_scrollbar.Name = "ctl32_scrollbar"
*</PropValue>
ENDDEFINE
DEFINE CLASS themedexplorergroup AS explorergroup OF "explorerbar.vcx"
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*<PropValue>
Name = "themedexplorergroup"
imgBackground.Name = "imgBackground"
linLeftBorder.Name = "linLeftBorder"
linRightBorder.Name = "linRightBorder"
linBottomBorder.Name = "linBottomBorder"
imgTitle.Name = "imgTitle"
lblTitle.Name = "lblTitle"
cmdFocus.Name = "cmdFocus"
cntUserControls.Name = "cntUserControls"
imgPicture.Name = "imgPicture"
shpMouseHandler.Name = "shpMouseHandler"
*</PropValue>
ENDDEFINE
DEFINE CLASS themedform AS form
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="imgBackground" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: changetheme && Occurs when theme change.
*m: initthemedcontrol
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
*<PropValue>
Caption = "Form"
DoCreate = .T.
Left = 0
Name = "themedform"
ShowTips = .T.
Top = 0
Width = 375
WindowState = 2
_memberdata = <VFPData>
<memberdata name="changetheme" type="method" display="ChangeTheme"/>
<memberdata name="initthemedcontrol" type="method" display="InitThemedControl"/>
</VFPData>
*</PropValue>
ADD OBJECT 'imgBackground' AS image WITH ;
Height = 0, ;
Name = "imgBackground", ;
Stretch = 2, ;
Width = 0
*< END OBJECT: BaseClass="image" />
PROCEDURE changetheme && Occurs when theme change.
With _Screen.ThemesManager
This.imgBackground.Picture = .GetMember("Form.Background.Picture")
Endwith
ENDPROC
PROCEDURE Init
With Thisform.imgBackground
.ZOrder(1)
.Anchor = 0
.Height = This.Height
.Width = This.Width
.Anchor = 15
Endwith
This.InitThemedControl()
ENDPROC
HIDDEN PROCEDURE initthemedcontrol
If Not Vartype(_Screen.ThemesManager)=="O"
_Screen.Newobject("ThemesManager","ThemesManager",This.ClassLibrary)
Endif
This.ChangeTheme()
ENDPROC
ENDDEFINE
DEFINE CLASS themedoutlooknavbar AS outlooknavbar OF "outlooknavbar.vcx"
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*<PropValue>
Name = "themedoutlooknavbar"
panelvertical.lblCaption.Name = "lblCaption"
panelvertical.Name = "panelvertical"
title.imgBackground.Name = "imgBackground"
title.lblCaption.Name = "lblCaption"
title.Name = "title"
overflowpanel.MenuButton.imgPicture.Name = "imgPicture"
overflowpanel.MenuButton.Name = "MenuButton"
overflowpanel.MenuButton.shpTransparent.Name = "shpTransparent"
overflowpanel.Name = "overflowpanel"
shrinkbutton.Name = "shrinkbutton"
Panel.Name = "Panel"
Splitter.imgBackground.Name = "imgBackground"
Splitter.imgGripper.Name = "imgGripper"
Splitter.Name = "Splitter"
panes.ActivePage = 0
panes.ErasePage = .T.
panes.Height = 332
panes.Name = "panes"
panes.Top = 28
*</PropValue>
ENDDEFINE
DEFINE CLASS themedoutlooknavbartbr AS toolbar
*< CLASSDATA: Baseclass="toolbar" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="ThemedOutlookNavBar" UniqueID="" Timestamp="" />
*<PropValue>
Caption = "Toolbar1"
Height = 406
Left = 0
Name = "themedoutlooknavbartbr"
ShowWindow = 1
Top = 0
Width = 210
*</PropValue>
ADD OBJECT 'ThemedOutlookNavBar' AS themedoutlooknavbar WITH ;
Anchor = 15, ;
Left = 5, ;
Name = "ThemedOutlookNavBar", ;
targetformname = (MWindow()), ;
Top = 3, ;
panelvertical.lblCaption.Name = "lblCaption", ;
panelvertical.Name = "panelvertical", ;
title.imgBackground.Name = "imgBackground", ;
title.lblCaption.Name = "lblCaption", ;
title.Name = "title", ;
overflowpanel.MenuButton.imgPicture.Name = "imgPicture", ;
overflowpanel.MenuButton.Name = "MenuButton", ;
overflowpanel.MenuButton.shpTransparent.Anchor = 15, ;
overflowpanel.MenuButton.shpTransparent.Name = "shpTransparent", ;
overflowpanel.Name = "overflowpanel", ;
shrinkbutton.Name = "shrinkbutton", ;
Panel.Name = "Panel", ;
Splitter.imgBackground.Name = "imgBackground", ;
Splitter.imgGripper.Name = "imgGripper", ;
Splitter.Name = "Splitter", ;
panes.ActivePage = 0, ;
panes.ErasePage = .T., ;
panes.Height = 332, ;
panes.Name = "panes", ;
panes.Top = 28
*< END OBJECT: ClassLib="themedcontrols.vcx" BaseClass="container" />
ENDDEFINE
DEFINE CLASS themedtitlecontainer 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="" />
*< OBJECTDATA: ObjPath="imgTitle" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="linTitle" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: caption_assign
*m: changetheme && Occurs when theme change.
*m: fontname_assign
*m: initthemedcontrol
*m: picture24_assign
*p: caption && Specifies the text displayed in an object's caption.
*p: fontname && Specifies the name of the font used to display text.
*p: picture24 && 24x24 image displayed in the title.
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
PROTECTED Init
*<PropValue>
Anchor = 15
BackColor = 255,255,255
caption = .F.
fontname = Arial
Height = 400
Name = "themedtitlecontainer"
picture24 = ("")
Width = 250
_memberdata = <VFPData>
<memberdata name="caption_assign" type="method" display="Caption_Assign"/>
<memberdata name="changetheme" type="method" display="ChangeTheme"/>
<memberdata name="picture24" type="property" display="Picture24"/>
<memberdata name="picture24_assign" type="method" display="Picture24_Assign"/>
<memberdata name="caption" type="property" display="Caption"/>
<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 = 11, ;
Height = 26, ;
Left = 1, ;
Name = "imgBackground", ;
Stretch = 2, ;
Top = 1, ;
Width = 248
*< END OBJECT: BaseClass="image" />
ADD OBJECT 'imgTitle' AS image WITH ;
Anchor = 3, ;
Height = 24, ;
Left = 3, ;
Name = "imgTitle", ;
Stretch = 1, ;
Top = 2, ;
Width = 24
*< END OBJECT: BaseClass="image" />
ADD OBJECT 'lblCaption' AS label WITH ;
Anchor = 11, ;
BackStyle = 0, ;
Caption = "Title", ;
FontBold = .T., ;
FontSize = 12, ;
Height = 22, ;
Left = 31, ;
Name = "lblCaption", ;
Top = 3, ;
Width = 213
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'linTitle' AS line WITH ;
Anchor = 11, ;
Height = 0, ;
Left = 1, ;
Name = "linTitle", ;
Top = 27, ;
Width = 248
*< END OBJECT: BaseClass="line" />
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 = 11
This.lblCaption.ForeColor = .GetMember("Title.FontColor")
This.linTitle.BorderColor = This.BorderColor
This.linTitle.Width = This.Width - 2
This.linTitle.Anchor = 0
This.linTitle.Anchor = 11
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","ThemedControls.vcx")
Endif
This.ChangeTheme()
ENDPROC
HIDDEN PROCEDURE picture24_assign
Lparameters vNewVal
This.imgTitle.Picture = m.vNewVal
ENDPROC
ENDDEFINE
DEFINE CLASS themedtitlepage AS page
*< CLASSDATA: Baseclass="page" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="TitleContainer" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="UserControls" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: caption_assign && Specifies the text displayed in an object's caption.
*m: picture24_assign
*p: clientareaheight
*p: clientareatop
*p: clientareawidth
*p: picture24 && 24x24 image displayed in the title.
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
*<PropValue>
Caption = "Page1"
clientareaheight = 0
clientareatop = 0
clientareawidth = 0
Height = 379
Name = "themedtitlepage"
picture24 = .F.
Width = 229
_memberdata = <VFPData>
<memberdata name="caption_assign" type="method" display="Caption_Assign"/>
<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="picture24_assign" type="method" display="Picture24_Assign"/>
<memberdata name="clientareaheight" type="property" display="ClientAreaHeight"/>
<memberdata name="clientareatop" type="property" display="ClientAreaTop"/>
<memberdata name="clientareawidth" type="property" display="ClientAreaWidth"/>
</VFPData>
*</PropValue>
ADD OBJECT 'TitleContainer' AS themedtitlecontainer WITH ;
Name = "TitleContainer", ;
imgBackground.Name = "imgBackground", ;
lblCaption.Name = "lblCaption", ;
imgTitle.Name = "imgTitle", ;
linTitle.Name = "linTitle"
*< END OBJECT: ClassLib="themedcontrols.vcx" BaseClass="control" />
ADD OBJECT 'UserControls' AS container WITH ;
Anchor = 15, ;
BackStyle = 0, ;
BorderWidth = 0, ;
Height = 371, ;
Left = 1, ;
Name = "UserControls", ;
Top = 28, ;
Width = 248
*< END OBJECT: BaseClass="container" />
HIDDEN PROCEDURE caption_assign && Specifies the text displayed in an object's caption.
Lparameters vNewVal
This.Caption = m.vNewVal
This.TitleContainer.Caption = m.vNewVal
ENDPROC
PROCEDURE Init
Local lnAnchor
With This.TitleContainer
lnAnchor = .Anchor
.Anchor = 0
.Width = This.Parent.Width
.Height = This.Parent.Height
.Anchor = lnAnchor
Endwith
DoDefault()
ENDPROC
HIDDEN PROCEDURE picture24_assign
Lparameters vNewVal
This.Picture24 = m.vNewVal
This.TitleContainer.Picture24 = m.vNewVal
ENDPROC
ENDDEFINE
DEFINE CLASS themedtitlepageframe AS pageframe
*< CLASSDATA: Baseclass="pageframe" Timestamp="" Scale="Pixels" Uniqueid="" />
PROTECTED Resize
*<PropValue>
ActivePage = 1
Anchor = 7
BorderWidth = 0
ErasePage = .T.
Height = 400
MemberClass = "themedtitlepage"
MemberClassLibrary = themedcontrols.vcx
Name = "themedtitlepageframe"
PageCount = 2
Tabs = .F.
Themes = .F.
Width = 250
Themedtitlepage1.Name = "Themedtitlepage1"
Themedtitlepage1.titlecontainer.imgBackground.Name = "imgBackground"
Themedtitlepage1.titlecontainer.imgTitle.Name = "imgTitle"
Themedtitlepage1.titlecontainer.lblCaption.Name = "lblCaption"
Themedtitlepage1.titlecontainer.linTitle.Name = "linTitle"
Themedtitlepage1.titlecontainer.Name = "titlecontainer"
Themedtitlepage2.Name = "Themedtitlepage2"
Themedtitlepage2.titlecontainer.imgBackground.Name = "imgBackground"
Themedtitlepage2.titlecontainer.imgTitle.Name = "imgTitle"
Themedtitlepage2.titlecontainer.lblCaption.Name = "lblCaption"
Themedtitlepage2.titlecontainer.linTitle.Name = "linTitle"
Themedtitlepage2.titlecontainer.Name = "titlecontainer"
*</PropValue>
PROTECTED PROCEDURE Resize
*!* DoDefault()
*!* Local loPage
*!* For Each loPage In This.Pages
*!* With loPage
*!* .ClientAreaTop = .TitleHeight
*!* .ClientAreaHeight = (This.Height - .TitleHeight)
*!* .ClientAreaWidth = This.Width
*!* Endwith
*!* Endfor
*!* loPage = Null
ENDPROC
ENDDEFINE
DEFINE CLASS themedtoolbox AS toolbox OF "toolbox.vcx"
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*<PropValue>
Name = "themedtoolbox"
Panes.ErasePage = .T.
Panes.Height = 398
Panes.Name = "Panes"
Panes.Top = 1
*</PropValue>
ENDDEFINE
DEFINE CLASS themedtoolboxtbr AS toolbar
*< CLASSDATA: Baseclass="toolbar" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="ThemedToolBox" UniqueID="" Timestamp="" />
*<PropValue>
Caption = "Toolbar1"
Height = 406
Left = 0
Name = "themedtoolboxtbr"
ShowWindow = 1
Top = 0
Width = 210
*</PropValue>
ADD OBJECT 'ThemedToolBox' AS themedtoolbox WITH ;
Left = 5, ;
Name = "ThemedToolBox", ;
Top = 3, ;
Panes.ErasePage = .T., ;
Panes.Height = 398, ;
Panes.Name = "Panes", ;
Panes.Top = 1
*< END OBJECT: ClassLib="themedcontrols.vcx" BaseClass="container" />
ENDDEFINE
DEFINE CLASS themedzoomnavbar AS zoomnavbar OF "zoomnavbar.vcx"
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*<PropValue>
Name = "themedzoomnavbar"
imgBackground.Name = "imgBackground"
cntReflected.Name = "cntReflected"
cntZoom.Name = "cntZoom"
shpMouseHandler.Name = "shpMouseHandler"
*</PropValue>
ENDDEFINE
DEFINE CLASS themedzoomnavbartbr AS toolbar
*< CLASSDATA: Baseclass="toolbar" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="ThemedZoomNavBar" UniqueID="" Timestamp="" />
*<PropValue>
Caption = "Toolbar1"
Height = 131
Left = 0
Name = "themedzoomnavbartbr"
ShowWindow = 1
Top = 0
Width = 210
*</PropValue>
ADD OBJECT 'ThemedZoomNavBar' AS themedzoomnavbar WITH ;
Left = 5, ;
Name = "ThemedZoomNavBar", ;
Top = 3, ;
imgBackground.Name = "imgBackground", ;
cntReflected.Name = "cntReflected", ;
cntZoom.Name = "cntZoom", ;
shpMouseHandler.Name = "shpMouseHandler"
*< END OBJECT: ClassLib="themedcontrols.vcx" BaseClass="container" />
ENDDEFINE
DEFINE CLASS themesmanager AS custom
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
#INCLUDE "themedcontrols.h"
*<DefinedPropArrayMethod>
*m: activetheme_assign
*m: apigetcurrentthemename
*m: changetheme && Occurs when theme change.
*m: getmember && Get a specified theme member.
*m: getwindowstheme
*m: inheritwindowstheme_assign
*m: loadthemes && Load the available themes.
*m: loopthroughcontrols
*m: setactivetheme && Disable InheritWindowsTheme property and set ActiveTheme to the specified value.
*m: showpanel && Show a form with Themes settings that can be changed by the user.
*m: windowsthemechanged
*p: activetheme && Specify the active theme.
*p: inheritwindowstheme
*p: inheritwindowsthemetext && Text displayed in the "Inherit Windows Theme" option.
*p: tempfolder && Temp folder name used to create the temporary images.
*p: themes && An object containing all Themes.
*p: themescount && Number of available themes.
*p: themessupport
*p: themesxmlfile && Path and name of a XML file containing themes.
*p: version && ThemesManager version.
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
HIDDEN themescount,themessupport
PROTECTED version
*<PropValue>
activetheme = 5
inheritwindowstheme = .F.
inheritwindowsthemetext = \<Inherit Windows Theme
Name = "themesmanager"
tempfolder = ("")
themes = .F.
themescount = 0
themessupport = (Os(3)+Os(4)>="51")
themesxmlfile = .F.
version = 3.5.0
Width = 90
_memberdata = <VFPData>
<memberdata name="activetheme" type="property" display="ActiveTheme"/>
<memberdata name="changetheme" type="method" display="ChangeTheme"/>
<memberdata name="getmember" type="method" display="GetMember"/>
<memberdata name="version" type="property" display="Version"/>
<memberdata name="tempfolder" type="property" display="TempFolder"/>
<memberdata name="themes" type="property" display="Themes"/>
<memberdata name="loadthemes" type="method" display="LoadThemes"/>
<memberdata name="showpanel" type="method" display="ShowPanel"/>
<memberdata name="loopthroughcontrols" type="method" display="LoopThroughControls"/>
<memberdata name="themesxmlfile" type="property" display="ThemesXMLFile"/>
<memberdata name="activetheme_assign" type="method" display="ActiveTheme_Assign"/>
<memberdata name="themescount" type="property" display="ThemesCount"/>
<memberdata name="windowsthemechanged" type="method" display="WindowsThemeChanged"/>
<memberdata name="getwindowstheme" type="method" display="GetWindowsTheme"/>
<memberdata name="inheritwindowstheme" type="property" display="InheritWindowsTheme"/>
<memberdata name="inheritwindowstheme_assign" type="method" display="InheritWindowsTheme_Assign"/>
<memberdata name="themessupport" type="property" display="ThemesSupport"/>
<memberdata name="apigetcurrentthemename" type="method" display="apiGetCurrentThemeName"/>
<memberdata name="inheritwindowsthemetext" type="property" display="InheritWindowsThemeText"/>
<memberdata name="setactivetheme" type="method" display="SetActiveTheme"/>
</VFPData>
*</PropValue>
HIDDEN PROCEDURE activetheme_assign
Lparameters vNewVal
m.vNewVal = Iif(Between(m.vNewVal,1,This.ThemesCount),m.vNewVal,This.ThemesCount)
This.ActiveTheme = m.vNewVal
This.ChangeTheme()
ENDPROC
HIDDEN PROCEDURE apigetcurrentthemename
Lparameters stringThemeName, lengthThemeName, stringColorName, lengthColorName, stringSizeName, lengthSizeName
Declare Integer GetCurrentThemeName In uxtheme ;
String @ stringThemeName, ;
Integer lengthThemeName, ;
String @ stringColorName, ;
Integer lengthColorName, ;
String @ stringSizeName, ;
Integer lengthSizeName
Return GetCurrentThemeName(@m.stringThemeName, m.lengthThemeName, @m.stringColorName, m.lengthColorName, @m.stringSizeName, lengthSizeName)
ENDPROC
PROCEDURE changetheme && Occurs when theme change.
Local loForm
For Each loForm In _Screen.Forms
This.LoopThroughControls(loForm)
Endfor
loForm = Null
ENDPROC
PROCEDURE Destroy
This.InheritWindowsTheme = .F.
Store Null To _Screen.ThemesPanel
Clear Resources
ENDPROC
PROCEDURE getmember && Get a specified theme member.
Lparameters lcMemberName
m.lcMemberName = Strtran(Strtran(Upper(m.lcMemberName),".","_"),"_PICTURE","")
Return Evaluate("This.Themes.Item(This.ActiveTheme)."+m.lcMemberName)
ENDPROC
HIDDEN PROCEDURE getwindowstheme
Local lnTheme
lnTheme = 5 && Office 2007 Blue
Local lc_ColorBuff
If apiIsThemeActive()==1
Local lcWindows, lnAttempts
Local lw_ThemeFileName, lw_ColorBuff, lw_SizeBuff
Local lc_ColorBuff, llThemed
lcWindows = Os(3)
lnAttempts = 1
Do While lnAttempts<=3
Store Space(254) To ;
lw_ThemeFileName, ;
lw_ColorBuff, ;
lw_SizeBuff
llThemed = (This.apiGetCurrentThemeName(@lw_ThemeFileName, Len(lw_ThemeFileName), @lw_ColorBuff, Len(lw_ColorBuff), @lw_SizeBuff, Len(lw_SizeBuff))==0)
If Not llThemed
* Give to Windows a try to return correct current theme
lnAttempts = lnAttempts + 1
Else
Exit
Endif
Enddo
If llThemed
lc_ColorBuff = Strconv(Strconv(lw_ColorBuff,6),2)
lc_ColorBuff = Upper(Left(lc_ColorBuff, At(Chr(0), lc_ColorBuff) - 1))
Do Case
Case lcWindows=="5"
Do Case
Case (lc_ColorBuff == 'NORMALCOLOR')
lnTheme = 1 && Office 2003 Blue
Case (lc_ColorBuff == 'HOMESTEAD')
lnTheme = 2 && Office 2003 Olive
Case (lc_ColorBuff == 'METALLIC')
lnTheme = 3 && Office 2003 Silver
Endcase
Case lcWindows=="6"
If (lc_ColorBuff == 'NORMALCOLOR')
lnTheme = 4 && Office 2007 Black
Endif
Endcase
Else
lc_ColorBuff = 'Error'
If lcWindows=="5"
* Give to Windows the last chance to return correct current theme
Local lnSysColor
lnSysColor = apiGetSysColor(2)
Do Case
Case lnSysColor == 14898176
lnTheme = 1 && Office 2003 Blue
Case lnSysColor == 6922635
lnTheme = 2 && Office 2003 Olive
Case lnSysColor == 12632256
lnTheme = 3 && Office 2003 Silver
Endcase
Endif
Endif
Else
lc_ColorBuff = 'Theme is not active (Windows Classic)'
Endif
Return lnTheme
ENDPROC
HIDDEN PROCEDURE inheritwindowstheme_assign
Lparameters vNewVal
If m.vNewVal
If This.ThemesSupport
*
* Add BindWindowsEventsProxy property to _VFP
If Not Pemstatus(_vfp,"BindWindowsEventsProxy",5)
AddProperty(_vfp,"BindWindowsEventsProxy",Null)
Endif
* Create BindWindowsEventsProxy object
If Not Vartype(_vfp.BindWindowsEventsProxy)=="O"
_vfp.BindWindowsEventsProxy = Newobject("BindWindowsEventsProxy", ;
Addbs(Justpath(This.ClassLibrary))+"VFPX.vcx")
Endif
* Bind to BindWindowsEventsProxy _Msg property changes
Bindevent(_vfp.BindWindowsEventsProxy,"_Msg",This,"WindowsThemeChanged",1)
*
This.ActiveTheme = This.GetWindowsTheme()
Else
m.vNewVal = .F.
Endif
Else
If Pemstatus(_vfp,"BindWindowsEventsProxy",5)
Unbindevents(_vfp.BindWindowsEventsProxy,"_Msg",This,"WindowsThemeChanged")
Endif
Endif
This.InheritWindowsTheme = m.vNewVal
ENDPROC
PROCEDURE Init
Local lcTempFolder
Try
lcTempFolder = Addbs(Sys(5)+Sys(2003))+"Temp"
If Not Directory(lcTempFolder)
Md (lcTempFolder)
Endif
Catch
lcTempFolder = Sys(2023)
Endtry
This.TempFolder = lcTempFolder
This.LoadThemes()
*
If Not Pemstatus(_Screen,"ThemesPanel",5)
_Screen.AddProperty("ThemesPanel",Null)
Endif
ENDPROC
HIDDEN PROCEDURE loadthemes && Load the available themes.
Local lcXML
If Empty(This.ThemesXMLFile)
m.lcXML = "Themes.xml"
Else
m.lcXML = This.ThemesXMLFile
Endif
If Not File(m.lcXML)
lcXML = Forcepath(lcXML, Justpath(This.ClassLibrary))
Endif
If File(m.lcXML)
Local lcAlias, loThemes As Collection, loXA As Xmladapter, loXT As Xmltable, ;
loTheme, lcMemberName, lnMemberValue, lcMemberImage, lcImageName
m.lcAlias = Alias()
m.loThemes = Createobject("Collection")
m.loXA = Createobject("XMLAdapter")
m.loXA.LoadXML(m.lcXML,.T.)
For Each m.loXT In m.loXA.Tables
m.loXT.ToCursor()
Endfor
Store Null To m.loXA, m.loXT
Select ThemesHeader
Go Top
Scan
m.loTheme = Createobject("Empty")
Select ThemesDetails
Scan For ThemesDetails.ThemeID==ThemesHeader.ThemeID
m.lcMemberName = Alltrim(ThemesDetails.MemberName)
m.lnMemberValue = ThemesDetails.MemberValue
m.lcMemberImage = ThemesDetails.MemberImage
If Empty(m.lcMemberImage)
AddProperty(m.loTheme,m.lcMemberName,m.lnMemberValue)
Else
m.lcImageName = Addbs(This.TempFolder) + ;
Alltrim(ThemesHeader.ThemeName) + ;
"_" + m.lcMemberName + ;
Iif(Substr(m.lcMemberImage,1,2)=="BM",".bmp",".png")
If Not File(m.lcImageName)
Strtofile(m.lcMemberImage,m.lcImageName)
Endif
AddProperty(m.loTheme,m.lcMemberName,m.lcImageName)
Endif
Endscan
Select ThemesHeader
m.loThemes.Add(m.loTheme,Alltrim(ThemesHeader.ThemeName))
m.loTheme = Null
Endscan
Use In ThemesHeader
Use In ThemesDetails
If Not Empty(m.lcAlias)
Select (m.lcAlias)
Endif
This.Themes = m.loThemes
This.ThemesCount = m.loThemes.Count
m.loThemes = Null
Endif
ENDPROC
HIDDEN PROCEDURE loopthroughcontrols
Lparameters toStartObj
Local loRef, lnCnt, lnCnt2, loObj, lcClass
loRef = toStartObj
If Pemstatus(loRef, "ChangeTheme", 5)
loRef.ChangeTheme()
Endif
*** Get the Base Class of the current object
lcClass = Lower(Alltrim(loRef.BaseClass))
*** Now Process the current object
Do Case
*** First Check for the classes with other collection names
Case lcClass = 'pageframe'
For lnCnt = 1 To loRef.PageCount
*** Call this method for each page
This.LoopThroughControls( loRef.Pages[lnCnt] )
Next
Case lcClass = 'grid'
For lnCnt = 1 To loRef.ColumnCount
*** Call this method for each column
This.LoopThroughControls( loRef.Columns[lnCnt] )
Next
Case Inlist( lcClass, 'form', 'container', 'column', 'custom', 'toolbar') Or lcClass == 'page' &&'control'
*** If so, loop through its collection
For lnCnt = 1 To loRef.ControlCount
loObj = loRef.Controls[lnCnt]
Do Case
Case Inlist( loObj.BaseClass, 'Grid', 'Custom', 'Control', 'Container', 'Pageframe')
*** Call this method recursively if this is a contained container
This.LoopThroughControls( loObj )
Case loObj.BaseClass = 'Optiongroup' Or loObj.BaseClass = 'Commandgroup'
If Pemstatus(loObj, "ChangeTheme", 5)
loObj.ChangeTheme()
Endif
For lnCnt2 = 1 To loObj.ButtonCount
*** Call this method for each form
This.LoopThroughControls( loObj.Buttons[lnCnt2] )
Next
Otherwise
If Pemstatus(loObj, "ChangeTheme", 5)
loObj.ChangeTheme()
Endif
Endcase
Next
Otherwise
*** Nothing more to do at this level
Endcase
*** Just return
Return
ENDPROC
PROCEDURE setactivetheme && Disable InheritWindowsTheme property and set ActiveTheme to the specified value.
Lparameters lnTheme
With This
.InheritWindowsTheme = .F.
.ActiveTheme = lnTheme
Endwith
ENDPROC
PROCEDURE showpanel && Show a form with Themes settings that can be changed by the user.
Lparameters tcThemePanelClass, tcThemePanelClassLibrary
If Vartype(tcThemePanelClass) = "C" And Not Empty(tcThemePanelClass)
* Already passed in, keep going
Else
tcThemePanelClass = "ThemesPanel"
Endif
If Vartype(tcThemePanelClass) = "C" And Not Empty(tcThemePanelClassLibrary)
* Already passed in, keep going
Else
tcThemePanelClassLibrary = This.ClassLibrary
Endif
If Not Vartype(_Screen.ThemesPanel)=="O"
_Screen.ThemesPanel = Newobject(tcThemePanelClass, tcThemePanelClassLibrary,"",This.Themes,This.ThemesSupport)
Endif
_Screen.ThemesPanel.Show()
_Screen.ThemesPanel = Null
ENDPROC
PROCEDURE windowsthemechanged
If _vfp.BindWindowsEventsProxy._Msg = WM_THEMECHANGED
This.ActiveTheme = This.GetWindowsTheme()
Endif
ENDPROC
ENDDEFINE
DEFINE CLASS themespanel AS form
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="lstThemes" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="cmdApply" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="cmdOk" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="cmdCancel" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="chkInherit" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: applytheme && Apply the selected theme.
*p: oldinherit
*p: oldtheme && The active theme number before changes.
*p: _memberdata && XML Metadata for customizable properties
*</DefinedPropArrayMethod>
*<PropValue>
AlwaysOnTop = .T.
AutoCenter = .T.
BorderStyle = 2
Caption = "Change the current theme"
Desktop = .T.
DoCreate = .T.
Height = 250
MaxButton = .F.
MinButton = .F.
Name = "themespanel"
oldinherit = .F.
oldtheme = .F.
ShowWindow = 1
Width = 375
WindowType = 1
_memberdata = <VFPData>
<memberdata name="applytheme" type="method" display="ApplyTheme"/>
<memberdata name="oldtheme" type="property" display="OldTheme"/>
<memberdata name="oldinherit" type="property" display="OldInherit"/>
</VFPData>
*</PropValue>
ADD OBJECT 'chkInherit' AS checkbox WITH ;
Alignment = 0, ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "\<Inherit Windows theme", ;
FontSize = 8, ;
Height = 16, ;
Left = 2, ;
Name = "chkInherit", ;
Top = 226, ;
Width = 128
*< END OBJECT: BaseClass="checkbox" />
ADD OBJECT 'cmdApply' AS commandbutton WITH ;
Caption = "\<Apply", ;
FontSize = 8, ;
Height = 27, ;
Left = 323, ;
Name = "cmdApply", ;
TabIndex = 5, ;
Top = 221, ;
Width = 50
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'cmdCancel' AS commandbutton WITH ;
Caption = "\<Cancel", ;
FontSize = 8, ;
Height = 27, ;
Left = 272, ;
Name = "cmdCancel", ;
TabIndex = 4, ;
Top = 221, ;
Width = 50
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'cmdOk' AS commandbutton WITH ;
Caption = "\<Ok", ;
FontSize = 8, ;
Height = 27, ;
Left = 221, ;
Name = "cmdOk", ;
TabIndex = 3, ;
Top = 221, ;
Width = 50
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'lstThemes' AS listbox WITH ;
AutoHideScrollbar = 1, ;
FontSize = 8, ;
Height = 214, ;
Left = 2, ;
Name = "lstThemes", ;
TabIndex = 1, ;
Top = 2, ;
Width = 371
*< END OBJECT: BaseClass="listbox" />
PROCEDURE applytheme && Apply the selected theme.
_Screen.ThemesManager.ActiveTheme = This.lstThemes.ListIndex
ENDPROC
PROCEDURE Init
Lparameters loThemes, llThemesSupport
Local lnTheme
For m.lnTheme=1 To m.loThemes.Count
This.lstThemes.AddItem(m.loThemes.GetKey(m.lnTheme))
Endfor
m.loThemes = Null
*
With _Screen.ThemesManager
Store .ActiveTheme To ;
This.lstThemes.Value, ;
This.OldTheme
Store .InheritWindowsTheme To ;
This.chkInherit.Value, ;
This.OldInherit
This.chkInherit.Caption = .InheritWindowsThemeText
Endwith
This.chkInherit.Visible = llThemesSupport
ENDPROC
PROCEDURE QueryUnload
Nodefault
This.Release()
ENDPROC
PROCEDURE Unload
_Screen.ThemesPanel = Null
ENDPROC
PROCEDURE chkInherit.InteractiveChange
With _Screen.ThemesManager
Store This.Value To ;
.InheritWindowsTheme
Thisform.lstThemes.Value = .ActiveTheme
Endwith
Thisform.lstThemes.Enabled = Not This.Value
ENDPROC
PROCEDURE chkInherit.ProgrammaticChange
Thisform.lstThemes.Enabled = Not This.Value
ENDPROC
PROCEDURE cmdApply.Click
Thisform.Release()
ENDPROC
PROCEDURE cmdCancel.Click
With _Screen.ThemesManager
If Not .ActiveTheme = Thisform.OldTheme
.ActiveTheme = Thisform.OldTheme
Endif
If Not .InheritWindowsTheme = Thisform.OldInherit
.InheritWindowsTheme = Thisform.OldInherit
Endif
Endwith
Thisform.Release()
ENDPROC
PROCEDURE cmdOk.Click
Thisform.Release()
ENDPROC
PROCEDURE lstThemes.Click
Thisform.ApplyTheme()
ENDPROC
PROCEDURE lstThemes.DblClick
Thisform.ApplyTheme()
Thisform.Release()
ENDPROC
ENDDEFINE
Reference in New Issue View Git Blame Copy Permalink