Working with reports,olecontrols and listener class

Published on by Yousfi Benameur

 
Reporting is in close relationship with business and bureatic environment.
the listeners introduced to vfp9 from Microsoft as subclassed libraries revolutionized conventional reports.
the outputs are now various as html,images,rtf,even PDF.
the codes below have for purpose to make some demos for the subjects:
1-convert vfp report to preview,print,html,images (jpg,png,gif,bmp,tif),xml-the html produced can be viewed from excel
  or word(the 2 last are not as well).
2-view olecontrols on forms and capture to images to build reports, preview,print or export to html,xml
3-Customize the preview report Toolbar many properties like the preview
  toolbar controls,hide the print button,change pictures,can change the dock position
4-Make the vfp report preview toolbar on topmost on a form.desktop=.t.
5-formatting a report with listener and dynamic formatting class.
6-watermark class as text used on report-watermark report manually throw the report designer and watermark with foxypreviewer.
4-using vfpx codeplex foxyPreviewer
5-create report with RTF contents even unicode (here arabic)
6-convert any string or txt file to TXT/RTF format
7-work with UTF-8 and Unicode in vfp reports

all codes and reports used in this post are in the downloadable zip below.
make sure each code concerned points to relative report frx in the unzip.
for certain codes foxypreviewer.app of vfpx must be present on system.   

can read more on listener in http://fox.wikis.com/wc.dll?Wiki~ReportListener


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


*1*
*--posted in Foxite-Time stamp vendredi 15 mai 2009; 11:58:55
*--Subject :VFp report to outputs (html,xml,tiff,emf,jpg,gif,png,bmp,xls,doc)
*--as pointed original post xls & doc output are not formatted as well...
*--i used html to view on excel and word only.
*--https://www.foxite.com/archives/report-listener-0000228319.htm

Set Safe Off
Publi m.yrep,m.yout
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
m.yout=m.yrep+"output"

If !Directory(m.yout)
Md (m.yrep+"output")
Else
Erase (m.yout+"\*.*")
Endi

Publi yform

yform=Createobject("ylisteners")
yform.Show
Read Events
Return

Define Class ylisteners As Form
Height = 116
Width = 489
ShowWindow = 2
backcolor=rgb (212,208,200)
AutoCenter = .T.
BorderStyle = 2
Caption = "Convert report to html,xml,tiff,emf,jpg,gif,bmp"
MaxButton = .F.
Name = "Form1"

Add Object command1 As CommandButton With ;
    Top = 12, ;
	Left = 12, ;
	Height = 27, ;
	Width = 84, ;
	Caption = "...FRX", ;
	backcolor=rgb(0,205,0),;
	mousepointer=15,;
	fontbold=.t.,;
	Name = "Command1"

Add Object combo1 As ComboBox With ;
	Height = 24, ;
	Left = 348, ;
	Top = 30, ;
	Width = 120, ;
	Name = "Combo1"

Add Object command2 As CommandButton With ;
	Top = 84, ;
	Left = 372, ;
	Height = 27, ;
	Width = 84, ;
	Caption = "Convert", ;
	backcolor=rgb(0,205,0),;
	mousepointer=15,;
	fontbold=.t.,;
	Name = "Command2"

Add Object text1 As TextBox With ;
	Height = 25, ;
	Left = 12, ;
	ReadOnly = .T., ;
	fontsize=8,;
	Top = 48, ;
	Width = 312, ;
	value=home(1)+"SAMPLES\SOLUTION\REPORTS\WRAPPING.FRX", ;
	Name = "Text1"

Add Object label1 As Label With ;
	AutoSize = .T., ;
	FontSize = 12, ;
	Alignment = 2, ;
	BackStyle = 1, ;
	Caption = "Output", ;
	forecolor=255,;
	backcolor=rgb(255,255,0),;
	Height = 21, ;
	Left = 375, ;
	Top = 5, ;
	Width = 47, ;
	Name = "Label1"

Add Object command3 As CommandButton With ;
	Top = 85, ;
	Left = 24, ;
	Height = 27, ;
	Width = 24, ;
	Caption = "?", ;
	backcolor=rgb(0,205,0),;
	mousepointer=15,;
	fontbold=.t.,;
	Name = "Command3"

Procedure Init
This.SetAll("mousepointer",15,"commandbutton")
Endproc

Procedure command1.Click
Local afile
afile=Getfile('frx')
Thisform.text1.Value=afile
Endproc

Procedure combo1.Init
with This
.AddItem("HTML")
.AddItem("XML")
.AddItem("TIF")
.AddItem("EMF")
.AddItem("JPG")
.AddItem("GIF")
.AddItem("PNG")
.AddItem("BMP")
.additem("DOC")
.additem("XLS")
endwith

This.Style=2
This.ListIndex=1
Endproc

Procedure command2.Click
If Empty(Thisform.text1.Value)
	Messagebox("Enter a report please!",16,"Error")
	Return .F.
Endi

myext="."+Thisform.combo1.Value   && output html,xml,tiff,emf,jpg,gif,png,bmp
myext=Upper(myext)

#Define OutputNothing -1
#Define OutputEMF 100  && This value specifies a filename, to be saved as image of EMF type.
#Define OutputJPEG 102 && This value specifies a filename, to be saved as image of JPEG type.
#Define OutputGIF 103  && This value specifies a filename, to be saved as image of GIF type.
#Define OutputPNG 104  &&  This value specifies a filename, to be saved as image of PNG type.
#Define OutputBMP 105  &&  This value specifies a filename, to be saved as image of BMP type.
#Define OutputTIFF 101  && This value specifies a filename, to be saved as image of TIFF type.
#Define OutputTIFFM 201  && This value specifies a filename, to be saved as image of TIFF multipage type.

oListener =Newobject("ReportListener")
oListener.ListenerType=3
Report Form (Thisform.text1.Value) Preview Object oListener

Do Case
Case myext=".EMF"
	ntype=OutputEMF

Case myext=".JPG"
	ntype=OutputJPEG

Case myext=".GIF"
	ntype=OutputGIF

Case myext=".PNG"
	ntype=OutputPNG

Case myext=".BMP"
	ntype=OutputBMP

Case myext=".TIF" And oListener.PageTotal=1  &&tiff mono
	ntype=OutputTIFF

Case myext=".TIF" And oListener.PageTotal>1  &&tiff multipages
	ntype=OutputTIFFM

Case myext=".HTML"
	ntype=1000

Case myext=".XML"
	ntype=1001
	
Case myext=".XLS"
	ntype=1002
	
Case myext=".DOC"
	ntype=1003

Endcase

m.yout=m.yrep+"output"

Do Case

Case ntype=1000    &&html output
	Local loListener,	loShell
	loListener  = .Null.
	Do (_ReportOutput) With 5, loListener
	loListener.TargetFileName =m.yout+"\MyReport.html"
	loListener.Quietmode      = .T.
	Wait Window 'Outputting to HTML...' Nowait
	Erase (loListener.TargetFileName)
	Report Form (Thisform.text1.Value) Object loListener
* show
	loShell = Newobject('_shellexecute', Home() + 'ffc\_environ.vcx')
	loShell.ShellExecute(m.yout+"\myreport.html")
	Wait Clear

		
case ntype=1002   &&excel
local loListener,	loShell
loListener  = .NULL.
do (_reportoutput) with 5, loListener
loListener.TargetFileName =m.yout+"\MyReport.html"
loListener.QuietMode      = .T.
wait window 'Outputting to HTML...' nowait
erase (loListener.TargetFileName)
report form (thisform.text1.value) object loListener
wait clear
**
local oExcel
oExcel=createObject("excel.application")
oExcel.workbooks.open(m.yout+"\myreport.html")
* show
oExcel.visible=.t.



case ntype=1003   &&word
local loListener,	loShell
loListener  = .NULL.
do (_reportoutput) with 5, loListener
loListener.TargetFileName = m.yout+"\MyReport.html"
loListener.QuietMode      = .T.
wait window 'Outputting to HTML...' nowait
erase (loListener.TargetFileName)
report form (thisform.text1.value) object loListener
wait clear
**
local oWord
oWord=createObject("word.application")
oWord.documents.open(m.yout+"\myreport.html")
* show
oWord.visible=.t.



Case ntype=1001   &&xml output
	Local loListener , loShell
	loListener  = .Null.
	Do (_ReportOutput) With 4, loListener
	loListener.TargetFileName = m.yout+"\MyReport.xml"
	loListener.XMLMode        = 0	&& 0 = data only, 1 = layout only, 2 = both
	loListener.Quietmode      = .T.
	Wait Window 'Outputting to XML...' Nowait
	Erase (loListener.TargetFileName)
	Report Form (Thisform.text1.Value) Object loListener

* Show
	loShell = Newobject('_shellexecute', Home() + 'ffc\_environ.vcx')
	loShell.ShellExecute(loListener.TargetFileName)
	Wait Clear


Case  ntype==OutputTIFFM    &&tif multipage output
	Local	loListener,loError
	Try
		loListener = Newobject('MPTiffListener',  Home()+"samples\solution\europa\europa.vcx")
		loListener.TargetFileName = m.yout+"\myreport.tif"
		loListener.Quietmode      = .T.
		Wait Window 'Outputting to TIFF...' Nowait
		Erase (loListener.TargetFileName)
		Report Form (Thisform.text1.Value) Object loListener
*Show
		m.oo=m.yout+"\myreport.tif"
		Run/N "explorer" &oo
	Catch To loError
		Messagebox(loError.Message)
	Endtry
	Wait Clear



Case ntype==OutputTIFF   &&tif output
	For nPageno=1 To oListener.PageTotal
		cOutputFile =m.yout+ "\myreport"+Trans(nPageno)+myext
* messagebox("ntype="+trans(nType)+"  "+coutputFile)
		oListener.OutputPage(nPageno, cOutputFile,m.ntype)     &&m.ntype)         &&, 0,0,1024,768)
	Next
Otherwise  &&other images output
	For nPageno=1 To oListener.PageTotal
		cOutputFile = m.yout+"\myreport"+Trans(nPageno)+myext
		oListener.OutputPage(nPageno, cOutputFile,m.ntype)     &&m.ntype)         &&, 0,0,1024,768)
	Next

Endcase

If Not Inlist(ntype,OutputTIFFM,1000,1001)
	Run/N "explorer"  &yout   &&folder where are images only
Endi

reporlistener=Null
Release ReportListener

Return

*syntaxe : oReportListener.OutputPage(;
nPageNo, ;
eDevice, ;
nDeviceType ;
[,nClipLeft,nClipTop, nClipWidth, nClipHeight]])
Endproc

Procedure Destroy
Clea Events
Endproc

Procedure text1.Init
This.DisabledBackColor=Rgb(255,255,255)
Endproc

Procedure command3.Click
TEXT to myvar noshow
	This tool convert any vfp report to the output as follow:
