VFP Form statusbar and progressbars

Published on by Yousfi Benameur

    

VFP have not a form statusbar.the only one is on vfp ide (under command widow).
the code works around an old class of Weswind "Creating a Statusbar control with VFP 8" can be found in https://www.west-wind.com/presentations/wwstatusbar/wwstatusbar.asp
it attachs to any form a statusbar with pure vfp code (no activeX).
this code illustrates this statusbar with some works around as:
   -binding events to result messages (mouseEnter/mouseLeave any control) on this statusbar
   -adding 2 methods to fire progressbar as demo (to adapt to context)
   -firing a monthview from a panel
   -firing vfp help from another panel
   -decorating with date and real time.
   -adding a contextuel custom menu with some custom items.

-can customize the statusbar styles in nstyle class property.i selected the nstyle=2 for this demo.
-all images originally in code are replaced by pictureVal image control property,accepting strings.
-i added an utility to list all MRU (recents used files).
-the forms  can be with ShowWindow=2,1,0
*Note i tried to integrate the olecontrol progressbar [OleClass = "COMCTL.ProgCtrl.1"] in the ostatus container without success.its seems that dont work with collections.
this statusbar is simple,flexible  and dont recquire all a library sometimes>1.5 Moctet !
can add other functionalities to this code.

*in same registry,added an ole statusbar (MSComctlLib.SBarCtrl.2) in code *2* below.

[post 260]


Click on code to select [then copy] -click outside to deselect


*1* created on friday 09 of february 2018
* a form statusbar,progressbars.
*https://www.west-wind.com/presentations/wwstatusbar/wwstatusbar.asp

if !_vfp.startmode=0
on shutdown quit
endi

clea all
close data all

Set Date French
set century on
Set Date short
publi obar
publi m.yrep
m.yrep=addbs(justpath(sys(16,1)))

if !directory(m.yrep+"bmps")
md m.yrep+"bmps"
endi
set defa to (yrep)
set safe off


Public oform1
oform1=Newobject("form1")
oform1.Show
Return
*
Define Class form1 As Form
  Top = 0
  Left = 0
  Height = 500
  Width = 800
  Caption = "StatusForm"
  ShowWindow=2  &&0,1
  borderstyle=3
  Name = "Form1"
  ycl=0

  Add Object ostatus As wwstatusbar With ;
    Top = 252, ;
    Left = 72, ;
    Width = 361, ;
    Height = 21, ;
    Name = "oStatus", ;
    oShadow.Name = "oShadow", ;
    oThumb.Height = 13, ;
    oThumb.Width = 16, ;
    oThumb.Name = "oThumb", ;
    Label1.Name = "Label1", ;
    Image1.Height = 17, ;
    Image1.Width = 2, ;
    Image1.Name = "Image1", ;
    Image2.Height = 16, ;
    Image2.Width = 16, ;
    Image2.Name = "Image2"

  Add Object txtpaneltext As TextBox With ;
    Height = 25, ;
    Left = 24, ;
    Top = 60, ;
    Width = 229, ;
    Name = "txtPanelText"

  Add Object txt As TextBox With ;
    Height = 25, ;
    Left = 224, ;
    Top = 60, ;
    Width = 60, ;
    visible=.F.,;
    Name = "txt"

   Add object edit1 as editbox with ;
   width=200,;
   height=200,;
   left=270,;
   top=10,;
   name="edit1"

   Add object cnt as container with ;
   width=100,;
   height=100,;
   left=270+210,;
   top=10,;
   name="cnt"

   Add object command1 as commandbutton with ;
   width=100,;
   height=27,;
   left=200,;
   top=220,;
   caption="progressbar",;
   name="command1"

   Add object command2 as commandbutton with ;
   width=100,;
   height=27,;
   left=310,;
   top=220,;
   caption="progressbarY",;
   name="command2"

   Add object img as image with ;
   width=100,;
   height=100,;
   left=24,;
   top=100,;
   picture=home(1)+"graphics\gifs\morphfox.gif",;
   name="img"

  Add Object timer1 As Timer With ;
    Top = 72, ;
    Left = 492, ;
    Height = 25, ;
    Width = 49, ;
    Interval = 60000, ;
    Name = "Timer1"

procedure yauthor()
local m.hyp
m.hyp=newObject("hyperlink")
m.hyp.navigateto("https://www.west-wind.com/presentations/wwstatusbar/wwstatusbar.asp")
m.hyp=null
endproc

procedure edit1.init
text to this.value pretext 7 noshow
Visual FoxPro 8 offers many new features and opportunities to make life easier.
In this article Rick describes how to build a native VFP based status bar that
fixes some of the problems found in the Windows Common Control OCX version (MSCOMCTL.OCX)
that ships with VFP and other development tools. This article introduces several new VFP 8
features in passing: Collections, the Emtpy object, AddProperty() and BindEvents and provides
good view of how to utilize and integrate some of these new features in a useful component.
 endtext
procedure yrecents
local oform
oform=newObject("yrecents")
oform.show(1)
endproc

procedure command2.click
with thisform.ostatus
.addobject("yprogressbar1","yprogressbar")
.panels(1).Text=""
.Panels(1).Icon=""

 WITH .yprogressbar1
		.Top = 2
		.Left = 0
		.height=.parent.height-4
		.Name = "Yprogressbar1"
		.Image1.Name = "Image1"
		.Timer1.Name = "Timer1"
		.Label1.Name = "Label1"
		.visible=.t.
endwith		
.yprogressbar1.ycall()
endwith
endproc

 procedure command1.click
 create cursor ycurs (lib i)
for i=1 to 10000
insert into ycurs values (i)
endfor

thisform.ostatus.panels(1).Text=""
Thisform.ostatus.Panels(1).Icon=""

local m.w
m.w=Thisform.ostatus.Panels(1).width
with thisform.ostatus
.addobject("shp","shape")
with .shp
.borderwidth=0
.left=0
.top=2
.height=.parent.height-4
.width=0
.backcolor=rgb(0,255,0)
.zorder(0)
.name="shp"
.visible=.t.
endwith
endwith

