#define OutputNothing -1
#define OutputTIFF 101
#define OutputTIFFAdditive (OutputTIFF+100)

LOCAL oReportListener
oReportListener = NEWOBJECT("MPTiffListener")
oReportListener.Filename = "Multi"

WAIT WINDOW "Processing report to TIFF file...." NOWAIT
REPORT FORM ? OBJECT oReportListener 
WAIT CLEAR

DEFINE CLASS MPTiffListener AS ReportListener

   PROCEDURE Init
      this.AddProperty("Filename", "temp")
      this.ListenerType = 2
   ENDPROC
   
   PROCEDURE BeforeReport
      ERASE this.Filename
   ENDPROC

   PROCEDURE OutputPage(nPageNo, eDevice, nDeviceType)
      IF (nDeviceType == OutputNothing)
         IF (nPageNo == 1)
             nDeviceType = OutputTIFF
         ELSE 
            nDeviceType = OutputTIFFAdditive
         ENDIF
         THIS.OutputPage(nPageNo, this.Filename, nDeviceType)
         NODEFAULT
     ENDIF
   ENDPROC

ENDDEFINE

#DEFINE OUTPUTDEVICETYPE_GDIPLUS 1
#DEFINE OUTPUTTO_PRINT           1
#DEFINE OUTPUTTO_FILE            2
#DEFINE LISTENER_TYPE_PRN        0
#DEFINE LISTENER_TYPE_PRV        1
#DEFINE LISTENER_TYPE_PAGED      2
LOCAL loRL, loForm
loRL = CREATEOBJECT("EchoListener")
REPORT FORM ? OBJECT loRL && Вывод на консоль
REPORT FORM ? OBJECT loRL NEXT 1 TO PRINT && вывод, на консоль и печатать
_SCREEN.Cls && Очистка экрана
REPORT FORM ? OBJECT loRL PREVIEW && предварительный просмотр, нет вывода на консоль
loForm = CREATEOBJECT("form")
loForm.Caption = "My Output Window"
loForm.Show()
REPORT FORM ? OBJECT loRL TO FILE c:\temp\x.txt && в файл и окно
REPORT FORM ? OBJECT loRL TO FILE c:\temp\x.txt NOCONSOLE && долько в файл

DEFINE CLASS EchoListener as ReportListener
  ListenerType = LISTENER_TYPE_PAGED 

  GP = 0
  RHeight = 0
  RWidth = 0
  
  PROCEDURE LoadReport()
    IF THIS.CommandClauses.Preview
       THIS.ListenerType = LISTENER_TYPE_PRV 
    ELSE
       IF INLIST(THIS.CommandClauses.OutputTo,OUTPUTTO_PRINT,OUTPUTTO_FILE)
          THIS.ListenerType = LISTENER_TYPE_PRN
       ENDIF
    ENDIF   
  ENDPROC   
  
  PROCEDURE BeforeReport()
     IF NOT (THIS.CommandClauses.NoConsole OR THIS.CommandClauses.Preview)
        DECLARE integer GdipCreateFromHWND IN GDIPLUS.DLL ;  
          integer hwnd, integer @ nGraphics
        LOCAL lH, nG
        nG = 0
        IF TYPE("_SCREEN.ActiveForm") = "O"
           m.lH = _SCREEN.ActiveForm.HWnd
        ELSE   
           m.lH = _SCREEN.HWnd 
        ENDIF   
       IF GdipCreateFromHWND( m.lH, @nG ) = 0
          THIS.GP = m.nG
          THIS.RHeight = THIS.GetPageHeight()/10 && преобразование 960 точек на дюйм в 96 точек на дюйм
          THIS.RWidth = THIS.GetPageWidth()/10
       ENDIF   
    ENDIF   
  ENDPROC

  PROCEDURE OutputPage(nPageNo, ;
                  eDevice, ;
                  nDeviceType, ;
                  nleft, nTop, nWidth, nHeight, ;
                  nClipLeft,nClipTop, nClipWidth, nClipHeight)
      IF THIS.GP # 0 
         DODEFAULT(nPageNo, THIS.GP,OUTPUTDEVICETYPE_GDIPLUS , ;
                   0,0,THIS.RWidth, THIS.RHeight, ;
                   0,0,THIS.RWidth, THIS.RHeight)            
      ENDIF             
                     
  ENDPROC
  
  PROCEDURE UnloadReport()
     * reset:
     IF NOT THIS.GP = 0
        DECLARE integer GdipDeleteGraphics IN GDIPLUS.DLL integer
        GdipDeleteGraphics( THIS.GP )
        THIS.GP = 0
     ENDIF
     THIS.ListenerType = LISTENER_TYPE_PAGED 
  ENDPROC
   
ENDDEFINE   

#DEFINE BASEPAGEHEIGHT  550
#DEFINE BASEPAGEWIDTH 425

CLEAR ALL  
oListener = NEWOBJECT("zoomListener")
oForm = CREATEOBJECT("form")

WITH oForm
   .ScaleMode = 3
   .allowOutput = .F.
   .top = 0
   .left = 0
   .height = BASEPAGEHEIGHT
   .width = BASEPAGEWIDTH
   .backcolor = RGB(255,255,255)
   .Show()
ENDWITH   

oListener.PreviewContainer = oForm
REPORT FORM ? OBJECT oListener
oListener.DoOutputPage(1,1)
WAIT window  ;
   "Масштаб 100%... " + ;
   "Нажмите клавишу для изменения масштаба"
oListener.DoOutputPage(2, .21123 ) 
WAIT window ;
   "Масштаб 21.123%... " + ;
   "Нажмите клавишу для изменения масштаба"
oListener.DoOutputPage(3,2.367) 
WAIT window ;
   "Масштаб at 236.7%... "

DEFINE CLASS zoomListener AS ReportListener
   ListenerType = 3 

   PROCEDURE DoOutputPage(tPage, tMultiplier)
      LOCAL liPage
      IF VARTYPE(tPage) = "N" AND ;
         BETWEEN(tPage,;
                 THIS.CommandClauses.RangeFrom, ;
                 IIF(THIS.CommandClauses.RangeTo=-1, ;
                     THIS.PageTotal, ;
                     THIS.CommandClauses.RangeTo))
         liPage = INT(tPage)
      ELSE
         liPage = THIS.CommandClauses.RangeFrom    
      ENDIF               
      THIS.SetPreview(tMultiplier)   
      THIS.OutputPage(liPage,ThIS.PreviewContainer.MyPreview,2) 
   ENDPROC

   PROCEDURE SetPreview(tMultiplier)
      LOCAL liHeight, liWidth
      IF TYPE("THIS.PreviewContainer.MyPreview") # "O" 
         THIS.PreviewContainer.AddObject("MyPreview","shape")       
      ENDIF
      IF VARTYPE(tMultiplier) = "N" AND ;
         BETWEEN(tMultiplier,.01, 10)
         liHeight = BASEPAGEHEIGHT * tMultiplier
         liWidth  = BASEPAGEWIDTH * tMultiplier
         WAIT WINDOW ;
            "H:" + TRANSFORM(liHeight)+ ;
          ", W:" + TRANSFORM(liWidth) TIMEOUT 1
         * note that VFP will round the pixels 
         WITH THIS.PreviewContainer
            .LockScreen = .T.            
            .MyPreview.Height = liHeight
            .MyPreview.Width = liWidth
            .Height = liHeight
            .Width = liWidth 
            .LockScreen = .F.
            .Cls()                   
         ENDWITH
      ENDIF
   ENDPROC

   PROCEDURE Destroy
      THIS.PreviewContainer = NULL
   ENDPROC

ENDDEFINE