-HTML
-XML
-TIFF (mono or multipage)
-EMF (serial of images as total report pages)
-JPG (serial of images    ")
-GIF (serial of images    " )
-PNG (serial of images    ")
-BMP (serial of images    ")
-XLS (alignment problem)
-DOC (alignment problem)
the report must be complet with its environnment (table or cursor).

ListenerType: This property determines what type of output is generated.
-1 = Do not generate output.
0 = Send output, page by page, to a printer driver.
1 = Prepare all pages and send to preview container.
2 = Create output on a page-by-page basis, but do not send to the printer.
3 = Create output for all pages, but do not send to the preview container.
4 = Provide XML output.
5 = Provide HTML output.

	 Yousfi Benameur El bayadh  Algeria  15 mai 2009
ENDTEXT
Messagebox(myvar,0+32,"yConverter")
Endproc

Procedure Destroy
Clea Events
Endproc

Enddefine
*ENDdefine ylisteners


can also  use code *2*  to convert images bmp (or jpg,png,gif...) to not searchable pdf with the utility images2pdf.exe as explained in this link: http://yousfi.over-blog.com/2016/02/working-with-open-source-xpdf-library.html

can also use code *2* to convert images bmp (or jpg,png,gif...) to not searchable pdf with the utility images2pdf.exe as explained in this link: http://yousfi.over-blog.com/2016/02/working-with-open-source-xpdf-library.html

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


*2* capture form client area  contents (even olecontrols )-convert vfp report to preview,print,html xml
*to use this code download first the zip above(unzip in source folder with this prg below)

clea all
close data all

publi yform
yform=newObject("yole")
yform.show
read events
retu
*
DEFINE CLASS yole AS form
Height = 566
Width = 932
ShowWindow = 2
AutoCenter = .T.
AlwaysonTop=.f.
Caption = "Reporting with oleObjets in vfp9"
BackColor = RGB(212,208,200)
ii = .F.
xtype = .F.
oCap=.f.

ADD OBJECT edit1 AS editbox WITH ;
FontBold = .T., ;
FontName = "Tahoma", ;
FontSize = 11, ;
FontCharSet = 178, ;
Height = 505, ;
Left = 12, ;
Top = 36, ;
Visible = .F., ;
Width = 661, ;
Margin=20,;
Alignment=1, ;
ForeColor = RGB(128,0,64), ;
DisabledBackColor = RGB(128,255,255), ;
RightToLeft = .T., ;
ReadOnly=.t., ;
Name = "Edit1"

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

ADD OBJECT olecontrol1 AS olecontrol WITH ;
oleclass="MSChart20Lib.MSChart.2",;
Top = 39, ;
Left = 12, ;
Height = 501, ;
Width = 661, ;
Name = "Olecontrol1"

ADD OBJECT olecontrol2 AS olecontrol WITH ;        
oleclass="MSComCtl2.MonthView.2",;
Top = 72, ;
Left = 696, ;
Height = 193, ;
Width = 217, ;
Name = "Olecontrol2"

ADD OBJECT image1 AS image WITH ;
Picture = home(1)+"samples\data\graphics\levejane.gif", ;
Stretch = 2, ;
BorderStyle = 1, ;
Height = 224, ;
Left = 684, ;
Top = 300, ;
Width = 240, ;
Name = "Image1"

ADD OBJECT label1 AS label WITH ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Segoe Script", ;
FontSize = 10, ;
BackStyle = 0, ;
Caption = "Yousfi Benameur", ;
Height = 22, ;
Left = 47, ;
Top = 545, ;
Width = 123, ;
ForeColor = RGB(128,0,64), ;
Name = "Label1"

ADD OBJECT label2 AS label WITH ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Segoe Script", ;
FontSize = 10, ;
BackStyle = 0, ;
Caption = "[yousfi.over-blog.com/]", ;
Height = 22, ;
Left = 174, ;
Top = 544, ;
Width = 162, ;
ForeColor = RGB(0,0,255), ;
Name = "Label2"

PROCEDURE yreport
lparameters yole,xtype
if pcount()=0
xtype=1
endi
local m.yout
m.yout=m.yrep+"output\"

do case

case xtype=1  &&preview
local listener
oListener = CREATEOBJECT("ReportListener")
oListener.ListenerType = 1 && Preview
REPORT FORM yole preview OBJECT oListener

case xtype=2  &&print  (to pdf if there is virtual printer as "print to PDF" of win10 for ex.)
local listener
oListener = CREATEOBJECT("ReportListener")
oListener.ListenerType = 0 &&for Print
REPORT FORM yole  OBJECT oListener


case xtype=3  &&html
local oHtmlListener,result
SET CLASSLIB TO HOME(1) + 'FFC\_REPORTLISTENER'
oHTMListener = CREATEOBJECT('HTMLListener')
oHTMListener.QuietMode=.t.
oHTMListener.TargetFileName = m.yout+'yole.html'
REPORT FORM yole OBJECT oHTMListener
sleep(3000)
&&shellexecute
try		
result = ShellExecute(0,"open", oHTMListener.TargetFileName,"","",1)
catch
messagebox("an error was occured",4+4096,"error")
endtry
*****

case xtype=4 &&XML
ERASE yole.XML
*-- Create the Listener class
SET CLASSLIB TO HOME(1) + 'FFC\_REPORTLISTENER'
ox = CREATEOBJECT('xmlListener')
*-- Set some properties
ox.TargetFileName = m.yout+"yole.xml"
OX.QuietMode=.t.
*-- Run the report
REPORT FORM yole OBJECT ox
local m.oo
m.oo=ox.TargetFilename
run/n notepad  &oo
endcase
set classlib to
ENDPROC

PROCEDURE Destroy
clea events
ENDPROC

PROCEDURE Load
 do ydeclare    
									
set safe off
close data all
create cursor ycurs (xtitle c(50),yf c(100))                                            
ENDPROC

PROCEDURE Init
publi m.yrep
m.yrep=addbs(justpath(sys(16,1)))
set defa to (yrep)
thisform.caption ="Reporting with oleObjets in vfp9"

if ! directory(m.yrep+"output")
md (m.yrep+"output")
else
endi

if ! directory(m.yrep+"output\images")
md (m.yrep+"output\images")
endi


try
erase (m.yrep+"output\images\*.*"=
erase m.yrep+"output\*.*
catch
endtry

local m.myvar
text to m.myvar noshow
77u/2K3ZhCDYp9mE2YrZiNmFINin2YTYrNmF2LnYqSDYp9mE2YXYr9ix2Kgg2KfZhNij2LHYrNmG2KrZitmG2Yog2YXYp9ix2LPZitmE2Ygg2KjZitmK2YTYs9inINil2YTZiSDYp9mE2KzYstin2KbYsSDYp9mE2LnYp9i12YXYqSDZhNmE2KrZgdin2YjYtiDZhdi5INix2KbZitizINin2YTYp9iq2K3Yp9iv2YrYqSDYp9mE2KzYstin2KbYsdmK2Kkg2YTZg9ix2Kkg2KfZhNmC2K/ZhSDZhdit2YXYryDYsdmI2LHYp9mI2Kkg2K3ZiNmEINiu2YTYp9mB2Kkg2KfZhNmB2LHZhtiz2Yog2YPYsdmK2LPYqtmK2KfZhiDYutmI2LHZg9mI2YEg2YHZiiDYqtiv2LHZitioINin2YTZhdmG2KrYrtioINin2YTYrNiy2KfYptix2YouDQrZiNit2LPYqCDZhdinINiw2YPYsSDZhdmI2YLYuSAi2KPZiNmG2LIg2YXZiNmG2K/Zitin2YQiINin2YTZgdix2YbYs9mKINmB2YLYryDZiNi12YQg2KfZhNmF2K/YsdioINin2YTYs9in2KjZgiDZhNij2YjZhNmF2KjZitmDINmF2KfYsdiz2YrZhNmK2Kcg2LXYqNin2K0g2KfZhNmK2YjZhSDYudmE2Ykg2KfZhNiz2KfYudipIDloNTUg2YjZg9in2YYg2YHZiiDYp9iz2KrZgtio2KfZhNmHINio2LPYsdmK2Kkg2LnYttmI2YrZhiDZhdmGICLYp9mE2YHYp9mBIiDYrdmK2Ksg2LrYp9iv2LEg2KfZhNmF2LfYp9ixINmF2KjYp9i02LHYqSDYp9mE2Ykg2YXZgtixINin2YTYp9iq2K3Yp9iv2YrYqSDYqNiv2KfZhNmKINin2KjYsdin2YfZitmFINmE2YTYqtmB2KfZiNi2INmF2Lkg2YXYrdmF2K8g2LHZiNix2KfZiNip2Iwg2K3ZitirINmF2YYg2KfZhNmF2YbYqti42LEg2KfZhiDZitmI2YLYuSDYp9mE2KrZgtmG2Yog2KfZhNin2LHYrNmG2KrZitmG2Yog2LnZhNmJINi52YLYryDZhNmF2K/YqSDYs9mG2KrZitmGINin2YTZiSDYutin2YrYqSDYs9mG2KkgMjAxOCDYrdiz2Kgg2KfZhNmF2YjZgti5INin2YTZgdix2YbYs9mKLg0K2YjYs9mK2YbYtSDYp9mE2LnZgtivINin2YTZhdio2LHZhSDYqNmK2YYg2LHZiNix2KfZiNipINmI2KjZitmK2YTYs9inINi52YTZiSDZh9iv2YHZitmGINmH2YXYpyDYqNmE2YjYuiAi2KfZhNiu2LbYsSIg2KfZhNmF2LHYqNi5INin2YTYsNmH2KjZiiDZhNmD2KPYsyDYpdmB2LHZitmC2YrYpyAyMDE3INio2KfZhNi62KfYqNmI2YbYjCDYqNin2YTYpdi22KfZgdipINil2YTZiSDYp9mE2KrYo9mH2YQg2YTZhdmI2YbYr9mK2KfZhCDYsdmI2LPZitinIDIwMTguICANCtiu2LHYrCDYp9mE2YbYp9iu2Kgg2KfZhNmI2LfZhtmKINi52YYg2LXZhdiq2Ycg2YHZitmF2Kcg2YrYrti1INmF2LPYqtmC2KjZhNmHINi52YTZiSDYsdij2LMg2KfZhNi52KfYsdi22Kkg2KfZhNmB2YbZitipINmE2YAg4oCc2KfZhNiu2LbYseKAndiMINit2YrYqyDYo9mI2LbYrSDYqNij2YYg2KfZhNi32YTYp9mCINi12KfYsSDYo9mF2LHYpyDYrdiq2YXZitin2Iwg2YXZiNi22K3YpyDYqNij2YbZhyDZiNil2YYg2YTZhSDZitmC2K/ZhSDYp9iz2KrZgtin2YTYqtmHINin2YTYsdiz2YXZitipINmB2KXZhiDYrNmE2LPYqSDZh9in2YXYqSDYs9iq2KzZhdi52Ycg2YXYuSDigJzYqNin2KrYsdmI2YbigJ0g2KfZhNmB2KfZgSDYqNi52K8g2LrYryDYp9mE2KPYrdivINio2YXZgtixINin2YTYp9iq2K3Yp9iv2YrYqSDZhNmE2KrYqNin2K3YqyDZgdmKINin2YTYtdmK2LrYqSDYp9mE2YXYq9mE2Ykg2YTYqtix2LPZitmFINix2K3ZitmE2YcuDQogIOKAnNmE2YUg2KPYs9iq2YLZhOKAnS4uINio2YfYsNinINin2YTYudmG2YjYp9mGINin2LPYqtmH2YTYqiDYp9mE2YrZiNmF2YrYqSDYp9mE2KXZhNmD2KrYsdmI2YbZitipINin2YTYrNmH2YjZitipINin2YTZgdix2YbYs9mK2Kkg2K3Yr9mK2KvZh9inINmE2YTZhtin2K7YqCDYp9mE2YjYt9mG2Yog2YPYsdmK2LPYqtmK2KfZhiDYutmI2LHZg9mI2YEg2LnYtNmK2Kkg2KPZhdiz2Iwg2YXZgdi22YTYpyDYqtit2KfYtNmKINin2YTYtdit2KfZgdipINin2YTYrNiy2KfYptix2YrYqSDYp9mE2KrZiiDYo9ir2KfYsdiqINmC2LbZitipINix2K3ZitmE2Ycg2YXZhtiwINiz2YLZiNi3IOKAnNin2YTYrti22LHigJ0g2YHZiiDZiNiv2YrYqSDYutmK2YbZitinINio2YXZhNi52KggNSDYrNmI2YrZhNmK2KnYjCDZiNiq2LnYstiyINi32LHYrSDYp9mE2LfZhNin2YIg2KjYudivINmF2KjYp9ix2KfYqSDYp9mE2KXZitin2Kgg2LbYryDYpdir2YrZiNio2YrYpy4NCg==
endtext

with thisform.edit1
.fontCharset=178  &&arabic
.value=strconv(substr(strconv(m.myvar,14),3),11,178,2)
 endwith
 
 thisform .addobject("im","image") 

thisform.xtype=int(val(inputbox("report output:1 (preview)-2 print),3 (html)-4 (xml)","","1")))
_screen.windowstate=1
if empty(thisform.xtype)
thisform.xtype=1  &&2,3,4
endi
thisform.ii=0

 local gnbre
gnbre=adir(gabase,home(1)+"samples\data\graphics\*.gif")
create cursor yim (yimage c(100))
for i=1 to 10
insert into yim values (home(1)+"samples\data\graphics\"+gabase(i,1))
endfor

locate

thisform.oCap = newobject("ycapture")      
thisform.caption="Reporting with oleObjets in vfp9.......wait until rendering!"
thisform.timer1.enabled=.t.
ENDPROC

PROCEDURE timer1.Timer
thisform.activate
sele yim
skip
thisform.image1.picture=yimage

 sleep(500)
 
 with thisform
.ii=.ii+1
thisform.caption="Reporting with oleObjets in vfp9.......wait until rendering!   ["+trans(.ii)+'/9]'

.olecontrol1.randomFill=.t.
do case
case .ii=1
.olecontrol1.ChartType=0
case .ii=2
.olecontrol1.ChartType=2
case .ii=3
.olecontrol1.ChartType=5
case .ii=4
.olecontrol1.ChartType=14
case .ii=5
.olecontrol1.ChartType=4
case .ii=6
.olecontrol1.ChartType=3
case .ii=7
.olecontrol1.ChartType=6
case .ii=8
.olecontrol1.ChartType=8
endcase
if between(.ii,1,8)
.olecontrol1.visible=.t.
.edit1.visible=.f.
else
.olecontrol1.visible=.f.
.edit1.visible=.t.
endi

with  thisform.olecontrol2
.day=INT((28 - 1+ 1) * RAND( ) + 1)
.month=INT((12 - 1 + 1) * RAND( ) + 1)
.year=INT((2020 - 2007 + 1) * RAND( ) + 2007)
.backcolor=rgb(255*rand(),255*rand(),255*rand())
.forecolor=rgb(255*rand(),255*rand(),255*rand())
.titlebackcolor=rgb(255*rand(),255*rand(),255*rand())
.titleforecolor=rgb(255*rand(),255*rand(),255*rand())
.trailingForecolor=rgb(255*rand(),255*rand(),255*rand())
endwith

if thisform.ii=9
sleep(2000)
endi
  with .im
 .left=0
 .top=0
 .PictureVal = thisform.oCap.Capture(thisform.hwnd)    && Lparameters thWnd,tlClientOnly,bmph,bmpw 
 .visible=.t. 
 sleep(1000)

m.lcdest=m.yrep+"output\images\myCap"+trans(thisform.ii)+".bmp"
strtofile(.pictureval,m.lcdest)

sele ycurs
appe blan
repl xtitle with (trans(recno())+" - VFP9 report with listener class")
repl yf with m.lcdest

.visible=.f.
endwith

if .ii=9
this.enabled=.f.
thisform.oCap=null
xtype=thisform.xtype
thisform.yreport(m.yrep+"yole",xtype)
.release
endi
endwith
ENDPROC

ENDDEFINE
*


*-- EndDefine: yole

Define Class yCapture As Custom     
BitsPerPixel = 24 && 16,24,32  
InterpolationMode = 7  
*!*	public enum InterpolationMode  
*!*	{  
*!*	    Default = 0,  
*!*	    Low = 1,  
*!*	    High = 2,  
*!*	    Bilinear = 3,  
*!*	    Bicubic = 4,  
*!*	    NearestNeighbor = 5,  
*!*	    HighQualityBilinear = 6,  
*!*	    HighQualityBicubic = 7  
*!*	}  


Procedure GetBitmapString  
Lparameters hdc, hBitmap, pnWidth, pnHeight  

Local  lcbithdr, lcquad, lcBitmap, lcbitinfo,;  
	lnhBitMap, lnhPrevBmp, lnhandle  
If Vartype(hdc)#"N"  
	Messagebox("You must at least pass the Device Context.",16,"Error")  
	Return ""  
Endif  

lcbithdr = This.GetBitmapInfoHeader(pnHeight, pnWidth, hdc)  
lcquad = ""  
Local lhMem,lnSize  
lnSize = This.GetBitmapSize(pnWidth, pnHeight)  
lhMem = GlobalAlloc(0,lnSize)  
ZeroMemory(lhMem,lnSize)  
lcbitinfo = lcbithdr + lcquad  
If GetDIBits(hdc, hBitmap, 0, pnHeight, lhMem, @lcbitinfo, 0)!=0  
	lcBitmap = This.GetFileHeader(lcbitinfo, lnSize) + lcbithdr + lcquad + Sys(2600,lhMem,lnSize)  
	GlobalFree(lhMem)  
	Return lcBitmap  
Else  
	GlobalFree(lhMem)  
	Return ""  
Endif  
Endproc  
Procedure GetBitmapInfoHeader  
Lparameters pnHeight, pnWidth, pnhDC  
* Structure size  
lcresult = BinToC(40, "4RS")  
* bitmap width  
lcresult = lcresult + BinToC(pnWidth, "4RS")  
* bitmap height  
lcresult = lcresult + BinToC(pnHeight, "4RS")  
* color planes  
lcresult = lcresult + BinToC(1, "2RS")  
* Bits per pixel  
lcresult = lcresult +BinToC(This.BitsPerPixel, "2RS")  
*Compression  
lcresult = lcresult +BinToC(0, "4RS")  
Return lcresult+Replicate(Chr(0),20)  
Endproc  

Procedure GetFileHeader  
Lparameters pcinfo, pnbits  
Return "BM" + BinToC(54 + pnbits, "4RS") + BinToC(0, "4RS")+BinToC(54, "4RS")  
Endproc  

Procedure GetBitmapSize  
Lparameters pnWidth, pnHeight  
Local lnBytesPerScan  
lnBytesPerScan = pnWidth*Int(This.BitsPerPixel/8)  
If lnBytesPerScan%4>0  
	lnBytesPerScan = lnBytesPerScan + 4 - lnBytesPerScan%4  
Endif  
Return lnBytesPerScan*pnHeight  
Endproc  


Procedure Capture
Lparameters thWnd,tlClientOnly,bmph,bmpw  
Local hdc,hMemDC,hBitmap,winh,winw,lcrect,iso,hOldBmp,lStretch,lcBitmap  
lcrect = Space(16)  
if empty(tlClientOnly)
tlClientOnly=.t.
endi

If tlClientOnly  =.f.
	GetWindowRect(m.thWnd,@lcrect)  
	hdc = GetWindowDC(m.thWnd)  
Else  
	GetClientRect(m.thWnd,@lcrect)  
	hdc = GetDC(m.thWnd)  
Endif  

winw = CToBin(Substr(lcrect,9,4),"4RS")-CToBin(Substr(lcrect,1,4),"4RS")  
winh = CToBin(Substr(lcrect,13,4),"4RS")-CToBin(Substr(lcrect,5,4),"4RS")  

*If !Empty(bmph) And !Empty(bmpw)  
*	lStretch = Min(bmpw/winw,bmph/winh)  
*Else  
	lStretch = 1  
*Endif  

bmpw = Round(lStretch*winw,0)  
bmph = Round(lStretch*winh,0)  

hMemDC = CreateCompatibleDC(hdc)  
hMemBmp = CreateCompatibleBitmap(hdc,winw,winh)  
hOldBmp = SelectObject(hMemDC,hMemBmp)  
#Define SRCCOPY	13369376  
BitBlt(hMemDC,0,0,winw,winh,hdc,0,0,SRCCOPY)  
  
ReleaseDC(thWnd,hdc)  

If lStretch!=1  
	Local hMemGfx,hGfx,gpImage,gpMemBmp  
	Store 0 to hMemGfx,hGfx,gpImage,gpMemBmp  

	GdipCreateBitmapFromHBITMAP(hMemBmp,0,@gpImage)  
	  
	GdipCreateFromHDC(hMemDC,@hMemGfx)  
	GdipCreateBitmapFromGraphics(bmpw,bmph,hMemGfx,@gpMemBmp)  
	GdipGetImageGraphicsContext(gpMemBmp,@hGfx)  

	GdipSetInterpolationMode(hGfx,this.InterpolationMode)  
	GdipDrawImageRectI(hGfx,gpImage,0,0,bmpw,bmph)  

	GdipCreateHBITMAPFromBitmap(gpMemBmp,@hBitmap,0)  
	lcBitmap = This.GetBitmapString(hMemDC, hBitmap, bmpw,bmph)  
	  
	GdipDisposeImage(gpMemBmp)  
	GdipDisposeImage(gpImage)  
	GdipDeleteGraphics(hGfx)  
	GdipDeleteGraphics(hMemGfx)  
Else  
	lcBitmap = This.GetBitmapString(hMemDC, hMemBmp, bmpw,bmph)  
EndIf  
SelectObject(hMemDC,hOldBmp)  
DeleteObject(hMemBmp)  
DeleteDC(hMemDC)  

Return lcBitmap  
EndProc
ENDDEFINE

******************
procedure ydeclare
declare integer Sleep in kernel32 integer
DECLARE INTEGER ShellExecute IN SHELL32.DLL INTEGER nWinHandle,;
											STRING cOperation,;
											STRING cFileName,;
											STRING cParameters,;
											STRING cDirectory,;
											INTEGER nShow
											
Declare Integer GlobalAlloc In kernel32 Integer wFlags, Integer dwBytes  
Declare RtlZeroMemory In kernel32 As ZeroMemory;  
	INTEGER Dest, Integer numBytes  
Declare Integer GlobalFree In kernel32 Integer Hmem  

Declare Integer GetDIBits In Win32API;  
	INTEGER hdc, Integer hbmp, Integer uStartScan,;  
	INTEGER cScanLines, Integer lpvBits,;  
	STRING @lpbi, Integer uUsage  
Declare Integer GetWindowRect In win32api Integer, String  
Declare Integer GetWindowDC In win32api Integer  
Declare Integer GetClientRect In win32api Integer, String  
Declare Integer GetDC In win32api Integer  
Declare Integer CreateCompatibleDC In win32api Integer  
Declare Integer CreateCompatibleBitmap In win32api Integer,Integer,Integer  
Declare Integer SelectObject In win32api Integer,Integer  
Declare Integer DeleteObject In win32api Integer  
Declare Integer ReleaseDC In win32api Integer,Integer  
Declare Integer DeleteDC In win32api Integer  
	  
Declare Integer GdipCreateFromHDC in gdiplus integer,integer@  
Declare Integer GdipDeleteGraphics in gdiplus integer  
DECLARE INTEGER GdipDisposeImage IN gdiplus integer  
DECLARE INTEGER GdipCreateBitmapFromGraphics IN gdiplus;  
		INTEGER   width,;  
		INTEGER   height,;  
		INTEGER   graphics,;  
		INTEGER @ bitmap  
DECLARE INTEGER GdipDrawImageRectI IN gdiplus;  
		INTEGER graphics,;  
		INTEGER img,;  
		INTEGER x,;  
		INTEGER y,;  
		INTEGER imgwidth,;  
		INTEGER imgheight  
DECLARE INTEGER GdipCreateHBITMAPFromBitmap IN gdiplus;  
	INTEGER   bitmap,;  
	INTEGER @ hbmReturn,;  
	INTEGER   background  
DECLARE INTEGER GdipCreateBitmapFromHBITMAP IN gdiplus;  
	INTEGER   hbm,;  
	INTEGER   hpal,;  
	INTEGER @ hbitmap  
DECLARE INTEGER GdipGetImageGraphicsContext IN gdiplus;  
	INTEGER   img,;  
	INTEGER @ graphics  
DECLARE INTEGER GdipSetInterpolationMode IN gdiplus;  
	INTEGER   graphics,;  
	INTEGER  mode 
Declare Integer BitBlt In win32api Integer dstDC,Integer dstx,Integer dsty,Integer dstw,Integer dsth,;  
	integer srcDC,Integer srcx,Integer srcy,Integer mode   		                                            
endproc	


font segoe script  is used in code .if absent, can replace with another font installed.
font segoe script  is used in code .if absent, can replace with another font installed.
font segoe script  is used in code .if absent, can replace with another font installed.
font segoe script  is used in code .if absent, can replace with another font installed.
font segoe script  is used in code .if absent, can replace with another font installed.
font segoe script  is used in code .if absent, can replace with another font installed.
font segoe script  is used in code .if absent, can replace with another font installed.
font segoe script  is used in code .if absent, can replace with another font installed.
font segoe script  is used in code .if absent, can replace with another font installed.
font segoe script  is used in code .if absent, can replace with another font installed.

font segoe script is used in code .if absent, can replace with another font installed.

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


*3*
*--Posted on Foxite-Time stamp lundi 1 juin 2009; 09:03:38
*--Subject :Customize the preview report Toolbar many propeties like the preview
*toolbar controls,hide the print button,change pictures,can change the dock position
*oform=Reference to the actual preview form.Normally used with toolbars (see samples\Solution)
*To disable the rightclick and the click i add a transparent shape over the Previewcontainer roolbar  print button in the code (loPreviewContainer.ToolbarIsVisible = .T. or .f.)

Close Databases All
Set Safety Off
Set Defa To Addbs(Justpath(Sys(16,1)))
#Define crlf Chr(13)+Chr(10)
Local loPreviewContainer, loReportListener,MyReport,aa
MyReport=Home(1)+"SAMPLES\SOLUTION\REPORTS\WRAPPING.FRX"          && GETFILE('frx')
*-- Create the preview container
Do (_ReportPreview) With loPreviewContainer

*-- Change some of the defaults
loPreviewContainer.Caption = 'My customized Report'
loPreviewContainer.ToolbarIsVisible = .T.

*-- Create the Report Listener
loReportListener = Createobject('ReportListener')
With loReportListener
    .ListenerType = 1 && Preview
*-- Assign the preview container to the listener
	.PreviewContainer = loPreviewContainer
Endwith

&&list all properties/methods of loPreviewContainer and save to txt file (to review for other customizations)
= Amembers(gaPropArray, loPreviewContainer, 3)
aa="";

aa=aa+crlf+Replicate('-',80)+crlf

For i=1 To Alen(gaPropArray)
	aa=aa+gaPropArray(i)+crlf
	If Mod(i,4)=0  &&jump a separatly line
		aa=aa+crlf
	Endi
Endfor
Strtofile(aa,"loPreviewContainer.txt")
*****
*-- Run the report (with NOWAIT)
Report Form (MyReport) Object loReportListener Nowait
**************************
loPreviewContainer.oform.AddObject("shape1","myshape")
With loPreviewContainer.oform.shape1
	.Top=0
	.Left=0
	.Width=.Parent.Width
	.Height=.Parent.Height
	.BackStyle=0
	.ZOrder(0)
	.Visible=.T.
Endwith

With  loPreviewContainer.oform
	With .Toolbar
		.Width=.Width+60
		.BackColor=Rgb(0,255,0)
		.Refresh
		aa="Toolbar Preview controls"+crlf+Replicate("-",28)+crlf+crlf
		.CMDPRINT.Visible=.F.   &&hide the printer button   &&there is ALLOWPRINTFROMPREVIEW method also

&&Retrieve all state controls
		Local xState
		For i=1 To .ControlCount
			If .Controls(i).Visible
				xState="Visible"
			Else
				xState="Hiddden"
			Endi
			aa=aa+.Controls(i).Name+"  "+xState+crlf
		Endfor
		.CBOZoom.Value=3 &&values=1-11 ...fix zoomlevel (in combo cboZoom)
&&Make changes  on preview toolbar buttons
		.cmdclose.Picture=Home()+"GRAPHICS\BITMAPS\ASSORTED\HAPPY.BMP"  &&any small bmp or ico

		With .cntPrev.Controls(1)
			.FontName="webdings"
			.FontSize=12
			.FontBold=.T.
			.ForeColor=255
			.Picture=""
			.Caption='3'
		Endwith

		With .cntPrev.Controls(2)
			.FontName="webdings"
			.FontSize=12
			.FontBold=.T.
			.ForeColor=255
			.Picture=""
			.Caption='7'
		Endwith

		With .cntNext.Controls(1)
			.FontName="webdings"
			.FontSize=12
			.FontBold=.T.
			.ForeColor=255
			.Picture=""
			.Caption='4'
		Endwith

		With .cntNext.Controls(2)
			.FontName="webdings"
			.FontSize=12
			.FontBold=.T.
			.ForeColor=255
			.Picture=""
			.Caption='8'
		Endwith

		.AddObject("About","ycommandbutton")  && add a custom button
		Messagebox(aa,0+32+4096,"",1500)  &&retrieve controls list of preview toolbar
		.Dock(0) && Dock position toolbar (values=-1,0,1,2,3)
	Endwith
	.WindowState = 2   &&maximize the view
Endwith

Set Safety On
Return

Define Class ycommandbutton As CommandButton
	Top = 1
	Height = 23
	Width = 45
	Caption = "About"
	Visible=.T.
	Name = "ycommand"

	Procedure Click
	Try
		Local lcBell
		lcBell = Set("Bell")
		Set Bell To (Addbs(Getenv('windir')))+"MEDIA\notify.WAV"
		?? Chr(7)
		Set Bell To (lcBell)
	Catch
	Endtry
	Run/N "notepad" loPreviewContainer.txt
	Endproc

Enddefine


Define Class myShape As Shape
	BackStyle=0
	Name="shape1"

	Procedure RightClick
	Messagebox("Rightclick is disabled by YB-can cut this messagebox in code !",0+32+4096)
	Return .F.
	Endproc

	Procedure Click
	Messagebox("clic is disabled by YB-can cut this messagebox in code !",0+32+4096)
	Return .F.
	Endproc

Enddefine



Working with reports,olecontrols and listener class

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


*!*4*
*!* Make the vfp report preview toolbar on topmost on a form.desktop=.t.
*!* with only 2 apis and no timer
Clea All
Set REPORTBEHAVIOR 90
Publi mytb As Form
Local oRep As Form
oRep = Createobject("FormReport")

With oRep As Form
    .Caption= "Report custom title"
	.WindowState = 2
	.Height      = Sysmetric(2)
	.Width       = Sysmetric(1)
Endwith
Local myreport
myreport=Home(1)+"SAMPLES\SOLUTION\REPORTS\WRAPPING.FRX"   &&getfile('frx')
Report Form Locfile(m.myreport) Preview Window (oRep.Name)  Nowait
oRep.ym()

Define Class FormReport As Form
	frmCaption=""
	formhandle=0
	Desktop = .T.

	Procedure Load
	Declare SetWindowPos In WIN32API Long HWnd,Long hwndafter,Long x,Long Y,Long cx,Long cy,Long Flags

	Declare Long SetParent In WIN32API Long, Long
	Endproc

	Procedure ym()
	For i=1 To _Screen.FormCount
		If Lower( _Screen.Forms(i).Name )=="previewtoolbar"
			Thisform.formhandle=_Screen.Forms(i).HWnd
			_Screen.Forms(i).Left=0
			_Screen.Forms(i).Top=Sysmetric(9)+Sysmetric(4)
			mytb=_Screen.Forms(i)
		Endi
	Endfor

	If Thisform.formhandle = 0
		messagebopx("Fail to find the previewToolbar",16)
		Return .F.
	Endi
	#Define   swp_nosize       1
	#Define   swp_nomove       2
	#Define   hwnd_topmost    -1
	#Define   hwnd_notopmost  -2

	SetParent(Thisform.formhandle,0)

	lretval=0
	lretval = SetWindowPos(mytb.HWnd,hwnd_topmost,0,0,0,0,swp_nosize+swp_nomove)
	Endproc
Enddefine



Working with reports,olecontrols and listener class

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


*5*
*formatting a report with listener and dynamic formatting class.
*can customize the definition class and then apply formatting for each field(even different colors,styles,...).
*Listener can particularise each object on the report and render it separatly before drawing.

Close Data All
Local yrep,    loListener

* Open the Orders table in the Northwind database.

Close Databases All
Use Addbs(Home(1)) + 'Samples\Northwind\Orders'
* Create the listener and run the report.
m.yrep=Addbs(Justpath(Sys(16,1)))
loListener  = Newobject('EffectsListener')  &&, forcepath('DynamicFormatting.prg', m.yrep))
loListener.OutputType = 1
Locate
Report Form Forcepath('yDynamicFormatting.FRX', m.yrep) Object loListener
Use




*derived from vfp/samples/solution/europa- Define a class that knows how to apply effects to objects in a report.
Define Class EffectsListener As _ReportListener Of ;
		home() + 'ffc\_ReportListener.vcx'
	oEffectHandlers = .Null.
&& a collection of effect handlers
	Dimension aRecords[1]
&& an array of information for each record in the FRX

* Create a collection of effect handler objects and fill it with the handlers
* we know about. A subclass or instance could be filled with additional ones.

	Function Init
	DoDefault()
	With This
		.oEffectHandlers = Createobject('Collection')
		.oEffectHandlers.Add(Createobject('DynamicForeColorEffect'))
		.oEffectHandlers.Add(Createobject('DynamicBackColorEffect')) &&add by YB 21 mai 2009
		.oEffectHandlers.Add(Createobject('DynamicStyleEffect'))
	Endwith
	Endfunc

* Dimension aRecords to as many records as there are in the FRX so we don't
* have to redimension it as the report runs. The first column indicates if
* we've processed that record in the FRX yet and the second column contains
* a collection of effect handlers used to process the record.

	Function BeforeReport
	DoDefault()
	With This
		.SetFRXDataSession()
		Dimension .aRecords[reccount(), 2]
		.ResetDataSession()
	Endwith
	Endfunc

* Apply any effects that were requested to the field about to be rendered.

	Function EvaluateContents(tnFRXRecno, toObjProperties)
	Local loEffectObject, ;
		loEffectHandler, ;
		lcExpression
	With This

* If we haven't already checked if this field needs any effects, do so and
* flag that we have checked it so we don't do it again.

		If Not .aRecords[tnFRXRecno, 1]
			.aRecords[tnFRXRecno, 1] = .T.
			.aRecords[tnFRXRecno, 2] = .SetupEffectsForObject(tnFRXRecno)
		Endif Not .aRecords[tnFRXRecno, 1]

* Go through the collection of effect handlers for the field (the collection
* may be empty if the field doesn't need any effects), letting each one do its
* thing.


		For Each loEffectObject In .aRecords[tnFRXRecno, 2]
			loEffectHandler = loEffectObject.oEffectHandler
			lcExpression    = loEffectObject.cExpression
			loEffectHandler.Execute(toObjProperties, lcExpression)
		Next loEffect

	Endwith

* Do the normal behavior.

	DoDefault(tnFRXRecno, toObjProperties)
	Endfunc

* Go through each effect handler to see if it'll handle the current report
* object. If so, add it to a collection of handlers for the object, and return
* that collection.

	Function SetupEffectsForObject(tnFRXRecno)
	Local loFRX, ;
		loHandlers, ;
		loObject
	With This
		loFRX      = .GetReportObject(tnFRXRecno)
		loHandlers = Createobject('Collection')
		For Each loEffectHandler In .oEffectHandlers
			loObject = loEffectHandler.GetEffect(loFRX)
			If Vartype(loObject) = 'O'
				loHandlers.Add(loObject)
			Endif Vartype(loObject) = 'O'
		Next loEffectHandler
	Endwith
	Return loHandlers
	Endfunc

* Return a SCATTER NAME object for the specified record in the FRX.

	Procedure GetReportObject(tnFRXRecno)
	Local loObject
	This.SetFRXDataSession()
	Go tnFRXRecno
	Scatter Memo Name loObject
	This.ResetDataSession()
	Return loObject
	Endproc
Enddefine

* Create a class that holds a reference to an effect handler and the expression
* the effect handler is supposed to act on for a particular record in the FRX.

Define Class EffectObject As Custom
	oEffectHandler = .Null.
	cExpression    = ''
Enddefine

* Define an abstract class for effect handler objects.

Define Class EffectHandler As Custom

* Execute is called by the EvaluateContents method of EffectsListener to
* perform an effect.

	Function Execute(toObjProperties, tcExpression)
	Endfunc

* GetEffects is called to return an object containing a reference to the
* handler and the expression it's supposed to work on if the specified report
* object needs this effect, or return null if not.

	Function GetEffect(toFRX)
	Local loObject
	loObject = .Null.
	Return loObject
	Endfunc

* EvaluateExpression may be called by Execute to evaluate the specified
* expression.

	Function EvaluateExpression(tcExpression)
	Return Evaluate(tcExpression)
	Endfunc
Enddefine

* Define an abstract class for effect handlers that look for
* "*:EFFECTS  = " in the USER memo.

Define Class UserEffectHandler As EffectHandler
	cEffectsDirective = '*:EFFECTS'
&& the directive that indicates an effect is needed
	cEffectName       = ''
&& the effect name to look for (filled in in a subclass)

	Function GetEffect(toFRX)
	Local lcEffect, ;
		loObject
	lcEffect = This.cEffectsDirective + ' ' + This.cEffectName
	If Atc(lcEffect, toFRX.User) > 0
		loObject = Createobject('EffectObject')
		loObject.oEffectHandler = This
		loObject.cExpression = Strextract(toFRX.User, lcEffect + ' = ', ;
			chr(13), 1, 3)
	Else
		loObject = .Null.
	Endif Atc(lcEffect, toFRX.User) > 0
	Return loObject
	Endfunc
Enddefine

* Define a class to provide dynamic forecolor effects.

Define Class DynamicForeColorEffect As UserEffectHandler
	cEffectName = 'FORECOLOR'

* Evaluate the expression. If the result is a numeric value and doesn't match
* the existing color of the object, change the object's color and set the
* Reload flag to .T.

	Function Execute(toObjProperties, tcExpression)
	Local lnColor, ;
		lnPenRed, ;
		lnPenGreen, ;
		lnPenBlue
	lnColor = This.EvaluateExpression(tcExpression)
	If Vartype(lnColor) = 'N'
		lnPenRed   = Bitand(lnColor, 0x0000FF)
		lnPenGreen = Bitrshift(Bitand(lnColor, 0x00FF00),  8)
		lnPenBlue  = Bitrshift(Bitand(lnColor, 0xFF0000), 16)
		With toObjProperties
			If .PenRed <> lnPenRed Or ;
					.PenGreen <> lnPenGreen Or ;
					.PenBlue <> lnPenBlue
				.PenRed   = lnPenRed
				.PenGreen = lnPenGreen
				.PenBlue  = lnPenBlue
				.Reload   = .T.
			Endif .PenRed <> lnPenRed ...
		Endwith
	Endif Vartype(lnColor) = 'N'
	Endfunc
Enddefine

* Define a class to provide dynamic style effects.

Define Class DynamicStyleEffect As UserEffectHandler
	cEffectName = 'STYLE'

* Evaluate the expression. If the result is a numeric value and doesn't match
* the existing style of the object, change the object's style and set the
* Reload flag to .T.
	Function Execute(toObjProperties, tcExpression)
	Local lnStyle
	lnStyle = This.EvaluateExpression(tcExpression)
	With toObjProperties
		If Vartype(lnStyle) = 'N' And .FontStyle <> lnStyle
			.FontStyle = lnStyle
			.Reload    = .T.
		Endif Vartype(lnStyle) = 'N' ...
	Endwith
	Endfunc
Enddefine
*
***************
&&add YB 21 mai 2009
Define Class DynamicBackColorEffect As UserEffectHandler
	cEffectName = 'BACKCOLOR'

* Evaluate the expression. If the result is a numeric value and doesn't match
* the existing color of the object, change the object's backcolor and set the
* Reload flag to .T.

	Function Execute(toObjProperties, tcExpression)
	Local lnColor, ;
		lnFillRed, ;
		lnFillGreen, ;
		lnFillBlue
	lnColor = This.EvaluateExpression(tcExpression)
	If Vartype(lnColor) = 'N'
		lnFillRed   = Bitand(lnColor, 0x0000FF)
		lnFillGreen = Bitrshift(Bitand(lnColor, 0x00FF00),  8)
		lnFillBlue  = Bitrshift(Bitand(lnColor, 0xFF0000), 16)
		With toObjProperties
			If .fillRed <> lnFillRed Or ;
					.fillGreen <> lnFillGreen Or ;
					.fillBlue <> lnFillBlue
				.fillRed   = lnFillRed
				.fillGreen = lnFillGreen
				.fillBlue  = lnFillBlue
				.Reload   = .T.
			Endif .fillRed <> lnFillRed ...
		Endwith
	Endif Vartype(lnColor) = 'N'
	Endfunc
Enddefine

* Define a class to provide dynamic style effects.

Define Class DynamicStyleEffect As UserEffectHandler
	cEffectName = 'STYLE'

* Evaluate the expression. If the result is a numeric value and doesn't match
* the existing style of the object, change the object's style and set the
* Reload flag to .T.
	Function Execute(toObjProperties, tcExpression)
	Local lnStyle
	lnStyle = This.EvaluateExpression(tcExpression)
	With toObjProperties
		If Vartype(lnStyle) = 'N' And .FontStyle <> lnStyle
			.FontStyle = lnStyle
			.Reload    = .T.
		Endif Vartype(lnStyle) = 'N' ...
	Endwith
	Endfunc
Enddefine
*


Working with reports,olecontrols and listener class

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


*6* the watermark class as text is  from Emerson Santon Reed and uses the native vfp9 gdiplus (http://weblogs.foxite.com/emersonreed/2006/09/13/a-sample-on-how-to-add-features-to-report-listener/)
*this code creates a report watermark as text based.the class is some modified to the puropose.

Set Classlib To (Addbs(Home(1)) + "FFC\_GDIPlus.vcx") Additive

* Create a Report Listener object
Local loReportListener
loReportListener = Newobject("MyReportListener")
With loReportListener
    .ListenerType = 1 && Preview
* Set the Watermark properties: text, font and style
	.cWatermark = "this is a demo Watermark"
	.cFontName = "Segoe Script"   &&tahoma
	.nFontStyle = 1 && Bold
Endwith

* Run the report using the new report engine (object-assisted output)
Report Form  locfile(Home(1) + "samples/solution/europa/employeesmd.frx","frx") Object loReportListener
Return
********************
* Create a class derived from _ReportListener base class and add some features
Define Class MyReportListener As _ReportListener Of Addbs(Home()) + "FFC\_ReportListener.VCX"
* Internal to the class
	Hidden nAngle, oBrush, oColor, oFont, oGDIGraphics, oRect, oStringFormat
	Hidden ResourceStatus
	nAngle = 0
	oBrush = Null
	oColor = Null
	oFont = Null
	oGDIGraphics = Null
	oRect = Null
	oStringFormat = Null
	cResourceStatus = Set("Resource")
* Public
	cWatermark = ""
	cFontName = ""
	nFontStyle = 0
*
	Procedure Init
	Lparameters cWatermark, cFontName, cFontStyle
	Set Resource Off
	With This
		.cWatermark = Evl(cWatermark,"")
		.cFontName = Evl(cFontName,"")
		.nFontStyle = Evl(cFontStyle,0)
	Endwith
	DoDefault()
	Endproc
*
	Procedure Destroy
	Local lcResourceStatus
	lcResourceStatus = This.cResourceStatus
	Set Resource &lcResourceStatus
	DoDefault()
	Endproc
*
	Procedure LoadReport
	DoDefault()
	With This
		If .ListenerType==1 And Not Vartype(.PreviewContainer)=="O"
			.ExtendPreviewContainer()
		Endif
	Endwith
	Endproc
*
	Procedure BeforeReport
	DoDefault()
	With This
		If Not Empty(.cWatermark)
			.oGDIGraphics = Createobject('GPGraphics')
			.SetWatermarkFontSize()
		Endif
	Endwith
	Endproc
*
	Procedure AfterBand(nBandObjCode, nFRXRecNo)
	If nBandObjCode==7 && Page footer
		With This
			If Not Empty(.cWatermark)
				.AddWatermark()
			Endif
		Endwith
	Endif
	DoDefault(nBandObjCode, nFRXRecNo)
	Endproc
*
	Function SetWatermarkFontSize
	With This
		.SetoGDIGraphicsHandle()

* Create a semi transparent Grey Color
		.oColor = Createobject('gpColor',128,128,128,127)

* Create a SolidBrush with Grey Color
		.oBrush = Createobject("gpSolidBrush", .oColor)

* Create a StringFormat
		#Define StringAlignmentNear 0
		#Define StringAlignmentCenter 1
		#Define StringAlignmentFar  2
		.oStringFormat = Createobject('gpStringFormat')
		With .oStringFormat
			.Create()
			.Alignment = StringAlignmentCenter
			.LineAlignment = StringAlignmentCenter
		Endwith

* Create a Font object
		Local loFont
		loFont = Createobject("GpFont")

		Local lnFactor, lnMaxWidth
		lnFactor = 0.80
		lnMaxWidth = (Sqrt((.SharedPageHeight ^ 2) + (.SharedPageWidth ^ 2))) * lnFactor

* To bypass GDI+ MeasureString bug to obtain the correct size
		Local loStringFormat As 'GpStringFormat' Of Home() + 'FFC\_gdiplus.vcx'
		loStringFormat = Newobject('GpStringFormat',Home() + 'FFC\_gdiplus.vcx')
		loStringFormat.Create()
		loStringFormat.GetGenericTypographic()

		Local loSize, lnSize, lnCharsFitted, lnLinesFilled, lnPerc
		lnSize = 1500

		loFont.Create(.cFontName,lnSize,.nFontStyle,2)
		lnCharsFitted = 0
		lnLinesFilled = 0
		loSize = .oGDIGraphics.MeasureStringA(.cWatermark,loFont, ,;
			loStringFormat, @lnCharsFitted, @lnLinesFilled)

		If Vartype(loSize)=="O"
			If loSize.W > lnMaxWidth
				lnPerc = loSize.W / lnMaxWidth
				lnSize = Int(lnSize / lnPerc)
			Endif
		Endif

		loFont.Create(.cFontName,lnSize,.nFontStyle,2)
		.oFont = loFont

* Calculate the rotation angle
		.nAngle = Rtod(Atan(.SharedPageHeight / .SharedPageWidth ))

* Create a rectangle with special dimensions
		.oRect = Createobject("gpRectangle", ;
			-.SharedPageWidth/2, -.SharedPageHeight/2, ;
			.SharedPageWidth*2, .SharedPageHeight*2)
	Endwith
	Endfunc
*
	Function AddWatermark
	With This
		.SetoGDIGraphicsHandle()

* Prepare transformation
		.oGDIGraphics.TranslateTransform(.SharedPageWidth/2, ;
			.SharedPageHeight/2)
		.oGDIGraphics.RotateTransform(-.nAngle)
		.oGDIGraphics.TranslateTransform(-.SharedPageWidth/2, ;
			-.SharedPageHeight/2)

* Draw a string
		.oGDIGraphics.DrawStringA(.cWatermark, .oFont, .oRect, .oStringFormat, .oBrush)

* Reset Rotation
		.oGDIGraphics.ResetTransform()
	Endwith
	Endfunc
*
	Function SetoGDIGraphicsHandle
	With This
		If Not .IsSuccessor
			.SharedGDIPlusGraphics = .GDIPlusGraphics
		Endif
		.oGDIGraphics.SetHandle(.SharedGDIPlusGraphics)
		.oGDIGraphics.TextRenderingHint = 3 && AntiAlias
	Endwith
	Endfunc
*
	Function ExtendPreviewContainer
	Local loPreviewContainer
	loPreviewContainer = Null
	Do (_ReportPreview) With loPreviewContainer
	loPreviewContainer.SetExtensionHandler(Newobject("MyExtensionHandler"))
	This.PreviewContainer = loPreviewContainer
	Endfunc
Enddefine

* Create a class that will extend Report Preview
Define Class MyExtensionHandler As Custom
	Procedure Show(iStyle)
	This.PreviewForm .WindowState = 2 && Maximize report preview
	DoDefault(iStyle)
	Endproc
*
Enddefine



background report image can be simply aded in report designer as described in photo.it can be done also programmatly with listener.Make this image as zorder(1) to dont hide the objects.
background report image can be simply aded in report designer as described in photo.it can be done also programmatly with listener.Make this image as zorder(1) to dont hide the objects.

background report image can be simply aded in report designer as described in photo.it can be done also programmatly with listener.Make this image as zorder(1) to dont hide the objects.

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


*7*
*download fxypreviewer from *https://foxypreviewer.codeplex.com/
*foxypreviewer application is a beautiful way to produce report outputs as PDF,images,HTML,RTF,XLS...see the objects enumeration below to use.

Do Locfile("FoxyPreviewer.App")

* Make PDF
Report Form ;
    (_Samples + "\Solution\Reports\Wrapping.frx") ;
	OBJECT Type 10 ; && OBJTYPE 10 = PDF , 11 = PDF AS IMAGE
To File "TestReport.PDF" ; && Destination
Preview && Open the default PDF viewer



*	OBJECT TYPE
*10 = Regular PDF
*11 = PDF AS IMAGE, to be used when the report is somehow complicated, with many objects over the others. The rendered
*PDF document pages are images, reproducing perfectly the report output, but not allowing searches, and a poor zoom.
*12 = RTF
*13 = XLS
*14 = HTML (not recommended for people who work with languages with double-byte characters)
*15 = HTML - Generates simplified HTML outputs. Good to be used in websites, no need of MSXML, faster rendering and
*Double-byte languages friendly
*16 = Image files - Saves the report as images. If you want exact, printable page copies, exporting to images is a very nice
*option. The image type will be determined by the file extension passed in the “TO FILE” clause. The available image types are the ones
*compatible with GDI+: BMP, GIF, JPG, PNG, TIFF and EMF.


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


 *8*
*Foxypreviewer able to make watermark with any image,adjusting it to page and setting transparency

Local m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))


Do Locfile("FoxyPreviewer.App")

* Adding watermarks to reports
With _Screen.oFoxyPreviewer
    .cWatermarkImage = Addbs(Home(1)) + "Graphics\Gifs\Morphfox.gif"
	.nWaterMarkType = 1 && 1 = Colored (default), 2 = B&W
	.nWatermarktransparency = .30 && (0-1) Transparency, 0 = Transparent, 1 = Opaque
	.nWaterMarkWidthRatio   = .75 && (0-1) Proportion that the watermark will occupy in the page width
	.nWaterMarkHeightRatio  = .75 && (0-1) Proportion that the watermark will occupy in the page height
Endwith

m.xreport=locfile(_Samples +"SOLUTION\REPORTS\WRAPPING.FRX")
Report Form  (m.xreport)  Object Type 10  To File (m.yrep+"Test.pdf") Preview

Return

*another syntaxes
*REPORT FORM (m.xreport)  OBJECT TYPE 10   PREVIEW
*REPORT FORM ?            OBJECT TYPE 10   PREVIEW

*can try also simplre report preview
*Report Form  (m.xreport)  Object Type 1  Preview


Working with reports,olecontrols and listener class

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


*9* create report with RTF contents even unicode (here arabic)
*the report have a general field (can use it when 1 page is needed only with rtf.
*rtf contents are embed in cursor as rtf codes,CLASS "RICHTEXT.RICHTEXTCTRL.1"
*rtf files are built in temp folder.
*the report myRTFreport must built before run the code.it consists on one oleboundcontrol as  general field ycurs.myrtf ( i inserted it in the zip above)

set defa to justpath(sys(16,1))
close data all
local myvar1,myvar2,myvar3,myvar4
text to myvar1 noshow  &&your rtf text here
{\rtf1\ansi\ansicpg1252\deff0{\fonttbl{\f0\fnil\fcharset0 Arial;}{\f1\fnil\fcharset0 Arial Black;}}
\viewkind4\uc1\pard\lang1033\fs18 The Rates are inclusive of Vat,Octrai and Transport Consignee : \b GSD \ul\i\fs30 Con\f1 struction\ulnone\b0\i0\f0\fs18
\par RHS Building No 1 & 2 Contact Person on Site : Mr. Mohan Bhoir
\par \i Akruti Green \i0 Woods
\par Vartak \i\fs24 Naga\i0\fs18 r Contact No On Site.: 9594047550
\par Thane
\par Destination : Vartak Nagar Thane
\par
\par Payment Terms.:
\par }
endtext

text to myvar2 noshow  &&another rtf here
{\rtf1\fbidis\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\fswiss\fcharset0 Comic Sans MS;}{\f1\fswiss\fcharset0 Arial Black;}{\f2\fswiss\fcharset0 Arial;}}
{\colortbl ;\red0\green0\blue0;\red255\green255\blue0;\red255\green0\blue0;\red128\green255\blue255;}
\viewkind4\uc1\pard\ltrpar\li180\ri240\f0\fs26\u8204?\u8204?The RichTextBox provides a number of \cf1 properties you can \strike use\strike0  to apply formatting to any portion \highlight2 of text \cf3\b\i\fs32 within\cf1\b0\i0\fs26  the control\highlight0 . To change the formatting of text, it must first be selected. \f1\fs32 Only selected \highlight4 text can\highlight0  be assigned\f0\fs26  character and paragraph formatting. \highlight4 Using \b these properties\highlight0 , you\b0  can make text bold or italic, change the color, and create superscripts and subscripts. You can also adjust paragraph formatting by setting both left and right indents, as well as hanging indents.\f2\fs20
\par \fs24
\par \fs20 The \b RichTextBox\b0  also opens and saves files in both the RTF format and regular ASCII text format. You can use methods of the control (\b LoadFile\b0  and \b SaveFile\b0 ) to directly read and write files, or use properties of the control such as \b SelRTF\b0  and \b TextRTF\b0  in conjunction with Visual Basic's file input/output statements. You can also load the contents of an .RTF file into the \b RichTextBox\b0  control simply by dragging the file (from the Windows 95 Explorer for example), or a highlighted portion of a file used in another application (such as Microsoft Word), and dropping the contents directly onto the control. You can also set the \b FileName\b0  property to load the contents of an .RTF or text file to the control.\fs24
\par }
endtext

text to m.myvar3 noshow
{\rtf1\fbidis\ansi\ansicpg1252\deff0\deflang1036\deflangfe1036\deftab708{\fonttbl{\f0\froman\fprq2\fcharset178 Times New Roman;}{\f1\froman\fprq2\fcharset0 Times New Roman;}{\f2\fswiss\fprq2\fcharset0 Calibri;}}
{\colortbl ;\red255\green0\blue0;\red0\green176\blue80;\red112\green48\blue160;}
\viewkind4\uc1\pard\ltrpar\cf1\lang1025\b\f0\rtlch\fs28\'ce\'d1\'cc \'c7\'e1\'e4\'c7\'ce\'c8 \'c7\'e1\'e6\'d8\'e4\'ed \'da\'e4 \'d5\'e3\'ca\'e5 \'dd\'ed\'e3\'c7 \'ed\'ce\'d5 \'e3\'d3\'ca\'de\'c8\'e1\'e5 \'da\'e1\'ec \'d1\'c3\'d3 \'c7\'e1\'da\'c7\'d1\'d6\'c9 \'c7\'e1\'dd\'e4\'ed\'c9 \'e1\'dc \lang1036\f1\ltrch\ldblquote\lang1025\f0\rtlch\'c7\'e1\'ce\'d6\'d1\f1\ltrch\rdblquote\f0\rtlch\'a1 \'cd\'ed\'cb \'c3\'e6\'d6\'cd \'c8\'c3\'e4 \'c7\'e1\'d8\'e1\'c7\'de \'d5\'c7\'d1 \'c3\'e3\'d1\'c7 \'cd\'ca\'e3\'ed\'c7\'a1 \'e3\'e6\'d6\'cd\'c7 \'c8\'c3\'e4\'e5 \'e6\'c5\'e4 \'e1\'e3 \'ed\'de\'cf\'e3 \'c7\'d3\'ca\'de\'c7\'e1\'ca\'e5 \'c7\'e1\'d1\'d3\'e3\'ed\'c9 \'dd\'c5\'e4 \'cc\'e1\'d3\'c9 \'e5\'c7\'e3\'c9 \'d3\'ca\'cc\'e3\'da\'e5 \'e3\'da \f1\ltrch\ldblquote\f0\rtlch\'c8\'c7\'ca\'d1\'e6\'e4\f1\ltrch\rdblquote  \f0\rtlch\'c7\'e1\'dd\'c7\'dd \'c8\'da\'cf \'db\'cf \'c7\'e1\'c3\'cd\'cf \'c8\'e3\'de\'d1 \'c7\'e1\'c7\'ca\'cd\'c7\'cf\'ed\'c9 \'e1\'e1\'ca\'c8\'c7\'cd\'cb \'dd\'ed \'c7\'e1\'d5\'ed\'db\'c9 \'c7\'e1\'e3\'cb\'e1\'ec \'e1\'ca\'d1\'d3\'ed\'e3 \'d1\'cd\'ed\'e1\'e5\lang1036\f1\ltrch .\cf0\b0\fs24
\par
\par \cf2\b\fs28   \ldblquote\lang1025\f0\rtlch\'e1\'e3 \'c3\'d3\'ca\'de\'e1\f1\ltrch\rdblquote\f0\rtlch .. \'c8\'e5\'d0\'c7 \'c7\'e1\'da\'e4\'e6\'c7\'e4 \'c7\'d3\'ca\'e5\'e1\'ca \'c7\'e1\'ed\'e6\'e3\'ed\'c9 \'c7\'e1\'c5\'e1\'df\'ca\'d1\'e6\'e4\'ed\'c9 \'c7\'e1\'cc\'e5\'e6\'ed\'c9 \'c7\'e1\'dd\'d1\'e4\'d3\'ed\'c9 \'cd\'cf\'ed\'cb\'e5\'c7 \'e1\'e1\'e4\'c7\'ce\'c8 \'c7\'e1\'e6\'d8\'e4\'ed \'df\'d1\'ed\'d3\'ca\'ed\'c7\'e4 \'db\'e6\'d1\'df\'e6\'dd \'da\'d4\'ed\'c9 \'c3\'e3\'d3\'a1 \'e3\'dd\'d6\'e1\'c7 \'ca\'cd\'c7\'d4\'ed \'c7\'e1\'d5\'cd\'c7\'dd\'c9 \'c7\'e1\'cc\'d2\'c7\'c6\'d1\'ed\'c9 \'c7\'e1\'ca\'ed \'c3\'cb\'c7\'d1\'ca \'de\'d6\'ed\'c9 \'d1\'cd\'ed\'e1\'e5 \'e3\'e4\'d0 \'d3\'de\'e6\'d8 \f1\ltrch\ldblquote\f0\rtlch\'c7\'e1\'ce\'d6\'d1\f1\ltrch\rdblquote  \f0\rtlch\'dd\'ed \'e6\'cf\'ed\'c9 \'db\'ed\'e4\'ed\'c7 \'c8\'e3\'e1\'da\'c8 5 \'cc\'e6\'ed\'e1\'ed\'c9\'a1 \'e6\'ca\'da\'d2\'d2 \'d8\'d1\'cd \'c7\'e1\'d8\'e1\'c7\'de \'c8\'da\'cf \'e3\'c8\'c7\'d1\'c7\'c9 \'c7\'e1\'c5\'ed\'c7\'c8 \'d6\'cf \'c5\'cb\'ed\'e6\'c8\'ed\'c7\lang1036\f1\ltrch .\cf0\b0\fs24
\par
\par \lang1025\f0\rtlch\'e6\'d1\'db\'e3 \'c3\'e4 \'e3\'cf\'d1\'c8 \'e1\'e6\'d1\'ed\'e6\'e4 \'c7\'e1\'d3\'c7\'c8\'de \'e4\'dd\'ec \'c7\'d3\'ca\'de\'c7\'e1\'ca\'e5 \'c7\'e1\'c5\'cf\'c7\'d1\'ed\'c9 \'de\'c7\'c6\'e1\'c7 \f1\ltrch\ldblquote\f0\rtlch\'d1\'db\'e3 \'c3\'e4\'e4\'ed \'df\'e4\'ca \'c3\'e3\'ca\'e1\'df \'e3\'cc\'e3\'e6\'da\'c9 \'cc\'ed\'cf\'c9 \'e3\'da \'e1\'e6\'d1\'ed\'e6\'e4\'a1 \'c5\'e1\'c7 \'c3\'e4 \cf3\'e3\'c7 \'c3\'da\'ed\'d4\'e5 \'e3\'da \'c7\'e1\'e3\'e4\'ca\'ce\'c8 \'c7\'e1\'cc\'d2\'c7\'c6\'d1\'ed \'ed\'da\'cf \'c3\'e3\'d1\'c7 \'ce\'c7\'d1\'de\'c7 \'e1\'e1\'da\'c7\'cf\'c9\'a1 \'ce\'d5\'e6\'d5\'c7 \'dd\'ed\'e3\'c7 \'ed\'ca\'da\'e1\'de \'c8\'c7\'e1\'cf\'dd\'c1 \'c7\'e1\'d0\'ed \'e6\'cc\'cf\'ca\'e5 \'e3\'da \'c7\'e1\'e1\'c7\'da\'c8\'ed\'e4\f1\ltrch\rdblquote\f0\rtlch\'a1 \'e6\'e3\'c7 \'c7\'e1\'d5\'e6\'d1\'c9 \'c7\'e1\'ca\'ed \'ca\'e1\'ca \'ca\'d3\'cc\'ed\'e1 \'dd\'ed\'db\'e6\'e1\'ed \'e1\'e1\'e5\'cf\'dd \'c7\'e1\'c3\'e6\'e1 \'d6\'cf \'c5\'cb\'ed\'e6\'c8\'ed\'c7 \'c5\'e1\'c7 \'cf\'e1\'ed\'e1 \'da\'e1\'ec \'ca\'d5\'d1\'ed\'cd\'c7\'ca \'c7\'e1\'e4\'c7\'ce\'c8\'a1 \'e6\'d1\'db\'e3 \'d0\'e1\'df \'df\'e1\'e5\'a1 \f1\ltrch\ldblquote\f0\rtlch\'c3\'d1\'ed\'cf \'c7\'e1\'d0\'e5\'c7\'c8\'a1 \'e6\'e5\'d0\'c7 \'e1\'ed\'d3 \'c8\'c7\'e1\'c3\'e3\'d1 \'c7\'e1\'cc\'cf\'ed\'cf\'a1 \'e6\'de\'cf \'d3\'c8\'de \'e1\'ed \'c7\'e1\'ca\'d5\'d1\'ed\'cd \'c8\'e5 \'e1\'d1\'c6\'ed\'d3 \'c7\'e1\'dd\'cf\'d1\'c7\'e1\'ed\'c9 \'dd\'ed \'d4\'e5\'d1 \'e4\'e6\'dd\'e3\'c8\'d1 \'e1\'df\'e4\'e5 \'d1\'dd\'d6 \'d8\'e1\'c8\'ed\f1\ltrch\rdblquote\f0\rtlch\'a1 \'e1\'ed\'d6\'ed\'dd \f1\ltrch\ldblquote\f0\rtlch\'ce\'e1\'c7\'e1 \'d1\'cd\'e1\'c9 \'c7\'e1\'da\'e6\'cf\'c9 \'e3\'e4 \'c3\'cf\'ed\'d3\'c7 \'c3\'c8\'c7\'c8\'c7\'a1 \'c3\'df\'cf\'ca \'e1\'e1\'c7\'da\'c8\'ed\'e4 \'c8\'c3\'e4 \'e3\'e6\'de\'dd\'ed \'e1\'e3 \'ed\'ca\'db\'ed\'d1 \'e6\'e3\'c7\'d2\'e1\'ca \'c3\'d1\'db\'c8 \'dd\'ed \'c7\'e1\'d1\'cd\'ed\'e1\lang1036\f1\ltrch\rdblquote . \lang1025\f0\rtlch\'e6\'df\'c7\'e4 \'df\'d1\'ed\'d3\'ca\'ed\'c7\'e4 \'db\'e6\'d1\'df\'e6\'dd \'de\'cf \'da\'c7\'cf \'c3\'e6\'e1 \'c3\'e3\'d3 \'c5\'e1\'ec \'dd\'d1\'e4\'d3\'c7 \'c7\'e1\'ca\'ed \'d5\'c7\'d1 \'ed\'dd\'d6\'e1 \'c7\'e1\'e3\'df\'e6\'cb \'c8\'e5\'c7 \'da\'df\'d3 \'e3\'c7 \'df\'c7\'e4 \'da\'e1\'ed\'e5 \'c7\'e1\'c3\'e3\'d1 \'dd\'ed \'c8\'cf\'c7\'ed\'c9 \'e3\'d3\'ed\'d1\'ca\'e5 \'e3\'da \f1\ltrch\ldblquote\f0\rtlch\'c7\'e1\'ce\'d6\'d1\f1\ltrch\rdblquote  \f0\rtlch\'dd\'ed \'d5\'ed\'dd 2014\'a1 \'cd\'ed\'cb \'de\'d1\'d1 \'c2\'e4\'d0\'c7\'df \'c7\'e1\'c7\'d3\'ca\'de\'d1\'c7\'d1 \'dd\'ed \'c7\'e1\'cc\'d2\'c7\'c6\'d1\lang1036\f1\ltrch .
\par \cf0
\par \pard\ltrpar\sa200\sl276\slmult1\f2\fs22
\par }
endtext

text to m.myvar4 noshow
{\rtf1\fbidis\ansi\ansicpg1252\deff0\deflang1036\deflangfe1036\deftab708{\fonttbl{\f0\froman\fprq2\fcharset178 Times New Roman;}{\f1\froman\fprq2\fcharset0 Times New Roman;}{\f2\fswiss\fprq2\fcharset0 Calibri;}{\f3\fnil\fcharset0 Arial;}}
{\colortbl ;\red192\green80\blue77;}
\viewkind4\uc1\pard\ltrpar\qc\cf1\lang1025\b\f0\rtlch\fs32\'e6\'ed\'e4\'ca\'d9\'d1 \'c3\'e4 \'ed\'cd\'e1 \'df\'d1\'ed\'d3\'ca\'ed\'c7\'e4 \'c8\'c7\'e1\'cc\'d2\'c7\'c6\'d1 \'c8\'da\'cf \'db\'cf \'c7\'e1\'c3\'cd\'cf \'e1\'e1\'de\'c7\'c1 \'d1\'c6\'ed\'d3 \'c7\'e1\'dd\'c7\'dd \'e1\'ca\'c8\'c7\'cd\'cb \'c7\'e1\'d8\'d1\'ed\'de\'c9 \'c7\'e1\'e3\'cb\'e1\'ec \'e1\'c5\'da\'e1\'c7\'e4 \'c7\'e1\'d8\'e1\'c7\'de \'c8\'c7\'e1\'ca\'d1\'c7\'d6\'ed\'a1 \'cd\'ed\'cb \'d5\'d1\'cd \'dd\'ed \'e5\'d0\'c7 \'c7\'e1\'d5\'cf\'cf \f1\ltrch\ldblquote\f0\rtlch\'e1\'c7 \'c3\'d1\'ed\'cf \'c7\'e1\'e6\'d5\'e6\'e1 \'c5\'e1\'ec \'d3\'e6\'c1 \'ca\'dd\'c7\'e5\'e3 \'e6\'c7\'e1\'c7\'cd\'ca\'df\'c7\'e3 \'c5\'e1\'ec \'c7\'e1\'cc\'c7\'e4\'c8 \'c7\'e1\'de\'c7\'e4\'e6\'e4\'ed \'dd\'ed \'c8\'e4\'e6\'cf \'da\'de\'cf\'ed\'a1 \'dd\'c3\'ed\'e4 \'ca\'df\'e3\'e4 \'e3\'d5\'e1\'cd\'c9 \'c7\'e1\'dd\'cf\'d1\'c7\'e1\'ed\'c9 \'dd\'ed \'c7\'e1\'c7\'cd\'ca\'dd\'c7\'d9 \'c8\'e4\'c7\'ce\'c8 \'ed\'d1\'ed\'cf \'c7\'e1\'d1\'cd\'ed\'e1\'bf\f1\ltrch\rdblquote\f0\rtlch\'a1 \'ca\'d3\'c7\'c1\'e1 \'db\'e6\'d1\'df\'e6\'dd \'de\'c8\'e1 \'c3\'e4 \'ed\'d6\'ed\'dd \lang1036\f1\ltrch\ldblquote\lang1025\f0\rtlch\'c7\'e1\'e3\'e4\'ca\'ce\'c8 \'da\'e1\'ec \'e3\'d4\'c7\'d1\'dd \'c7\'e1\'ca\'c3\'e5\'e1\'a1 \'e6\'c7\'e1\'da\'d8\'e1\'c9 \'c7\'e1\'d5\'ed\'dd\'ed\'c9 \'da\'e1\'ec \'c7\'e1\'c3\'c8\'e6\'c7\'c8\'a1 \'e1\'d0\'e1\'df \'c3\'d1\'ec \'c8\'c3\'e4\'e5 \'c7\'e1\'e6\'de\'ca \'c7\'e1\'c3\'e3\'cb\'e1 \'e1\'e1\'ca\'ce\'e1\'ed \'da\'e4 \'e3\'e4\'d5\'c8\'ed\f1\ltrch\rdblquote\f0\rtlch\'a1 \'e4\'c7\'dd\'ed\'c7 \'dd\'ed \'d0\'c7\'ca \'c7\'e1\'e6\'de\'ca \'d1\'c8\'d8 \'d8\'e1\'c8\'e5 \'c7\'e1\'d1\'cd\'ed\'e1 \'c8\'c7\'e1\'c7\'ca\'d5\'c7\'e1\'c7\'ca \'c7\'e1\'ca\'ed \'e6\'d5\'e1\'ca\'e5 \'e3\'e4 \'c7\'e1\'da\'cf\'ed\'cf \'e3\'e4 \'c3\'e4\'cf\'ed\'c9 \'c7\'e1\'d1\'c7\'c8\'d8\'c9 \'c7\'e1\'dd\'d1\'e4\'d3\'ed\'c9 \'c7\'e1\'c3\'e6\'e1\'ec\'a1 \'da\'e1\'ec \'db\'d1\'c7\'d1 \'d1\'ed\'e4 \'e6\'c8\'e6\'d1\'cf\'e6 \'e6\'e4\'c7\'e4\'ca\lang1036\f1\ltrch .
\par
\par \pard\ltrpar\sa200\sl276\slmult1\cf0\b0\f2\fs22                                                              \f3\fs18{\pict\wmetafile8\picw3387\pich2912\picwgoal1862\pichgoal1700
0100090000036011000000001f1100000000050000000b0200000000050000000c025600640004
00000003010800050000000b0200000000050000000c0256006400030000001e00050000000701
04000000050000000701040000001f110000410b2000cc00560064000000000056006400000000
002800000064000000560000000100080000000000000000000000000000000000190000000000
000000000000ffffff00333300009966000066660000cc99000066663300666666006699660033
9999000099cc00006699000033660000333300333333009999990099993300cccccc0099663300
3300cc0066336600330099000066cc009999cc006666cc00000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000000000000000000e0e0e0e0e0e0e
0e0e0e0e0e0e0e0000000e0e0e0e0e0000000d0d02020202020202020202020202020202020202
0202020202020202020202020202020202020202020d0d0000000e0e0e0e0e0000000e0e0e0e0e
0e0e0e0e0e0e0e0e0e00000000000e0f0f0f0f0f0f0f0f0f0f0f0f0f0e000e00070f0f0f0f0f0e
000d0a090303030303030303030303030303030303030303030303030303030303030303030303
030303090a0d000e0f0f0f0f0f070000000e0f0f0f0f0f0f0f0f0f0f0f0f0f0e000000000e0f0f
0f0f0f0f0f0f0f0f0f0700000f1107000e0f0f0f0f0f0700000b0a060303030303030303030303
0303030303030303030303030303030303030303030303060a0b00000e0f0f0f0f0f0e0007110f
0000070f0f0f0f0f0f0f0f0f0f0f0e000000000e0f0f0f0f0f0f0f0f0f0f070007111111110f0e
00070f0f0f0f0700000c0a08030303030303030303030303030303030303030303030303030303
0303030303080a0c0000070f0f0f0f07000e0f1111111107000e0f0f0f0f0f0f0f0f0f0f0e0000
00000e0f0f0f0f0f0f0f0f070e000f1111111111111107000e0f0f0f0f0f0e000d0a0903030303
0303030303030303030303030303030303030303030303030303090a0d000e0f0f0f0f0f0e0007
111111111111110f000e070f0f0f0f0f0f0f0f0e000000000e0f0f0f0f0f0f0f07000711111111
1111111111110f0000070f0f0f0f0700000b0a0603030303030303030505050505050505050303
03030303030303060a0b0000070f0f0f0f0700000f111111111111111111110700070f0f0f0f0f
0f0f0e000000000e0f0f0f0f0f0f0e000f111111111107070f11111111110700070f0f0f0f0700
000c0a08030303050505050505050505050505050505050503030303080a0c0000070f0f0f0f07
000e11111111110f070711111111110f000e070f0f0f0f0f0e000000000e0f0f0f0f07000e1111
111111110e0000071111111111110f000e070f0f0f0f0e000d0a09100505050505050505050505
05050505050505050510090a0d000e0f0f0f0f0f0e000f11111111111107000000111111111111
0700070f0f0f0f0e000000000e0f0f0f0e000f111111111111110000000f110f0f11111111110e
00070f0f0f0f0700000b0a10050505050505030505050305050305050505100a0b0000070f0f0f
0f07000e0f111111110f0f110f0000000f1111111111110f000e0f0f0f0e000000000e0f07000e
1111111111070e07110f0f110f0000000f111111111107000e0f0f0f0f0700000c0a0803030505
030305050503030505030305080a0c0000070f0f0f0f0e000711111111110f0000000f110f0f11
0f0e0711111111110700070f0e00000000000e000f111111111107000000111111110700000011
110f111111110f0e00070f0f0f0f0e000d0b091005030303050505030305050303090a0d000e0f
0f0f0f07000e0f111111110f111100000007111111110000000711111111110f000e0000000000
000e111111111111110e00000f110f0711110707110f00000e111111111107000e0f0f0f0f0700
000b0a0803030305050503030305100a0b0000070f0f0f0f0e000711111111110e00000f110707
1111070f110f00000e111111111111110e00000000000e111111110f0e0e11110f0f110e000007
111111110e00000e1111111111110f0e00070f0f0f070e000c0a090303050505030303080a0c00
00070f0f0f0700000f1111111111110e000000111111110700000e11110f11110e0e0711111111
0e000000000e1111110f0000000f111111110000000f110f0f110f0e07110f00000f1111111107
000e0f0f0f0f0e000d0a08030505050303080a0d000e0f0f0f0f0e0007111111110f00000f1107
0e07110f0f110f000000111111110f0000000f1111110e000000000e1111110f000007110f070f
110f070f110e00000f1111110f0000000711111111110f0000070f0f0f07000b08030505050303
080b000e0f0f0f070e000f1111111111070000000f1111110f0000000f0f070f110f070f110700
00071111110e000000000e070711111111110700000e11111111070000000f1111111100000711
0f0e07111111110e00070f0f07000b08030505050303080b00070f0f07000e11111111070e0f11
0700000f1111110f00000007111111110e000007111111111107070e0000000000000007111111
110e000007110f0f111107070f0f0e000e111111110f0000000f111111110f000e0707000b0803
0505050303080b00070f0e000f111111111100000007111111110700000f0f07070f110f0f110f
00000e1111111107000000000000000000000f110f0f110f0f0f110e000007111111110e000000
1111111107000007110f070f1111110e000e000b08030505050303080b000e000e0f11110f070f
1107000007111111110e00000e111111110700000e110f0f0f110f0f110f000000000000000e0f
110f000000111111110f0000000f11111111070e0e0f0f0e0e0f110f0f110700000e1111111107
00000b08030505050303080b000007111111110e00000711110f110f0e0e0f0f0e0e0711111111
0f0000000f111111110000000f110f0e000000000e11110700000e111111111107070f110e0000
111111111100000007111111110000000f1111110f0e00000a08030505050303080a00000e0f11
11110f00000011111111070000000f1111111100000e0f0f070711111111110e00000711110e00
0000000e11110f0707110f0000071111111107000000111111111100000e110f0707110f070f11
11110700000c0a090303050505030303090a0c0000071111110f070f1107070f110e00000f1111
111100000007111111110700000f1107070f11110e00000000000f111111111100000007111111
110f0e0e0f0f0e0007111111110f0000000f111111110f00000d0a0a0603030305050503030303
060a0a0d00000f111111110f0000000f1111111107000e0f0f0e0e0f1111111107000000111111
11110f000000000000000711111111070e07110f0e0e0f111111110000000e111111110700000e
1111110f0e00000b0a080303030303050505030303030303080a0b00000e0f1111110e00000711
1111110e000000111111110f0e0e0711070e0711111111070000000000000e0f00000f11111111
110f0000000f111111110e000e0f0f070e0f110f0f1111110700000c0a09100505050505050505
050505050505050510090a0c0000071111110f0f111107070f0f0e000e111111110f0000000f11
111111110f00000f0e000000000e111107000e0f1111110f000007110f0e07111111110f000000
07111111110f00000d0a0910050505050505050505050505050505050505050510090a0d000007
111111110f0000000f111111110f0e0f110700000f1111110f0e000711110e000000000e111111
0f0e000711111111111107000000111111110f00000e1111110f0e00000b0a0803050303030303
0303030505050303030303030305050303080a0b00000e0f1111110e00000f1111111100000007
11111111111107000e0f1111110e000000000e11111111110f0000071111111107000007110f07
0f110f0f1111110700000c0a090303050503030303030303030505050303030303030305050303
0303090a0c0000071111110f0f1111070f110f00000e111111110700000f11111111110e000000
000e111111111111110700000f1111110f0f110e00000e111111110f00000d0a0a060303030505
03030303030303030505050303030303030303050303030303060a0a0d00000711111111070000
0e110f0f1111110f000007111111111111110e000000000e11111111111111111107000e0f1111
11110000000f11110f0e00000b0a08030303030305050303030303030303050505030303030303
03030505030303030303080a0b00000e0f11110f000000111111110f0e00071111111111111111
110e00000000000f1111111111111111110f0e00071111110f070f11110700000c0a0903030303
03030305050303030303030303050505030303030303030305050303030303030303090a0c0000
0711110f070f11111107000e0f1111111111111111110f00000000000000000f11111111111111
11110f00000f111111110f00000d0a090603030303030303030505030303030303030305050503
030303030303030505030303030303030305100a0a0d000007111111110f00000f111111111111
1111110f000000000000000d0c0000000f11111111111111111107000e0f0f0e00000b0a080503
030303030303030305050303030303030303050505030303030303030305050303030303030303
030503080a0b00000e0f0f0e00071111111111111111110f0000000c0d000000000d0a0a0c0000
000f11111111111111110f0e0000000c0a09030505030303030303030303050503030303030303
030505050303030303030303050503030303030303030305050303090a0c0000000e0f11111111
111111110f0000000c0a0a0d000000000d0a0a0a0a0b0000000f11111111111111110f0e00000b
0a0805050303030303030303030503030303030303030305050503030303030303030505030303
030303030303050503080a0b0000000f11111111111111110f0000000c0a0a0a0a0d000000000d
0a0a0a0a0a0a0b0000000f11111111111111110700000d0a090303030303030303030505030303
0303030303030505050303030303030303050503030303030303030305100a0a0d000007111111
11111111110f0000000b0a0a0a0a0a0a0d000000000d0a0a0a0a0a0a0a0a0b0000000711111111
111111110700000a06030303030303030305050303030303030303030505050303030303030303
050503030303030303030305100a00000711111111111111110f0000000b0a0a0a0a0a0a0a0a0d
000000000d0a0a0a0a0a0a0a0a0a0a0b000000071111111111111107000a060303030303030303
05050303030303030303030505050303030303030303050503030303030303030305100a000e11
111111111111070000000b0a0a0a0a0a0a0a0a0a0a0d000000000d0a0a0a0a0a0a0a0a0a0a0a0a
0b00000007111111111107000a0603030303030303030505030303030303030303050505030303
0303030303050503030303030303030305100a000e1111111111070000000b0a0a0a0a0a0a0a0a
0a0a0a0a0d000000000d0a0a0a0a0a0a0a0a0a0a0a0a0a0a0b00000e1111111107000a06030303
030303030305050303030303030303030505050303030303030303050503030303030303030305
100a000e111111110e00000b0a0a0a0a0a0a0a0a0a0a0a0a0a0a0d000000000d0a0a0a0a0a0a0a
0a0a0a0a0a0a0a0a0a0d0e1111111107000a060303030303030303050503030303030303030305
05050303030303030303050503030303030303030305100a000e111111110e000a0a0a0a0a0a0a
0a0a0a0a0a0a0a0a0a0d000000000d0a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0d0e111111110700
0a1005050505050505050505050505050505050505050505050505050505050505050505050505
0505050505100a000e111111110e000a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0d000000000d0a0a
0a0a0a0a0a0a0a0a0a0a0a0a0a0a0d0e1111111107000a10050505050505050505050505050505
050505050505050505050505050505050505050505050505050505100a000e111111110e000a0a
0a0a0a0a0a0a0a0a0a0a0a0a0a0a0d000000000d0a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0d0e11
11111107000a100505050505050505050505050505050505050505050505050505050505050505
05050505050505050505100a000e111111110e000a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0d0000
00000d0a0a0a0a0a0a0a0a0a1613160a0a0a0a0d0e1111111107000a0603030303030303030505
0303030303030303030505050303030303030303050503030303030303030305100a000e111111
110e000a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0d000000000d0a0a0a0a0a0a0a0a131313160a0a
0a0a0d0e1111111107000a06030303030303030305050303030303030303030505050303030303
030303050503030303030303030305100a000e111111110e000a0a0a0a0a0a0a0a0a0a0a0a0a0a
0a0a0d000000000d0a0a0a0a0a0a16131313130a0a0a0a0a0d0e1111111107000a060303030303
03030305050303030303030303030505050303030303030303050503030303030303030305100a
000e111111110e000a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0d000000000d0a0a0a0a1613131313
13160a0a0a0a0a0d0e1111111107000a0603030303030303030505030303030303030303050505
0303030303030303050503030303030303030305100a000e111111110e000a0a0a0a0a0a0a0a0a
0a0a0a0a0a0a0a0d000000000d0a0a0a13131313131313160a0a0a0a0a0d0e1111111107000a06
030303030303030305050303030303030303030505050303030303030303050503030303030303
030305100a000e111111110e000a0a0a0a0a1616160a0a0a0a0a0a0a0a0d000000000d0a0a0a16
13131313131313131316160a0d0e1111111107000a100303030303030303030503030303030303
03030505050303030303030303050503030303030303030305100a000e111111110e000a0a1613
131313130a0a0a0a0a0a0a0a0d000000000d0a0a0a0a1313131313131313131313131515171711
1107000a1003030303030303030305030303030303030303050505030303030303030305050303
0303030303030305100a000e1111111714151313131313131313160a0a0a0a0a0a0a0d00000000
0d0a0a0a0a16131313131313131313131313131313131815151610030303030303030303050503
030303030303030505050303030303030303050503030303030303030305100a000e1818131313
131313131313131313160a0a0a0a0a0a0a0d000000000d0a0a0a0a0a1313131316161313131313
131313131313131313131315141414121203030505030303030303030305050503030303030303
03050503030303030312141414151313131313131313131313131313160a0a0a0a0a0a0a0a0a0a
0d000000000d0a0a0a0a0a161313130a0a0a0a1616161313131313131313131313131313131313
131315151514141414141412121212121212121212141407141415151513131313131313131313
1313131313131316160a0a0a0a0a0a0a0a0a0a0a0a0a0d000000000d0a0a0a0a0a0a1313160a0a
0a0a0a0a0a0d0e1718181313131313131313131313131313131313131313131313131313131313
13131313131313131313131313131313131313131313131318180e000a0a0a0a0a0a0a0a0a0a0a
0a0a0a0a0a0d000000000d0a0a0a0a0a0a1613160a0a0a0a0a0a0a0d0e11111111070016071415
151313131313131313131313131313131313131313131313131313131313131313131313131313
131516150e171111110e000a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0d000000000d0a0a0a0a0a0a
0a130a0a0a0a0a0a0a0a0d0e1111111107000a1005030303031214141414141515131313131313
1313131313131313131313131313151514141412120503060a000e111111110e000a0a0a0a0a0a
0a0a0a0a0a0a0a0a0a0a0d000000000d0a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0d0e1111111107
000a10050303030303030303050503030303030312121212121212121212120305050303030303
030303050503060a000e111111110e000a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0d000000000d0a
0a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0d0e1111111107000a100505050505050505050505050505
05050505050505050505050505050505050505050505050505050505100a000e111111110e000a
0a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0d000000000d0a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0d0e
1111111107000a1005050505050505050505050505050505050505050505050505050505050505
0505050505050505050505100a000e111111110e000a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0a0d00
000000000d0d0c0b0b0a0a0a0a0a0a0a0a0a0a0a0d0e1111111107000a10050505050505050505
050505050505050505050505050505050505050505050505050505050505050505100a000e1111
11110e000a0a0a0a0a0a0a0a0a0a0a0b0b0c0c0d0000000000000e0000000000000d0c0b0b0a0a
0a0a0a0d0e1111111107000a060305050303030303030305050303030303030305050503030303
03030305030303030303030305050303060a000e111111110e000a0a0a0a0a0b0b0c0d00000000
00000e00000000000e11110f0f07070e0000000000000d0d0c000e1111111107000a0603050503
030303030303050503030303030303050505030303030303050503030303030303050503030306
0a000e111111110e000c0c0d0000000000000e07070f0f11110e000000000e1111111111111111
110f0f070e0e0000000e1111111107000a06030305050303030303030305030303030303030505
050303030303030505030303030303030505030303060a000e111111110e0000000e0e070f0f11
11111111111111110e000000000e1111111111111111111111111111110f0f0f1111111107000a
060303050503030303030303050503030303030305050503030303030305050303030303030505
03030303060a000e111111110f0f0f1111111111111111111111111111110e000000000e111111
1111111111111111111111111111111111111107000a0603030305050303030303030505030303
0303030505050303030303030503030303030303050503030303060a000e111111111111111111
111111111111111111111111110e000000000e1111111111111111111111111111111111111111
111107000a06030303050503030303030305050303030303030505050303030303050503030303
030305050303030303100a000e111111111111111111111111111111111111111111110e000000
00000e0707070f0f1111111111111111111111111111111107000a060303030305050303030303
03050303030303030505050303030303050503030303030305050303030305100a000e11111111
1111111111111111111111110f0f0707070e00000000000000000000000000000e0e07070f0f0f
1111111111111107000a1003030303030505030303030305050303030303050505030303030305
0303030303030505030303030505100a000e111111111111110f0f0f07070e0e00000000000000
0000000000000d0a0a0a0b0b0c0c0d0d00000000000000000e0e07070f07000a10050503030305
050303030303050503030303030505050303030305050303030303050503030303050505060a00
0e0f07070e0e00000000000000000d0d0c0c0b0b0a0a0a0d0000000002030606080809090a0a0a
0a0b0b0b0c0c0d0d0000000000000a060505050303030505030303030305050303030305050503
03030305050303030305050303030305050503060a0000000000000d0d0c0c0b0b0b0a0a0a0a09
090808060604000000000002030303030303030303030606080809090a0a0a0a0b0b0b0c0a0603
050505030303050503030303050503030303050505030303050503030303050505030305050505
0303060a0c0b0b0b0a0a0a0a090908080606030303030303030303040000000000020303030303
030303030303030303030303030606070808090906030305050505030305050303030305050303
030505050303030505030303050505030305050503030303060909080807060603030303030303
030303030303030303030400000000000203030303030303030303030303030303030303030303
030303030303030305050505030505050303050503030305050503030505030303050505030505
050503030303030303030303030303030303030303030303030303030303030304000000000002
030303030303030303030303030303030303030303030303030303030303030505050505050505
030305050303050505030305050305050505050505050303030303030303030303030303030303
030303030303030303030303030303040000000000020303030303030303030303030303030303
030303030303030303030303030303030505050505050505050505030505050305050505050505
050505030303030303030303030303030303030303030303030303030303030303030303030400
000000000203030303030303030303030303030303030303030303030303030303030303030303
030305050505050505050505050505050505050505050503030303030303030303030303030303
030303030303030303030303030303030303030304000000000002030303030303030303030303
030303030303030303030303030303030303030303030303030303050505050505050505050505
050505030303030303030303030303030303030303030303030303030303030303030303030303
030303040000000000020303030303030303030303030303030303030303030303030303030303
030303030303030303030303030303030505030303030303030303030303030303030303030303
030303030303030303030303030303030303030303030303030400000000000203030303030303
030303030303030303030303030303030303030303030303030303030303030303030303030303
030303030303030303030303030303030303030303030303030303030303030303030303030303
030303030303030304000000000002030303030303030303030303030303030303030303030303
030303030303030303030303030303030303030303030303030303030303030303030303030303
030303030303030303030303030303030303030303030303030303030303040000000000020303
030303030303030303030303030303030303030303030303030303030303030303030303030303
030303030303030303030303030303030303030303030303030303030303030303030303030303
030303030303030303030303030400000000000002020202020202020202020202020202020202
020202020202020202020202020202020202020202020202020202020202020202020202020202
020202020202020202020202020202020202020202020202020202020202020202020200000000
000000000000000000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000000000000000000000
00000000000c00000040092900aa000000000000005600640000000000040000002701ffff0300
00000000
}\f2\fs22
\par }
endtext



set safe off
local afile1,afile2,afile3
afile1= sys(2023)+"\myrtf1.rtf"
afile2= sys(2023)+"\myrtf2.rtf"
afile3=sys(2023)+"\myrtf3.rtf"
afile4=sys(2023)+"\myrtf4.rtf"

strtofile(m.myvar1,m.afile1)
strtofile(m.myvar2,m.afile2)
strtofile(m.myvar3,m.afile3)
strtofile(m.myvar4,m.afile4)
set safe on


CREATE cursor  ycurs (num i,myrtf g)
for i=1 to 4   &&create 4 records with rtf contents
INSERT INTO ycurs (num)  VALUES (i)
endfor


sele ycurs
scan
do case
case recno()=1
APPEND GENERAL myrtf FROM (m.afile1)  CLASS "RICHTEXT.RICHTEXTCTRL.1"
case recno()=2
APPEND GENERAL myrtf FROM (m.afile2)  CLASS "RICHTEXT.RICHTEXTCTRL.1"
case recno()=3
APPEND GENERAL myrtf FROM (m.afile3)  CLASS "RICHTEXT.RICHTEXTCTRL.1"
case recno()=4
APPEND GENERAL myrtf FROM (m.afile4)  CLASS "RICHTEXT.RICHTEXTCTRL.1"
endcase
endscan

*brow

REPORT FORM myRTFreport PREVIEW NOCONSOLE
use in ycurs


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


*10* 
*converting any string to TXT/RTF format
*this code can convert a txt file or string to rtf format and fill the cursor above .

Local m.myvar
TEXT TO myvar noshow
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin vel risus eget lorem feugiatfermentum nec a turpis. Phasellus purus sem, mollis ac posuere eget, ornare vel orci. Sed ac rutrum
nulla. Aenean ultrices eget lectus eu efficitur. In hac habitasse platea dictumst. Nulla in iaculis nisi.
Nullam et pulvinar tellus. Donec arcu dui, efficitur a odio non, porta congue dolor. Aenean viverra auctor sagittis. Integer lobortis dignissim auctor. Proin et volutpat massa.
ENDTEXT

Local oRichtext
oRichtext = Createobject("RichText.RichtextCtrl.1")
oRichtext.TextRTF = myvar
oRichtext.savefile("mytxt.txt",1)   &&txt
Run/N "notepad" mytxt.txt  &&show

oRichtext.savefile("myrtf.rtf",0)   &&rtf
&&show in associated application (word)
Declare Integer ShellExecute In shell32.Dll ;
	INTEGER hndWin, String cAction, String cFileName, ;
	STRING cParams, String cDir, Integer nShowWin

ShellExecute(0,"open","myrtf.rtf","","",1)

*can also write text in word and save as rtf file.


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


*11*
* vfp reports works with utf-8 and unicode texts as well with some conditions
*copy any utf-8 text (nortepad) to table or cursor (each record).the report listener converts it automatically to unicode rendered as well
*simply mark the report/properties/other/user data as : or  ans save it to tell the listener class what render.
*issue modi comm (utf-8 file txt) and copy contents to m.myvar below in code.

Set Date Long
#Define crlf Chr(13)+Chr(10)
Create Cursor ycurs (yunicode m)
TEXT to m.myvar noshow
حل اليوم الجمعة المدرب الأرجنتيني مارسيلو بييلسا إلى الجزائر العاصمة للتفاوض مع رئيس الاتحادية الجزائرية لكرة القدم محمد روراوة حول خلافة الفرنسي كريستيان غوركوف في تدريب المنتخب الجزائري.
وحسب ما ذكر موقع "أونز مونديال" الفرنسي فقد وصل المدرب السابق لأولمبيك مارسيليا صباح اليوم على الساعة 9h55 وكان في استقباله بسرية عضوين من "الفاف" حيث غادر المطار مباشرة الى مقر الاتحادية بدالي ابراهيم للتفاوض مع محمد روراوة، حيث من المنتظر ان يوقع التقني الارجنتيني على عقد لمدة سنتين الى غاية سنة 2018 حسب الموقع الفرنسي.
وسينص العقد المبرم بين روراوة وبييلسا على هدفين هما بلوغ "الخضر" المربع الذهبي لكأس إفريقيا 2017 بالغابون، بالإضافة إلى التأهل لمونديال روسيا 2018.
خرج الناخب الوطني عن صمته فيما يخص مستقبله على رأس العارضة الفنية لـ “الخضر”، حيث أوضح بأن الطلاق صار أمرا حتميا، موضحا بأنه وإن لم يقدم استقالته الرسمية فإن جلسة هامة ستجمعه مع “باترون” الفاف بعد غد الأحد بمقر الاتحادية للتباحث في الصيغة المثلى لترسيم رحيله.
“لم أستقل”.. بهذا العنوان استهلت اليومية الإلكترونية الجهوية الفرنسية حديثها للناخب الوطني كريستيان غوركوف عشية أمس، مفضلا تحاشي الصحافة الجزائرية التي أثارت قضية رحيله منذ سقوط “الخضر” في ودية غينيا بملعب 5 جويلية، وتعزز طرح الطلاق بعد مباراة الإياب ضد إثيوبيا.
ENDTEXT
For i= 1 To 6   &&6 records as demo
Insert Into ycurs Values (Trans(i)+crlf+m.myvar)
Endfor
*brow
Sele ycurs
Locate

m.xtitle="vfp report supporting unicode texts as UTF8"

*Create  own listener  making conversion to Unicode in records having certain User data:
loListener = Createobject("xUTF8")
Try
Report Form Locfile('yreport_unicode.frx')  Object loListener Preview
Catch To loExc
Messagebox(loExc.Message)
Endtry

Define Class xUTF8 As ReportListener
ListenerType = 1

Procedure Render
Lparameters nFRXRecNo ;
    , nLeft, nTop, nWidth, nHeight ;
    , nObjectContinuationType ;
	, cContentsToBeRendered ;
	, GDIPlusImage

Local lcExpr, lcResult, llStrConv

Set DataSession To This.FRXDatasession
Go nFRXRecNo

   *-- Check User data in report definition
IF User = "< UTF-8 >" OR User = "< UNICODE >"  &&cut spaces/brackets
lcExpr = Expr
llStrConv = User = "< UTF-8 >"  &&cut spaces/brackets
ENDIF
Set DataSession To This.CurrentDatasession

If !Empty(lcExpr)
	lcResult = Evaluate(lcExpr)
	If Vartype(lcResult) = "C"
		If llStrConv
*-- Report field is in UTF-8 - convert it to Unicode
			cContentsToBeRendered = Strconv(lcResult, 12)
		Else
*-- Report field is in Unicode already
			cContentsToBeRendered = lcResult
		Endif
	Endif
Endif

DoDefault(nFRXRecNo ;
	, nLeft, nTop, nWidth, nHeight ;
	, nObjectContinuationType, cContentsToBeRendered, GDIPlusImage)
Nodefault
Endproc
Enddefine


take precaution to make the image in background to dont hide the text report (toobar and make it as zorder(1)).

take precaution to make the image in background to dont hide the text report (toobar and make it as zorder(1)).

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


*12*
*make a form appears as fullscreen mode
*simply embed it on a top level form-the modality take superiority on showWindow=2
*Important:In all case and if lost the toolbar (by clicking it in x button), issue ESC to close the report.
*If using listener and lost the toolbar,rightclick to restore it.

LOCAL oPreview
oPreview = CREATEOBJECT("yForm")
oPreview.name="yPreview"
oPreview.visible=.t.
REPORT FORM (getfile('frx')) PREVIEW IN WINDOW yPreview
oPreview.release
retu

define class yform as form
showWindow=2
titlebar=1
caption="Report Viewer on form"
windowstate=2

procedure init
this.titlebar=0  &&cut the form titlebar
endproc

enddefine


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


Notes:
1-i seen in past some wonderfull codes with listener to render directly pure html (as memo in table/cursor) into a shape (rectangle) in VFP report .
its done with an external FLL whose render the html into the shape (html tags,images,...) simply by telling listener to render on user field with some mark (*:HTML).
same thing can be done with rtf.
i ignore if the pointed fll was just for protecting the author work or the job cannot be done from vfp !
it was an exclusive commercial app named Moxie.Unfortunatly the site was broken there is a while.

2-If you run  foxypreviewer.app  its toolbar takes place of the native one.close all before running codes out of foxypreviewer.



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

*13*created on 26 of february 2017
*A user asks how to center a vfp report on screen
*it can be done with native codes with a defined window used as container

Define Window yb  from 0,0 to 1,1  Name ywin && as OOP object resized nextly
With ywin As Form
	.Width=950
	.Height=600
	.AutoCenter=.T.
Endwith

Activate Window yb
Report Form Home(1)+"samples\solution\reports\ledger" Preview Nowait  Window yb  && can use ? or getfile('frx')to get frx with dialog
Release Window yb
Retu


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


*14* created on 27 of february 2017
*working with blob fields to store images
*this is the previous code but with choosing any folder of images (can be any formt jpg,bmp,png,gif,emf)
*this builds programmatly a report (not with designer)-this use the report frx as a table and appe a record (17=image)
*and fill the other fields needed programmatly.
*if you create manually the report forget this step(makeReport).

Set Classlib To Locfile( Home(1)+"FFC\_DATANAV.VCX") AddI
Publi yform
yform=Newobject("yblob")
yform.Show
Release Classlib  Home(1)+"FFC\_DATANAV.VCX"
Read Events
Retu
*
Define Class yblob As Form
	Top = 0
	Left = 0
	Height = 290
	Width = 470
	ShowWindow = 2
	Caption = "Working with blobs & pictures"
	Name = "Form1"

	Add Object image1 As Image With ;
		Anchor = 0, ;
		Stretch = 2, ;
		Height = 180, ;
		Left = 5, ;
		Top = 2, ;
		Width = 192, ;
		Name = "Image1"

	Add Object edit1 As EditBox With ;
		Anchor = 15, ;
		Height = 276, ;
		Left = 216, ;
		ReadOnly = .T., ;
		Top = 6, ;
		Width = 252, ;
		ControlSource = "ycurs.img", ;
		Name = "Edit1"

	Add Object _navbtns1 As _navbtns   With ;
		Top = 252, ;
		Left = 36, ;
		tablealias = "ycurs", ;
		Name = "_navbtns1", ;
		Vcrtop.Name = "Vcrtop", ;
		Vcrprevious.Name = "Vcrprevious", ;
		Vcrnext.Name = "Vcrnext", ;
		vcrbottom.Name = "vcrbottom"

	Add Object yreport As CommandButton With;
		top=252,;
		left=136,;
		width=70,;
		height=27,;
		mousepointer=15,;
		backcolor=Rgb(0,255,0),;
		name="yreport"

	Add Object label1 As Label With ;
		FontBold = .T., ;
		FontSize = 8, ;
		WordWrap = .T., ;
		BackStyle = 0, ;
		Caption = "", ;
		Height = 49, ;
		Left = 12, ;
		Top = 192, ;
		Width = 181, ;
		ForeColor = Rgb(255,0,0), ;
		Name = "Label1"

	Procedure yreport.Click
	Sele ycurs
	*Brow
	Locate
	=yblob2report()
	Endproc

	Procedure Load
	Close Data All
	Local m.gnbre,m.yrep
	m.yrep=Getdir()
	If Empty(m.yrep)
		Return .F.
	Endi
	m.yrep=Addbs(m.yrep)
	gnbre=Adir(gabase,m.yrep+"*.*")
	Create Cursor ycurs (Name c(20),img  Blob)
	For i=1 To  gnbre
		If Inlist( Lower(Justext(m.yrep+gabase(i,1))),"jpg","png","bmp","gif","emf")
			Insert Into ycurs Values (Justfname(m.yrep+gabase(i,1)),Filetostr(m.yrep+gabase(i,1)))
		Endi
	Endfor
	*Brow

	Sele ycurs
	Locate
	Endproc

	Procedure Init
	With Thisform
		.image1.PictureVal=ycurs.img
		.label1.Caption=Name
	Endwith
	Endproc

	Procedure _navbtns1.Vcrtop.MouseDown
	Lparameters nButton, nShift, nXCoord, nYCoord
	Try
		With Thisform
			.image1.PictureVal=ycurs.img
			.label1.Caption=Name
		Endwith
	Catch
	Endtry
	Endproc

	Procedure _navbtns1.Vcrprevious.MouseDown
	Lparameters nButton, nShift, nXCoord, nYCoord
	Try
		With Thisform
			.image1.PictureVal=ycurs.img
			.label1.Caption=Name
		Endwith
	Catch
	Endtry
	Endproc

	Procedure _navbtns1.Vcrnext.MouseDown
	Lparameters nButton, nShift, nXCoord, nYCoord
	Try
		With Thisform
			.image1.PictureVal=ycurs.img
			.label1.Caption=Name
		Endwith
	Catch
	Endtry
	Endproc

	Procedure _navbtns1.vcrbottom.MouseDown
	Lparameters nButton, nShift, nXCoord, nYCoord
	Try
		With Thisform
			.image1.PictureVal=ycurs.img
			.label1.Caption=Name
		Endwith
	Catch
	Endtry
	Endproc

	Procedure Destroy
	Clea Events
	Endproc
Enddefine
*
*-- EndDefine: yblob

Function yblob2report()
*adapted from https://support.microsoft.com/en-us/help/895602/how-to-print-pictures-and-how-to-display-pictures-that-are-stored-in-a-blob-field-in-visual-foxpro-9.0
*if you work on this kind of building report programmatly can be documented with this link: http://www.mattslay.com/pages/FoxPro-Report-FRX-Structure.html

Local lcDataDIR As String, ;
	lcThisDir As String, ;
	loRL As ReportListener
*-- This calls a function that makes a report programmatically.
*-- This is included here just to make sure that this sample can be run
*-- as-is, without asking the developer to manually create a report.
MakeReport()

*-- Create an instance of the PreviewListener
*-- class defined later in this code.
*-- Call its custom InitBLOBImage() method,
*-- which creates an instance of an IMAGE object.
*-- This IMAGE has its PictureVal property set to the BLOB
*-- field ( 'ycurs.PIC' ) and its reference ( loRL.oBlobImage )
*-- is used as the control source for the OLE Bound control
*-- on the report.
loRL = Newobject( 'PreviewListener' )
loRL.InitBLOBImage( 'ycurs.img' )
*-- Make sure that the cursor is selected,
*-- and then run the report to preview using
*-- the instance of our Report Listener.
Select ycurs
Report Form BlobReport Object loRL
Return

*--------------------------------
*-- There has to be some way of redrawing the
*-- picture in the IMAGE class as the record pointer
*-- in the report's driving cursor changes; it does not occur
*-- automatically. This could be done by a UDF() in the PrintWhen
*-- of the OLE Bound control on the report, or as is illustrated here,
*-- by a Report Listener BEFOREBAND() Event.
Define Class PreviewListener As ReportListener
	oBlobImage = Null
	PicBlobFld = ''
	ListenerType = 1  && Preview Listener

	Procedure InitBLOBImage(lpcBlobField As String)
	This.PicBlobFld = lpcBlobField
	This.oBlobImage = Newobject( 'IMAGE' )
	This.oBlobImage.PictureVal = This.PicBlobFld
	Endproc

	Procedure BeforeBand( nBandObjCode, nFRXRecNo )
*-- Before the DETAIL band is rendered, ;
*-- just redraw the IMAGE object so that it has
*-- the correct picture from the BLOB field.
	If nBandObjCode = 4 && Detail band
		This.oBlobImage.PictureVal =;
			EVALUATE( This.PicBlobFld )
	Endif
	Endproc
Enddefine

*--------------------------------
*-- This function programmatically creates a report
*-- with an OLE Bound control and other fields. This is included
*-- only for demonstration purposes so this article code can stand-alone.
*-- Typically, you would create your own report manually by using
*-- the report designer.
Function MakeReport
Create Report BlobReport From ycurs
*-- Open the report file (FRX) as a table.
Use BlobReport.FRX In 0 Alias TheReport Exclusive
Select TheReport
*-- Increase the height of the Detail band
*-- (ObjType = 9 & ObjCode = 4) to fit the
*-- Picture/OLE Bound control that is inserted later.
Update TheReport Set Vpos = 0, Hpos = 0, Height = 23542;
	WHERE ObjType = 9 And ObjCode = 4

*-- Since you increased the height of the Detail Band, you need to move
*-- the items from the footer down so they are back in the footer again.
Update TheReport Set Vpos = 29479.167 ;
	WHERE ( ObjType = 8 Or ObjType = 5 ) And ;
	INLIST( Expr, 'DATE()', '"Page "', '_PAGENO' )

*-- Add a Picture/OLE Bound control to the report by inserting a
*-- record with appropriate values. Using an object that is based on the EMPTY
*-- class here and the GATHER NAME class later to insert the record makes it easier to
*-- see which values line up to which fields (when compared to a large
*-- SQL-INSERT command).
Local loNewRecObj As Empty
loNewRecObj = Newobject( 'EMPTY' )
AddProperty( loNewRecObj, 'PLATFORM', 'WINDOWS' )
AddProperty( loNewRecObj, 'Uniqueid', Sys(2015) )
AddProperty( loNewRecObj, 'ObjType', 17 ) && "Picture/OLE Bound Control"
AddProperty( loNewRecObj, 'NAME', 'loRL.oBlobImage' ) && The object ref to the IMAGE object.
AddProperty( loNewRecObj, 'Hpos', 27500.000) && Place it in DETAIL band.
AddProperty( loNewRecObj, 'Vpos', 3854.167)
AddProperty( loNewRecObj, 'HEIGHT', 21354.167)
AddProperty( loNewRecObj, 'WIDTH', 25104.167)
AddProperty( loNewRecObj, 'DOUBLE', .T. ) && Picture is centered in the "Picture/OLE Bound Control"
* from http://www.mattslay.com/pages/FoxPro-Report-FRX-Structure.html
 * 0 = Clip     1 = Scale Retain Shape   2 = Scale and fill frame
 AddProperty( loNewRecObj, 'GENERAL', 2 )

* No Stretch                         : STRETCH = .F. STRETCHTOP = .F.
* Stretch relative to tallest object : STRETCH = .F. STRETCHTOP = .T.
* Stretch relative to height of band : STRETCH = .T. STRETCHTOP = .T.
AddProperty( loNewRecObj, 'STRETCH',.T. )
AddProperty( loNewRecObj, 'STRETCHTOP',.T. )

AddProperty( loNewRecObj, 'Supalways', .T. )
*-- For the Picture/OLE Bound control, the contents of the OFFSET field specify whether
*-- Filename (0), General field name (1), or Expression (2) is the source.
AddProperty( loNewRecObj, 'Offset', 2 )

*-- Add the Picture/OLE Bound control record to the report.
Append Blank In TheReport
Gather Name loNewRecObj Memo

*-- Clean up and then close the report table.
Pack Memo
Use In Select( 'TheReport' )
Endfunc
*



Working with reports,olecontrols and listener class

Important:All Codes above are tested on VFP9SP2 & windows 10 pro.

Please come back with any bug.correcting code is usefull to all readers.

To be informed of the latest articles, subscribe:
Comment on this post
M
Printroom Group distribute printed material and printed training manuals,number one manual printing company of UK. We provide immediate online quote
Reply