scan
Thisform.ostatus.shp.width=(recno()/reccount())*m.w
thisform.ostatus.panels(2).Text=  trans((100*recno()/reccount()) ,"999")+" %"
Thisform.ostatus.RenderPanels()
endscan
thisform.ostatus.removeObject("shp")
thisform.ostatus.renderPanels()
 endproc

  *-- Déclench un changement d'information dans l'interface utilisateur fourni par DoStatus.
  Procedure UpdateStatus
    Lparameters lcFirstPanel, lcSecondPanel,lcThreePanel,lcFourPanel,lcFivePanel
    If !Empty(lcFirstPanel)
      This.ostatus.Panels(1).Text = lcFirstPanel
    Endif
    If !Empty(lcSecondPanel)
      This.ostatus.Panels(2).Text = lcSecondPanel
    Endif

    If !Empty(lcThreePanel)
      This.ostatus.Panels(3).Text = lcThreePanel
         Endif
    If !Empty(lcFourPanel)
      This.ostatus.Panels(4).Text = lcFourPanel
    Endif
     If !Empty(lcFivePanel)
      This.ostatus.Panels(5).Text = lcFivePanel
    Endif
    If !Empty(lcSixPanel)
      This.ostatus.Panels(6).Text = lcSixPanel
    Endif
     If !Empty(lcSixPanel)
      This.ostatus.Panels(7).Text = lcSevenPanel
    Endif
    This.ostatus.RenderPanels()
  Endproc

  Procedure Init
  local m.myvar
 text to m.myvar noshow
 R0lGODlhEAAQAPcAAAAAAAAAhAAA/wCEAACEhISEhMbGxv//AP///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////ywAAAAAEAAQAAAIfAARCBxIsKBBBAUSFjg4MKEBAQQICBBwcKEBBAMEDMgYoKBFAgpDAiBY4OKAhQIPGEApEOXDhQcEXkzYksDDlQInGgDAs+VDiAViIhC6s2XGiSgnUiya8yjMlAiYIgigNOnEqCMHUhXwdCjWggEClDRAtmzWgjzTqmXINiAAOw==
endtext
strtofile(strconv(m.myvar,14),"weblink.gif")
    Bindevent(Thisform.txtpaneltext,"lostfocus",Thisform,"my")
    with thisform
   .ostatus.AddPanel("Ready",400,.T.,0)
   .ostatus.AddPanel("control",150,.f.,3)
   .ostatus.AddPanel("MontView",80,.f.,3)
   .ostatus.AddPanel(proper(substr(cdow(date()),1,2))+" "+substr(ttoc(dateTime()),1,10) ,100,.F.,3)
   .ostatus.AddPanel(Substr(Time(),1,5) ,60,.F.,2)
   .oStatus.Addpanel("Help",50,.f.,2)
   .ostatus.AddPanel("Menu",50,.f.,2)
   .ostatus.RenderPanels()
   .Resize()

for i=1 to .controlcount   
    if !.controls(i)=thisform.oStatus
    try
    Bindevent(.controls(i),"mouseEnter",thisform,"my1")
    Bindevent(.controls(i),"mouseLeave",thisform,"my2")
    catch
    endtry
    endi
    endfor
    endwith
  Endproc

  procedure my1
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
Thisform.ostatus.Panels(2).Text =loObject.parent.name+"."+loObject.name
Thisform.ostatus.RenderPanels()
  endproc

   procedure my2
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
   Thisform.ostatus.Panels(2).Text =""
    Thisform.ostatus.RenderPanels()
  endproc

  Procedure  my
    DoDefault()
    If Empty(Thisform.ostatus.Panels(1).Icon)
      Thisform.ostatus.Panels(1).Icon = "weblink.gif"
      Thisform.ostatus.FontBold = .T.
    Else
      Thisform.ostatus.Panels(1).Icon = ""
      Thisform.ostatus.FontBold = .F.
    Endif

    If !Empty(Thisform.txtpaneltext.Value)
      Thisform.ostatus.Panels(1).Text = Thisform.txtpaneltext.Value
    Else
      Thisform.ostatus.Panels(1).Text = "Ready..."
    Endif
    *** Whenever we make size or icon changes we
    *** have to re-render the entire status bar
    Thisform.ostatus.RenderPanels()
  Endproc

  Procedure timer1.Timer
    Thisform.ostatus.Panels(4).Text = proper(substr(cdow(date()),1,2))+" "+substr(ttoc(dateTime()),1,10)
    Thisform.ostatus.Panels(5).Text = Substr(Time(),1,5)
    Thisform.ostatus.RenderPanels()
  Endproc
Enddefine
*
*-- EndDefine: form1
*
Define Class wwstatusbar As Container
  Width = 361
  Height = 20
  BorderWidth = 0
  ColorSource = 0
  BackColor = Rgb(236,233,216)

  Panels = .Null.
  *-- Specifies the name of the font used to display text.
  FontName = "Tahoma"
  *-- Specifies the font size for text displayed with an object.
  FontSize = 8
  *-- Specifies if the text is bold.
  FontBold = .F.
  *-- 0 - Automatic, 1 - Xp Style, 2 - Classic Windows Style, 3 - Classic thumb but XP style bar
  Protected ndisplaymode
  ndisplaymode = 0


  *-- The picture used for a thumb in XP.
  cxpthumbpicture = ""
  *-- Classic Thumb image for Win2k, NT etc.
  cclassicthumbpicture =""
  *-- Image used for separator in XP.
  cxpseparatorpicture = ""
  *-- 0 - Automatic, 1 - XP Style, 2 - Windows Classic, 3 - XP Style but with classic thumb
  nstyle =2   &&0-1-2-3
  *nstyle class property
*!*	0  Automatic – Automatically adjusts the style depending on whether themes are active
*!*	1  XP Style with Themes enabled
*!*	2  Classic Windows Style.
*!*	3  Modified Classic Windows Style. Automatic uses this for classic Windows.

  *-- Internal prop-erty used to determine the current position of the next panel to render.
  Protected nrenderposition
  nrenderposition = 0
  *-- Determines whether the status bar automatically resizes itself with BindEvents to the container's Resize event.
  lautoresize = .T.
  Name = "wwstatusbar"

  Add Object oShadow As Shape With ;
    Top = 0, ;
    Left = 0, ;
    Height = 2, ;
    Width = 553, ;
    BorderStyle = 0, ;
    BorderWidth = 0, ;
    BackColor = Rgb(202,202,202), ;
    Name = "oShadow"

  Add Object oThumb As Image With ;
    Picture = "", ;
    Height = 13, ;
    Left = 343, ;
    Top = 7, ;
    Visible = .T., ;
    Width = 16, ;
    Name = "oThumb"

  Add Object Label1 As Label With ;
    FontName = "Tahoma", ;
    FontSize = 8, ;
    BackStyle = 0, ;
    Caption = "wwStatusBar Control", ;
    Height = 13, ;
    Left = 14, ;
    Top = 3, ;
    Visible = .F., ;
    Width = 166, ;
    Name = "Label1"

  Add Object Image1 As Image With ;
    Picture = "", ;
    Height = 17, ;
    Left = 312, ;
    Top = 2, ;
    Visible = .F., ;
    Width = 2, ;
    Name = "Image1"

  Add Object Image2 As Image With ;
    Picture = "", ;
    Height = 16, ;
    Left = 324, ;
    Top = 2, ;
    Visible = .F., ;
    Width = 16, ;
    Name = "Image2"


  *-- Adds a new panel to the status bar.
  Procedure AddPanel
    Lparameters lcText, lnWidth, llSpring, lnAlign
    If Isnull(This.Panels )
      This.Panels = Createobject("Collection")
    Endif

    If Empty(lnAlign)
      lnAlign = 0
    Endif

    loPanel = Createobject("EMPTY")
    AddProperty(loPanel,"Text",lcText)
    AddProperty(loPanel,"Width",lnWidth)
    AddProperty(loPanel,"Spring",llSpring)
    AddProperty(loPanel,"Align",lnAlign)
    AddProperty(loPanel,"Icon","")
    AddProperty(loPanel,"IconAlignment",0)
    AddProperty(loPanel,"Left",0)

    *** TODO: Add Font and other formatting
    This.Panels.Add(loPanel)
    Return loPanel
  Endproc


  *-- Draws the panels and the thumb.
  Procedure RenderPanels
    Local x, lnLockScreen
    lnTotalWidth = This.Width
    lnFixedWidth = 0
    lnSpringIndex = 0
    For x=1 To This.Panels.Count
      If !This.Panels(x).Spring
        lnFixedWidth = lnFixedWidth + This.Panels(x).Width
      Else
        lnSpringIndex = x
      Endif

    Endfor

    If lnSpringIndex > 0
      *** Resize the panel width of the spring item
      This.Panels(lnSpringIndex).Width = lnTotalWidth - lnFixedWidth - ;
        THIS.oThumb.Width + 2
    Endif

    lnLockScreen = Thisform.LockScreen
    Thisform.LockScreen = .T.
