Using a vfp window as files viewer

Published on March 28 2016 by Yousfi Benameur


The vfp window opened with "modify command" can be used as viewer on a form for some based prg files as:
-prg
-mpr
-txt
-mpr
-h
-htm
-html
-xml
-....can add others txt based extensions.
it can be manipulated as object and then can use some properties inherited from the form class.
it have the advantage to retrieve all properties and syntax coloring of vfp window.If rightclick on the window can obtain also same contextuel menu.the vfp window is resizable as well.See the syntax used to make it as a "vfp system window" to be scrollable...the titlebar here is cut.

the code gathers all prg based files in any directory in a listbox and can view them in vfp window.
as normal behavior the vfp window disappears , simply re click on form or listbox to show it.
i made the files viewed not editable in code.
can open a new prg and save it (warning copy yblank.prg to another file otherwise its overwritten by code)

Note:
*select all (CTRL+A) dont work as expected-must select manuallay with  mouse. In normal behavior even with clause "nomenu  noedit" CTRL+A works

*if enabled in vfp/tools/options/ide :modi comm fires always coloring syntax.

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


*1*
set exact on
publi yform
yform=newObject("yvfpViewer")
yform.show
read events
retu
*

DEFINE CLASS yvfpViewer AS form
Height = 553
Width = 910
ShowWindow = 2
DoCreate = .T.
AutoCenter = .T.
Caption = "Using VFP Window as viewer"
Name = "Form1"

ADD OBJECT list1 AS listbox WITH ;
    Anchor = 0, ;
	Height = 468, ;
	Left = 0, ;
	Top = 0, ;
	Width = 253, ;
	Name = "List1"

ADD OBJECT command1 AS commandbutton WITH ;
	Top = 484, ;
	Left = 12, ;
	Height = 25, ;
	Width = 73, ;
	FontBold = .T., ;
	Anchor = 768, ;
	Caption = "Getdir...", ;
	MousePointer = 15, ;
	BackColor = RGB(128,255,0), ;
	Name = "Command1"

ADD OBJECT label1 AS label WITH ;
	AutoSize = .T., ;
	Anchor = 768, ;
	Caption = "", ;
	Height = 17, ;
	Left = 100, ;
	Top = 484, ;
	Width = 2, ;
	Name = "Label1"

ADD OBJECT label2 AS label WITH ;
	FontBold = .T., ;
	FontSize = 10, ;
	Anchor = 768, ;
	Caption = "", ;
	Height = 25, ;
	Left = 264, ;
	Top = 523, ;
	Width = 600, ;
	ForeColor = RGB(0,255,0), ;
	BackColor = RGB(0,0,0), ;
	Name = "Label2"

ADD OBJECT combo1 AS combobox WITH ;
	Anchor = 768, ;
	Height = 25, ;
	Left = 12, ;
	Top = 515, ;
	Width = 73, ;
	Name = "Combo1"

ADD OBJECT command2 AS commandbutton WITH ;
	Top = 524, ;
	Left = 204, ;
	Height = 25, ;
	Width = 49, ;
	FontBold = .T., ;
	Anchor = 768, ;
	Caption = "New", ;
	MousePointer = 15, ;
	BackColor = RGB(128,255,0), ;
	Name = "Command2"

PROCEDURE Destroy
	clea events
ENDPROC

PROCEDURE MouseDown
	LPARAMETERS nButton, nShift, nXCoord, nYCoord
	sele ycurs
	with thisform.list1
	.listindex=recno()
	.click
	endwith
ENDPROC

PROCEDURE Resize
	thisform.list1.height=thisform.command1.top-10
	try
	if wexist("yb")
	with yb as object
	.scrollbars=3
	.titlebar=0
	.left=thisform.list1.left+thisform.list1.width+1
	.top=0
	.width=thisform.width-thisform.list1.width-thisform.list1.left-2*sysmetric(3)
	.height=thisform.height-thisform.label2.height-33
	thisform.click
	endwith
	endi
	catch
	endtry
ENDPROC

PROCEDURE Load
	set safe off
	create cursor ycurs (cdir c(100),afile c(50))
ENDPROC

PROCEDURE Init
	publi m.yrep0
	m.yrep0=addbs(justpath(sys(16,1)))
ENDPROC

PROCEDURE list1.Click
	*MODIFY COMMAND [FileName | ?] [NOEDIT] [NOMENU] [NOWAIT]
	*   [RANGE nStartCharacter, nEndCharacter] [[WINDOW WindowName1]
	*   [IN [WINDOW] WindowName2 | IN SCREEN]] [AS nCodePage] [SAME]
	*   [SAVE]
	try
	yb=null
	catch
	endtry

	define window yb FROM 1, 1 TO 2,2  in (thisform.name) system  grow name yb   &&noclose nogrow nofloat
	hide window yb
	thisform.resize
	thisform.label2.caption=allt(cdir)+allt(afile)
	sele ycurs
	modi comm (allt(cdir)+allt(afile)) nomenu noedit window yb in (thisform.name)   &&save
	thisform.resize
ENDPROC

PROCEDURE list1.Init
	with this
	.rowsource="ycurs.afile"
	.rowsourcetype=6
	.SelectedItemBackColor=Rgb(70,60,50)
			.SelectedItemForeColor=Rgb(10,191,160)
			.SpecialEffect=1
			.FontSize=8
			.ItemBackColor=Rgb(40,40,40)
			.ItemForeColor=Rgb(255,204,153)
			.BorderColor=Rgb(235,132,0)
			.ItemTips=.T.
			.MousePointer=15
		   .listindex=1
	endwith
ENDPROC

PROCEDURE command1.Click
	thisform.label1.caption=""
	local m.yrep,gnbre,i,j
	m.yrep=getdi()
	if empty(m.yrep)
	return .f.
	endi

	m.yrep=addbs(m.yrep)
	if thisform.combo1.value="All"
	gnbre=adir(gabase,m.yrep+"*.*")
	else
	gnbre=adir(gabase,m.yrep+"*."+thisform.combo1.value)
	endi

	if gnbre=0
	retu .f.
	endi
	zap in select("ycurs")

	j=0
	for i=1 to gnbre
	if inlist(lower(justext(gabase(i,1))),"prg","txt","h","mpr","htm","html","xml")
	insert into ycurs values(m.yrep,allt(gabase(i,1)))
	j=j+1
	endi
	endfor
	*brow
	thisform.label1.caption=trans(j)+" Files"
	thisform.list1.requery()
	thisform.list1.setfocus
ENDPROC


PROCEDURE combo1.Click
ENDPROC

PROCEDURE combo1.Init
With This
        .AddItem("All")
	.AddItem("prg")
	.AddItem("mpr")
	.AddItem("txt")
	.AddItem("htm")
	.AddItem("html")
	.AddItem("h")
	.AddItem("xml")
	.ListIndex=1
	.Style=2
Endwith
ENDPROC

PROCEDURE command2.Click
	strtofile('*new blank prg*',m.yrep0+"yblank.prg")
	try
	yb=null
	catch
	endtry
	define window yb FROM 1, 1 TO 2,2  in (thisform.name) system  grow name yb
	thisform.resize
	thisform.label2.caption=m.yrep0+"yblank.prg"
	modi comm (m.yrep0+"yblank.prg") nomenu  window yb in (thisform.name)      &&editable here
	thisform.resize
ENDPROC

ENDDEFINE
*
*-- EndDefine: yvfpViewer