/* * Written by Scott Auge scott_auge@yahoo.com sauge@amduus.com * Copyright (c) 2004 Amduus Information Works, Inc. www.amduus.com * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by Amduus Information Works * Inc. and its contributors. * 4. Neither the name of Amduus Information Works, Inc. nor the names of * its contributors may be used to endorse or promote products derived * from this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY AMDUUS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AMDUUS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * */ &IF DEFINED(PDFHELP_I) = 0 &THEN &GLOBAL-DEFINE PDFHELP_I YEP DEF VAR PDF_HELP_I_RCSVersion AS CHARACTER INIT "$Header: /home/sauge/code/progress/PDF/RCS/pdf_help.i,v 1.5 2004/07/18 00:53:30 sauge Exp sauge $" NO-UNDO. &ENDIF /************************************************************************/ /* Set of routines to ease the creation of table oriented data. */ /************************************************************************/ DEF TEMP-TABLE ttBuildTable FIELD Row AS INTEGER FIELD Type AS CHARACTER FIELD Name AS CHARACTER FIELD Data AS CHARACTER INDEX key1 Row ASCENDING. /************************************************************************/ /* We basically slap down a colored rectangles and then put the text on */ /* on top of it. This is rough and dirty, but optimize on next pass. */ /************************************************************************/ PROCEDURE TblBuild: DEF INPUT PARAMETER cStreamName AS CHARACTER NO-UNDO. DEF INPUT PARAMETER hHndl AS HANDLE. DEF VAR iCurrentX AS INTEGER NO-UNDO. DEF VAR iCurrentY AS INTEGER NO-UNDO. DEF VAR iStartX AS INTEGER NO-UNDO. DEF VAR iStartY AS INTEGER NO-UNDO. DEF VAR cCurValue AS CHARACTER NO-UNDO. DEF VAR iCurColumn AS INTEGER NO-UNDO. DEF VAR iCurRow AS INTEGER NO-UNDO. DEF VAR iNumColumn AS INTEGER NO-UNDO. DEF VAR cDelimiter AS CHARACTER NO-UNDO. DEF VAR cHeaderFont AS CHARACTER NO-UNDO. DEF VAR iHeaderPt AS INTEGER NO-UNDO. DEF VAR cDataFont AS CHARACTER NO-UNDO. DEF VAR iDataPt AS INTEGER NO-UNDO. DEF VAR iHeight AS INTEGER NO-UNDO. DEF VAR iDataWidth AS INTEGER NO-UNDO. DEF VAR iCurWidth AS INTEGER NO-UNDO. DEF BUFFER ttDataBuildTable FOR ttBuildTable. /* Figure out our delimiter for columns */ /* Transfer settings to variables. */ ASSIGN cDelimiter = TblGetSetting("DELIM") iStartX = INT(TblGetSetting("STARTX")) iStartY = INT(TblGetSetting("STARTY")) cHeaderFont = ENTRY(1, TblGetSetting("HEADFONT"), cDelimiter) iHeaderPt = INT(ENTRY(2, TblGetSetting("HEADFONT"), cDelimiter)) cDataFont = ENTRY(1, TblGetSetting("DATAFONT"), cDelimiter) iDataPt = INT(ENTRY(2, TblGetSetting("DATAFONT"), cDelimiter)) iHeight = INT(TblGetSetting("HEIGHT")). /* Determine the number of columns */ FIND FIRST ttBuildTable WHERE ttBuildTable.Type = "DATA" NO-ERROR. IF NOT AVAILABLE ttBuildTable THEN LEAVE. ASSIGN iNumColumn = NUM-ENTRIES(ttBuildTable.Data, cDelimiter). /* Determine the widest peice of data for each column to set */ /* the column size automatically. */ /* Compute out width of columns by finding MAX pdf_text_width() */ /* Since different fonts can cause different sizes, we need to */ /* set the font the text will render in to get the right pt */ /* size. */ ASSIGN iCurRow = 1. FOR EACH ttDataBuildTable WHERE ttDataBuildTable.Type = "DATA": /* On the first row, this is actually the header, so set header stuff */ IF iCurRow = 1 THEN RUN pdf_set_font IN hHndl (cStreamName, cHeaderFont, iHeaderPt). ELSE IF iCurRow = 2 THEN RUN pdf_set_font IN hHndl (cStreamName, cDataFont, iDataPt). DO iCurColumn = 1 TO iNumColumn: ASSIGN iCurWidth = INT(TblGetSetting("COL" + STRING(iCurColumn))). IF iCurWidth = ? THEN ASSIGN iCurWidth = 0. /* The largest string rubs against the next border, so we add a blank space */ /* to aid with readability. */ ASSIGN cCurValue = ENTRY(iCurColumn, ttDataBuildTable.Data, cDelimiter) + " ". ASSIGN iDataWidth = pdf_text_width(cStreamName, cCurValue). IF iDataWidth > iCurWidth THEN RUN TblAddSetting("COL" + STRING(iCurColumn), STRING(iDataWidth + 5)). END. /* DO */ /* Seems we never get the last DO loop in. Force it here. */ IF iDataWidth > iCurWidth THEN RUN TblAddSetting("COL" + STRING(iCurColumn), STRING(iDataWidth + 5)). /* Count our rows for light or dark determination */ ASSIGN iCurRow = iCurRow + 1. END. /* FOR EACH ttDataBuildTable */ /* First we need to slap down the rectangles and lines needed */ /* for the table. Text needs to go on top of these else they */ /* are written out. Have the setting BORDERS set to YES for */ /* borders to be shown. */ IF TblGetSetting("BORDER") = "YES" THEN DO: ASSIGN iCurrentY = iStartY - 2. ASSIGN iCurRow = 1. FOR EACH ttDataBuildTable WHERE ttDataBuildTable.Type = "DATA": /* Row one is always considered the header */ IF iCurRow = 1 THEN DO: ASSIGN cCurValue = TblGetSetting("HEADCLR"). RUN pdf_stroke_fill IN hHndl (cStreamName, DECIMAL(ENTRY(1,cCurValue, cDelimiter)), DECIMAL(ENTRY(2,cCurValue, cDelimiter)), DECIMAL(ENTRY(3,cCurValue, cDelimiter))). END. /* IF iCurRow = 1 */ /* Figure out what color this row should be for "green barring" the data */ ELSE IF iCurRow > 1 THEN DO: /* Even rows are light and modulus to zero */ IF iCurRow MOD 2 = 0 THEN DO: ASSIGN cCurValue = TblGetSetting("LGHTCLR"). RUN pdf_stroke_fill IN hHndl (cStreamName, DECIMAL(ENTRY(1,cCurValue, cDelimiter)), DECIMAL(ENTRY(2,cCurValue, cDelimiter)), DECIMAL(ENTRY(3,cCurValue, cDelimiter))). END. /* Odd rows are dark and modulus to one */ ELSE DO: ASSIGN cCurValue = TblGetSetting("DARKCLR"). RUN pdf_stroke_fill IN hHndl (cStreamName, DECIMAL(ENTRY(1,cCurValue, cDelimiter)), DECIMAL(ENTRY(2,cCurValue, cDelimiter)), DECIMAL(ENTRY(3,cCurValue, cDelimiter))). END. END. /* ELSE IF iCurRow > 1 */ /* Draw the rectangles to hold the data in */ ASSIGN iCurrentX = iStartX - 2. ASSIGN iCurColumn = 1. DO iCurColumn = 1 TO iNumColumn: RUN pdf_rect IN hHndl (cStreamName, iCurrentX, iCurrentY, INT(TblGetSetting("COL" + STRING(iCurColumn))), iHeight, /* WARNING: 14 PTS MAX FONT */ 1). ASSIGN iCurrentX = iCurrentX + INT(TblGetSetting("COL" + STRING(iCurColumn))). END. /* DO */ /* Prep for next round */ ASSIGN iCurrentX = iStartX iCurrentY = iCurrentY - iHeight iCurRow = iCurRow + 1. END. /* FOR EACH ttDataBuildTable */ END. /* IF TblGetSetting("BORDER") */ /* Start pumping out data */ ASSIGN iCurRow = 1. ASSIGN iCurrentY = iStartY. FOR EACH ttDataBuildTable WHERE ttDataBuildTable.Type = "DATA": /* On the first row, this is actually the header, so set header stuff */ IF iCurRow = 1 THEN DO: RUN pdf_set_font IN hHndl (cStreamName, cHeaderFont, iHeaderPt). END. /* If we are on the second row, we want to set the data font. */ IF iCurRow = 2 THEN DO: RUN pdf_set_font IN hHndl (cStreamName, cDataFont, iHeaderPt). END. ASSIGN iCurrentX = iStartX. ASSIGN iCurColumn = 1. DO iCurColumn = 1 TO iNumColumn: ASSIGN cCurValue = ENTRY(iCurColumn, ttDataBuildTable.Data, cDelimiter). RUN pdf_text_xy IN hHndl (cStreamName, cCurValue, iCurrentX, iCurrentY). ASSIGN iCurrentX = iCurrentX + INT(TblGetSetting("COL" + STRING(iCurColumn))). END. /* DO */ RUN pdf_skip IN hHndl (cStreamName). ASSIGN iCurrentX = iStartX iCurrentY = iCurrentY - iHeight iCurRow = iCurRow + 1. END. /* FOR EACH ttBuildTable */ END. /* PROCEDURE BuildTable */ /************************************************************************/ /* Some useful defaults for a table. Override with TblAddSetting. */ /* Called automatically by TblClear. */ /************************************************************************/ PROCEDURE TblDefault: RUN TblAddSetting ("DELIM", "|"). RUN TblAddSetting ("HEIGHT", "14"). RUN TblAddSetting ("HEADCLR", "0.8|0.8|0.8"). RUN TblAddSetting ("LGHTCLR", "1.0|1.0|1.0"). RUN TblAddSetting ("DARKCLR", "0.9|0.9|0.9"). RUN TblAddSetting ("LGHTLET", "0.0|0.0|0.0"). /* Not Implemented */ RUN TblAddSetting ("DARKLET", "0.0|0.0|0.0"). /* Not Implemented */ RUN TblAddSetting ("HEADFONT", "Times-Bold|12"). RUN TblAddSetting ("DATAFONT", "Times-Roman|12"). END. /* PROCEDURE TblDefault */ /************************************************************************/ /* DELIM - Delimiter to use between data columns */ /* COLn - Width in points of Column n */ /* STARTX - Top X point of table (works downward) */ /* STARTY - Top Y point of table (works downward) */ /* HEIGHT - Height of the cells */ /* HEADCLR - Color for table heading */ /* LGHTCLR - Color for light row entries */ /* DARKCLR - Color for dark row entries */ /* LGHTLET - Color for letters in light row entries */ /* DARKLET - Color for letters in dark row entries */ /* ALIGN - DELIM list of CENTER:LEFT:RIGHT for each column for each */ /* column to state alignment. */ /************************************************************************/ PROCEDURE TblAddSetting: DEF INPUT PARAMETER cName AS CHARACTER NO-UNDO. DEF INPUT PARAMETER cValue AS CHARACTER NO-UNDO. /* Allow rewriting or creation of a setting */ FIND ttBuildTable EXCLUSIVE-LOCK WHERE ttBuildTable.Type = "SETTING" AND ttBuildTable.Name = cName NO-ERROR. IF NOT AVAILABLE ttBuildTable THEN CREATE ttBuildTable. ASSIGN ttBuildTable.Type = "SETTING" ttBuildTable.Name = cName ttBuildTable.Data = cValue ttBuildtable.Row = 0. END. /* PROCEDURE AddSetting */ /************************************************************************/ /* Convenient way to pull back setting information. */ /************************************************************************/ FUNCTION TblGetSetting RETURNS CHARACTER (INPUT cName AS CHARACTER): DEF BUFFER bttBuildTable FOR ttBuildTable. FIND bttBuildTable WHERE bttBuildTable.Type = "SETTING" AND bttBuildTable.Name = cName NO-ERROR. IF AVAILABLE bttBuildTable THEN RETURN bttBuildTable.Data. ELSE RETURN ?. END. /* FUNCTION TblGetSetting */ /************************************************************************/ /* Rows are shown in order of entry. */ /************************************************************************/ PROCEDURE TblAddRow: DEF INPUT PARAMETER cData AS CHARACTER NO-UNDO. DEF VAR iIter AS INTEGER NO-UNDO. FIND LAST ttBuildTable NO-LOCK USE-INDEX key1. IF AVAILABLE ttBuildTable THEN ASSIGN iIter = ttBuildTable.Row. ELSE iIter = 0. ASSIGN iIter = iIter + 1. CREATE ttBuildTable. ASSIGN ttBuildTable.Type = "DATA" ttBuildTable.Row = iIter ttBuildTable.Name = "" ttBuildTable.Data = cData. END. /* PROCEDURE AddRow */ /************************************************************************/ /* Clear out the table used to create the PDF table. */ /* Since it sets defaults, it should be the first routine called when */ /* creating a table on the PDF. */ /************************************************************************/ PROCEDURE TblClear: FOR EACH ttBuildTable: DELETE ttBuildTable. END. RUN TblDefault. END. /* PROCEDURE TblClear */