local m.thumb,m.xpthumb,m.xpSeparator
text to m.thumb noshow
R0lGODlhEAAQAPcAAAAAADMAAGYAAJkAAMwAAP8AAAAzADMzAGYzAJkzAMwzAP8zAABmADNmAGZmAJlmAMxmAP9mAACZADOZAGaZAJmZAMyZAP+ZAADMADPMAGbMAJnMAMzMAP/MAAD/ADP/AGb/AJn/AMz/AP//AAAAMzMAM2YAM5kAM8wAM/8AMwAzMzMzM2YzM5kzM8wzM/8zMwBmMzNmM2ZmM5lmM8xmM/9mMwCZMzOZM2aZM5mZM8yZM/+ZMwDMMzPMM2bMM5nMM8zMM//MMwD/MzP/M2b/M5n/M8z/M///MwAAZjMAZmYAZpkAZswAZv8AZgAzZjMzZmYzZpkzZswzZv8zZgBmZjNmZmZmZplmZsxmZv9mZgCZZjOZZmaZZpmZZsyZZv+ZZgDMZjPMZmbMZpnMZszMZv/MZgD/ZjP/Zmb/Zpn/Zsz/Zv//ZgAAmTMAmWYAmZkAmcwAmf8AmQAzmTMzmWYzmZkzmcwzmf8zmQBmmTNmmWZmmZlmmcxmmf9mmQCZmTOZmWaZmZmZmcyZmf+ZmQDMmTPMmWbMmZnMmczMmf/MmQD/mTP/mWb/mZn/mcz/mf//mQAAzDMAzGYAzJkAzMwAzP8AzAAzzDMzzGYzzJkzzMwzzP8zzABmzDNmzGZmzJlmzMxmzP9mzACZzDOZzGaZzJmZzMyZzP+ZzADMzDPMzGbMzJnMzMzMzP/MzAD/zDP/zGb/zJn/zMz/zP//zAAA/zMA/2YA/5kA/8wA//8A/wAz/zMz/2Yz/5kz/8wz//8z/wBm/zNm/2Zm/5lm/8xm//9m/wCZ/zOZ/2aZ/5mZ/8yZ//+Z/wDM/zPM/2bM/5nM/8zM///M/wD//zP//2b//5n//8z//////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAKwALAAAAAAQABAAAAg8AFkJHEiwoMGDCBMqXMjwGkOB1wI9jChxIcWGgSQ6THgxIseMrC4e7AhyJMiOBklqrDhQZciSEE/KrBgQADs=
endtext
this.cclassicthumbpicture=strconv(m.thumb,14)

text to m.xpthumb noshow
R0lGODlhEAANAPcAAAAAADMAAGYAAJkAAMwAAP8AAAAzADMzAGYzAJkzAMwzAP8zAABmADNmAGZmAJlmAMxmAP9mAACZADOZAGaZAJmZAMyZAP+ZAADMADPMAGbMAJnMAMzMAP/MAAD/ADP/AGb/AJn/AMz/AP//AAAAMzMAM2YAM5kAM8wAM/8AMwAzMzMzM2YzM5kzM8wzM/8zMwBmMzNmM2ZmM5lmM8xmM/9mMwCZMzOZM2aZM5mZM8yZM/+ZMwDMMzPMM2bMM5nMM8zMM//MMwD/MzP/M2b/M5n/M8z/M///MwAAZjMAZmYAZpkAZswAZv8AZgAzZjMzZmYzZpkzZswzZv8zZgBmZjNmZmZmZplmZsxmZv9mZgCZZjOZZmaZZpmZZsyZZv+ZZgDMZjPMZmbMZpnMZszMZv/MZgD/ZjP/Zmb/Zpn/Zsz/Zv//ZgAAmTMAmWYAmZkAmcwAmf8AmQAzmTMzmWYzmZkzmcwzmf8zmQBmmTNmmWZmmZlmmcxmmf9mmQCZmTOZmWaZmZmZmcyZmf+ZmQDMmTPMmWbMmZnMmczMmf/MmQD/mTP/mWb/mZn/mcz/mf//mQAAzDMAzGYAzJkAzMwAzP8AzAAzzDMzzGYzzJkzzMwzzP8zzABmzDNmzGZmzJlmzMxmzP9mzACZzDOZzGaZzJmZzMyZzP+ZzADMzDPMzGbMzJnMzMzMzP/MzAD/zDP/zGb/zJn/zMz/zP//zAAA/zMA/2YA/5kA/8wA//8A/wAz/zMz/2Yz/5kz/8wz//8z/wBm/zNm/2Zm/5lm/8xm//9m/wCZ/zOZ/2aZ/5mZ/8yZ//+Z/wDM/zPM/2bM/5nM/8zM///M/wD//zP//2b//5n//8z//////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAALkALAAAAAAQAA0AAAg4AHMJHEiwoMGDiBAdRIjo2kKD1xw+nFgwoUCLDxM61DgxokCPFDMqzIURI0GOKBtClAgSZMiBAQEAOw==
endtext
this.cxpthumbpicture=strconv(m.xpthumb,14)

