D:\perfil\Descargas\GridExtras\CopyToReport.prg jueves, 07 de febrero de 2019 10:55 p.m.

** lo copié del VCX D:\Descargas\GridExtras\CopyToReport.prg

PROCEDURE CopyToReport
Lparameters tcFRXName, tnOrientation, tnPaperSize, tnScale

*************************************************************
** tnOrientation : 0 = Portrait, 1 = Landscape
** tnPaperSize : 1 = Letter, 5 = Legal
** tnScale : 1 = 100%
*************************************************************
Local loGrid As Grid
Local loColumn As Column
Local loField As TextBox
Local loControl As Header
Local loForm As Form
Local lnLeft, lnTop, lnMaxHeight, lnPageWidth
Local loReport As SFReportFile Of SFRepObj/SFRepObj.vcx
Local loText As SFReportText Of SFRepObj/SFRepObj.vcx
Local loField As SFReportText Of SFRepObj/SFRepObj.vcx
Local loDetail As SFReportBand Of SFRepObj/SFRepObj.vcx
Local loPageHeader As SFReportBand Of SFRepObj/SFRepObj.vcx
Local lcUniqueCursorName, lnSelect

m.tcFRXName = Evl(m.tcFRXName, This.GridReportFile)

m.tnOrientation = Evl(m.tnOrientation, 1)
m.tnScale = Evl(m.tnScale, 1)
m.tnPaperSize = Evl(m.tnPaperSize, 1)
m.lcUniqueCursorName = SYS(2015)
DO WHILE USED(m.lcUniqueCursorName)
m.lcUniqueCursorName = SYS(2015)
ENDDO
m.loGrid = This.GridObject

m.lnSelect = Select(0)

Create Cursor (m.lcUniqueCursorName) ;

( Expr m, ;
TYPE c(1), ;
TOP i, ;
LEFT i, ;
WIDTH i, ;
HEIGHT i, ;
ORDER i, ;
FONTNAME v(150), ;
FONTSIZE i, ;
FontStyle i, ;
FORECOLOR i, ;
BACKCOLOR i, ;
INPUTMASK v(100), ;
ALIGNMENT i, ;
CAPTION v(150), ;
CaptionFontName v(150), ;
CaptionFontSize i, ;
CaptionFontStyle i, ;

-1-
D:\perfil\Descargas\GridExtras\CopyToReport.prg jueves, 07 de febrero de 2019 10:55 p.m.

CaptionForeColor i, ;
CaptionBackColor i, ;
CaptionAlignment i)

For Each m.loColumn In m.loGrid.Columns FoxObject

IF TYPE("m.loColumn.Width")="N" AND m.loColumn.Width=0
LOOP
ENDIF
IF TYPE("m.loColumn.Visible")="L" AND !m.loColumn.Visible
LOOP
ENDIF
SELECT (m.lcUniqueCursorName)
Scatter Memo Name m.loData Blank
With m.loData
.Order = m.loColumn.ColumnOrder
.Width = m.loColumn.Width

.Expr = m.loColumn.ControlSource
.FontName = m.loColumn.FontName
.FontSize = m.loColumn.FontSize
.FontStyle = 0
.FontStyle = .FontStyle + Iif(m.loColumn.FontBold, 1, 0)
.FontStyle = .FontStyle + Iif(m.loColumn.FontItalic, 2, 0)
.FontStyle = .FontStyle + Iif(m.loColumn.FontUnderline, 4, 0)
.FontStyle = .FontStyle + Iif(m.loColumn.FontStrikethru, 8, 0)
.ForeColor = m.loColumn.ForeColor
.BackColor = m.loColumn.BackColor
.Alignment = m.loColumn.Alignment
.InputMask = m.loColumn.InputMask

For Each m.loControl In m.loColumn.Controls FoxObject

Do Case
Case m.loControl.BaseClass = "Header"
.Caption = m.loControl.Caption
.CaptionFontName = m.loControl.FontName
.CaptionFontSize = m.loControl.FontSize
.CaptionFontStyle = 0
.CaptionFontStyle = .CaptionFontStyle + Iif(m.loControl.FontBold, 1, 0)
.CaptionFontStyle = .CaptionFontStyle + Iif(m.loControl.FontItalic, 2, 0)
.CaptionFontStyle = .CaptionFontStyle + Iif(m.loControl.FontUnderline, 4, 0)
.CaptionFontStyle = .CaptionFontStyle + Iif(m.loControl.FontStrikethru, 8, 0)
.CaptionForeColor = m.loControl.ForeColor
.CaptionBackColor = m.loControl.BackColor
.CaptionAlignment = m.loControl.Alignment

Case m.loColumn.Sparse = .F. And m.loControl.Name = m.loColumn.CurrentControl AND

TYPE("m.loControl.InputMask") = "C"
.Expr = m.loControl.ControlSource
.FontName = m.loControl.FontName
.FontSize = m.loControl.FontSize
.FontStyle = 0
.FontStyle = .FontStyle + Iif(m.loControl.FontBold, 1, 0)
.FontStyle = .FontStyle + Iif(m.loControl.FontItalic, 2, 0)

-2-
D:\perfil\Descargas\GridExtras\CopyToReport.prg jueves, 07 de febrero de 2019 10:55 p.m.

.FontStyle = .FontStyle + Iif(m.loControl.FontUnderline, 4, 0)

.FontStyle = .FontStyle + Iif(m.loControl.FontStrikethru, 8, 0)
.ForeColor = m.loControl.ForeColor
.BackColor = m.loControl.BackColor
.Alignment = m.loControl.Alignment
.InputMask = m.loControl.InputMask
Endcase
Endfor
.Type = Type(.Expr)
.Height = Fontmetric(1, .FontName, .FontSize)

