Using a vfp window as files viewer
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
Important:All Codes above are tested on VFP9SP2 & windows 10 pro.
Please come back with any bug.correcting code is usefull to all readers.