text to m.xpSeparator noshow
R0lGODlhAgARAPcAAL29pca9rcbGrcbGtc7Gtf///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////ywAAAAAAgARAAAIGAAJFBgwsCDBgwUEFAiwsACAAgIRSiwQEAA7
endtext
this.cxpseparatorpicture=strconv(m.xpseparator,14)
**************************
    *** In XP mode display a shadow
    Do Case
      Case This.ndisplaymode = 1
        This.oShadow.Visible = .T.

        This.oThumb.PictureVAL = This.cxpthumbpicture
         Case This.ndisplaymode = 2
        This.oShadow.Visible = .F.
        This.oThumb.PictureVaL = This.cclassicthumbpicture
      Case This.ndisplaymode = 3
        This.oShadow.Visible = .T.
        This.oThumb.PictureVaL = This.cclassicthumbpicture
    Endcase

    This.nrenderposition = 0

    For x=1 To This.Panels.Count
      This.RenderPanel(x,.T.)
    Endfor

    Thisform.LockScreen = lnLockScreen
  Endproc

  Procedure RenderPanel
    Lparameters x, llFirstRender
    Local loLabel As TextBox
    *** Create the panel textbox
    loPanel = This.Panels(x)
    If Type("THIS.Panel" + Transform(x)) # "O"
      This.AddObject("Panel" + Transform(x),"TextBox")
      loLabel = Evaluate("THIS.Panel" + Transform(x))
      loLabel.Themes = .F.
      loLabel.BackStyle = 0
      loLabel.ReadOnly = .F.
      loLabel.TabStop = .F.
      loLabel.DisabledForeColor = This.Parent.ForeColor
      loLabel.Enabled = .F.
      loLabel.Height = This.Height - 2

      If This.ndisplaymode = 2
        *** 3D Box no shadow must be closer to top
        loLabel.Top = 1
        loLabel.BorderStyle = 1
      Else
        loLabel.Top = 3
        loLabel.BorderStyle = 0
      Endif
    Else
      loLabel = Evaluate("THIS.Panel" + Transform(x))
    Endif

    *** Inherit Font from container
    loLabel.FontName = This.FontName
    loLabel.FontSize = This.FontSize
    loLabel.FontBold = This.FontBold
    loLabel.Value = loPanel.Text

    If llFirstRender
      loLabel.Left = This.nrenderposition
    Endif

    loLabel.Alignment = loPanel.Align
    loLabel.Visible = .T.
    lnWidth = loPanel.Width - 2
    If lnWidth < 1
      loLabel.Width = 1
    Else
      loLabel.Width = lnWidth
    Endif

    *** Store Left value so we can handle clicks
    loPanel.Left = loLabel.Left

    *** Draw Icon into textbox
    If !Empty(loPanel.Icon)
      If Type("THIS.PanelIcon" + Transform(x)) # "O"
        This.AddObject("PanelIcon" + Transform(x),"Image")
      Endif
      loIcon = Evaluate("THIS.PanelIcon" + Transform(x))
      loIcon.Picture = loPanel.Icon
      If llFirstRender
        loIcon.Left = This.nrenderposition + 4
      Endif
      loIcon.Height = 16
      loIcon.Width = 16
      loIcon.Top = 4

      loIcon.Visible = .T.

      loLabel.Value = "       " + loLabel.Value
    Else
      If Type("THIS.PanelIcon" + Transform(x)) = "O"
        This.RemoveObject("PanelIcon" + Transform(x))
      Endif
    Endif

    This.nrenderposition = This.nrenderposition + loLabel.Width + 1

    *** Paint XP style separator after all but last panel
    If llFirstRender And ;
        this.ndisplaymode # 2 And ;
        x < This.Panels.Count
      If Type("THIS.PanelSep" + Transform(x)) # "O"
        This.AddObject("PanelSep" + Transform(x),"Image")
      Endif
      loImage = Evaluate("THIS.PanelSep" + Transform(x))
      loImage.Left = This.nrenderposition

      loImage.Top = 3
      This.nrenderposition = This.nrenderposition + 2
      loImage.Pictureval = This.cxpseparatorpicture
      loImage.Visible = .T.
    Endif
  Endproc

  Procedure updatepanel
    Lparameters lnPanel, lcText, lcIcon
    This.nrenderposition = 0
    loPanel = This.Panels(lnPanel)
    loPanel.Text = lcText
    If !Empty(lcIcon)
      loPanel.Icon = lcIcon
    Endif
    This.RenderPanel(lnPanel,.T.)
  Endproc

  *-- Called when somebody clicks on a panel (or label within it really)
  Procedure panelclick
    Lparameters lnPanel
if !inlist(lnpanel,3,6,7)  &&monthview and shortcut edition menu  here
return .f.
endi
if lnpanel=3
with thisform
.ycl=iif(.ycl=0,1,0)
do case
case .ycl=1
.AddObject("olecontrol1","OleControl","MSComCtl2.MonthView.2")
 With .olecontrol1
	.Height = 178
	.Width = 288
	.Top = thisform.ostatus.top-.height
	.Left = thisform.ostatus.panels(lnPanel).left-50	
	.BorderStyle=0
    .TitleForecolor=rgb(128,0,64)
    .Titlebackcolor=rgb(212,210,208)
    .TrailingForecolor=rgb(0,0,255)
    .Monthbackcolor=rgb(255,255,230)
    .forecolor=0	
    .Name = "Olecontrol1"
    .visible=.t.
   wait window "re click to remove monthview"  timeout 1
endwith

case .ycl=0
try
.removeObject("olecontrol1")
catch
endtry
endcase	
endwith	
endi
thisform.edit1.setfocus  &&to make menu edition/search working
if lnpanel=6
keyboard "{F1}"
endi

if lnpanel=7
DEFINE POPUP raccourci SHORTCUT RELATIVE FROM MROW()-10,MCOL() COLOR G/W*, B/W*,,,,W+/GR
    DEFINE BAR 1 OF raccourci PROMPT "all recents MRU files" ;		
		PICTURE  home(1)+"graphics\icons\misc\misc15.ico" ;
		MESSAGE "LIST OF ALL RECENTS IN WINDOWS MRU"
		
	DEFINE BAR 2 OF raccourci PROMPT "Run explorer" ;		
		PICTURE  home(1)+"Gallery\Graphics\view.ico" ;
		MESSAGE "Run windows explorer"	
		
	DEFINE BAR 3 OF raccourci PROMPT "class explorer" ;		
		PICTURE  home(1)+"Gallery\Graphics\classlib.ico" ;
		MESSAGE "Run class explorer"
			
	DEFINE BAR 4 OF raccourci PROMPT "object explorer" ;		
		PICTURE  home(1)+"Gallery\Graphics\class.ico" ;
		MESSAGE "Run object explorer"	
		
	DEFINE BAR 5 OF raccourci PROMPT "MSPaint" ;		
		PICTURE  home(1)+"Gallery\Graphics\picture.ico" ;
		MESSAGE "Run MSPAINT"	
		
    DEFINE BAR 6 OF raccourci PROMPT "Original author page" ;		
		PICTURE  home(1)+"Gallery\Graphics\website.ico" ;
		MESSAGE "Weswind page"	

	DEFINE BAR _med_slcta OF raccourci PROMPT "Sélectionner tout" ;
		KEY CTRL+A, "Ctrl+A" ;
		PICTRES _med_slcta ;
		MESSAGE "Sélectionne tout le texte ou tous les éléments de la fenêtre active"
	DEFINE BAR _med_paste OF raccourci PROMPT "Coller" ;
		KEY CTRL+V, "Ctrl+V" ;
		PICTRES _med_paste ;
		MESSAGE "Place le contenu du Presse-papiers au point d'insertion"
	DEFINE BAR _med_copy OF raccourci PROMPT "Copier" ;
		KEY CTRL+C, "Ctrl+C" ;
		PICTRES _med_copy ;
		MESSAGE "Copie la sélection et la place dans le Presse-papiers"
	DEFINE BAR _med_cut OF raccourci PROMPT "Couper" ;
		KEY CTRL+X, "Ctrl+X" ;
		PICTRES _med_cut ;
		MESSAGE "Enlève la sélection et la place dans le Presse-papiers"
	DEFINE BAR _med_redo OF raccourci PROMPT "Rétablir" ;
		KEY CTRL+R, "Ctrl+R" ;
		PICTRES _med_redo
	DEFINE BAR _med_undo OF raccourci PROMPT "Annuler" ;
		KEY CTRL+Z, "Ctrl+Z" ;
		PICTRES _med_undo ;
		MESSAGE "Annule la dernière modification"		
	DEFINE BAR _med_find OF raccourci PROMPT "Rechercher" ;
		KEY CTRL+Z, "Ctrl+Z" ;
		PICTRES _med_find ;
		MESSAGE "Recherche texte"	
		
