A special visual foxpro starting window

Published on by Yousfi Benameur


This is a code for a special vfp starting :

1-its shows the Hello+day+date on vfp command window (idea from B.Bout-Foxite)
2-starts a toolbar and docks it at top with the last opened files as pjx,prg,scx,frx,dbf,mnx...can open any.
 its very usefull (vfp  menu shows only some last pjx.. files opened)
 click on left icon to close this toolbar or simply issue "clea all" on command window.
this last is described in this previous link
http://yousfi.over-blog.com/2015/02/last-vfp-files-opened-windows-recent.html
3-launches a given txt file ymemo used as personal memo here (file must exists on disc ,created here as mymemo.txt).
can fire any another format file from here(with associated app (shellexecute)) .i added a clickable shape to launch this memo.
all these use the vfp resource (foxuser.dbf or sys(2005)) file whose stores all needed informations( set resource must be ON.its the  default behaviour).
can also add in config.fpw file a line to start a prg file as:COMMAND=do MyVpfStart.prg 

the procedure to apply is the follow:
-save this code as myVFPStart.prg  in vfp9  source folder  (of course can put it in another location).
-in vfp9 menu/tools/option/file ....put this prg file location(fullpath) as starting code (dialog box).
then vfp9 in each start executes mandatory this file.

*updated version in second code below


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

 

*1*
*save this code  as home(1)+"myvfpstart.prg"
*Go vfp menu/tools/options/files/file starter and choose home(1)+"myvfpstart.prg" and save
*in each vfp start the myvfpstart.prg is executed automatically.
*the code shows the ("Hello"+day date) and the mru toolbar docked.
*can close the toolbar with button click or issue in command window: clea all
*can also add in config.fpw file a line to start a prg file as:COMMAND=do MyVpfStart.prg 

Set Date French
Set Date Long
Local m.bb
m.bb=Upper("*Bonjour !***"+Transform(Datetime()))+Chr(13)+Repli("*-",22)+Chr(13)
*KEYBOARD(m.bb)
=Strtofile(m.bb,Home(1)+"_command.prg",1)   &&this is executed as command vfp window.can add other wanted things.

_vfp.EditorOptions =""
*Messagebox("Bonjour et bonne journée "+ttoc(dateTime()),0+32+4096,"",2000)  &&its an option also
******************************
*a txt file i want to start with vfp and can memorize some personal informations
*this file can be another type uts only for demo.
m.my=Home(1)+"MYMEMO.TXT"
If File(m.my)   &&must exists
    Run/N notepad.Exe &my
Endi
******************************
&& last vfp file opened as MRU in resources
If !Pemstatus(_Screen,'myBar',5)
	_Screen.AddProperty('myBar',.Null.)
Endif

With _Screen
	If Vartype(_Screen.myBar) <> 'O'
		.myBar = Newobject('myBarClass')
		.myBar.Dock(0)
	Endif
	.myBar.Show()
Endwith
Return

Define Class myBarClass As Toolbar
	Caption = "yRecents"

	Procedure Init

	DoDefault()
	This.AddObject("image1","yimage")
	This.AddObject("combo0","combo0")
	This.AddObject("cmdRefresh","cmdRefresh")
	This.AddObject("cmdMRU","cmdMRU")
	This.AddObject("separator1","separator")
	This.separator1.Visible=.T.
	This.AddObject("shape1","yshape")
	crit="MRUL"
	This.SetUpButtons()
	Endproc

	Procedure SetUpButtons
	Local llSuccess, lcErrorMessage, lnErrorIcon
	This.Visible=.F.
	llSuccess = .T.
	lcErrorMessage = ""
	lnErrorIcon = 16

	Local laResult[1], loException As Exception
	Do Case
	Case This.combo0.Value="PJX"
		crit="MRUL"
	Case This.combo0.Value="PRG"
		crit="MRUB"
	Case This.combo0.Value="SCX"
		crit="MRUH"
	Case This.combo0.Value="MNX"
		crit="MRUE"
	Case This.combo0.Value="DBF"
		crit="MRUS"
	Endcase

	If m.llSuccess
		Try
			Select Data ;
				FROM (Sys(2005)) Where Id=crit Into Array laResult
		Catch To loException
			llSuccess = .F.
		Endtry
	Endif
	Local lnItem, lcItem
	If m.llSuccess
		lcList = laResult[1]
		lcList = Strtran(m.lcList,Chr(0),Chr(44))
		lcList = Strtran(m.lcList,Chr(4),Chr(44))
		lcList = Strtran(m.lcList,Chr(32),Chr(44))
		This.cmdMRU.Clear
		For lnItem = 1 To Getwordcount(m.lcList,Chr(44))
			lcItem = Getwordnum(m.lcList,m.lnItem,Chr(44))
			If File(m.lcItem,1)
				This.cmdMRU.AddItem(m.lcItem)
			Endif
		Endfor
	Endif
	This.Visible=.T.
	Endproc