If m.tnScale <> 1
.FontSize = Round(.FontSize * m.tnScale, 0)
.Height = Round(.Height * m.tnScale, 0)
.Width = Round(.Width * m.tnScale, 0)
.CaptionFontSize = Round(.CaptionFontSize*m.tnScale, 0)
Endif

Endwith
Insert Into (m.lcUniqueCursorName) From Name m.loData
Endfor

Index On Order Tag Order

Go Top
m.lnLeft = 0
m.lnTop = 0
m.lnMaxHeight = Height

Do Case
Case m.tnOrientation = 0
m.lnPageWidth = 8*96
Case m.tnPaperSize = 1 && Letter
m.lnPageWidth = 10.5*96
Case m.tnPaperSize = 5 && Legal
m.lnPageWidth = 13.5*96
Otherwise
m.lnPageWidth = 8*96
Endcase

Scan
If m.lnLeft+Width > m.lnPageWidth And m.lnLeft <> 0
m.lnTop = m.lnTop + m.lnMaxHeight + 5
m.lnLeft = 0
m.lnMaxHeight = Height
Endif
Replace ;
LEFT With m.lnLeft, ;
TOP With m.lnTop, ;
FORECOLOR With Iif(ForeColor=0,-1,ForeColor), ;
BACKCOLOR With Iif(BackColor=Rgb(255,255,255),-1,BackColor), ;
CaptionForeColor With Iif(CaptionForeColor=0,-1,CaptionForeColor)
m.lnLeft = m.lnLeft + Width + 5
m.lnMaxHeight = Max(m.lnMaxHeight, Height)

-3-
D:\perfil\Descargas\GridExtras\CopyToReport.prg jueves, 07 de febrero de 2019 10:55 p.m.

Endscan

m.loReport = Newobject('SFReportFile', 'SFRepObj/SFRepObj')

m.loReport.cReportFile = m.tcFRXName
m.loReport.cUnits = "I"
m.loReport.cFontName = 'Arial'
m.loReport.nOrientation = m.tnOrientation
m.loReport.nPaperSize = m.tnPaperSize

m.loPageHeader = loReport.GetReportBand('Page Header')

m.loPageHeader.nHeight = 0

m.loDetail = loReport.GetReportBand('Detail')
m.loDetail.nHeight = 0

m.loText = loPageHeader.AddItem('Text')

m.loForm = m.loGrid.Parent
Do While TYPE("m.loForm.Caption") != "C" && loForm.BaseClass <> "Form" And
Vartype(m.loForm.Parent)="O"
m.loForm = m.loForm.Parent
Enddo

m.loText.cExpression = m.loForm.Caption
m.loText.nVPosition = 0.1
m.loText.nHPosition = 0.1
m.loText.nFontSize = 18
m.loText.lFontBold = .T.
m.lnMaxBottom = 0

SELECT(m.lcUniqueCursorName)
Scan All
m.lcAlign = "left"
Do Case
Case Alignment = 3
If Type$"NYIFBDT"
m.lcAlign = "right"
Else
m.lcAlign = "left"
Endif
Case Alignment = 0
m.lcAlign = "left"
Case Alignment = 1
m.lcAlign = "center"
Case Alignment = 2
m.lcAlign = "right"
Endcase
m.loText = loPageHeader.AddItem('Text')
m.loText.cExpression = Caption
m.loText.nVPosition = (Top/96) + 0.50
m.loText.nHPosition = (Left/96) + 0.125
m.loText.nWidth = (Width+2)/96
m.loText.cFontName = CaptionFontName

-4-
D:\perfil\Descargas\GridExtras\CopyToReport.prg jueves, 07 de febrero de 2019 10:55 p.m.

m.loText.nFontSize = CaptionFontSize
m.loText.lFontBold = Bitand(CaptionFontStyle,1)=1
m.loText.lFontItalic = Bitand(CaptionFontStyle,2)=2
m.loText.nForeColor = CaptionForeColor
m.loText.cAlignment = m.lcAlign

m.lnMaxBottom = (Top/96) + 0.50 + (Height/96)

m.loField = loDetail.AddItem('Field')
m.loField.cExpression = Expr
m.loField.nWidth = (Width+2)/96
m.loField.nVPosition = (Top/96) + 0.125
m.loField.nHPosition = (Left-1)/96 + 0.125
m.loField.cFontName = FontName
m.loField.nFontSize = FontSize
m.loField.lFontBold = Bitand(FontStyle,1)=1
m.loField.lFontItalic = Bitand(FontStyle,2)=2
m.loField.nForeColor = ForeColor
m.loField.cAlignment = m.lcAlign
m.loField.cDataType = Icase(Type$"NYIFB","N", Type$"DT", "D", "C")
m.loField.cPicture = InputMask
m.loField.cDesignCaption = Caption
Endscan

m.loObject = loPageHeader.AddItem('Line')
m.loObject.nWidth = m.lnPageWidth/96
m.loObject.nVPosition = m.lnMaxBottom
m.loObject.nHPosition = 0
m.loObject.nPenSize = 1
m.loObject.nForeColor = Rgb(0, 0, 128)
IF FILE(m.tcFRXName)
ERASE (m.tcFRXName)
ENDIF
m.loReport.Save()

IF FILE(m.tcFRXName)
TRY
Select (m.loGrid.RecordSource)
REPORT FORM (m.tcFRXName) TO PRINTER PROMPT PREVIEW
IF FILE(m.tcFRXName)
ERASE (m.tcFRXName)
ENDIF
CATCH
*!* Handle the error however you wish here
ENDTRY
ENDIF

Select(m.lnSelect)

ENDPROC
**

-5-