Import initial din SVN ROAAUTO/Trunk @HEAD

This commit is contained in:
2026-04-11 17:11:32 +03:00
commit 656d98697f
1856 changed files with 163525 additions and 0 deletions

Binary file not shown.

Binary file not shown.

View File

@@ -0,0 +1,85 @@
<title>
A simple guide on how to use ThemedControls
</title>
<body>
<p>Add the following files to your project:</p>
<ul>
<li>Text files from Other tab in Project Manager<br>Ctl32.h (mark it as "Excluded" from your project)<br>ThemedControls.h (mark it as "Excluded" from your project)<br>Themes.xml (mark it as "Excluded" from your project)<br><em>*** Don't forget to distribute these xml file together with your application! ***</em><br><br>
<li>Applications from Code tab in Project Manager<br>System.app (GDIPlusX from VFPX)<br><em>*** Don't forget to distribute these app file together with your application! ***<br><br></em>
<li><em></em>Programs from Code tab in Project Manager<br>Ctl32.prg<br>Ctl32_Api.prg<br>Ctl32_Classes.prg<br>Ctl32_Functions.prg<br>Ctl32_Structures.prg<br>Ctl32_Vfp2c32.prg<br><br>
<li>Classes tab in Project Manager<br>Buttons.vcx<br>Ctl32.vcx<br>ExplorerBar.vcx<br>OutlookNavBar.vcx<br>ThemedControls.vcx<br>ThemedControlsBuilders.vcx (mark it as "Excluded" from your project)<br>ToolBox.vcx<br>VFPX.vcx<br>ZoomNavBar.vcx<br><em>*** Don't use controls from Buttons.vcx, ExplorerBar.vcx, OutlookNavBar.vcx, ToolBox.vcx and ZoomNavBar.vcx directly because they are base classes. Use the subclassed controls in ThemedControls.vcx. ***</em></li></ul>
<p><strong></strong>&nbsp;</p>
<p><strong><font color="#0000ff">Before use any ThemedControl:</font></strong> </p>
<p>ThemesManager and BindWindowsEventsProxy objects used to handle themes are created automatically, but you need to destroy them before finish your application. </p>
<blockquote>
<p><pre>* Destroy ThemesManager object<br>If Vartype(_Screen.ThemesManager)=="O"<br>&nbsp;&nbsp; _Screen.RemoveObject("ThemesManager")<br>Endif</p><p>* Destroy BindWindowsEventsProxy object<br>If Type("_vfp.BindWindowsEventsProxy")<>"U"<br> _vfp.BindWindowsEventsProxy = Null<br>Endif</p></pre></blockquote>
<p>&nbsp;</p>
<p><strong>To use Button:</strong>
<ol>
<li>Add a ThemedButton object from ThemedControls.vcx to your form;
<li>Double click CustomBuilder property in Properties Window to show the Builder;
<li>Fill the properties and click in <em>Save and Exit</em> button;
<li>Use Click method to handle the button click.</li></ol>
<p>&nbsp;</p>
<p><strong></strong>
<p><strong>To use ExplorerBar:</strong>
<ol>
<li>Add a ThemedExplorerGroup object from ThemedControls.vcx to your form;
<li>Double click CustomBuilder property in Properties Window to show the Builder;
<li>Fill the properties and click in <em>Save and Exit</em> button;
<li>Click with right mouse button in ThemedExplorerGroup and choose Edit from shortcut menu to edit the control;
<li>Click with right mouse button in cntUserControls and choose Edit from shortcut menu to edit the control;
<li>Place any control that you want inside cntUserControls;
<li>Repeat steps from 1 to 6 to create how much groups you want;
<li>Add a ThemedExplorerBar object from ThemedControls.vcx to your form;
<li>Select all ThemedExplorerGroups you created and press CTRL + X in your keyboard;
<li>Click with right mouse button in ThemedExplorerBar and choose Edit from shortcut menu to edit the control;
<li>Press CTRL + V in your keyboard to move all ThemedExplorerGroups inside ThemedExplorerBar.</li></ol>
<blockquote>
<p>Or</p></blockquote>
<ol>
<li>Add a ThemedExplorerBar object from ThemedControls.vcx to your form;
<li>Double click CustomBuilder property in Properties Window to show the Builder;
<li>Fill the properties and click in <em>Add this group to the bar</em> button;
<li>Repeat step 3 to create how much groups you want;
<li>Click with right mouse button in ThemedExplorerBar and choose Edit from shortcut menu to edit the control;
<li>Click with right mouse button in ThemedExplorerGroup and choose Edit from shortcut menu to edit the control;
<li>Click with right mouse button in cntUserControls and choose Edit from shortcut menu to edit the control;
<li>Place any control that you want inside cntUserControls;
<li>Repeat steps from 6 to 8 for each group you created.</li></ol>
<p><strong></strong>&nbsp;</p>
<p><strong>To use OutlookNavBar:</strong></p>
<ol>
<li>Add a ThemedOutlookNavBar object from ThemedControls.vcx to your form;
<li>Click with right mouse button in ThemedOutlookNavbar and choose Edit from shortcut menu to edit the control;
<li>Click in the empty control area to select the Panes pagreframe object;
<li>Set the PageCount property to the number of buttons that you want to display;
<li>In the Properties Window, activate each page and set Caption, HotKey, Picture16 and Picture24 properties;
<li>Add the controls you want to display in each page (you can add any control: TreeView, TextBox, CommandButton, ...);
<li>Use ButtonClicked method to handle the correspondent button click. This method receive 3 parameters about the button clicked: lnNumber, lcCaption and lcPicture24.</li></ol>
<p><em>*** Note that at run time, the control will create a button for each page and will use Caption, HotKey, Picture16 and Picture24 page properties as the source of caption and picture button properties. ***</em></p>
<p>&nbsp;</p>
<p><strong>To use ToolBox:</strong>
<ol>
<li>Add a ThemedToolBox object from ThemedControls.vcx to your form;
<li>Click with right mouse button in ThemedToolBox and choose Edit from shortcut menu to edit the control;
<li>Click in the empty control area to select the Panes pagreframe object;
<li>Set the PageCount property to the number of titles that you want to display;
<li>In the Properties Window, activate each page and set Caption property;
<li>Add the controls you want to display in each page (you can add any control: TreeView, TextBox, CommandButton, ...);
<li>Use TitleClicked method to handle the correspondent title click. This method receive a parameter named lcTitle containing the name of title clicked.</li></ol>
<p><em>*** Note that at run time, the control will create a title for each page and will use Caption page property as the source of caption title property. ***</em></p>
<p>&nbsp;</p>
<p><strong>To use ZoomNavBar:</strong>
<ol>
<li>Add a ThemedZoomNavBar object from ThemedControls.vcx to your form;
<li>In the Init method, place the code to add the buttons that you want to display:<br>
<p><pre>DoDefault()<br>With This<br>&nbsp;&nbsp; .AddButton("Printers","Manage your printers.","Printer96.png")<br>&nbsp;&nbsp; .AddButton("Display","Change the display settings.","Monitor96.png")<br>&nbsp;&nbsp; .AddButton("Explorer","Show computer's files and folders.","Folder96.png")<br>&nbsp;&nbsp; *<br>&nbsp;&nbsp; .AddButton("Separator")<br>&nbsp;&nbsp; *<br>&nbsp;&nbsp; .AddButton("ControlPanel","Change your OS settings.","ControlPanel96.png")<br>&nbsp;&nbsp; .AddStackButton("ControlPanel","Button1","Add/Remove programs","Software32.png")<br>&nbsp;&nbsp; .AddStackButton("ControlPanel","Button2","Hardware settings","Hardware32.png")<br>&nbsp;&nbsp; .AddStackButton("ControlPanel","Button3","Network settings","Network32.png")<br>Endwith</pre>
<li>Use AddButton method to add a button and AddStackButton to add an option to a button menu.<br>Sintax:<br><pre>AddButton( cButtonName, cToolTip, cImagePathAndName )<br>AddStackButton( cParentButtonName, cButtonName, cToolTip, cImagePathAndName )</pre>
<li>Use ButtonClicked and StackButtonClicked to handle the correspondent button click:<br><pre>Lparameters lcName<br>Do Case<br>&nbsp;&nbsp; Case lcName=="Printers"<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; apiShellExecute(0, "Open", "Control.exe", "Printers", "", 1)<br>&nbsp;&nbsp; Case lcName=="Display"<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; apiShellExecute(0, "Open", "Control.exe", "Desk.cpl", "", 1)<br>&nbsp;&nbsp; Case lcName=="Explorer"<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; apiShellExecute(0, "Explore", "", "", "", 1)<br>&nbsp;&nbsp; Otherwise<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Messagebox("Button '"+lcName+"' was clicked!")<br>Endcase</pre>
<p></p></li></ol>
<p>
<p>&nbsp; <p>If you have questions, suggestions or want to report bugs, feel free to contact me.</p>
<p>&nbsp;</p>
<p>Emerson Santon Reed<br><a href="mailto:emerson_reed@hotmail.com">emerson_reed@hotmail.com</a></p>
</body>

