REBOL [
    title:      "Crystal Reports"
    
    name:       'crystal-reports
    file:       %crystal-reports.r
    
    author:     "Christian Ensel"
    date:       6-Apr-2007
    version:    0.1.0
    
    purpose: {
        Provides a basic API to the Crystal-Report® report engine (crpe32.dll) to show, print and export reports.
        Allows for setting formulas and selection criteriae as well as passing parameters when launching reports.
    }  
    
    example: [
        open-report-engine
        ticket: none
        view center-face layout [
            btn "Öffne Report"    [all [none? ticket ticket: show-report/with/only %/C/Reuffel/Reporte/Explore.rpt ["Debugging" "True"] {{RechnungEF_txt.ADRESS_RKNR_KNR} = "24170"}]] 
            btn "Schließe Report" [close-report ticket ticket: none]
            btn "Ende" [unview/all]
            at 20x100 box black 800x600
        ]
        close-report-engine 
    ]
    
    exposes: [
        open-report-engine   "Opens the Crystal-Report® report engine."
        close-report-engine  "Closes the Crystal-Report® report engine."
        show-report          "Shows a Crystal-Report® report."
        print-report         "Prints a Crystal-Report® report."      
        launch-report        "Launches a Crystal-Report® report."
        close-report         "Close a Crystal-Report® report."                                                                                 
    ]
    needs:     [%crpe32.dll]    
    reference: [
        http://database.ittoolbox.com/groups/technical-functional/access-l/how2-generate-crystal-reports-353276#
        http://www.apostate.com/programming/vb-crpe.html
        file://localhost/C:/Reuffel/Reporte/VB_Report_Engine_API.pdf
        file://localhost/C:/Reuffel/Reporte/devmode.pdf
    ]
    
    library: [
        level:          'intermediate
        Platform:       'win
        type:           [module tool function]
        code:           'module
        domain:         [win-api database external-library printing visualization]
        license:        'BSD
        support:        none
        see-also:       none
        tested-under:   [view 1.3.2.3.1 on [WinXP] "CHE"]
    ]
    
    todo: {         
        - EXPORT-REPORT not implemented yet.
        - Utilize PEWINDOWOPTIONS and other options.
        - Refinements get complicated already, better dialect them.     
        - Dewierdify error handling.
    }
    history: [            
        6-Apr-2007 0.1.0 CHE "Initial version"
    ]
]