ON SELECTION BAR 1 OF RACCOURCI  _SCREEN.ACTIVEFORM.yrecents()		
ON SELECTION BAR 2 OF RACCOURCI  run/n explorer
ON SELECTION BAR 3 OF RACCOURCI  do (_browser)
ON SELECTION BAR 4 OF RACCOURCI  DO (_OBJECTBROWSER)
ON SELECTION BAR 5 OF RACCOURCI  run/n Mspaint
ON SELECTION BAR 6 OF RACCOURCI  _screen.activeform.yauthor()
	ACTIVATE POPUP raccourci
endi	

Endproc

  Procedure nstyle_assign
    Lparameters lnNewVal
    This.nstyle = lnNewVal
    *** Automatic mode depending on XP themes
    If lnNewVal = 0
      If Sys(2700) = "0"
        This.ndisplaymode = 3   && Themed with old thumb
      Else
        This.ndisplaymode = 1   && Themed
      Endif
      Return
    Endif
    This.ndisplaymode = lnNewVal
  Endproc

  Procedure MouseDown
    Lparameters nButton, nShift, nXCoord, nYCoord
    Local x, loPanel

    For x=1 To This.Panels.Count
      loPanel = This.Panels(x)
      If loPanel.Left <= nXCoord And loPanel.Left + loPanel.Width >= nXCoord
        This.panelclick(x)
      Endif
    Endfor
  Endproc

  Procedure Resize
    Local lnOldLockScreen
    lnOldLockScreen = Thisform.LockScreen
    Thisform.LockScreen = .T.

    This.Left = 0
    This.Width = This.Parent.Width
    This.Top = This.Parent.Height - This.Height

    If Vartype(This.Panels) = "O"
      This.RenderPanels()
    Endif

    This.oThumb.Left = This.Width - This.oThumb.Width
    This.oThumb.Top = This.Height - This.oThumb.Height
    This.oShadow.Width = This.Width

    Thisform.LockScreen = lnOldLockScreen
  Endproc

  Procedure Init
    If This.lautoresize
      Bindevent(This.Parent,"Resize",This,"Resize")
    Endif
    This.nstyle_assign(This.nstyle)
  Endproc

  *-- Handles the resize event of the parent container.
  Procedure resizeeventhandler
  Endproc

Enddefine
*
*-- EndDefine: wwstatusbar
*
DEFINE CLASS yprogressbar AS container  &&adapt to user context
	Width = 349
	Height = 61
	BackStyle = 0  &&1
	SpecialEffect = 1
	borderwidth=0
	Visible = .F.
	BackColor = RGB(0,0,0)
	Name = "yprogressbar"

	ADD OBJECT image1 AS image WITH ;
		Stretch = 2, ;
		Height = 60,;
		Left = 0, ;
		Top = 0, ;
		Width = 48, ;
		Name = "Image1"

	ADD OBJECT timer1 AS timer WITH ;
		Top = 12, ;
		Left = 312, ;
		Height = 23, ;
		Width = 23, ;
		Enabled = .F., ;
		Interval = 100, ;
		Name = "Timer1"

	ADD OBJECT label1 AS label WITH ;
		FontBold = .T., ;
		FONTNAME="ARIAL BLACK",;
		FontSize = 9, ;
		BackStyle = 0, ;
		Caption = "", ;
		Height = 37, ;
		Left = 137, ;
		Top = 0, ;
		Width = 85, ;
		ForeColor = RGB(255,0,0), ;
		Name = "Label1"

	PROCEDURE ycall	
		declare integer  Sleep in kernel32 integer
		local m.myvar		
		text to m.myvar  noshow
		iVBORw0KGgoAAAANSUhEUgAAAIEAAAAiCAIAAAD3Si1HAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAACpSURBVGhD7dorDkJBFIPh2uuxaDQajUaj0Vg0Go0muXBfy8R3Aa35k28Hk8yZOa2kEW3DiDLtvijT/osyHX4o0/GHMp0mlOk8oUyXCWW6TijTbUaZ7jPK9FhQpueCMr1WlOm9okyfDWXaNpT5mSDP7ybk+YxGnr9Vked/NuT57gJ5vsNDnu+ykeeZDvI820SeZ/zI864L8rzzhTzvPiLPO8DI8y48wobxDzLSnWgHgZKZAAAAAElFTkSuQmCC
		endtext
		with this.image1
		.pictureVAl=strconv(m.myvar,14)
		.width=0
		endwith
		with this
		.visible=.t.
		.timer1.enabled=.t.
		endwith
	ENDPROC

	PROCEDURE image1.Init
		this.width=0
		this.left=0
	ENDPROC

	PROCEDURE timer1.Timer
		local m.x,m.val
		m.delta=3
		with this.parent.image1
		.parent.label1.zorder(0)
		.width=.width+m.delta
		m.val=100*.width/.parent.width
		if m.val<=100
		.parent.label1.caption=trans(100*.width/.parent.width,"999 %")
		else
		.parent.label1.caption=trans(100,"999 %")
		endi
		if .width>=.parent.width
		this.enabled=.f.
		sleep(1000)
		.width=0
		this.parent.visible=.f.
		**********
		thisform.ostatus.removeObject("yprogressbar1")
		endi
		endwith
	ENDPROC
ENDDEFINE
*
*yRecents
Define Class yRecents As Form
BorderStyle = 2
Height = 327
Width = 620
ShowWindow = 1
desktop=.t.
AutoCenter = .T.
Caption = "Recent files opened"
MaxButton = .F.
Name = "Form1"