Enddefine

Define Class combo0 As ComboBox
	Left=35
	Height=24
	Width=50
	FontSize=8
	ItemTips=.F.
	Style=2
	ToolTipText="Memo programs opened"
	Visible=.T.

	Procedure Init
	This.AddItem("PJX")
	This.AddItem("PRG")
	This.AddItem("SCX")
	This.AddItem("MNX")
	This.AddItem("DBF")
	This .ListIndex=1
	Endproc

	Procedure Click
	This.Parent.CMDRefresh.Click
	Endproc
Enddefine

Define Class cmdMRU As ComboBox
	Left=85
	Height=24
	FontSize=8
	ItemTips=.T.
	Style=2
	Visible=.T.

	Procedure Init
	This .ListIndex=1
	Endproc

	Procedure Click
	Do Case
	Case Lower(Justext(Alltrim(This.Value)))="pjx"
		Modify Project (This.Value)
	Case Lower(Justext(Alltrim(This.Value)))="prg"
		Modi Comm (This.Value)
	Case Lower(Justext(Alltrim(This.Value)))="scx"
		Modify Form (This.Value)
	Case Lower(Justext(Alltrim(This.Value)))="mnx"
		Modi Menu (This.Value)
	Case Lower(Justext(Alltrim(This.Value)))="dbf"
		Use (This.Value) Again
		Brow
	Endcase
	Endproc
Enddefine
*EndDefine myBarclass
************************
Define Class CMDRefresh As CommandButton
	Left=52
	Height=24
	FontSize=8
	Caption="REFRESH"
	ForeColor=Rgb(0,192,0)
	AutoSize=.T.
	Visible=.F.

	Procedure Click
	This.Parent.SetUpButtons()
	Endproc
Enddefine

Define Class yimage As Image
	Left=0
	MousePointer=15
	Picture=Home(1)+"graphics\icons\misc\misc15.ico"
	ToolTipText="exit"
	Visible=.T.
	Procedure Click
	_Screen.myBar=Null
	Endproc
Enddefine

Define Class yshape As Shape
	Left=117
	Width=20
	Height=20
	Curvature=99
	MousePointer=15
	ToolTipText="yMemo"
	BackColor=Rgb(0,255,0)
	Visible=.T.

	Procedure Click
	Local m.uu
	m.uu=Home(1)+"MYMEMO.TXT"
	If File (m.uu)
		Set Safe Off
		=Strtofile(Filetostr(m.uu)+Chr(13)+Chr(10)+Chr(13)+Chr(10)+'-todo....:'+Ttoc(Datetime())+Chr(13)+Chr(10)+Repli('*',42),m.uu)
		Set Safe On
		Run/N notepad  &uu
	Endi
	Endproc
Enddefine

*End code



*in the code toolbar can add other controls as button firing an mpr contextuel menu....
*in the code toolbar can add other controls as button firing an mpr contextuel menu....

*in the code toolbar can add other controls as button firing an mpr contextuel menu....

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


*2*
*new updated version on sunday 4 october 2015
*added a contextuel menu
*save this code  as home(1)+"myvfpstart.prg"
*Go vfp menu/tools/options/files/file starter and choose home(1)+"yvfpstart.prg" and save
*in each vfp start the yvfpstart.prg is executed automatically.
*the code shows the ("Hello"+day date) and the mru toolbar docked.
*can close the toolbar with button click or issue in command window: clea all
*can also add in config.fpw file a line to start a prg file as:COMMAND=do MyVpfStart.prg 

Set Date French
Set Date Long
Local m.bb
m.bb=Upper("*Bonjour !***"+Transform(Datetime()))+Chr(13)+Repli("*-",22)+Chr(13)
*KEYBOARD(m.bb)
=Strtofile(m.bb,Home(1)+"_command.prg",1)   &&this is executed as command vfp window.can add other wanted things.

_vfp.EditorOptions =""
*Messagebox("Hello and good day! "+ttoc(dateTime()),0+32+4096,"",2000)  &&its an option also
******************************
*a txt file i want to start with vfp and can memorize some personal informations
*this file can be another type uts only for demo.
m.my=Home(1)+"MYMEMO.TXT"
If File(m.my)   &&must exists
    Run/N notepad.Exe &my
Endi
******************************
&& last vfp file opened as MRU in resources
If !Pemstatus(_Screen,'myBar',5)
	_Screen.AddProperty('myBar',.Null.)
Endif