2484
COMUN/utile/ctl32/Themes.xml Normal file

File diff suppressed because it is too large Load Diff

Binary file not shown.

Binary file not shown.

Binary file not shown.

4557
COMUN/utile/ctl32/ctl32.h Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,39 @@
********************************************************************************
*!* ctl32.prg
********************************************************************************
*!* This is the main file for the ctl32 classes. This gets called by
*!* each and every class in the Init event.
#Include ctl32.h
*!* Adding this file location to the path list. ADDITIVE is not used, it seems
*!* to have problems with expressions, so to avoid using macro substitution:
If .F.
Local m.lcPath As String
m.lcPath = Addbs(Justpath(Sys(16)))
If Empty(Set("Path")) Then
Set Path To (m.lcPath)
Else
If Not m.lcPath $ Set("Path") Then
Set Path To (Set("Path") + ";" + m.lcPath)
Endif
Endif
*!* Load the main visual classes VCX file:
If Not "CTL32.VCX" $ Upper(Set("Classlib")) Then
Set Classlib To m.lcPath + "ctl32.vcx" Additive
Endif
Endif
*!* Load ctl32 modules:
Do ctl32_api.prg
Do ctl32_classes.prg
Do ctl32_functions.prg
Do ctl32_structures.prg
Do ctl32_vfp2c32.prg
Return