Add Object combo1 As ComboBox With ;
Anchor = 0, ;
Height = 32, ;
Left = 163, ;
Top = 4, ;
Width = 133, ;
Name = "Combo1"

Add Object grid1 As Grid With ;
FontBold = .T., ;
FontSize = 10, ;
Anchor = 0, ;
DeleteMark = .F., ;
GridLines = 0, ;
Height = 263, ;
Left = 3, ;
RecordSource = ['"zcurs"'], ;
RowHeight = 19, ;
Top = 43, ;
Width = 610, ;
ForeColor = Rgb(0,0,255), ;
Name = "Grid1"

Add Object label1 As Label With ;
FontBold = .T., ;
FontSize = 12, ;
Anchor = 0, ;
Caption = "", ;
Height = 25, ;
Left = 398, ;
Top = 3, ;
Width = 156, ;
ForeColor = Rgb(255,0,0), ;
BackColor = Rgb(255,255,0), ;
Name = "Label1"

Add Object label2 As Label With ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Click on cfile to open cfile link (file or folder)with associated application", ;
Height = 17, ;
Left = 96, ;
Top = 310, ;
Width = 386, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label2"

Procedure my
Lparameters nButton, nShift, nXCoord, nYCoord
&&shellexecute
Sele zcurs
If Messagebox("open the link :"+Justfname(cfilename)+" ?",4+64+4096)=6
result = ShellExecute(0, "open", cfilename,"","",1)
Endi
Endproc

Procedure Init
Set Date Long
With Thisform.combo1
.Value="prg"
.Click()
Endwith
Endproc

Procedure Load
Close Data All
Declare Integer ShellExecute In SHELL32.Dll Integer nWinHandle,;
STRING cOperation,;
STRING cFileName,;
STRING cParameters,;
STRING cDirectory,;
INTEGER nShowWindow
Endproc

Procedure combo1.Click
m.ext=Lower(This.Value)

Local objShell,objFolder,objFolderItem
objShell = Createobject("Shell.Application")
objFolder = objShell.Namespace( 0x08)
objFolderItem = objFolder.Self

Local m.yrep
m.yrep=Addbs(objFolderItem.Path)
objShell=Null
objFolder=Null
objFolderItem=Null

*m.yrep="%APPDATA%\Microsoft\Windows\Recent\"
*win8.1 : m.yrep="c:\Users\yousfi\AppData\Roaming\Microsoft\Windows\Recent\"
gnbre=Adir(gabase,m.yrep+"*.*")
Create Cursor ycurs (cfile c(100),cfilename c(150),modified c(90))
For i=1 To gnbre
xcfilename=m.yrep+Substr(gabase(i,1),1,Len(gabase(i,1))-4)
xfile=Justfname(m.xcfilename)
xmodified=Ttoc(gabase(i,3))+" "+gabase(i,4)
Insert Into ycurs Values(xfile,xcfilename+".LNK",xmodified)
Endfor

If !m.ext=="*.*"
Sele * From ycurs Where Lower(Justext(cfile))==Lower(m.ext) Into Cursor zcurs
Sele zcurs
Else
Sele * From ycurs Into Cursor zcurs
Endi
Count To xr

With Thisform.grid1
.RecordSource=""
.RecordSource="zcurs"
.column2.Visible=.F.
.column1.Width=300
.column3.Width=300
.RecordSourceType=1
.column1.SetAll("mousepointer",15,"column")
.SetAll("backcolor",Rgb(100,10,120),"header")
.SetAll("forecolor",255,"header")
.Themes=.F.
.DeleteMark=.F.
.GridLines=0
.HeaderHeight=28
.RowHeight=18
.SetAll("fontbold",.T.,"header")
.SetAll("fontsize",14,"header")
.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0, RGB(255,255,204), RGB(155,255,215))", "Column")
Locate
.Refresh
Endwith

Thisform.label1.Caption=Trans(xr)+" files ("+m.ext+")"
Bindevent(Thisform.grid1.column1.text1,;
"mousedown",Thisform,"my")
Endproc

Procedure combo1.Init
With This &&can add other extensions
.AddItem("pjx")
.AddItem("prg")
.AddItem("vcx")
.AddItem("frx")
.AddItem("txt")
.AddItem("htm")
.AddItem("html")
.AddItem("exe")
.AddItem("scx")
.AddItem("mpr")
.AddItem("mnx")
.AddItem("h")
.AddItem("*.*")
.ListIndex=1
.Style=2
Endwith
Endproc

Enddefine


VFP Form statusbar and progressbars
VFP Form statusbar and progressbars
VFP Form statusbar and progressbars
VFP Form statusbar and progressbars
VFP Form statusbar and progressbars
VFP Form statusbar and progressbars
VFP Form statusbar and progressbars

Click on code to select [then copy] -click outside to deselect


*2* created on sunday 11 of february 2018
*MS ole Statusbar (activeX) shipped with vfp.
*same demo as pure vfp statusbar above with some particularities.
*ole statusbar use also collection
*ole statusbar picture property are objects and must use loadpicture() function to set.
*Use the Add Method to Create a Collection of Panel Objects
*Configure Each Panel Object with properties (text,style,picture,inde ,key...)
*code each panel.click to do what you project to do with.
*can add panel num and caps with constants above(sbrCaps,sbrNum)...
*use preferably pictures or icons 16x16
*at design time can rightckick on ole statusbar...assistant to fire a form settings properties.can also change fontname/fontsize...and each panel(text,picture,style,bevel,autosize properties).
**ole statusbar showTips is a readonly property and can set at design time only to fire tooltips on ole statusbar (its ignored even if its coded in a prg).its available on visual form at design time only not on prg ???.it seems to be a bug.

Set Date short
Set Century On
Set Safe Off
_screen.windowstate=1

publi m.yrep
m.yrep=addbs(justpath(sys(16,1)))
set defa to (yrep)

Public oform
oform=Newobject("yoleStatusbar")
oform.Show
Read Events
Return
*
Define Class yolestatusbar As Form
  Top = 13
  Left = 157
  Height = 458
  Width = 1061
  ShowWindow = 2
  ShowTips = .T.
  Caption = "ole statusbar MSComctlLib.SBarCtrl.2"
  oldvalue = .F.
  ycl = 0
  Name = "Form1"

  Add Object olecontrol1 As OleControl With ;
    oleclass="MSComctlLib.SBarCtrl.2" , ;
    Top = 432, ;
    Left = 0, ;
    Height = 32, ;
    Width = 1061, ;
    Align = 2, ;
    style=0 ,;
    enabled=.T. , ;
    showTips=.t. , ;
    Name = "Olecontrol1"