With _Screen
	If Vartype(_Screen.myBar) <> 'O'
		.myBar = Newobject('myBarClass')
		.myBar.Dock(0)
	Endif
	.myBar.Show()
Endwith
Return

Define Class myBarClass As Toolbar
	Caption = "yRecents"

	Procedure Init

	DoDefault()
	This.AddObject("image1","yimage")
	This.AddObject("combo0","combo0")
	This.AddObject("cmdRefresh","cmdRefresh")
	This.AddObject("cmdMRU","cmdMRU")
	This.AddObject("separator1","separator")
	This.separator1.Visible=.T.
	This.AddObject("shape1","yshape")
	crit="MRUL"
	This.SetUpButtons()
	Endproc

	Procedure SetUpButtons
	Local llSuccess, lcErrorMessage, lnErrorIcon
	This.Visible=.F.
	llSuccess = .T.
	lcErrorMessage = ""
	lnErrorIcon = 16

	Local laResult[1], loException As Exception
	Do Case
	Case This.combo0.Value="PJX"
		crit="MRUL"
	Case This.combo0.Value="PRG"
		crit="MRUB"
	Case This.combo0.Value="SCX"
		crit="MRUH"
	Case This.combo0.Value="MNX"
		crit="MRUE"
	Case This.combo0.Value="DBF"
		crit="MRUS"
	Endcase

	If m.llSuccess
		Try
			Select Data ;
				FROM (Sys(2005)) Where Id=crit Into Array laResult
		Catch To loException
			llSuccess = .F.
		Endtry
	Endif
	Local lnItem, lcItem
	If m.llSuccess
		lcList = laResult[1]
		lcList = Strtran(m.lcList,Chr(0),Chr(44))
		lcList = Strtran(m.lcList,Chr(4),Chr(44))
		lcList = Strtran(m.lcList,Chr(32),Chr(44))
		This.cmdMRU.Clear
		For lnItem = 1 To Getwordcount(m.lcList,Chr(44))
			lcItem = Getwordnum(m.lcList,m.lnItem,Chr(44))
			If File(m.lcItem,1)
				This.cmdMRU.AddItem(m.lcItem)
			Endif
		Endfor
	Endif
	This.Visible=.T.
	Endproc
Enddefine
*Enddefine MyBarClass
*****************************
Define Class combo0 As ComboBox
	Left=35
	Height=24
	Width=50
	FontSize=8
	ItemTips=.F.
	Style=2
	ToolTipText="Memo programs opened"
	Visible=.T.

	Procedure Init
	This.AddItem("PJX")
	This.AddItem("PRG")
	This.AddItem("SCX")
	This.AddItem("MNX")
	This.AddItem("DBF")
	This .ListIndex=1
	Endproc

	Procedure Click
	This.Parent.CMDRefresh.Click
	Endproc
Enddefine
*Enddefine combo0
******************************
Define Class cmdMRU As ComboBox
	Left=85
	Height=24
	FontSize=8
	ItemTips=.T.
	Style=2
	Visible=.T.

	Procedure Init
	This .ListIndex=1
	Endproc

	Procedure Click
	Do Case
	Case Lower(Justext(Alltrim(This.Value)))="pjx"
		Modify Project (This.Value)
	Case Lower(Justext(Alltrim(This.Value)))="prg"
		Modi Comm (This.Value)
	Case Lower(Justext(Alltrim(This.Value)))="scx"
		Modify Form (This.Value)
	Case Lower(Justext(Alltrim(This.Value)))="mnx"
		Modi Menu (This.Value)
	Case Lower(Justext(Alltrim(This.Value)))="dbf"
		Use (This.Value) Again
		Brow
	Endcase
	Endproc
Enddefine
*EndDefine cmdMRU
************************
Define Class CMDRefresh As CommandButton
	Left=52
	Height=24
	FontSize=8
	Caption="REFRESH"
	ForeColor=Rgb(0,192,0)
	AutoSize=.T.
	Visible=.F.

	Procedure Click
	This.Parent.SetUpButtons()
	Endproc
Enddefine

Define Class yimage As Image
	Left=0
	MousePointer=15
	Picture=Home(1)+"graphics\icons\misc\misc15.ico"
	ToolTipText="exit"
	Visible=.T.
	Procedure Click
	_Screen.myBar=Null
	Endproc