context [
    crpe32.dll: load/library %crpe32.dll

    &pe: [unchanged -1 sizeof [window_options 32]]              ;-- crpe32.DLL constants
                                                                                                                         
    &ws: [maximize 16777216 maximizebox 65536 sysmenu 524288]   ;-- These are alien to crpe32.dll, they belong to user32.dll. I need them here for PEOutputToWindow to open a maximized    
    &cw: [usedefault -2147483648]                               ;   window with system menu, miximise and close button.    
                                                                               
    PEWindowOptions: make struct! [                                                 
        StructSize            [short] ; initialize to &PE/SIZEOF/WINDOW_OPTIONS
        hasGroupTree          [short] 
        canDrillDown          [short] 
        hasNavigationControls [short] 
        hasCancelButton       [short] 
        hasPrintButton        [short] 
        hasExportButton       [short] 
        hasZoomControl        [short] 
        hasCloseButton        [short] 
        hasProgressControls   [short] 
        hasSearchButton       [short] 
        hasPrintSetupButton   [short] 
        hasRefreshButton      [short] 
        showToolbarTips       [short] ; Default is TRUE (*Show* tooltips on toolbar)
        showDocumentTips      [short] ; Default is FALSE (*Hide* tooltips on document)
        hasLaunchButton       [short]
    ] none
    
    PEOpenEngine:           make routine! [return: [short]] crpe32.dll "PEOpenEngine"
    PECloseEngine:          make routine! [] crpe32.dll "PECloseEngine"
    PEOpenPrintJob:         make routine! [report [string!] return: [short]] crpe32.dll "PEOpenPrintJob"
    PESetSelectionFormula:  make routine! [job [short] formula [string!] return: [short]] crpe32.dll "PESetSelectionFormula"
    PEClosePrintJob:        make routine! [job [short] return: [integer!]] crpe32.dll "PEClosePrintJob"   
    PEOutputToPrinter:      make routine! [job [short] copies [short] return: [integer!]] crpe32.dll "PEOutputToPrinter"
    PEOutputToWindow:       make routine! [job [short] title [string!] left [integer!] top [integer!] width [integer!] height [integer!] style [integer!] window [integer!] return: [integer!]] crpe32.dll "PEOutputToWindow"
    PEStartPrintJob:        make routine! [job [short] wait? [integer!] return: [short]] crpe32.dll "PEStartPrintJob"                               
    PEGetErrorCode:         make routine! [job [short] return: [short]] crpe32.dll "PEGetErrorCode"
    PEGetErrorText:         make routine! compose/deep [job [short] handle [struct! [value [integer!]]] length [struct! [value [integer!]]] return: [integer!]] crpe32.dll "PEGetErrorText"
    PEGetHandleString:      make routine! compose/deep [handle [integer!] buffer [string!] length [short] return: [integer!]] crpe32.dll "PEGetHandleString"
    PEEnableProgressDialog: make routine! [job [short] enable [integer!] return: [integer!]] crpe32.dll "PEEnableProgressDialog"
    PESetFormula:           make routine! [job [short] name [string!] formula [string!] return: [integer!]] crpe32.dll "PESetFormula" 
    
    
    ;----------------------------------------------- open/close-report-engine --
    ;
    report-error: func ["Opens the Crystal-Report® report engine." job [integer! none!] message [string!] /local code handle length error] [
        code: PEGetErrorCode any [job 0]
        handle: make struct! [value [integer!]] [0]
        length: make struct! [value [short]] [0]
        PEGetErrorText job handle length
        error: head change change/dup make string! length + 1 any [byte #"."] length "^@"
        PEGetHandleString handle/value error length/value
        throw make error! rejoin [message " (" code "): " trim/lines error]
    ]
    
    ;----------------------------------------------- open/close-report-engine --
    ;
    set 'open-report-engine  func ["Opens the Crystal-Report® report engine." ] [PEOpenEngine ]
    set 'close-report-engine func ["Closes the Crystal-Report® report engine."] [PECloseEngine]
    
    ;------------------------------------------------------------ show-report --
    ;
    set 'show-report func [
        "Shows a Crystal-Report® report." [catch]
        report [file!] "Report to show" 
        /only "Supplies a selection criteria." selection [string!]
        /with "Supplies a formula(s)." formulas [block!]
        /input "Supplies parameters." parameters [string!]
    ][
        launch-report/options 'show report reduce ['only selection 'with formulas 'input parameters]  
    ]
    
    ;----------------------------------------------------------- print-report --
    ;
    set 'print-report func [
        "Prints a Crystal-Report® report." [catch] 
        report [file!] "Report to print" 
        /only "Supplies a selection criteria." selection [string!]
        /with "Supplies a formula(s)." formulas [block!]
        /input "Supplies parameters." parameters [string!]
    ][
        launch-report/options 'print report reduce ['only selection 'with formulas 'input parameters]  
    ]
    
    ;---------------------------------------------------------- launch-report --
    ;
    set 'launch-report func [
        "Launches a Crystal-Report® report." [catch]
        action [word!] "One of 'SHOW, 'PRINT or 'EXPORT"  
        report [file!] "Report to launch"
        /only "Supplies selection formula(s)." selection [string!] 
        /with "Supplies formula(s)." formulas [block!]
        /input "Supplies parameters." parameters [string!]
        /title "Window title" window [string!]
        /options arguments [block!]
        /local job 
    ][
        if options [
            selection:  select arguments 'only
            formulas:   select arguments 'with
            parameters: select arguments 'input
        ]
        
        if zero? job: PEOpenPrintJob report: join to-local-file report #"^@" [ 
            crystal-error job "Error opening print job"
        ]
        
        foreach [name formula] any [formulas []] [
            if zero? PESetFormula job name formula [
                crystal-error job rejoi ["Error setting formula '" name "' to '" value "'"]
            ]    
        ]
        
        if selection [
            ;selection: join selection #"^@"
            if zero? PESetSelectionFormula job selection [
                crystal-error job "Error specifying selection formula"
            ]
        ]
    
        switch action [
            print [
                if zero? PEOutputToPrinter job 1  [
                    crystal-error job "Error outputting to printer"
                ]
            ]
            show [
                if zero? PEOutputToWindow job any [window system/script/parent/title "REBOL - Crystal-Reports® Report Engine"] &cw/usedefault &cw/usedefault &cw/usedefault &cw/usedefault &ws/maximize or &ws/maximizebox or &ws/sysmenu 0 [
                    crystal-error job "Error outputting to window" 
                ]
            ]
        ;   export [
        ;        Dim Options As PEExportOptions
        ;        Options.StructSize = Len(Options)
        ;        require PEGetExportOptions(iPrintJob, Options)
        ;        require PEExportTo(iPrintJob, Options)
        ;   ]
        ]
        
        if zero? PEStartPrintJob job 1 [
            crystal-error job "Error starting to print report"
        ]
        
        if action <> 'show [
            if zero? PEClosePrintJob job [
                crystal-error job "Error starting to print report"
            ]
        ]
        
        either action = 'show [job] [true]
    ]
    
    ;----------------------------------------------------------- close-report --
    ;
    set 'close-report func [job] [
        if zero? PEClosePrintJob job [
            crystal-error job "Error starting to print report"
        ]
    ] 

]