*statusbar can be aligned   (olecontrol1.align property= 0,1,2,3,4)
*          0 default; 1 top; 2 bottom; 3 left; 4right of the window

  Add Object text1 As TextBox With ;
    Height = 25, ;
    Left = 48, ;
    Top = 48, ;
    Width = 277, ;
    Name = "Text1"

  Add Object edit1 As EditBox With ;
    Height = 229, ;
    Left = 360, ;
    Top = 12, ;
    Width = 301, ;
    Name = "Edit1"

  Add Object container1 As Container With ;
    Top = 18, ;
    Left = 696, ;
    Width = 200, ;
    Height = 200, ;
    Name = "Container1"

  Add Object image1 As Image With ;
    Picture = Home(1)+"graphics\gifs\morphfox.gif", ;
    Height = 120, ;
    Left = 48, ;
    Top = 108, ;
    Width = 116, ;
    Name = "Image1"

  Procedure my1
    Lparameters nButton, nShift, nXCoord, nYCoord
    *--- aevent create an array laEvents
    Aevents( myArray, 0)
    *--- reference the calling object
    loObject = myArray[1]
    Thisform.olecontrol1.Panels(2).Text =loObject.Parent.Name+"."+loObject.Name
  Endproc

  Procedure my2
    Lparameters nButton, nShift, nXCoord, nYCoord
    *--- aevent create an array laEvents
    Aevents( myArray, 0)
    *--- reference the calling object
    loObject = myArray[1]
    Thisform.olecontrol1.Panels(2).Text =""
  Endproc

  Procedure Init
    With Thisform
      .olecontrol1.Resize
      For i=1 To .ControlCount
        If !.Controls(i)=Thisform.olecontrol1
          Try
            Bindevent(.Controls(i),"mouseEnter",Thisform,"my1")
            Bindevent(.Controls(i),"mouseLeave",Thisform,"my2")
          Catch
          Endtry
        Endi
      Endfor
    Endwith
  Endproc

  Procedure Resize
    This.olecontrol1.Resize
  Endproc

  Procedure olecontrol1.PanelClick
    Lparameters Panel
    If Panel.Index=3  &&invoke vfp help
      Keyboard "{F1}"
    Endi

    If Panel.Index=6
      With Thisform
        .ycl=Iif(.ycl=0,1,0)
        Do Case
          Case .ycl=1
            .AddObject("olecontrol2","OleControl","MSComCtl2.MonthView.2")
            With .olecontrol2
              .Height = 178
              .Width = 288
              .Top = Thisform.Height-Thisform.olecontrol1.Height-.Height-1
              .Left = Panel.Left-50
              .BorderStyle=0
              .TitleForecolor=Rgb(128,0,64)
              .Titlebackcolor=Rgb(212,210,208)
              .TrailingForecolor=Rgb(0,0,255)
              .Monthbackcolor=Rgb(255,255,230)
              .ForeColor=0
              .Name = "Olecontrol2"
              .Visible=.T.
              Wait Window "re click to remove monthview"  Timeout 1
            Endwith

          Case .ycl=0
            Try
              .RemoveObject("olecontrol2")
            Catch
            Endtry
        Endcase
      Endwith
    Endi

    If Panel.Index=7
      Thisform.edit1.SetFocus  &&to make menu edition/search working
      Define Popup raccourci SHORTCUT Relative From Mrow()-17,Mcol()-17 Color G/W*, B/W*,,,,W+/GR
      Define Bar 1 Of raccourci Prompt "Calculator" ;
        PICTURE  Home(1)+"graphics\icons\misc\misc15.ico" ;
        MESSAGE "Calculator"

      Define Bar 2 Of raccourci Prompt "Run explorer" ;
        PICTURE  Home(1)+"Gallery\Graphics\view.ico" ;
        MESSAGE "Run windows explorer"

      Define Bar 3 Of raccourci Prompt "class explorer" ;
        PICTURE  Home(1)+"Gallery\Graphics\classlib.ico" ;
        MESSAGE "Run class explorer"

      Define Bar 4 Of raccourci Prompt "object explorer" ;
        PICTURE  Home(1)+"Gallery\Graphics\class.ico" ;
        MESSAGE "Run object explorer"

      Define Bar 5 Of raccourci Prompt "MSPaint" ;
        PICTURE  Home(1)+"Gallery\Graphics\picture.ico" ;
        MESSAGE "Run MSPAINT"
      Define Bar 6 Of raccourci Prompt "MSDN Help" ;
        PICTURE  Home(1)+"Gallery\Graphics\website.ico" ;
        MESSAGE "MSDN Help"

      Define Bar _Med_slcta Of raccourci Prompt "Sélectionner tout" ;
        KEY CTRL+A, "Ctrl+A" ;
        PICTRES _Med_slcta ;
        MESSAGE "Sélectionne tout le texte ou tous les éléments de la fenêtre active"
      Define Bar _Med_paste Of raccourci Prompt "Coller" ;
        KEY CTRL+V, "Ctrl+V" ;
        PICTRES _Med_paste ;
        MESSAGE "Place le contenu du Presse-papiers au point d'insertion"
      Define Bar _Med_copy Of raccourci Prompt "Copier" ;
        KEY CTRL+C, "Ctrl+C" ;
        PICTRES _Med_copy ;
        MESSAGE "Copie la sélection et la place dans le Presse-papiers"
      Define Bar _Med_cut Of raccourci Prompt "Couper" ;
        KEY CTRL+X, "Ctrl+X" ;
        PICTRES _Med_cut ;
        MESSAGE "Enlève la sélection et la place dans le Presse-papiers"
      Define Bar _Med_redo Of raccourci Prompt "Rétablir" ;
        KEY CTRL+R, "Ctrl+R" ;
        PICTRES _Med_redo
      Define Bar _Med_undo Of raccourci Prompt "Annuler" ;
        KEY CTRL+Z, "Ctrl+Z" ;
        PICTRES _Med_undo ;
        MESSAGE "Annule la dernière modification"
      Define Bar _Med_find Of raccourci Prompt "Rechercher" ;
        KEY CTRL+Z, "Ctrl+Z" ;
        PICTRES _Med_find ;
        MESSAGE "Recherche texte"

      On Selection Bar 1 Of raccourci  Run/N Calc
      On Selection Bar 2 Of raccourci  Run/N explorer
      On Selection Bar 3 Of raccourci  Do (_Browser)
      On Selection Bar 4 Of raccourci  Do (_Objectbrowser)
      On Selection Bar 5 Of raccourci  Run/N Mspaint
      On selection bar 6 Of raccourci  msdnHelp()
      Activate Popup raccourci
    Endi
  Endproc

 Procedure olecontrol1.Init

 *statusbar constants
#define sbrNormal 0  &&multiple panels
#define sbrSimple 1  && simple panel simple text

*panel alignment constants
#define sbrLeft   0  &&left
#define sbrCenter 1  &¢er
#define sbrRight  2  &&right

*panel autosize
#define sbrNoAutosize 0  &&none
#define sbrSpring     1
#define sbrContents   2

*panel bevel constants
#define  sbrNoBevel   0
#define  sbrInset     1
#define  sbrRaised    2