Enddefine
*EndDefine CMDRefresh
***********************
Define Class yshape As Shape
	Left=117
	Width=20
	Height=20
	Curvature=99
	MousePointer=15
	ToolTipText="my contextuel menu"
	BackColor=Rgb(0,255,0)
	Visible=.T.

	Procedure Click
	Define Popup raccourci SHORTCUT Relative From Mrow(),Mcol()
	Define Bar 1 Of raccourci Prompt "vfp Help"
	Define Bar 2 Of raccourci Prompt "Mspaint"
	Define Bar 3 Of raccourci Prompt "Notepad"
	Define Bar 4 Of raccourci Prompt "Mymemo"
	Define Bar 5 Of raccourci Prompt "Firefox"
	Define Bar 6 Of raccourci Prompt "Internet Explorer"
	Define Bar 7 Of raccourci Prompt "Colors"

	On Selection Bar 1 Of raccourci ;
		DO y_4gm0kw424
	On Selection Bar 2 Of raccourci ;
		DO y_4gm0kw425
	On Selection Bar 3 Of raccourci ;
		DO y_4gm0kw427
	On Selection Bar 4 Of raccourci ;
		DO y_4gm0kw428
	On Selection Bar 5 Of raccourci ;
		DO y_4gm0kw429
	On Selection Bar 6 Of raccourci ;
		DO y_4gm0kw42a
	On Selection Bar 7 Of raccourci ;
		DO y_4gm0llmrr

	Activate Popup raccourci
	Endproc

Enddefine
*EndDefine yshape
************************
Procedure y_4gm0kw424
&&shellexecute
Declare Integer ShellExecute In SHELL32.Dll Integer nWinHandle,;
	STRING cOperation,;
	STRING cFileName,;
	STRING cParameters,;
	STRING cDirectory,;
	INTEGER nShowWindow
Local m.lcfile
m.lcfile=Home(1)+"dv_foxhelp.chm"  &&to confirm is this original chm shipped !
If File(m.lcfile)
	result = ShellExecute(0, "open", m.lcfile,"","",1)
Else
	Messagebox(m.uu+" not found!",16+4096,'error')
Endi
Endproc
**************************
Procedure y_4gm0kw425
Run/N mspaint.Exe
Endproc
****************************
Procedure y_4gm0kw427
Run/N notepad.Exe
Endproc
****************************
Procedure y_4gm0kw428
Local m.uu
m.uu=Home(1)+"MYMEMO.TXT"
If File (m.uu)
	Set Safe Off
	=Strtofile(Filetostr(m.uu)+Chr(13)+Chr(10)+Chr(13)+Chr(10)+'-todo....:'+Ttoc(Datetime())+Chr(13)+Chr(10)+Repli('*',42),m.uu)
	Set Safe On
	Run/N notepad  &uu
Endi

Endproc
***************************
Procedure y_4gm0kw429
&&shellexecute
Declare Integer ShellExecute In SHELL32.Dll Integer nWinHandle,;
	STRING cOperation,;
	STRING cFileName,;
	STRING cParameters,;
	STRING cDirectory,;
	INTEGER nShowWindow
result = ShellExecute(0, "open", "firefox.exe","","",1)
Endproc
*********************************************************
Procedure y_4gm0kw42a
&&shellexecute
Declare Integer ShellExecute In SHELL32.Dll Integer nWinHandle,;
	STRING cOperation,;
	STRING cFileName,;
	STRING cParameters,;
	STRING cDirectory,;
	INTEGER nShowWindow

result = ShellExecute(0, "open", "iexplore.exe","","",1)
Endproc
**********************************************************
Procedure   y_4gm0llmrr
Local m.tnColor
m.tnColor=Getcolor()

If m.tnColor=-1  &&cancel dialogbox
	Return .F.
Endi

Local lnRed,lnGreen,lnBlue
lnRed	= Bitrshift(Bitand(m.tnColor, 0x0000FF),0)
lnGreen	= Bitrshift(Bitand(m.tnColor, 0x00FF00),8)
lnBlue	= Bitrshift(Bitand(m.tnColor, 0xFF0000),16)
************
*convert RGB colot to HTML color
Local xhtml_color
xhtml_color=Chrtran("123456","563412",Right(Trans(m.tnColor         ,"@0"),6))
************
_Cliptext="RGB Color  ="+Trans(m.tnColor)+"  RGB("+ Transform(m.lnRed)+","+Transform(m.lnGreen)+","+Transform(m.lnBlue)+")"+Chr(13)+ "HTML color= #"+xhtml_color



Messagebox(_Cliptext+Chr(13)+Chr(13)+"-Color is in clipboard (can paste)",0+32+4096)
Endproc



Can see how to integrate an mpr menu in a prg without file .mpr or ..mnx

Can see how to integrate an mpr menu in a prg without file .mpr or ..mnx

 
*Important:*the code above is tested on visual foxpro 9 sp2-under windows 10 pro

To be informed of the latest articles, subscribe:
Comment on this post
L
Thank you for giving us a code here
Reply