/* TODO: */ &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/lt2krpt/RCS/pdf_help.i,v 1.7 2004/07/23 17:37:43 sauge Exp sauge $" NO-UNDO. &ENDIF /************************************************************************/ /* Set of routines to ease the creation of table oriented data. */ /************************************************************************/ DEF TEMP-TABLE ttBuildTable FIELD TblName AS CHARACTER /* A way to differentiate between tables */ 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 VAR cTableHeader AS CHARACTER NO-UNDO. DEF BUFFER ttDataBuildTable FOR ttBuildTable. DEF BUFFER ttColumnHeader 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")) cTableHeader = TblGetSetting("HEADER"). /************************ BEGIN AUTO WIDTH CALCULATING *****************/ /* Determine the number of columns in the table by the first data */ /* encountered. We don't use the header, because we can have a */ /* a table with no headers. */ FIND ttDataBuildTable NO-LOCK WHERE ttDataBuildTable.Type = "DATA" AND ttDataBuildTable.Row = 1 NO-ERROR. ASSIGN iNumColumn = NUM-ENTRIES(ttDataBuildTable.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. We use the header font because we assume that the */ /* header is the thickest font used. */ IF cTableHeader <> "" THEN DO: RUN pdf_set_font IN hHndl (cStreamName, cHeaderFont, iHeaderPt). DO iCurColumn = 1 TO iNumColumn: /* The largest string rubs against the next border, so we add a blank space */ /* to aid with readability. */ ASSIGN cCurValue = ENTRY(iCurColumn, cTableHeader, cDelimiter) + " ". ASSIGN iDataWidth = pdf_text_width(cStreamName, cCurValue). RUN TblAddSetting("COL" + STRING(iCurColumn), STRING(iDataWidth + 5)). END. /* DO */ /* Some weird mojo here where last column needs to be outside the do */ RUN TblAddSetting("COL" + STRING(iCurColumn), STRING(iDataWidth + 5)). END. /* IF cTableHeader <> "" */ /* Here we are doing the data to try and find the largest data */ /* TODO: We need to substring long strings to long length */ RUN pdf_set_font IN hHndl (cStreamName, cDataFont, iDataPt). FOR EACH ttDataBuildTable WHERE ttDataBuildTable.Type = "DATA": 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 */ END. /* FOR EACH ttDataBuildTable */ /*************************** END AUTO WIDTH CALCULATION *********************/ /******************************* BEGIN TABLE RENDERING **********************/ /* Start rendering the table */ ASSIGN iCurrentY = iStartY - 2. ASSIGN iCurRow = 1. FOR EACH ttDataBuildTable WHERE ttDataBuildTable.Type = "DATA": /* 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. */ /******************** BEGIN HEADER ************************************/ /* Row one is always considered the header */ IF iCurRow = 1 AND cTableHeader <> "" THEN DO: RUN pdf_set_font IN hHndl (cStreamName, cHeaderFont, iHeaderPt). IF TblGetSetting("BORDER") = "YES" THEN DO: /* Draw the rectangles to hold the data in */ 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))). 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 */ END. /* IF Border = YES */ /* Slap out the header text onto these new rectangles */ ASSIGN iCurrentX = iStartX. ASSIGN iCurColumn = 1. DO iCurColumn = 1 TO iNumColumn: cCurValue = ENTRY(iCurColumn, cTableHeader, cDelimiter). RUN pdf_text_xy IN hHndl (cStreamName, cCurValue, iCurrentX, iCurrentY + 3). ASSIGN iCurrentX = iCurrentX + INT(TblGetSetting("COL" + STRING(iCurColumn))). END. /* DO */ RUN pdf_skip IN hHndl (cStreamName). /* Increment our graphical cursor */ ASSIGN iCurrentX = iStartX iCurrentY = iCurrentY - iHeight. /* Set the font to the data font for data rows coming here after */ RUN pdf_set_font IN hHndl (cStreamName, cDataFont, iHeaderPt). END. /* IF iCurRow = 1 */ /* If we have no header, then the above if block does not fire. We */ /* still need this font set even if we are not putting out headers. */ ELSE RUN pdf_set_font IN hHndl (cStreamName, cDataFont, iHeaderPt). /******************** END HEADER ************************************/ /******************** BEGIN DATA ************************************/ IF TblGetSetting("BORDER") = "YES" THEN DO: /* Figure out what color this row should be for "green barring" the data */ /* 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. /* 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 */ END. /* IF TblGetSetting("BORDER") */ /* Put in the text */ /* Set the data font when we put out a header. Doing so every row */ /* will add size to the PDF that we don't need. */ 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 + 3). ASSIGN iCurrentX = iCurrentX + INT(TblGetSetting("COL" + STRING(iCurColumn))). END. /* DO */ /* Prep for next round */ ASSIGN iCurrentX = iStartX iCurrentY = iCurrentY - iHeight iCurRow = iCurRow + 1. /* If we have hit the bottom of the page, then new page, put out */ /* the column headers, and re-compute StartY at top of page. */ IF iCurrentY < INT(TblGetSetting("BOTTOMPAGEY")) THEN DO: /* Put out the footer */ RUN PageFooter (cStreamName, hHndl) NO-ERROR. /* New page PDF */ RUN pdf_new_page IN hHndl(cStreamName). /* Put out the Header */ RUN PageHeader (cStreamName, hHndl) NO-ERROR. /* Graphical cursor at top of page */ ASSIGN iCurrentY = INT(tblgetsetting("TOPPAGEY")). /* This should be a table setting! */ /* Reset row count for green bar and new header */ ASSIGN iCurRow = 1. END. /* IF iCurrentY < pdf_PageBottom(cStreamName) */ END. /* FOR EACH ttDataBuildTable */ 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. */ /* TOPPAGEY - When table starts a new page, start here. Automatic */ /* call to PageHeader if available. */ /* BOTTOMPAGEY - Point when table runs off bottom of page. Automatic */ /* call to PageFooter if available. */ /************************************************************************/ 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 */ /************************************************************************/ /* Sometimes we get strings that are to dang big to fit into a table */ /* column. This function figures out how much we need to cut off the */ /* the string in order for it to fit in n points worth of space. */ /************************************************************************/ FUNCTION FitColumn RETURNS CHARACTER (INPUT cStreamName AS CHARACTER, INPUT hHndl AS HANDLE, INPUT cOrgText AS CHARACTER, INPUT cFontName AS CHARACTER, INPUT iFontPoint AS INTEGER, INPUT iFitIntoPoints AS INTEGER): DEFINE VARIABLE iDataWidth AS INTEGER NO-UNDO. /* First set the font so that pdf calculation comes out right */ /* Different font's are different widths... */ RUN pdf_set_font IN hHndl (cStreamName, cFontName, iFontPoint). ASSIGN iDataWidth = pdf_text_width(cStreamName, cOrgText). DO WHILE iDataWidth > iFitIntoPoints: ASSIGN iDataWidth = pdf_text_width(cStreamName, cOrgText). ASSIGN cOrgText = SUBSTRING(cOrgText, 1, LENGTH(cOrgText) - 1). /* display iDataWidth cOrgText with frame a. down with frame a. */ END. /* DO WHILE */ RETURN cOrgText. END. /* FUNCTION FitColumn */ /************************************************************************/ /* Used to store our statistics data. Allows easy creation of a new */ /* statistic of a given name. */ /************************************************************************/ DEF TEMP-TABLE Statistic FIELD TheType AS CHARACTER FIELD TheName AS CHARACTER FIELD TheInt AS INTEGER FIELD TheDec AS DECIMAL INDEX key1 TheType TheName. FUNCTION dGetStatistic RETURNS DECIMAL (INPUT cType AS CHARACTER, INPUT cName AS CHARACTER): FIND Statistic NO-LOCK WHERE Statistic.TheType = cType AND Statistic.TheName = cName NO-ERROR. IF NOT AVAILABLE Statistic THEN RETURN 0.0. ELSE RETURN Statistic.TheDec. END. /* FUNCTION GetStatistic */ FUNCTION iGetStatistic RETURNS INT (INPUT cType AS CHARACTER, INPUT cName AS CHARACTER): FIND Statistic NO-LOCK WHERE Statistic.TheType = cType AND Statistic.TheName = cName NO-ERROR. IF NOT AVAILABLE Statistic THEN RETURN 0. ELSE RETURN Statistic.TheInt. END. /* FUNCTION GetStatistic */ /* Since we do so much addition, just make a procedure to clean code */ PROCEDURE iAddStatistic: DEFINE INPUT PARAMETER cType AS CHARACTER NO-UNDO. DEFINE INPUT PARAMETER cName AS CHARACTER NO-UNDO. DEFINE INPUT PARAMETER iAdd AS INTEGER NO-UNDO. FIND Statistic EXCLUSIVE-LOCK WHERE Statistic.TheType = cType AND Statistic.TheName = cName NO-ERROR. IF NOT AVAILABLE Statistic THEN DO: CREATE Statistic. ASSIGN Statistic.TheName = cName Statistic.TheType = cType. END. /* IF NOT AVAILABLE Statistic */ ASSIGN Statistic.TheInt = Statistic.TheInt + iAdd. END. /* PROCEDURE iAddStatistic */ PROCEDURE dAddStatistic: DEFINE INPUT PARAMETER cType AS CHARACTER NO-UNDO. DEFINE INPUT PARAMETER cName AS CHARACTER NO-UNDO. DEFINE INPUT PARAMETER iAdd AS DECIMAL NO-UNDO. FIND Statistic EXCLUSIVE-LOCK WHERE Statistic.TheType = cType AND Statistic.TheName = cName NO-ERROR. IF NOT AVAILABLE Statistic THEN DO: CREATE Statistic. ASSIGN Statistic.TheName = cName Statistic.TheType = cType. END. /* IF NOT AVAILABLE Statistic */ ASSIGN Statistic.TheDec = Statistic.TheDec + iAdd. END. /* PROCEDURE iAddStatistic */ PROCEDURE HorizontalBarChart: /* DEFINE INPUT PARAMETER cStreamName AS CHARACTER NO-UNDO. DEFINE INPUT PARAMETER hHndl AS HANDLE NO-UNDO. DEFINE VARIABLE iYOffset AS INTEGER NO-UNDO. DEFINE VARIABLE cLabels AS CHARACTER NO-UNDO. DEFINE VARIABLE cValues AS CHARACTER NO-UNDO. ASSIGN iYOffset = TblGetSetting("HEIGHT") cLabels = TblGetSetting("HEADER"). RUN pdf_set_graphicx IN hHndl = TblGetSetting("STARTX"). RUN pdf_set_graphicx IN hHndl = TblGetSetting("STARTY"). FOR EACH ttDataBuildTable WHERE ttDataBuildTable.Type = "DATA": END. /* FOR EACH ttDataBuildTable */ */ END. /* PROCEDURE HorizontalBarChart */