*panel style constants
#define  sbrText 0
#define  sbrCaps 1
#define  sbrNum  2
#define  sbrIns  3
#define  sbrScrl 4
#define  sbrTime 5
#define  sbrDate 6
#define  sbrKana 7

local m.xpthumb  &&gripper gif
text to m.xpthumb noshow
R0lGODlhEAANAPcAAAAAADMAAGYAAJkAAMwAAP8AAAAzADMzAGYzAJkzAMwzAP8zAABmADNmAGZmAJlmAMxmAP9mAACZADOZAGaZAJmZAMyZAP+ZAADMADPMAGbMAJnMAMzMAP/MAAD/ADP/AGb/AJn/AMz/AP//AAAAMzMAM2YAM5kAM8wAM/8AMwAzMzMzM2YzM5kzM8wzM/8zMwBmMzNmM2ZmM5lmM8xmM/9mMwCZMzOZM2aZM5mZM8yZM/+ZMwDMMzPMM2bMM5nMM8zMM//MMwD/MzP/M2b/M5n/M8z/M///MwAAZjMAZmYAZpkAZswAZv8AZgAzZjMzZmYzZpkzZswzZv8zZgBmZjNmZmZmZplmZsxmZv9mZgCZZjOZZmaZZpmZZsyZZv+ZZgDMZjPMZmbMZpnMZszMZv/MZgD/ZjP/Zmb/Zpn/Zsz/Zv//ZgAAmTMAmWYAmZkAmcwAmf8AmQAzmTMzmWYzmZkzmcwzmf8zmQBmmTNmmWZmmZlmmcxmmf9mmQCZmTOZmWaZmZmZmcyZmf+ZmQDMmTPMmWbMmZnMmczMmf/MmQD/mTP/mWb/mZn/mcz/mf//mQAAzDMAzGYAzJkAzMwAzP8AzAAzzDMzzGYzzJkzzMwzzP8zzABmzDNmzGZmzJlmzMxmzP9mzACZzDOZzGaZzJmZzMyZzP+ZzADMzDPMzGbMzJnMzMzMzP/MzAD/zDP/zGb/zJn/zMz/zP//zAAA/zMA/2YA/5kA/8wA//8A/wAz/zMz/2Yz/5kz/8wz//8z/wBm/zNm/2Zm/5lm/8xm//9m/wCZ/zOZ/2aZ/5mZ/8yZ//+Z/wDM/zPM/2bM/5nM/8zM///M/wD//zP//2b//5n//8z//////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAALkALAAAAAAQAA0AAAg4AHMJHEiwoMGDiBAdRIjo2kKD1xw+nFgwoUCLDxM61DgxokCPFDMqzIURI0GOKBtClAgSZMiBAQEAOw==
endtext
strtofile(strconv(m.xpthumb,14),"xpthumb.gif")

    With This.Object
      .Panels.Add(1,"","Text1 value",0,LoadPicture(home(1)+"graphics\icons\elements\sun.ico") )   &&  index, key, text, style, picture)
      .Panels.Add(2,"","Controls",0 )
      .Panels.Add(3,"","VFP Help",0 ,loadpicture( home(1)+"gallery\graphics\help.ico"))
      .Panels.Add(4,"","Date",0)
      .Panels.Add(5,"","Time",0)
      .Panels.Add(6,"","MonthView",0,loadpicture(home(1)+"graphics\icons\office\graph04.ico"))
      .Panels.Add(7,"","Menu",0)
      .Panels.Add(8,"","",0,LoadPicture("xpThumb.gif"))
 wait window "panels count="+trans(.panels.count-1) timeout 1

*!*	panel properties
*!*	bevel:0 sbrInset ;1 sbrNoBevel ;2 sbrRaised
*!*	Alignment:0 sbrLeft  ; 1 sbrCenter ;2 sbrRight
*!*	Style: 0 sbrText; 1 sbrCaps; 2 sbrNum; 3 sbrIns; 4 sbrCtrl; 5 sbrTime; 6 sbrDate;7 sbrKana
*!*	Autosize:0 sbrNOAutosize;1 sbrSpring;2 sbrContents

      For i=1 To .panels.count
        .Panels(i).Visible=.T.
        .Panels(i).AutoSize=sbrNoAutosize  &&0,1,2
        .panels(i).bevel=sbrInset   &&0,1,2
      Endfor
      .panels(8).bevel=sbrNoBevel   && 0,1,2
      .panels(8).alignment=1
      .Panels(4).text=proper(substr(cdow(date()),1,2))+" "+Substr(Ttoc(Datetime()),1,10)  && can put sbrDate only as style without cdow
      .Panels(5).style=sbrTime                                                            && Text=Substr(Time(),1,5)
      .Refresh
    Endwith
  Endproc

  Procedure olecontrol1.Resize
    Local m.W
    m.W=Thisform.Width  && 100%of form width
    Try
      With This
        For i=1 To 7
          .Panels(1).Width=0.28*W
          .Panels(2).Width=0.2*W
          .Panels(3).Width=0.1*W
          .Panels(4).Width=0.1*W
          .Panels(5).Width=0.1*W
          .Panels(6).Width=0.1*W
          .Panels(7).Width=0.1*W
          .Panels(8).Width=20
        Endfor
        .Refresh
      Endwith
    Catch
    Endtry
  Endproc

  Procedure text1.Valid
    Thisform.olecontrol1.Panels(1).Text=This.Value
  Endproc

  Procedure edit1.Init
    TEXT to this.value pretext 7 noshow
		VFP have not a form statusbar.the only one is on vfp ide (under command widow).
		the code works around an old class of Weswind "Creating a Statusbar control with VFP 8" can be found in https://www.west-wind.com/presentations/wwstatusbar/wwstatusbar.asp
		it attachs to any form a statusbar with pure vfp code (no activeX).
		this code illustrates this statusbar with some works around as:
		   -binding events to result messages (mouseEnter/mouseLeave any control) on this statusbar
		   -adding 2 methods to fire progressbar as demo (to adapt to context)
		...
   ENDTEXT
  Endproc

  Procedure Destroy
    Clea Events
  Endproc

Enddefine
*
*-- EndDefine: yolestatusbar

function msdnHelp()  && msdn page help
local m.o
m.o=newObject("hyperlink")
m.o.navigateto("https://msdn.microsoft.com/en-us/library/aa733695(v=vs.60).aspx")
m.o=null
endfunc


VFP Form statusbar and progressbars
VFP Form statusbar and progressbars
VFP Form statusbar and progressbars
VFP Form statusbar and progressbars

                     

Yousfi Benameur


Important:All Codes above are tested on VFP9SP2 & windows 10 pro 64 bits version 1709(fall creator) & IE11 emulation.

To be informed of the latest articles, subscribe:
Comment on this post
S
Thankyou very much sir for giving updates on our language, it is very useful for us and we are very much thankful to all the team thanks once again.<br /> <br /> Kindly let us know is there any possibility for vfp version 10
Reply