View File

@@ -0,0 +1,25 @@
ctl32 Classes README FILE - Carlos Alloatti - calloatti@gmail.com
ctl32_scontainer scrollable container by Carlos Alloatti & Malcolm Greene
http://www.ctl32.com.ar/
TESTED ONLY IN VFP9, Windows 2000, XP, Vista
This classes are free to use, please contribute reporting bugs,
proposing changes and updates.
To use these classes you only need the following files added them to your project:
ctl32.h (excluded)
ctl32.prg
ctl32.vct
ctl32.vcx
ctl32_api.prg
ctl32_classes.prg
ctl32_functions.prg
ctl32_structures.prg
ctl32_vfp2c32.prg
vfpx.vct
vfpx.vcx

BIN
COMUN/utile/ctl32/ctl32.vct Normal file

Binary file not shown.

BIN
COMUN/utile/ctl32/ctl32.vcx Normal file

Binary file not shown.

File diff suppressed because it is too large Load Diff

Binary file not shown.

Binary file not shown.

View File

@@ -0,0 +1,594 @@
********************************************************************************
*!* ctl32_classes.prg
********************************************************************************
#Include ctl32.h
If Not Sys(16) $ Upper(Set("Procedure")) Then
Set Procedure To Sys(16) Additive
Endif
********************************************************************************
Define Class ctl32_menu As Custom
Height = 0
MenuId = 0
Protected _MemberData
_MemberData = '<VFPData>' + ;
'<memberdata name="" type="property" display=""/>' + ;
'</VFPData>'
Enddefine
********************************************************************************
Define Class ctl32_menuitem As Custom
BarBreak = ""
Break = ""
CanRaiseEvents = ""
Caption = ""
Checked = FALSE
Container = ""
DefaultItem = FALSE
DesignMode = ""
Enabled = FALSE
Events = ""
MenuId = 0
Index = ""
IsParent = ""
MdiList = ""
MdiListItem = ""
MenuId = 0
MenuItems = ""
MergeOrder = ""
MergeType = ""
Mnemonic = ""
Name = "MenuItem"
OwnerDrawn = ""
RadioCheck = FALSE
Shortcut = ""
ShowShortcut = ""
Site = ""
Tag = ""
Visible = ""
ItemID = 0
Picture = ""
PictureObject = FALSE
PictureId = 0
DisabledPicture = ""
DisabledPictureObject = FALSE
DisabledPictureId = 0
DownPicture = ""
DownPictureObject = FALSE
DownPictureId = 0
SubMenuId = 0
Protected _MemberData
_MemberData = '<VFPData>' + ;
'<memberdata name="" type="property" display=""/>' + ;
'</VFPData>'
Procedure SubMenuId_Assign
Lparameters m.vNewVal
*!* Destroy any previous submenu:
If This.SubMenuId > 0 Then
apiDestroyMenu(This.SubMenuId)
Endif
This.SubMenuId = m.vNewVal
If This.ItemID = 0 Then
Return
Endif
*!* update menu item submenu info:
Local ;
m.lcMenuItemInfo As String,;
m.loMenuItemInfo As _MENUITEMINFO
m.loMenuItemInfo = Createobject("_MENUITEMINFO")
m.loMenuItemInfo.fMask = MIIM_SUBMENU
m.loMenuItemInfo.hSubMenu = This.SubMenuId
m.lcMenuItemInfo = m.loMenuItemInfo.Value
apiSetMenuItemInfo(This.MenuId, This.ItemID, MF_BYCOMMAND, @m.lcMenuItemInfo)
m.loMenuItemInfo = .Null.
Release m.loMenuItemInfo
Endproc
Procedure Picture_Assign
Lparameters m.vNewVal
*!* Here we store the value to use, HBMMENU_CALLBACK
*!* If a numeric system bitmap is choosen, we use that
Local m.hbmpItem As Integer
m.hbmpItem = 0
Do Case
Case Vartype(m.vNewVal) = "N"
This.Picture = ""
This.PictureId = m.vNewVal
m.hbmpItem = This.PictureId
Case Vartype(m.vNewVal) = "C"
This.Picture = m.vNewVal
If File(m.vNewVal)
This.PictureObject = LoadPicture(m.vNewVal)
This.PictureId = This.PictureObject.Handle
Else
This.PictureId = 0
Endif
If ctlGetOsVersion() < NTDDI_VISTA
m.hbmpItem = HBMMENU_CALLBACK
Endif
Otherwise
This.Picture = ""
This.PictureId = 0
If ctlGetOsVersion() < NTDDI_VISTA
m.hbmpItem = HBMMENU_CALLBACK
Endif
Endcase
If This.ItemID = 0 Then
Return
Endif
Local m.lcMenuItemInfo As String
Local m.loMenuItemInfo As _MENUITEMINFO
m.loMenuItemInfo = Createobject("_MENUITEMINFO")
m.loMenuItemInfo.fMask = MIIM_BITMAP
m.loMenuItemInfo.hbmpItem = m.hbmpItem
m.lcMenuItemInfo = m.loMenuItemInfo.Value
apiSetMenuItemInfo(This.MenuId, This.ItemID, MF_BYCOMMAND, @m.lcMenuItemInfo)
m.loMenuItemInfo = .Null.
Endproc
Procedure Caption_Assign
Lparameters vNewVal
This.Caption = m.vNewVal
Endproc
Procedure Caption_Access
Return This.Caption
Endproc
Procedure DefaultItem_Assign
Lparameters vNewVal
If Vartype(m.vNewVal) = "N" Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
Endif
This.DefaultItem = m.vNewVal
If This.ItemID = 0 Then
Return
Endif
If This.DefaultItem = TRUE Then
apiSetMenuDefaultItem(This.MenuId, This.ItemID, MF_BYCOMMAND)
Else
apiSetMenuDefaultItem(This.MenuId, -1, MF_BYPOSITION)
Endif
Endproc
Procedure Enabled_Assign
Lparameters vNewVal
If Vartype(m.vNewVal) = "N" Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
Endif
This.Enabled = m.vNewVal
If This.ItemID = 0 Then
Return
Endif
If This.Enabled = TRUE Then
apiEnableMenuItem(This.MenuId, This.ItemID, Bitor(MF_BYCOMMAND, MF_ENABLED))
Else
apiEnableMenuItem(This.MenuId, This.ItemID, Bitor(MF_BYCOMMAND, MF_GRAYED))
Endif
Endproc
Procedure Checked_Assign
Lparameters vNewVal
If Vartype(m.vNewVal) = "N" Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
Endif
This.Checked = m.vNewVal
If This.ItemID = 0 Then
Return
Endif
If This.Checked = TRUE Then
apiCheckMenuItem(This.MenuId, This.ItemID , Bitor(MF_BYCOMMAND, MF_CHECKED))
Else
apiCheckMenuItem(This.MenuId, This.ItemID , Bitor(MF_BYCOMMAND, MF_UNCHECKED))
Endif
Endproc
Procedure RadioCheck_Assign
Lparameters vNewVal
If Vartype(m.vNewVal) = "N" Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
Endif
This.RadioCheck = m.vNewVal
If This.ItemID = 0 Then
Return
Endif
*!* Get current fType, we set fMask to MIIM_FTYPE
Local ;
m.lcMenuItemInfo As String, ;
m.loMenuItemInfo As _MENUITEMINFO, ;
m.lfType As Integer
m.loMenuItemInfo = Createobject("_MENUITEMINFO")
*!* Build MenuItemInfo structure:
m.loMenuItemInfo.fMask = MIIM_FTYPE
m.lcMenuItemInfo = m.loMenuItemInfo.Value
If apiGetMenuItemInfo(This.MenuId, This.ItemID , MF_BYCOMMAND, @m.lcMenuItemInfo) <> 0 Then
m.loMenuItemInfo.Value = m.lcMenuItemInfo
If This.RadioCheck = TRUE Then
m.loMenuItemInfo.fType = Bitor(MFT_RADIOCHECK, m.loMenuItemInfo.fType)
Else
m.loMenuItemInfo.fType = Bitxor(MFT_RADIOCHECK, Bitor(MFT_RADIOCHECK, m.loMenuItemInfo.fType))
Endif
m.lcMenuItemInfo = m.loMenuItemInfo.Value
apiSetMenuItemInfo(This.MenuId, This.ItemID , MF_BYCOMMAND, m.lcMenuItemInfo)
m.loMenuItemInfo = .Null.
Endif
Endproc
Enddefine
********************************************************************************
Define Class ctl32_statusbar_panel As Custom
Height = 16
Width = 120
*-- Specifies the icon displayed for a Form at run time when the Form is minimized.
ctlicon = ""
ctlcaption = ""
ctlformat = 0
*-- Specifies the text that appears as a ToolTip for a control.
ctltooltiptext = ""
ctlindex = 0
*-- Right x value position for Panel
_right = -1
_oicon = ""
*-- Specifies if an object is visible or hidden.
ctlvisible = .T.
*-- Specifies if a control is automatically resized to fit its contents.
ctlautosize = .T.
_width = 0
*-- Specifies the alignment of text associated with a control.
ctlalignment = 0
ctlwidth = ""
ctlname = ""
Name = "ctl32_statusbar_panel"
Procedure ctlIcon_assign
Lparameters vNewVal
Local lnHandle
This.ctlicon = m.vNewVal
This._oicon = .Null.
*!* 2006-07-17 Now takes icon handle too //Anton
Do Case
Case Vartype(This.ctlicon) = T_NUMERIC
m.lnHandle = m.vNewVal
Case Vartype(This.ctlicon) = T_CHARACTER And File(This.ctlicon)
This._oicon = LoadPicture(This.ctlicon)
m.lnHandle = This._oicon.Handle
Otherwise
m.lnHandle = 0
Endcase
apiSendMessageInteger(This.Parent._ControlHWnd, SB_SETICON, This.ctlindex, m.lnHandle)
If This.Parent._ControlHWnd <> 0 And This.ctlindex <> 0 And This.Parent._Creating = FALSE Then
This.Parent.ctlResizePanels()
Endif
Endproc
Procedure ctlcaption_assign
Lparameters vNewVal
*!* 2006-06-27 Added Transform()
This.ctlcaption = Alltrim(Transform(m.vNewVal))
Local lcPadLeft, lcPadRight, lcCaption
m.lcCaption = m.vNewVal
*!* we add spaces so text does not fit and tooltips show
Do Case
Case This.ctlalignment = 1 And This.ctlautosize = FALSE && Right
m.lcPadLeft = TABCHAR + TABCHAR
m.lcPadRight = Space(1)
Case This.ctlalignment = 2 And This.ctlautosize = FALSE && Center
m.lcPadLeft = TABCHAR
m.lcPadRight = Space(0)
Otherwise && Left
m.lcPadLeft = Space(0)
m.lcPadRight = Space(10)
*!* Add one space to left if this is PanelMessage and
*!* ctlAlignment is left, so it separates the text a little from border
If This.ctlindex = 0
m.lcPadLeft = m.lcPadLeft + Space(1)
Endif
Endcase
*!* If changing indicator panels Caption, let tmrUpdater update captions:
If This.Name = "PanelOvr" Then
This.Parent._OldOVR = Not Insmode()
Endif
If This.Name = "PanelNum" Then
This.Parent._OldNUM = Not Numlock()
Endif
If This.Name = "PanelCaps" Then
This.Parent._OldCAPS = Not Capslock()
Endif
*!* If setting Caption for Message Panel
If This.ctlindex = 0
This.Parent._OldMessage = Sys(2015)
Endif
m.lcCaption = m.lcPadLeft + m.lcCaption + m.lcPadRight + NULA
*!* Do not set Panel Caption for ProgressBar:
If This.ctlindex <> 1 Then
apiSendMessageString(This.Parent._ControlHWnd, SB_SETTEXTA, This.ctlindex , m.lcCaption)
Endif
If This.Parent._ControlHWnd <> 0 And This.ctlindex <> 0 And This.Parent._Creating = FALSE Then
This.Parent.ctlResizePanels()
Endif
Endproc
Procedure ctlformat_assign
*!* Property only valid for PanelDate
Lparameters vNewVal
This.ctlformat = m.vNewVal
If This.Name = "PanelDate" Then
If This.ctlformat > 0 Then
This.ctlcaption = ctlGetDateFormat(This.ctlformat)
Else
This.ctlcaption = ""
Endif
Endif
Endproc
Procedure ctltooltiptext_assign
Lparameters vNewVal
This.ctltooltiptext = m.vNewVal
If Len(m.vNewVal) > 0 Then
m.vNewVal = Space(1) + This.ctltooltiptext + Space(1)
Endif
apiSendMessageString(This.Parent._ControlHWnd,SB_SETTIPTEXTA, This.ctlindex, m.vNewVal)
Endproc
Procedure ctlvisible_assign
Lparameters vNewVal
If Vartype(m.vNewVal) = "N" Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
Endif
If Vartype(m.vNewVal) <> "L" Then
Messagebox("Parameter must be Logical: " + Program(), 16)
Return
Endif
This.ctlvisible = m.vNewVal
If This.Parent._ControlHWnd <> 0 And This.Parent._Creating = FALSE Then
This.Parent.ctlResizePanels()
Endif
Endproc
*-- Called when creating the statusbar to update all data of Panels
Procedure _updateall
This.ctlcaption = This.ctlcaption
This.ctlformat = This.ctlformat
This.ctlicon = This.ctlicon
This.ctltooltiptext = This.ctltooltiptext
This.ctlvisible = This.ctlvisible
Endproc
Procedure ctlautosize_assign
Lparameters vNewVal
If Vartype(m.vNewVal) = "N" Then
If m.vNewVal = 0 Then
m.vNewVal = FALSE
Else
m.vNewVal = TRUE
Endif
Endif
*!* Index 0 is first Panel, PanelMessage, that should always have ctlAutosize = FALSE
If This.ctlindex = 0 Then
This.ctlautosize = FALSE
Else
This.ctlautosize = m.vNewVal
*!* Reset caption to get rid of center/right codes if ctlAutosize is TRUE
This.ctlcaption = This.ctlcaption
Endif
Endproc
Procedure ctlalignment_assign
Lparameters vNewVal
This.ctlalignment = m.vNewVal
*!* If message panel, force update
If This.ctlindex = 0
This.Parent._OldMessage = Sys(2015)
Endif
This.ctlcaption = This.ctlcaption
Endproc
Procedure ctlname_access
Return This.Name
Endproc
Procedure ctlname_assign
Lparameters vNewVal
This.Name = m.vNewVal
Endproc
Procedure ctlwidth_access
Return This.Width
Endproc
Procedure ctlwidth_assign
Lparameters vNewVal
This.Width = m.vNewVal
Endproc
Procedure Destroy
This._oicon = .Null.
Endproc
Enddefine
********************************************************************************
Define Class ctl32_statusbar_toolbar As Toolbar
Caption = "ctl32_statusbar_toolbar"
Height = 16
Left = 0
Top = 51
Visible = .F.
Width = 32028
ShowWindow = 1
Name = "ctl32_statusbar_toolbar"
Add Object ctlHeightShape As Shape With ;
Top = 3, ;
Left = 5, ;
Height = 13, ;
Width = 16384, ;
Name = "ctlHeightShape"
Procedure Init
*!* Hide the toolbar thru API so it is still there but invisible
With This
.Dock(TOOL_BOTTOM, 0, 0)
.Visible = TRUE
apiShowWindow(.HWnd, SW_HIDE)
Endwith
Endproc
Procedure ctlHeightShape.Click
This.Parent.Dock(3, 0, 0)
Endproc
Procedure ctlHeightShape.Init
If ctlGetOsVersion() >= NTDDI_VISTA && Vista
This.Height = 13
Else
This.Height = 17
Endif
Endproc
Enddefine
********************************************************************************
Define Class ctl32_statusbar_timer As Timer
Height = 23
Width = 23
Interval = 100
_Interval = 100
_IntervalTrace = 10000
Name = "ctl32_statusbar_timer"
Procedure Timer
*!* 20070701 Added trace aware timer, suggested by ajh
If Wvisible("trace") Or ;
Wvisible("debugger") Or ;
Wvisible("call") Or ;
Wvisible("watch") Or ;
Wvisible("locals")
If This.Interval # This._IntervalTrace
This.Interval = This._IntervalTrace
Endif
Else
If This.Interval # This._Interval
This.Interval = This._Interval
Endif
Endif
This.Parent.ctlUpdatePanels()
Endproc
Enddefine
********************************************************************************
*!* END ctl32_classes
********************************************************************************

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

File diff suppressed because it is too large Load Diff

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@@ -0,0 +1,2 @@
#Define WM_THEMECHANGED 0x031A
#Define GWL_WNDPROC (-4)

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

BIN
COMUN/utile/ctl32/vfpx.VCT Normal file

Binary file not shown.

BIN
COMUN/utile/ctl32/vfpx.vcx Normal file

Binary file not shown.

Binary file not shown.