*-------------------------------------------------------------------------------------------------------------------------------------------------------- * (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! *-------------------------------------------------------------------------------------------------------------------------------------------------------- *< FOXBIN2PRG: Version="1.21" SourceFile="webreporter.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) * * DEFINE CLASS frm_webreporter AS form *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder *< OBJECTDATA: ObjPath="cmdOpen" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="cmdPrint" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="Command1" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="cmdSave" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="cmdBack" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="cmdCopy" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="cmdHelp" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="cmdProperties" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="cmdForward" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="Command2" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="oleWebBrowser" UniqueID="" Timestamp="" /> * *m: beginlist && Start an HTML list *m: beginreport && Sets up a file to contain a report to be displayed *m: begintable && Begin an HTML Table *m: begintablefromdbf *m: displayreport && Displkays report in web browser *m: endlist && End an HTML list *m: endreport && Ends a report and optionally displays it *m: endtable && End an HTML table *m: endtablefromdbf *m: errorhandler && Method to handle errors while the Report Viewer is active *m: setbold *m: setcolumnheads *m: setcolumnmask *m: setcolumnsum *m: setcolumnwidth *m: setfontcolor && set HTML font color *m: setfontface && Set the HTML font face *m: setfontsize && Set HTML font size *m: setitalic *m: setnumericmask *m: setreportmargin && Set margins for the document: T, B,. L, R *m: setreportwidth && set width of report and window *m: setunderline *m: storeerrorcode && Method to store the error handler in use by the program calling Report Viewer *m: switcherrorcode *m: write *m: writefont && Write font characteristcs *p: calignreport *p: cbasetitle && Caption on form preceding title of file *p: cdefaultpage && Default page used before report is created (if any) *p: cglobalvariablename && Public reference to this class object -- needed for ON ERROR statement *p: cnumericmask *p: conerrorcode && String representing the error handler in use by the program, which is suspended when the Report Viewer is active *p: creportfilename && File name (and path) of report being generated *p: creportfontcolor && Specifies HTML font color *p: creportfontface && HTML Font face reference *p: creportfontsize && HTML font size reference (1-6) *p: creportpath *p: creportstyles && Optional HTML code for stylesheet inserted in file header *p: creporttablealias && alias of current DBF-to-table *p: creporttablecellstyle && Style attributes for the TD tag *p: creporttablestyle && Style attributes for the TABLE tag *p: creporttitle && Title of the Report *p: creportwidth *p: lreleaseglobalvariablenameondestroy && If a global variable is created in Init, it needs to be released on Destroy *p: lreportbold && Whether the text is currently bold *p: lreportitalic && Whether the text is currently italic *p: lreportunderline && Whether the text is cxurrently underlined *p: nreportbmargin && HTML document bottom margin *p: nreporthandle && File number assigned to report created in beginReport *p: nreportinlist && Whether we are between execution of beginList and endList methods *p: nreportintable && Whether we are between execution of beginTable and endTable methods *p: nreportlmargin && HTML left margin on page *p: nreportrmargin && HTML document right margin *p: nreporttablecurrentcolumn && Current column being written to *p: nreporttmargin && HTML document top margin *p: nreportwidth && Width of report in pixels *a: aclines[1,0] && Array containing the lines of the body of the report *a: acreporttablecolumnheads[1,0] && Column heads for table *a: acreporttablecolumnmasks[10,1] && Column masks by table and column number *a: acreporttablecolumnwidths[10,1] *a: alists[10,0] && Keeps track of bulleted and numbered list tags *a: alreporttablecolumnsum[1,0] && Whether column is summed *a: anreporttablecolumns[1,0] && Number of columns in table *a: areportfontdefaults[3,0] && Font default values * PROTECTED cdefaultpage,cglobalvariablename,conerrorcode,lreleaseglobalvariablenameondestroy,nreporthandle * AutoCenter = .T. calignreport = center Caption = "Report Viewer" cbasetitle = Report Viewer cdefaultpage = cglobalvariablename = aa cnumericmask = 999,999,999,999.99 conerrorcode = creportfilename = aaaaaaaa creportfontcolor = black creportfontface = "Arial,Helvetica,Sans Serif" creportfontsize = 2 creportstyles = creporttablealias = creporttablecellstyle = "border-top:gray solid 1pt" creporttablestyle = "border-top:gray solid 2pt;border-bottom:gray solid 2pt" creporttitle = Raport creportwidth = 100% DoCreate = .T. Height = 352 Name = "frm_webreporter" nreportbmargin = 15 nreporthandle = 0 nreportinlist = 0 nreportintable = 0 nreportlmargin = 15 nreportrmargin = 15 nreporttablecurrentcolumn = 0 nreporttmargin = 15 nreportwidth = 600 ShowTips = .T. ShowWindow = 1 Width = 793 WindowState = 2 * ADD OBJECT 'cmdBack' AS commandbutton WITH ; Caption = "", ; Enabled = .F., ; Height = 22, ; Left = 186, ; Name = "cmdBack", ; Picture = ..\graphics\left.bmp, ; TabIndex = 8, ; ToolTipText = "Open previously saved document", ; Top = 1, ; Width = 23 *< END OBJECT: BaseClass="commandbutton" /> ADD OBJECT 'cmdCopy' AS commandbutton WITH ; Caption = "", ; Height = 22, ; Left = 101, ; Name = "cmdCopy", ; Picture = ..\graphics\copy.bmp, ; TabIndex = 5, ; ToolTipText = "Copy", ; Top = 1, ; Width = 23 *< END OBJECT: BaseClass="commandbutton" /> ADD OBJECT 'cmdForward' AS commandbutton WITH ; Caption = "", ; Enabled = .F., ; Height = 22, ; Left = 208, ; Name = "cmdForward", ; Picture = ..\graphics\right.bmp, ; TabIndex = 9, ; ToolTipText = "Go forward", ; Top = 1, ; Width = 23 *< END OBJECT: BaseClass="commandbutton" /> ADD OBJECT 'cmdHelp' AS commandbutton WITH ; Caption = "", ; Height = 22, ; Left = 129, ; Name = "cmdHelp", ; Picture = ..\graphics\help.bmp, ; TabIndex = 6, ; ToolTipText = "Help", ; Top = 1, ; Width = 23 *< END OBJECT: BaseClass="commandbutton" /> ADD OBJECT 'cmdOpen' AS commandbutton WITH ; Caption = "", ; Height = 22, ; Left = 29, ; Name = "cmdOpen", ; Picture = ..\graphics\open.bmp, ; TabIndex = 2, ; ToolTipText = "Open previously saved document", ; Top = 1, ; Width = 23 *< END OBJECT: BaseClass="commandbutton" /> ADD OBJECT 'cmdPrint' AS commandbutton WITH ; Caption = "", ; Height = 22, ; Left = 1, ; Name = "cmdPrint", ; Picture = ..\graphics\print.bmp, ; TabIndex = 1, ; ToolTipText = "Print document", ; Top = 1, ; Width = 23 *< END OBJECT: BaseClass="commandbutton" /> ADD OBJECT 'cmdProperties' AS commandbutton WITH ; Caption = "", ; Height = 22, ; Left = 157, ; Name = "cmdProperties", ; Picture = ..\graphics\prop.bmp, ; TabIndex = 7, ; ToolTipText = "Properties", ; Top = 1, ; Width = 23 *< END OBJECT: BaseClass="commandbutton" /> ADD OBJECT 'cmdSave' AS commandbutton WITH ; Caption = "", ; Height = 22, ; Left = 73, ; Name = "cmdSave", ; Picture = ..\graphics\smmail.bmp, ; TabIndex = 4, ; ToolTipText = "Save document", ; Top = 1, ; Width = 23 *< END OBJECT: BaseClass="commandbutton" /> ADD OBJECT 'Command1' AS commandbutton WITH ; Caption = "", ; Height = 22, ; Left = 51, ; Name = "Command1", ; Picture = ..\graphics\save.bmp, ; TabIndex = 3, ; ToolTipText = "Save document", ; Top = 1, ; Width = 23 *< END OBJECT: BaseClass="commandbutton" /> ADD OBJECT 'Command2' AS commandbutton WITH ; Caption = "Command2", ; Height = 22, ; Left = 236, ; Name = "Command2", ; TabIndex = 10, ; Top = 1, ; Visible = .F., ; Width = 84 *< END OBJECT: BaseClass="commandbutton" /> ADD OBJECT 'oleWebBrowser' AS olecontrol WITH ; Comment = "*:onResize=ss", ; Height = 312, ; Left = 1, ; Name = "oleWebBrowser", ; Top = 24, ; Width = 793 *< END OBJECT: BaseClass="olecontrol" OLEObject="c:\winnt\system32\shdocvw.dll" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/CQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9/////v////7////+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKARyrl1PsQBAwAAAEABAAAAAAAAAwBPAGwAZQBPAGIAagBlAGMAdABEAGEAdABhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4AAgEDAAAAAgAAAP////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAArAAAAAAAAAADAEEAYwBjAGUAcwBzAE8AYgBqAFMAaQB0AGUARABhAHQAYQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJgACAP///////////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAA4AAAAAAAAAAMAQwBoAGEAbgBnAGUAZABQAHIAbwBwAHMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcAAIA////////////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAAQAAAAAAAAAAwAAAP7////+////BAAAAP7///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9h+VaICjTQEalrAMBP1wWiTAAAAPVRAAA/IAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAATAAAAAAAAAAAAAAAOAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAAAA4NBXAHM1zxGuaQgAKy4SYggAAAAAAAAATAAAAAEUAgAAAAAAwAAAAAAAAEaAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==" /> PROCEDURE Activate * ==================================================================== * Activate * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: When activating form, switch to form's * ...............: error handler * Parameters.....: * Return type....: * Changes........: * ==================================================================== thisform.Resize thisform.SwitchErrorCode(.T.) ENDPROC PROCEDURE beginlist && Start an HTML list * ==================================================================== * BeginList * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: Write tags to begin an HTML list * ...............: * Parameters.....: tlOrdered - OPTIONAL - ordered list * Return type....: * Changes........: * ==================================================================== lparameters tlOrdered thisform.nReportInList = thisform.nReportInList + 1 if tlOrdered thisform.aLists(thisform.nReportInList) = "OL" else thisform.aLists(thisform.nReportInList) = "UL" endi thisform.write("<" + thisform.aLists(thisform.nReportInList) + ">", .t., "") ENDPROC PROCEDURE beginreport && Sets up a file to contain a report to be displayed * ==================================================================== * BeginReport Method * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: Starts the process of setting up a report to be * ...............: displayed * Parameters.....: tcReportTitle - OPTIONAL - title of report * Return type....: Boolean - .t. if successful * Changes........: * ==================================================================== lparameters tcReportTitle local llSuccess *-- If report title was passed (and is a string), save it if vartype(tcReportTitle) = "C" thisform.cReportTitle = tcReportTitle endif IF EMPTY(thisform.cReportFileName) *-- Create a (marginally) unique file name thisform.cReportFileName = "Report" + sys(2015) + ".htm" ENDIF *-- Create the file lcfisier=IIF(!EMPTY(thisform.cReportPath),thisform.cReportPath+"\"+thisform.cReportFileName,thisform.cReportFileName) thisform.nReportHandle = fcreate(lcfisier) *-- Check success llSuccess = thisform.nReportHandle # -1 *-- Start with default values for font thisform.writeFont *-- Return boolean indicating whether file was created return llSuccess ENDPROC PROCEDURE begintable && Begin an HTML Table * ==================================================================== * BeginTable * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: Write tags to begin an HTML table * Parameters.....: tnNumberofColumns - Number of columns in table * ...............: teTableWidth -- can be string or number * ...............: tnBorderWidth - default is zero * Return type....: * Changes........: * ==================================================================== lparameters tnNumberofColumns, teTableWidth, tnBorderWidth *-- Border width is zero if no parameter passed if vartype(tnBorderWidth) <> "N" tnBorderWidth = 0 endif *-- Default table width local lcTableWidth, i do case case empty(teTableWidth) lcTableWidth = "" case vartype(teTableWidth) = "N" lcTableWidth = allt(str(teTableWidth)) otherw lcTableWidth = teTableWidth endcase *-- Write tag thisform.write("", .t., "") thisform.nReportInTable = thisform.nReportInTable + 1 *-- Redimension array for storing column numbers if necessary if alen(thisform.anReportTableColumns,1) < thisform.nReportInTable dimension thisform.anReportTableColumns(thisform.nReportInTable) endif *-- Redimension array for storing column numbers if necessary if alen(thisform.acReportTableColumnMasks,1) < thisform.nReportInTable or alen(thisform.acReportTableColumnMasks,2) < tnNumberofColumns dimension thisform.acReportTableColumnMasks(max(alen(thisform.acReportTableColumnMasks,1), thisform.nReportInTable),max(alen(thisform.acReportTableColumnMasks,2), tnNumberofColumns )) endif *-- Redimension array for storing column numbers if necessary if alen(thisform.acReportTableColumnWidths,1) < thisform.nReportInTable or alen(thisform.acReportTableColumnwidths,2) < tnNumberofColumns dimension thisform.acReportTableColumnWidths(max(alen(thisform.acReportTableColumnWidths,1), thisform.nReportInTable),max(alen(thisform.acReportTableColumnWidths,2), tnNumberofColumns )) endif *-- Redim array for storing column heads if alen(thisform.acReportTableColumnHeads,1) < tnNumberofColumns dimension thisform.acReportTableColumnHeads(tnNumberofColumns) endif store '' to thisform.acReportTableColumnHeads *-- Redim array for storing column heads if alen(thisform.alReportTableColumnSum,1) < tnNumberofColumns dimension thisform.alReportTableColumnSum(tnNumberofColumns) endif store .f. to thisform.alReportTableColumnSum *-- Store number of columns thisform.anReportTableColumns(thisform.nReportInTable)= tnNumberofColumns *-- Set column masks for this table to the default for i = 1 to tnNumberofColumns thisform.acReportTableColumnMasks(thisform.nReportInTable, i) = thisform.cNumericMask thisform.acReportTableColumnHeads(i) = proper(field(i)) endfor ENDPROC PROCEDURE begintablefromdbf * ==================================================================== * BeginTableFromDBF Method * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 10 March 2000 * -------------------------------------------------------------------- * Description....: Begins process of making a report table from DBF * Parameters.....: lcAlias - name of table * Return type....: -- * Changes........: * ==================================================================== lparameters tcAlias, teTableWidth, tnBorderWidth *-- Get number of columns local lnNumberofColumns lnNumberofColumns = fcount(tcAlias) *-- Call begin table method thisform.beginTable(lnNumberofColumns, teTableWidth, tnBorderWidth) *-- Store alias thisform.cReportTableAlias = tcAlias ENDPROC PROCEDURE Deactivate * ==================================================================== * Deactivate * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: When deactivating form, switch back to * ...............: external program's error handler * Parameters.....: * Return type....: * Changes........: * ==================================================================== *-- Revert to program's error handler thisform.SwitchErrorCode(.f.) ENDPROC PROCEDURE Destroy * ==================================================================== * Destroy * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: Destroy -> Release variable created in Init * ...............: (if any) * Parameters.....: * Return type....: * Changes........: * ==================================================================== *-- Check for whether variable was created in Init *-- If there was, release it to prevent memory clutter lcerror=thisform.cOnErrorCode ON ERROR &lcerror if thisform.lReleaseGlobalVariableNameOnDestroy local lcReference lcReference = thisform.cGlobalVariableName release &lcReference endif ENDPROC PROCEDURE displayreport && Displkays report in web browser * ==================================================================== * DisplayReport * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based ReportViewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: Displays report by navigating web browser to * ...............: file that was created * Parameters.....: * Return type....: * Changes........: * ==================================================================== local llOK llOK = .f. *-- Check to make sure it's a valid file lcfisier=IIF(!EMPTY(thisform.cReportPath),thisform.cReportPath+"\"+thisform.cReportFileName,thisform.cReportFileName) do case case vartype(lcfisier) <> "C" case empty(lcfisier) case not file(lcfisier) otherw thisform.WindowState=2 thisform.visible = .t. ThisForm.oleWebBrowser.navigate(lcfisier) llOK = .t. endcase *-- Notify user if there was a problem if not llOK =messageb("There was a problem loading the file. The file was not created, or the filename supplied was not valid.", 16) endif ENDPROC PROCEDURE endlist && End an HTML list * ==================================================================== * EndList * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based ReportViewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: Ends HTML list * ...............: * Parameters.....: tlOrdered - OPTIONAL * Return type....: * Changes........: * ==================================================================== *-- Write end of table, ignoring surrounding tags thisform.write("", .t., "") *-- Step back a level in table hierarchy thisform.nReportInList = max(0, thisform.nReportInList - 1) ENDPROC PROCEDURE endreport && Ends a report and optionally displays it * ==================================================================== * EndReport * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: Web-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: Closes report file and performs any necessary * ...............: clean-up * Parameters.....: tlDisplay - OPTIONAL - Display report * Return type....: * Changes........: * ==================================================================== lparameters tlNoDisplay local lnCounter *-- Write top of file =fputs(thisform.nReportHandle, "") =fputs(thisform.nReportHandle, "") =fputs(thisform.nReportHandle, "" + thisform.cReportTitle + "") *-- If any styles were inserted for stylesheet, put em here if not empty(thisform.cReportStyles) =fputs(thisform.nReportHandle, "") endif =fputs(thisform.nReportHandle, "") =fputs(thisform.nReportHandle, "") *-- Aliniez raportul =fputs(thisform.nReportHandle,[
]) *-- Set width of report (default is 600) =fputs(thisform.nReportHandle, "
") *-- Write ReportBody *-- Step through lines created using Write method and write em to file for lnCounter = 1 to alen(thisform.acLines,1) =fputs(thisform.nReportHandle, thisform.acLines(lnCounter) ) endfor =fputs(thisform.nReportHandle, "
") *-- Inchid alinierea =fputs(thisform.nReportHandle, "") =fputs(thisform.nReportHandle, "") *-- End file =fputs(thisform.nReportHandle, "") *-- Close File =fclose(thisform.nReportHandle) *-- Display file? if not tlNoDisplay thisform.displayReport endif ENDPROC PROCEDURE endtable && End an HTML table * ==================================================================== * EndTable * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based ReportViewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: Ends HTML table * ...............: * Parameters.....: * Return type....: * Changes........: * ==================================================================== *-- Step back a level in table hierarchy thisform.nReportInTable = max(0, thisform.nReportInTable - 1) *-- Write end of table, ignoring surrounding tags thisform.write("", .t., "") ENDPROC PROCEDURE endtablefromdbf * ==================================================================== * EndTableFromDBF Method * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 10 March 2000 * -------------------------------------------------------------------- * Description....: End process of making a report table from DBF * Parameters.....: * Return type....: -- * Changes........: * ==================================================================== *-- store current work area local lcOldAlias, i, lnSum lcOldAlias = select() *-- Choose area with table select (thisform.cReportTableAlias) *-- Show col heads thisform.setBold(.t.) for i = 1 to fcount() thisform.write ( thisform.acReportTableColumnHeads(i) ) endfor thisform.setBold(.f.) *-- step through table scan for i = 1 to fcount() thisform.write (evaluate(field(i))) endfor endscan *-- Show col heads thisform.setItalic(.t.) thisform.setBold(.t.) for i = 1 to fcount() if thisform.alReportTableColumnSum(i) calc sum(evaluate(field(i))) to lnSum thisform.write ( lnSum ) else thisform.write ("") endif endfor thisform.setItalic(.f.) thisform.setBold(.f.) *-- Finish table thisform.EndTable *-- Return to original selected workarea select (lcOldAlias) ENDPROC PROCEDURE errorhandler && Method to handle errors while the Report Viewer is active * ==================================================================== * ErrorHandler * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: Error handler to trap the problem created by * ...............: webBrowser.ExecWB print dialog * Parameters.....: tnErrorNumber - Error number passed from ON ERROR * Return type....: None * Changes........: * ==================================================================== lparameters tnErrorNumber *!* *-- Alert user to error *!* =messageb("An error occurred. The requested action was canceled.",; *!* 64, "VFP Error " + allt(str(tnErrorNumber)) ) ENDPROC PROCEDURE Init * ==================================================================== * Init * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: Setup for claFrmWebReporter class * Parameters.....: tcGlobalVariableName - optional - name used to * ...............: create this class (with index if necessary) * Return type....: * Changes........: * ==================================================================== lparameters tcGlobalVariableName *-- Set caption to base caption (later, form caption will be base *-- title + document title) This.caption = this.cBaseTitle *-- If no parameter was passed, make a unique global variable if pcount() =0 tcGlobalVariableName = "goReportViewer" + sys(2015) public &tcGlobalVariableName. &tcGlobalVariableName. = this thisform.lReleaseGlobalVariableNameOnDestroy = .t. endif *-- Make a unique public variable reference to this form which can be *-- used in the ON ERROR Statement in the SwitchErrorCode *-- method (cannot use THISFORM in ON ERROR) thisform.cGlobalVariableName = tcGlobalVariableName *-- Store the current ON ERROR code thisform.StoreErrorCode *-- If there is a default/base page to use before creating a report, *-- go to it if not empty(thisform.cDefaultPage) ThisForm.oleWebBrowser.navigate(thisform.cDefaultPage) endif ENDPROC PROCEDURE KeyPress LPARAMETERS nKeyCode, nShiftAltCtrl IF nkeycode =27 nodefault this.release ENDIF ENDPROC PROCEDURE QueryUnload * ==================================================================== * QueryUnload * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based ReportViewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: QueryUnload - Delete file if any * Parameters.....: * Return type....: * Changes........: * ==================================================================== *-- Check to make sure it's a valid file before deleting do case case vartype(thisform.cReportFileName) <> "C" case empty(thisform.cReportFileName) case not file(thisform.cReportFileName) otherw delete file (thisform.cReportFileName) endcase ENDPROC PROCEDURE Resize * ==================================================================== * Resize * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: Resize form --> resize/move components as well * ...............: * Parameters.....: * Return type....: * Changes........: * ==================================================================== *-- Resize WebBrowser object to fill form ThisForm.oleWebBrowser.height = this.height - 44 ThisForm.oleWebBrowser.width = this.width *-- Move and change width of statusbar *-- Note: StatusBar control is NOT aligned @ bottom of form, *-- since progressBar disappears behind it *!* ThisForm.oleStatusBar.top = this.height - ThisForm.oleStatusBar.height *!* ThisForm.oleStatusBar.width = this.width - ThisForm.oleProgressBar.width *-- Place progressbar next to statusBar at bottom *!* ThisForm.oleProgressBar.top = this.height - ThisForm.oleProgressBar.height *!* ThisForm.oleProgressBar.left = This.width - ThisForm.oleProgressBar.width ENDPROC PROCEDURE setbold * ==================================================================== * SetBold * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: Turn Bold on or off * ...............: * Parameters.....: tlOn - OPTIONAL - Switch to turn on or off * Return type....: * Changes........: * ==================================================================== lparameters tlOn thisform.lReportBold = tlOn ENDPROC PROCEDURE setcolumnheads * ==================================================================== * SetColumnHeads Method * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 10 March 2000 * -------------------------------------------------------------------- * Description....: Apply column heads to current table * Parameters.....: tcCSVColumnHeads - column heads * Return type....: -- * Changes........: * ==================================================================== lparameters tcCSVColumnHeads local lnColumnNumber, lnCommaAt, lcColumn, lcRest lnColumnNumber = 0 *-- Separate out parameter tcCSVColumnHeads = tcCSVColumnHeads + "," do while "," $ tcCSVColumnHeads ; and lnColumnNumber < thisform.anReportTableColumns(thisform.nReportInTable) lnColumnNumber = lnColumnNumber + 1 lnCommaAt = at(",", tcCSVColumnHeads ) lcColumn = left(tcCSVColumnHeads , lnCommaAt - 1) tcCSVColumnHeads = substr(tcCSVColumnHeads , lnCommaAt + 1) thisform.acReportTableColumnHeads(lnColumnNumber) = lcColumn enddo ENDPROC PROCEDURE setcolumnmask * ==================================================================== * setColumnMask Method * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 10 March 2000 * -------------------------------------------------------------------- * Description....: Apply mask to column(s) of table * Parameters.....: tnColumn - column to set; 0 = all * ...............: tcMask - TRANSFORM-style Mask * Return type....: -- * Changes........: * ==================================================================== lparameters tnColumn, tcMask *-- If column is 0, apply to all columns *-- Otherwise apply to specified column local i if tnColumn = 0 for i = 1 to thisform.anReportTableColumns(thisform.nReportInTable ) thisform.acReportTableColumnMasks(; thisform.nReportInTable, i) = tcMask endfor else thisform.acReportTableColumnMasks(; thisform.nReportInTable, tnColumn) = tcMask endif ENDPROC PROCEDURE setcolumnsum * ==================================================================== * SetColumnSum Method * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 10 March 2000 * -------------------------------------------------------------------- * Description....: Set whether certain columns are summed * Parameters.....: tcCSVBooleans - Format "boolean[,boolean[,..." * Return type....: -- * Changes........: * ==================================================================== lparameters tcCSVBooleans local lnColumnNumber, lnCommaAt, lcColumn, lcRest lnColumnNumber = 0 *-- Separate out parameter tcCSVBooleans = tcCSVBooleans + "," do while "," $ tcCSVBooleans ; and lnColumnNumber < thisform.anReportTableColumns(thisform.nReportInTable) lnColumnNumber = lnColumnNumber + 1 lnCommaAt = at(",", tcCSVBooleans ) lcColumn = left(tcCSVBooleans , lnCommaAt - 1) tcCSVBooleans = substr(tcCSVBooleans , lnCommaAt + 1) thisform.alReportTableColumnSum(lnColumnNumber) = eval(lcColumn) enddo ENDPROC PROCEDURE setcolumnwidth * ==================================================================== * setColumnWidth Method * -------------------------------------------------------------------- * Author.........: Marius Mutu * Project........: WebBrowser-based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 25 Mai 2000 * -------------------------------------------------------------------- * Description....: Apply widths to column(s) of table * Parameters.....: tnColumn - column to set; 0 = all * ...............: tcWidth - TRANSFORM-style Width * Return type....: -- * Changes........: * ==================================================================== lparameters tnColumn, tcWidth *-- If column is 0, apply to all columns *-- Otherwise apply to specified column local i if tnColumn = 0 for i = 1 to thisform.anReportTableColumns(thisform.nReportInTable ) thisform.acReportTableColumnWidths(thisform.nReportInTable, i) = tcWidth endfor else thisform.acReportTableColumnWidths(thisform.nReportInTable, tnColumn) = tcWidth endif ENDPROC PROCEDURE setfontcolor && set HTML font color * ==================================================================== * SetFontColor * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: Sets the font Color and writes it to body * Parameters.....: tcFontColor - OPTIONAL - name of font Color * ...............: (if empty, sets to default) * Return type....: * Changes........: * ==================================================================== lparameters tcFontColor *-- If it hasn't changed from the default value, *-- save the default value for future use if PEMSTATUS(this, "cReportFontColor", 0) = .f. thisform.aReportFontDefaults(3) = thisform.cReportFontColor endif *-- If no value was passed, use default value *-- Otherwise Save passed Color if pcount() = 0 thisform.cReportFontColor = thisform.aReportFontDefaults(3) else thisform.cReportFontColor = tcFontColor endif *-- Write font tag thisform.writeFont ENDPROC PROCEDURE setfontface && Set the HTML font face * ==================================================================== * SetFontFace * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: Sets the font Face and writes it to body * Parameters.....: tcFontFace - OPTIONAL - name of font Face * ...............: (if empty, sets to default) * Return type....: * Changes........: * ==================================================================== lparameters tcFontFace *-- If it hasn't changed from the default value, *-- save the default value for future use if PEMSTATUS(this, "cReportFontFace", 0) = .f. thisform.aReportFontDefaults(1) = thisform.cReportFontFace endif *-- If no value was passed, use default value *-- Otherwise Save passed Face if pcount() = 0 thisform.cReportFontFace = thisform.aReportFontDefaults(1) else thisform.cReportFontFace = tcFontFace endif *-- Write font tag thisform.writeFont ENDPROC PROCEDURE setfontsize && Set HTML font size * ==================================================================== * SetFontSize * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: Sets the font size and writes it to body * Parameters.....: tnFontSize - OPTIONAL - font size 1 (lg) - 6 (sm) * ...............: (if empty, sets to default) * Return type....: * Changes........: * ==================================================================== lparameters tnFontSize *-- If it hasn't changed from the default value, *-- save the default value for future use if PEMSTATUS(this, "nReportFontSize", 0) = .f. thisform.aReportFontDefaults(2) = thisform.nReportFontSize endif *-- If no value was passed, use default value *-- Otherwise Save passed Size if pcount() = 0 thisform.nReportFontSize = thisform.aReportFontDefaults(2) else thisform.nReportFontSize = tcFontSize endif *-- Write font tag thisform.writeFont ENDPROC PROCEDURE setitalic * ==================================================================== * SetItalic * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: Turn Italic on or off * ...............: * Parameters.....: tlOn - OPTIONAL - Switch to turn on or off * Return type....: * Changes........: * ==================================================================== lparameters tlOn thisform.lReportItalic = tlOn ENDPROC PROCEDURE setnumericmask * ==================================================================== * stNumericMask * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based ReportViewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: Mask used for numbers passed directly to Write * Parameters.....: tcMask * Return type....: * Changes........: * ==================================================================== lparam tcMask *-- default if empty(tcMask) tcMask = "999,999,999,999.99" endif thisform.cNumericMask = tcMask ENDPROC PROCEDURE setreportmargin && Set margins for the document: T, B,. L, R * ==================================================================== * SetReportMargin * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser_based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: Set report margin * Parameters.....: tcWhichMargin - Which margin to set: L, R, T, B * ...............: tnValue1 - Value to set margin to * ...............: tnValue2 - OPTIONAL ) If more than one value is * ...............: tnValue3 - OPTIONAL ) passed, user is setting * ...............: tnValue4 - OPTIONAL ) all margins (1st param ign.) * Return type....: * Changes........: * ==================================================================== lparameters tcWhichMargin , tnValue1, tnValue2, tnValue3, tnValue4 *-- If extra parameters passed, set all margins if pcount() > 2 if pcount() = 5 thisform.nReportBMargin = tnValue4 endif if pcount() >= 4 thisform.nReportTMargin = tnValue3 endif if pcount() >= 3 thisform.nReportRMargin = tnValue2 endif if pcount() >= 2 thisform.nReportLMargin = tnValue1 endif else *-- Set the margin specified local lcPropertyName tcWhichMargin = upper(left(tcWhichMargin, 1)) *-- Make sure it's a valid property if tcWhichMargin $ "LRTB" lcPropertyName = "nReport" + tcWhichMargin + "Margin" thisform.&lcPropertyName. = tnValue1 endi endif ENDPROC PROCEDURE setreportwidth && set width of report and window * ==================================================================== * SetReportWidth * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser_based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: Set report width and window size also * ...............: * Parameters.....: tnWidth - width in pixels * Return type....: * Changes........: * ==================================================================== lparameters tnWidth *-- Save value in form prop thisform.nReportWidth = tnWidth *-- Change size of window to match *-- (including width of form edge and report margin) if thisform.WindowState = 0 && Normal thisform.width = thisform.nReportWidth + 25; + thisform.nReportLMargin ; + thisform.nReportRMargin endif ENDPROC PROCEDURE setunderline * ==================================================================== * SetUnderline * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: Turn Underline on or off * ...............: * Parameters.....: tlOn - OPTIONAL - Switch to turn on or off * Return type....: * Changes........: * ==================================================================== lparameters tlOn thisform.lReportUnderline = tlOn ENDPROC PROTECTED PROCEDURE storeerrorcode && Method to store the error handler in use by the program calling Report Viewer * ==================================================================== * Store ErrorCode (private) * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: Stores the current ON ERROR code from the calling * ...............: program so that it can be reasserted when this * ...............: form is deactivated or destroyed * Parameters.....: None * Return type....: None * Changes........: * ==================================================================== local lcFile, lnFile, lcOnErrorCode, lcLine *-- Set aside a variable in which to store the current ON ERROR code lcOnErrorCode = "" *-- The only way I know to get the current ON ERROR code is *-- from LIST STATUS. Consequently we need to LIST STATUS to file *-- and analyze the file *-- If there is no ON ERROR, lcOnErrorCode will remain blank lcFile = "STATUS" + sys(2015) + ".TXT" list status to file (lcFile) noconsole *-- Open the file lnFile = fopen(lcFile) if lnFile # -1 *-- Step through the file line by line do while !feof(lnFile) *-- Get next line file file lcLine = fgets(lnFile) *-- If it's the on error line, store the rest in *-- the variable and exit loop if left(lcLine , 9) = "On Error:" lcOnErrorCode = substr(lcLine, 10) exit endif enddo && File read loop endif && File opened successfully *-- Close the file =fclose(lnFile) *-- Store error code as class property for use in other methods thisform.cOnErrorCode = lcOnErrorCode *-- Delete the file that was created by LIST STATUS if file (lcFile) delete file (lcFile) endif ENDPROC PROTECTED PROCEDURE switcherrorcode * ==================================================================== * SwitchErrorCode Method (private) * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: Toggles between the error handler used by the * ...............: program that called this class, and the handler * ...............: used by Report Viewer. Necessary because of the * ...............: OLE error generated by canceling the Print dialog * ...............: that's called from ExecWB * Parameters.....: tlSwitch - .t. means use this class's handler * Return type....: -- * Changes........: * ==================================================================== lparameters tlSwitch *-- If tlSwitch is true, use the class's error handler *-- Else, use the error handler used by the external program *-- *-- This switch occurs on thisform.activate and .deactivate *-- *-- External ON ERROR code is stored during StoreErrorCode method if tlSwitch *-- Pass error code to error handler method *-- Use the reference to the variable assigned to this object *-- passed to Init and stored in thisform.cGlobalVariableName local lcMacro lcMacro = "on error " + thisform.cGlobalVariableName + ".errorHandler(error())" &lcMacro else *-- Store external error handler in local variable local lcErrorCode lcErrorCode = thisform.cOnErrorCode *-- Set error handler to external code on error &lcErrorCode endif ENDPROC PROCEDURE write * ==================================================================== * Write * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser_based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: Adds a new lines to the array containing the * ...............: body copy of the Report * Parameters.....: tcText - the text to write * ...............: tcAlign - OPTIONAL - "left", "center", "right" * ...............: tlSkipSurroundTags - OPTIONAL - Suppress list, * ...............: table tags * Return type....: * Changes........: * ==================================================================== lparameters teText, tlSkipSurroundTags, tcAlign local lnInstance, lcFontString, lcTextToWrite, lcMask *-- Account for numbers and other data being passed local lcText lcText = "" do case case vartype(teText) = "C" lcText = teText case vartype(teText) = "N" *-- Get the mask to use *-- If regular test, use current setting for mask *-- If in a table, use column-specific mask if thisform.nReportInTable = 0 lcMask = thisform.cNumericMask else lcMask = thisform.acReportTableColumnMasks(; thisform.nReportInTable, ; thisform.nReportTableCurrentColumn ) endif lcText = ltrim( transform(teText, lcMask)) if empty(tcAlign) tcAlign = "right" endif case vartype(teText) = "L" lcText = iif(teText, "True", "False") endcase *!* if thisform.nReportInTable = 0 *!* lcWidth="" *!* else *!* lcWidth = thisform.acReportTableColumnWidths(thisform.nReportInTable,thisform.nReportTableCurrentColumn ) *!* endif lcWidth="" lcFontString = "" lcTextToWrite = lcText if not tlSkipSurroundTags *-- If bold is on, make bold (etc.) if thisform.lReportBold lcTextToWrite = "" + lcTextToWrite + "" endif if thisform.lReportItalic lcTextToWrite = "" + lcTextToWrite + "" endif if thisform.lReportUnderline lcTextToWrite = "" + lcTextToWrite + "" endif *-- If we are in the middle of writing a list, add list tags if thisform.nReportInList > 0 lcTextToWrite = "
  • " + lcTextToWrite + "
    • " else *-- Use alignment if it was passed local lcAlign lcAlign = "left" if not empty(tcAlign) lcAlign = tcAlign endi lcTextToWrite = "

    " + lcTextToWrite + "

    " endi *-- If we are in the middle of writing a table, add cell tags if thisform.nReportInTable > 0 *-- Increment the counter reflecting current column thisform.nReportTableCurrentColumn = thisform.nReportTableCurrentColumn + 1 *-- Add cell tag lcTextToWrite = [" + lcFontString + lcTextToWrite + "    " *-- If it's the first column, add row tag if thisform.nReportTableCurrentColumn =1 lcTextToWrite = "" +CHR(13)+CHR(10)+ lcTextToWrite endif *-- If it's the last column, add close row tag and reset counter if thisform.nReportTableCurrentColumn ; = thisform.anReportTableColumns(thisform.nReportInTable ) lcTextToWrite = lcTextToWrite + CHR(13)+CHR(10)+"" thisform.nReportTableCurrentColumn = 0 endif endif endif *-- Place text in last line of array lnInstance = alen(thisform.acLines, 1) thisform.acLines[lnInstance] = lcTextToWrite *-- Redimension array to next line dimension thisform.acLines[lnInstance + 1] *-- Write empty string to it so it can be added to text file thisform.acLines[lnInstance + 1] = "" ENDPROC PROCEDURE writefont && Write font characteristcs * ==================================================================== * WriteFont * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 Feb 2000 * -------------------------------------------------------------------- * Description....: Write font characteristics * ...............: * Parameters.....: * Return type....: * Changes........: * ==================================================================== *-- Compile font string lcFontString = ""; + "" thisform.write(lcFontString, .t., "") ENDPROC PROCEDURE cmdBack.Click * ==================================================================== * cmdBack.click * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: Go back to last page in history list. This button * ...............: enabled/disabled by CommandStateChange * Parameters.....: * Return type....: * Changes........: * ==================================================================== ThisForm.oleWebBrowser.goBack ENDPROC PROCEDURE cmdCopy.Click * ==================================================================== * cmdCopy.click * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: Copy selected text in web doc to clipboard * ...............: * Parameters.....: * Return type....: * Changes........: * ==================================================================== ThisForm.oleWebBrowser.execWB ( 12, 0) && Copy do default ENDPROC PROCEDURE cmdForward.Click * ==================================================================== * cmdForward.click * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: Go no next item in history. This button enabled/ * ...............: disabled by CommandStateChange * Parameters.....: * Return type....: * Changes........: * ==================================================================== ThisForm.oleWebBrowser.goForward ENDPROC PROCEDURE cmdOpen.Click * ==================================================================== * cmdOpen.Click * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: Since the ExecWB Open command seems not to work, * ...............: ask for and navigate to a file (not a URL) * Parameters.....: * Return type....: * Changes........: * ==================================================================== *-- Ask for a file to open gcFile = getfile('HTML pages:HTM,HTML;Text files:TXT,BAK', 'Browse for an HTM file:', 'Browse', 0,; 'Open File') *-- Evaluate response do case case empty(gcFile ) *-- User canceled return otherwise *-- Go to file specified thisform.oleWebBrowser.navigate(gcFile ) endcase ENDPROC PROCEDURE cmdPrint.Click * ==================================================================== * cmdPrint.click * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: Print document using ExecWB method (note: this * ...............: procedure generates an OLE error if the user * ...............: cancels the Printr dialog) * Parameters.....: * Return type....: * Changes........: * ==================================================================== ThisForm.oleWebBrowser.execWB ( 6, 0) && Print, do default ENDPROC PROCEDURE cmdProperties.Click * ==================================================================== * cmdProperties.click * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: Show properties window for web doc * ...............: * Parameters.....: * Return type....: * Changes........: * ==================================================================== ThisForm.oleWebBrowser.execWB ( 10, 0) && Properties, do default ENDPROC PROCEDURE cmdSave.Click * ==================================================================== * cmdSave.click * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: Allows user to save document locally for future * ...............: reference * Parameters.....: * Return type....: * Changes........: * ==================================================================== cMessageText = "MessageText" cMessageSubj = "Test Mail with OLE Messaging" SESSION=CREATEOBJECT('mapi.session') && Create the MAPI object. SESSION.LOGON && Logon to mail; With exchange it NEW=SESSION.OUTBOX.MESSAGES.ADD && Create a new message. WITH NEW .SUBJECT = cMessageSubj && Add a message subject. .TEXT= cMessageText *-- objAttach = .Attachments.Add WITH objAttach .Type = 1 && CdoFileData .Position = 0 .Name = "C:\WebReporter\NNwilso1.BMP" .ReadFromFile( "C:\WebReporter\NNwilso1.BMP" ) ENDWITH objAttach.Name = "NNwilso1.BMP" ENDWITH SENDTO=NEW.RECIPIENTS.ADD && Add a recipient object SENDTO.NAME="mbw@rocketship.com" && Email address to mail message to SENDTO.TYPE=1 && 1= "TO:"; 2="CC:"; 3="BCC:" SENDTO.RESOLVE && Looks up address in addressbook. NEW.UPDATE && Required to save changes to a message object. NEW.SEND(1,0,0) && Parameter 1 = save copy in "Sent Mail" folder. SESSION.LOGOFF && Release the MAPI object. *====End of OLE Messaging Program. ENDPROC PROCEDURE Command1.Click * ==================================================================== * cmdSave.click * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: Allows user to save document locally for future * ...............: reference * Parameters.....: * Return type....: * Changes........: * ==================================================================== ThisForm.oleWebBrowser.execWB ( 4, 1) && Save As.., prompt user ENDPROC PROCEDURE oleWebBrowser.CommandStateChange * ==================================================================== * WebBrowser.CommandStateChange * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: Enable/disable forward and back buttons using * ...............: method inherited from ActiveX control * Parameters.....: command - number indicating what status changed * ...............: enable - boolean reflecting button status * Return type....: none * Changes........: * ==================================================================== *** ActiveX Control Event *** LPARAMETERS command, enable do case case command=1 *-- Status of browser's forward button changed ThisForm.cmdForward.enabled= enable case command=2 *-- Status of browser's back button changed ThisForm.cmdBack.enabled= enable endc ENDPROC PROCEDURE oleWebBrowser.DownloadBegin * ==================================================================== * WebBrowser.DownloadBegin * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: Indicate on statusbar when downloading begins * ...............: * Parameters.....: * Return type....: * Changes........: * ==================================================================== *** ActiveX Control Event *** ThisForm.oleStatusBar.panels(1).text = "Downloading..." ENDPROC PROCEDURE oleWebBrowser.DownloadComplete * ==================================================================== * WebBrowser.DownloadComplete * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: Indicate on statusbar when downloading is complete * ...............: * Parameters.....: * Return type....: * Changes........: * ==================================================================== *** ActiveX Control Event *** ThisForm.oleStatusBar.panels(1).text = "Download complete." ENDPROC PROCEDURE oleWebBrowser.ProgressChange * ==================================================================== * WebBrowser.ProgressChange * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: Display progress bar and status as docuiment loads * Parameters.....: progress - number from -1 (done) to progressmax * ...............: progressmax - number of bytes to be downloaded * Return type....: none * Changes........: * ==================================================================== *** ActiveX Control Event *** lparameters progress, progressmax *-- Variable to pass to progressbar local lnValue do case case progress = -1 or progress = 0 or progressmax = 0 *-- Data are downloaded or there were no data lnValue = 0 thisform.oleStatusBar.panels(1).text = "Download complete." otherw *-- Prepare to show progress on ProgressBar lnValue = 100*progress/progressmax *-- Also show percent downloaded thisform.oleStatusBar.panels(1).text = "Downloading... " ; + trans(round(lnValue,0), "999%") + " complete." endc *-- Show value on progressBar (range is 0 to 100) thisform.oleProgressBar.value = lnValue ENDPROC PROCEDURE oleWebBrowser.TitleChange * ==================================================================== * MODULE * -------------------------------------------------------------------- * Author.........: Mark Wilson * Project........: WebBrowser-Based Report Viewer * Notice.........: (c) 2000 First Manhattan Consulting Group * Date...........: 23 February 2000 * -------------------------------------------------------------------- * Description....: When title of web doc changes, reflect it in * ...............: ther caption for the form * Parameters.....: text - string representing title * Return type....: * Changes........: * ==================================================================== *** ActiveX Control Event *** LPARAMETERS text Thisform.caption = thisform.cBaseTitle + " - " + text ENDPROC ENDDEFINE