ну вопрос не в том чтобы сделать вывод .. как таковой, а чтобы использовать шаблоны для вывода документов. Ну там шапка, табличные части с разным оформлением и подпись...
Вывод делается в Linux ... и файл передается на клиента и открывается
Как пример расходная накладная. задается шаблон в xml
программка берет с него части + стили + форматирование
и добавляет данные программным методом
после чего выдает красивую расходную накладную...
Для затравки: для 10 версии прогресса есть библиотека
мож. не совсем красиво ... но работоспособно ...
для вывода, но с шаблонами работать пока не умеет ...
если у кого будут умные идеи ... делитесь ...
Вывод в Excel (формирование XML ) для 2003 и выше
Ну а что мешает загрузить XML-шаблон (X-DOCUMENT:LOAD), разобрать его и потом в отмеченных ячейках (ну скажем в них будет текст %<name>%) вставляет нужные данные в соответствии с тегом <name> и сохранять потом уже в готовый новый файл.
Можно заполнять хоть отдельные поля, хоть сразу какую временную табличку выводить ...
Можно заполнять хоть отдельные поля, хоть сразу какую временную табличку выводить ...
И в чем сложность?
Для просто просто не надо расписывать саму таблицу в шаблоне по полям.
Оставляем шапку. Вместо этого перечисления вставляем какой-нить тег типа [TA:TABLE]
Ну итого подбить тоже не проблема.
Если при разборе встречается такая конструкция - то заменям ее на табличку.
Ширина колонок есть, стиль каким писать есть ... пока создаешь новые ветки в XML - подбиваешь итого ... какие сложности?
Для просто просто не надо расписывать саму таблицу в шаблоне по полям.
Оставляем шапку. Вместо этого перечисления вставляем какой-нить тег типа [TA:TABLE]
Ну итого подбить тоже не проблема.
Если при разборе встречается такая конструкция - то заменям ее на табличку.
Ширина колонок есть, стиль каким писать есть ... пока создаешь новые ветки в XML - подбиваешь итого ... какие сложности?
Если не проблемма .. неплохо было бы пример реализации
и еще, в табличной части при добавлении строк (которых нет в шаблоне)
необходимо вставить теги в xml
и сумму выводить ... нужно знать где ...
разобрать xml файл - не проблема
нужно как-то спозиционироваться допустим в ячейку (D:6) и туда что-то вставить
как ее найти во множестве тегов
или нужно в табличной части добавить строку (может со своим стилем) и вставить туда данные.
как определить куда спозицианироваться для вставки блока
и еще, в табличной части при добавлении строк (которых нет в шаблоне)
необходимо вставить теги в xml
и сумму выводить ... нужно знать где ...
разобрать xml файл - не проблема
нужно как-то спозиционироваться допустим в ячейку (D:6) и туда что-то вставить
как ее найти во множестве тегов
или нужно в табличной части добавить строку (может со своим стилем) и вставить туда данные.
как определить куда спозицианироваться для вставки блока
Не надо заморачиваться над поиском ячейки D:6 … это не нужно.
Выдумывать что-то с позиционированием – вообще не надо. Шаблон он для того и есть, что путем содержания определенного текста в ячейки показывает, что туда нужно положить. Стили – это тоже задача шаблона.
Поидее, при заполнении шаблона не должно быть никакой отсебятины … во всяком случае я так понимаю …
Для вставки целой таблички – можно придумать множество вариантов.
Как вариант – накачать XML во временную таблицу с сохранение иерархии, т.е. ввести поля Col и Row (номера можно взять из соответствующих атрибутов ss:Index).
Потом уже по временной таблице бежим, ищем «наши» теги, меняем их значения на то, что надо … если встречаем тег таблицы – то добавляем новые записи (ну и соответственно смещаем индексы строк). После всех манипуляций - проделываем обратный путь и запихиваем временную табличку в новый xml.
Можно делать и "на лету" (поиграться с методом INSERT-BEFORE ... но ИМХО тут будет менее наглядно).
Какие поля таблицы выводить – известно заранее (у вас для каждого шаблона все равно будет своя процедура, формирующая отчет) … шаблон просто укажет место, куда вставлять.
Если обязательно нужен пример – напишу … только вечером или завтра … сейчас нет столько времени …
Выдумывать что-то с позиционированием – вообще не надо. Шаблон он для того и есть, что путем содержания определенного текста в ячейки показывает, что туда нужно положить. Стили – это тоже задача шаблона.
Поидее, при заполнении шаблона не должно быть никакой отсебятины … во всяком случае я так понимаю …
Для вставки целой таблички – можно придумать множество вариантов.
Как вариант – накачать XML во временную таблицу с сохранение иерархии, т.е. ввести поля Col и Row (номера можно взять из соответствующих атрибутов ss:Index).
Потом уже по временной таблице бежим, ищем «наши» теги, меняем их значения на то, что надо … если встречаем тег таблицы – то добавляем новые записи (ну и соответственно смещаем индексы строк). После всех манипуляций - проделываем обратный путь и запихиваем временную табличку в новый xml.
Можно делать и "на лету" (поиграться с методом INSERT-BEFORE ... но ИМХО тут будет менее наглядно).
Какие поля таблицы выводить – известно заранее (у вас для каждого шаблона все равно будет своя процедура, формирующая отчет) … шаблон просто укажет место, куда вставлять.
Если обязательно нужен пример – напишу … только вечером или завтра … сейчас нет столько времени …
-
MaksimZ
- Старожил
- Сообщения: 433
- Зарегистрирован: 08 авг 2005, 15:24
- Откуда: Рыбинск. Ярославская область
/* *************************** Definitions ************************** */
CREATE WIDGET-POOL.
/*DEF VAR hXdoc AS HANDLE.*/
DEF VAR hXcell AS HANDLE.
/*DEF VAR xXnamespace AS HANDLE.*/
DEF VAR hXworkbook AS HANDLE.
DEF VAR hXstyles AS HANDLE.
DEF VAR hXstyle AS HANDLE.
DEF VAR hXfont AS HANDLE.
DEF VAR hxNumberFormat AS HANDLE.
DEF VAR hXworksheet AS HANDLE.
DEF VAR hXtable AS HANDLE.
DEF VAR hXpi AS HANDLE.
DEF VAR hXrow AS HANDLE.
DEF VAR hXdata AS HANDLE.
DEF VAR hXtext AS HANDLE.
DEF VAR hXcolumn AS HANDLE.
DEFINE VARIABLE hTempTable AS HANDLE NO-UNDO.
DEF TEMP-TABLE tt-style
FIELD styleName AS CHAR.
DEF TEMP-TABLE tt-styleElement
FIELD styleName AS CHAR
FIELD elementName AS CHAR.
DEF TEMP-TABLE tt-styleElementAttribute
FIELD styleName AS CHAR
FIELD elementName AS CHAR
FIELD AttributeName AS CHAR
FIELD AttributeValue AS CHAR.
DEF TEMP-TABLE tt-ColumnStyle
FIELD styleName AS CHAR
FIELD columnName AS CHAR.
DEF TEMP-TABLE tt-columnwidth
FIELD columnName AS CHAR
FIELD columnWidth AS INT.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
/* ******************** Preprocessor Definitions ******************** */
&Scoped-define PROCEDURE-TYPE Procedure
&Scoped-define DB-AWARE no
/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME
/* *********************** Procedure Settings ************************ */
&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
Type: Procedure
Allow:
Frames: 0
Add Fields to: Neither
Other Settings: CODE-ONLY COMPILE
*/
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS
/* ************************* Create Window ************************** */
&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB)
CREATE WINDOW Procedure ASSIGN
HEIGHT = 15
WIDTH = 60.
/* END WINDOW DEFINITION */
*/
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
/* *************************** Main Block *************************** */
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
/* ********************** Internal Procedures *********************** */
&IF DEFINED(EXCLUDE-addStyle) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE addStyle Procedure
PROCEDURE addStyle :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEFINE INPUT PARAMETER p-stylename AS CHAR NO-UNDO.
FIND tt-style WHERE tt-Style.styleName = p-styleName NO-ERROR.
IF NOT AVAILABLE tt-Style THEN DO:
CREATE tt-Style.
tt-style.styleName = p-stylename.
END.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
&IF DEFINED(EXCLUDE-addStyleElement) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE addStyleElement Procedure
PROCEDURE addStyleElement :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEFINE INPUT PARAMETER p-stylename AS CHAR NO-UNDO.
DEF INPUT PARAMETER p-elementname AS CHAR NO-UNDO.
FIND tt-styleElement WHERE tt-styleElement.styleName = p-styleName
AND tt-StyleElement.elementName = p-elementName NO-ERROR.
IF NOT AVAILABLE tt-styleElement THEN DO:
CREATE tt-styleElement.
ASSIGN
tt-styleElement.styleName = p-stylename
tt-styleElement.elementName = p-elementName.
END.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
&IF DEFINED(EXCLUDE-addStyleElementAttribute) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE addStyleElementAttribute Procedure
PROCEDURE addStyleElementAttribute :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEFINE INPUT PARAMETER p-stylename AS CHAR NO-UNDO.
DEF INPUT PARAMETER p-elementname AS CHAR NO-UNDO.
DEF INPUT PARAMETER p-attributeName AS CHAR NO-UNDO.
DEF INPUT PARAMETER p-attributeValue AS CHAR NO-UNDO.
FIND tt-styleElementAttribute WHERE tt-styleElementAttribute.styleName = p-styleName
AND tt-StyleElementAttribute.elementName = p-elementName
AND tt-StyleElementAttribute.attributeName = p-attributeName
AND tt-StyleElementAttribute.AttributeValue = p-attributeValue
NO-ERROR.
IF NOT AVAILABLE tt-styleElementAttribute THEN DO:
CREATE tt-styleElementAttribute.
ASSIGN
tt-styleElementAttribute.styleName = p-stylename
tt-styleElementAttribute.elementName = p-elementName
tt-StyleElementAttribute.attributeName = p-attributeName
tt-StyleElementAttribute.AttributeValue = p-attributeValue
.
END.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
&IF DEFINED(EXCLUDE-assignStyleToColumn) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE assignStyleToColumn Procedure
PROCEDURE assignStyleToColumn :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEF INPUT PARAMETER p-StyleName AS CHAR.
DEF INPUT PARAMETER p-columnName AS CHAR NO-UNDO.
FIND tt-columnStyle WHERE
tt-ColumnStyle.styleName = p-StyleName
AND tt-ColumnStyle.columnName = p-columnName NO-ERROR.
IF NOT AVAILABLE tt-columnStyle THEN DO:
CREATE tt-columnStyle.
ASSIGN
tt-columnStyle.stylename = p-styleName
tt-columnStyle.columnName = p-columnName.
END.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
&IF DEFINED(EXCLUDE-createColumns) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE createColumns Procedure
PROCEDURE createColumns :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEF VAR hBuff AS HANDLE.
DEF VAR i AS INT NO-UNDO.
DEF VAR decstring AS CHAR NO-UNDO.
DEF VAR hyperlinknumber AS INT NO-UNDO.
DEF VAR vChars AS INT NO-UNDO.
DEF VAR charsToPoints AS INT INIT 6.
DEF INPUT PARAMETER hXdoc AS HANDLE.
hBuff = hTempTable:DEFAULT-BUFFER-HANDLE.
CREATE X-NODEREF hXcolumn.
DO i = 1 TO hBuff:NUM-FIELDS:
/* If the column-label is set to <skip> then skip the column from the
data export */
IF hBuff:BUFFER-FIELD(i):COLUMN-LABEL = "<SKIP>" THEN
NEXT.
hXdoc:CREATE-NODE(hXcolumn,"Column","element").
hyperLinkNumber =
LOOKUP(hBuff:BUFFER-FIELD(i):NAME,hbuff:BUFFER-FIELD("hyperlink_info"):LABEL)
NO-ERROR.
/* If we find a custom style for this column apply it */
FIND tt-columnstyle WHERE tt-columnStyle.columnName =
string(hBuff:BUFFER-FIELD(i):NAME) NO-ERROR.
IF AVAILABLE tt-columnstyle THEN DO:
hxColumn:SET-ATTRIBUTE("ss:StyleID",tt-columnStyle.styleName).
END.
/* If no custom style and this column gets hyperlinked, apply
the hyperlink style */
ELSE IF hyperlinkNumber GT 0 AND hyperLinkNumber NE ? THEN DO:
hXColumn:SET-ATTRIBUTE("ss:StyleID","Hyperlink").
END.
/* Otherwise, figure out what style to apply based upon the data type */
ELSE DO:
CASE hBuff:BUFFER-FIELD(i):DATA-TYPE:
WHEN "date" THEN DO:
hxColumn:SET-ATTRIBUTE("ss:StyleID","Date").
END.
WHEN "datetime" THEN DO:
hxColumn:SET-ATTRIBUTE("ss:StyleID","DateTime").
END.
WHEN "datetime-tz" THEN DO:
hxColumn:SET-ATTRIBUTE("ss:StyleID","DateTime").
END.
WHEN "DECIMAL" THEN DO:
decstring = ENTRY(2,hBuff:BUFFER-FIELD(i):FORMAT,".") NO-ERROR.
IF hBuff:BUFFER-FIELD(i):DECIMALS EQ 2
OR decstring EQ "99"
OR decstring EQ "99)"
THEN
hxColumn:SET-ATTRIBUTE("ss:StyleID","Decimal2").
ELSE hxColumn:SET-ATTRIBUTE("ss:StyleID","Default").
END.
WHEN "logical" THEN DO:
hxColumn:SET-ATTRIBUTE("ss:StyleID","Logical").
END.
OTHERWISE DO:
hxColumn:SET-ATTRIBUTE("ss:StyleID","Default").
END.
END CASE.
END.
/* autofitwidth only works for numbers and dates */
IF hBuff:BUFFER-FIELD(i):DATA-TYPE NE "CHARACTER" THEN
hXcolumn:SET-ATTRIBUTE("AutoFitWidth","1").
/* It's a character, use the format attribute to set the width */
ELSE DO:
vChars = LENGTH(STRING(" ",hBuff:BUFFER-FIELD(i):FORMAT)) NO-ERROR.
IF vChars NE ? THEN
hXcolumn:SET-ATTRIBUTE("ss:Width",STRING(vChars * charsToPoints)).
END.
/* This is an alternate way to set the column width and depends upon the
use of the setColumnWidth procedure */
FIND tt-columnWidth WHERE tt-columnwidth.columnName =
string(hBuff:BUFFER-FIELD(i):NAME) NO-ERROR.
IF AVAILABLE tt-columnwidth THEN
hXcolumn:SET-ATTRIBUTE("ss:Width",string(tt-columnwidth.columnwidth)).
hXtable:APPEND-CHILD(hXcolumn).
END. /* 1 to num-fields */
DELETE OBJECT hXcolumn.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
&IF DEFINED(EXCLUDE-createHeader) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE createHeader Procedure
PROCEDURE createHeader :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEF VAR hBuff AS HANDLE.
DEF VAR i AS INT NO-UNDO.
DEF INPUT PARAMETER hXdoc AS HANDLE.
hBuff = hTempTable:DEFAULT-BUFFER-HANDLE.
CREATE X-NODEREF hXrow.
CREATE X-NODEREF hXcell.
CREATE X-NODEREF hXdata.
CREATE X-NODEREF hXtext.
hXdoc:CREATE-NODE(hXrow,"Row","element").
hXrow:SET-ATTRIBUTE("ss:StyleID","Header").
DO i = 1 TO hBuff:NUM-FIELDS:
/* If the column-label is set to <skip> then skip the column from the
data export */
IF hBuff:BUFFER-FIELD(i):COLUMN-LABEL = "<SKIP>" THEN
NEXT.
hXdoc:CREATE-NODE(hXcell,"Cell","element").
hXdoc:CREATE-NODE(hXdata,"Data","element").
hXdata:SET-ATTRIBUTE("ss:Type","String").
hXdoc:CREATE-NODE(hXtext,"","text").
hXtext:NODE-VALUE = hBuff:BUFFER-FIELD(i):COLUMN-LABEL.
hXdata:APPEND-CHILD(hXtext).
hXCell:APPEND-CHILD(hXdata).
hxRow:APPEND-CHILD(hXcell).
END.
hXtable:APPEND-CHILD(hXrow).
DELETE OBJECT hXtext.
DELETE OBJECT hXdata.
DELETE OBJECT hXcell.
DELETE OBJECT hXrow.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
&IF DEFINED(EXCLUDE-createRows) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE createRows Procedure
PROCEDURE createRows :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEF VAR hBuff AS HANDLE.
DEF VAR hQuery AS HANDLE.
DEF VAR i AS INT NO-UNDO.
DEF VAR hyperlinkNumber AS INT NO-UNDO.
DEF VAR testNum AS DEC NO-UNDO.
DEF INPUT PARAMETER hXdoc AS HANDLE.
hBuff = hTempTable:DEFAULT-BUFFER-HANDLE.
CREATE QUERY hQuery.
hQuery:SET-BUFFERS(hBuff).
hQuery:QUERY-PREPARE("for each " + hTempTable:NAME).
hQuery:QUERY-OPEN.
CREATE X-NODEREF hXrow.
CREATE X-NODEREF hXcell.
CREATE X-NODEREF hXdata.
CREATE X-NODEREF hXtext.
REPEAT:
hQuery:GET-NEXT().
IF hQuery:QUERY-OFF-END THEN LEAVE.
hXdoc:CREATE-NODE(hXrow,"Row","element").
DO i = 1 TO hBuff:NUM-FIELDS:
IF hBuff:BUFFER-FIELD(i):COLUMN-LABEL = "<SKIP>" THEN
NEXT.
hXdoc:CREATE-NODE(hXcell,"Cell","element").
hXdoc:CREATE-NODE(hXdata,"Data","element").
hXdoc:CREATE-NODE(hXtext,"","text").
/* Handle the Progress unknown value for any data type */
IF hBuff:BUFFER-FIELD(i):BUFFER-VALUE EQ ?
THEN do:
hXtext:NODE-VALUE = "?".
hXdata:SET-ATTRIBUTE("ss:Type","String").
END.
ELSE DO:
CASE hBuff:BUFFER-FIELD(i):DATA-TYPE:
WHEN "date" THEN do:
hXtext:NODE-VALUE =
ISO-DATE(hBuff:BUFFER-FIELD(i):BUFFER-VALUE).
hXdata:SET-ATTRIBUTE("ss:Type","DateTime").
END.
WHEN "datetime" THEN DO:
hXtext:NODE-VALUE =
ISO-DATE(hBuff:BUFFER-FIELD(i):BUFFER-VALUE).
hXdata:SET-ATTRIBUTE("ss:Type","DateTime").
END.
WHEN "datetime-tz" THEN DO:
hXtext:NODE-VALUE =
ISO-DATE(hBuff:BUFFER-FIELD(i):BUFFER-VALUE).
hXdata:SET-ATTRIBUTE("ss:Type","DateTime").
END.
WHEN "decimal" THEN DO:
hXtext:NODE-VALUE = hBuff:BUFFER-FIELD(i):BUFFER-VALUE.
hXdata:SET-ATTRIBUTE("ss:Type","Number").
END.
WHEN "Integer" THEN DO:
hXtext:NODE-VALUE = hBuff:BUFFER-FIELD(i):BUFFER-VALUE.
hXdata:SET-ATTRIBUTE("ss:Type","Number").
END.
WHEN "logical" THEN DO:
hXtext:NODE-VALUE = string(int(hBuff:BUFFER-FIELD(i):BUFFER-VALUE)).
hXdata:SET-ATTRIBUTE("ss:Type","Number").
END.
OTHERWISE do:
hXtext:NODE-VALUE = hBuff:BUFFER-FIELD(i):BUFFER-VALUE.
/* See if the format says change this to a number if possible */
IF hBuff:BUFFER-FIELD(i):FORMAT = "xlNumber" THEN DO:
testNum = DEC(hBuff:BUFFER-FIELD(i):BUFFER-VALUE) NO-ERROR.
IF NOT ERROR-STATUS:ERROR THEN
hXdata:SET-ATTRIBUTE("ss:Type","Number").
ELSE
hXdata:SET-ATTRIBUTE("ss:Type","String").
END.
ELSE
hXdata:SET-ATTRIBUTE("ss:Type","String").
END.
END CASE.
END.
hyperLinkNumber =
LOOKUP(hBuff:BUFFER-FIELD(i):NAME,hbuff:BUFFER-FIELD("hyperlink_info"):LABEL)
NO-ERROR.
IF hyperlinkNumber GT 0 AND hyperLinkNumber NE ? THEN DO:
IF entry(hyperlinkNumber, hbuff:BUFFER-FIELD("hyperlink_info"):BUFFER-VALUE) NE "" THEN
DO:
/*hXcell:SET-ATTRIBUTE("ss:StyleID","Hyperlink").*/
hXcell:SET-ATTRIBUTE("ss:HRef",
entry(hyperlinkNumber,hbuff:BUFFER-FIELD
("hyperlink_info"):BUFFER-VALUE)).
END.
ELSE
hXcell:SET-ATTRIBUTE("ss:StyleID","Default").
END.
hXdata:APPEND-CHILD(hXtext).
hXCell:APPEND-CHILD(hXdata).
hxRow:APPEND-CHILD(hXcell).
END. /* 1 to num-fields */
hXtable:APPEND-CHILD(hXrow).
END. /* repeat */
DELETE OBJECT hXrow.
DELETE OBJECT hXcell.
DELETE OBJECT hXdata.
DELETE OBJECT hXtext.
hQuery:QUERY-CLOSE().
DELETE OBJECT hQuery.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
&IF DEFINED(EXCLUDE-createStyles) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE createStyles Procedure
PROCEDURE createStyles :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEF INPUT PARAMETER hXdoc AS HANDLE.
CREATE X-NODEREF hXstyles.
CREATE X-NODEREF hXstyle.
CREATE X-NODEREF hXfont.
CREATE X-NODEREF hXNumberFormat.
hXdoc:CREATE-NODE(hXstyles,"Styles","element").
/* Header Style */
hXdoc:CREATE-NODE(hXstyle,"Style","element").
hXstyle:SET-ATTRIBUTE("ss:ID","Header").
hXdoc:CREATE-NODE(hXfont,"Font","element").
hXfont:SET-ATTRIBUTE("ss:Bold","1").
hXstyle:APPEND-CHILD(hXfont).
hXdoc:CREATE-NODE(hXfont,"Alignment","element").
hXfont:SET-ATTRIBUTE("ss:WrapText","1").
hXstyle:APPEND-CHILD(hXfont).
hXstyles:APPEND-CHILD(hXstyle).
/* Default Style */
hXdoc:CREATE-NODE(hXstyle,"Style","element").
hXstyle:SET-ATTRIBUTE("ss:ID","Default").
hXstyles:APPEND-CHILD(hXstyle).
/* Date Style */
hXdoc:CREATE-NODE(hXstyle,"Style","element").
hXstyle:SET-ATTRIBUTE("ss:ID","Date").
hXdoc:CREATE-NODE(hXNumberFormat,"NumberFormat","element").
hXNumberFormat:SET-ATTRIBUTE("ss:Format","[ENG][$-409]d\-mmm\-yyyy;@").
hXstyle:APPEND-CHILD(hXNumberFormat).
hXstyles:APPEND-CHILD(hXstyle).
/* DateTime Style */
hXdoc:CREATE-NODE(hXstyle,"Style","element").
hXstyle:SET-ATTRIBUTE("ss:ID","DateTime").
hXdoc:CREATE-NODE(hXNumberFormat,"NumberFormat","element").
hXNumberFormat:SET-ATTRIBUTE("ss:Format","[ENG][$-409]d\-mmm\-yyyy\ hh:mm;@").
hXstyle:APPEND-CHILD(hXNumberFormat).
hXstyles:APPEND-CHILD(hXstyle).
/* Time Style */
/* CREATE X-NODEREF hXstyle.*/
/* hXdoc:CREATE-NODE(hXstyle,"Style","element").*/
/* hXstyle:SET-ATTRIBUTE("ss:ID","Time").*/
/* CREATE X-NODEREF hXNumberFormat.*/
/* hXdoc:CREATE-NODE(hXNumberFormat,"NumberFormat","element").*/
/* hXNumberFormat:SET-ATTRIBUTE("ss:Format","Long Time").*/
/* hXstyle:APPEND-CHILD(hXNumberFormat).*/
/* hXstyles:APPEND-CHILD(hXstyle).*/
/* Two Decimals Style */
hXdoc:CREATE-NODE(hXstyle,"Style","element").
hXstyle:SET-ATTRIBUTE("ss:ID","Decimal2").
hXdoc:CREATE-NODE(hXNumberFormat,"NumberFormat","element").
hXNumberFormat:SET-ATTRIBUTE("ss:Format","#,##0.00_);[Red]\(#,##0.00\)").
hXstyle:APPEND-CHILD(hXNumberFormat).
hXstyles:APPEND-CHILD(hXstyle).
/* Logical Style */
hXdoc:CREATE-NODE(hXstyle,"Style","element").
hXstyle:SET-ATTRIBUTE("ss:ID","Logical").
hXdoc:CREATE-NODE(hXNumberFormat,"NumberFormat","element").
hXNumberFormat:SET-ATTRIBUTE("ss:Format","Yes/No").
hXstyle:APPEND-CHILD(hXNumberFormat).
hXstyles:APPEND-CHILD(hXstyle).
/* Hyperlink Style */
hXdoc:CREATE-NODE(hXstyle,"Style","element").
hXstyle:SET-ATTRIBUTE("ss:ID","Hyperlink").
hXdoc:CREATE-NODE(hXfont,"Font","element").
hXfont:SET-ATTRIBUTE("ss:Color","#0000FF").
hXfont:SET-ATTRIBUTE("ss:Underline","Single").
hXstyle:APPEND-CHILD(hXfont).
hXstyles:APPEND-CHILD(hXstyle).
FOR EACH tt-Style:
hXdoc:CREATE-NODE(hXstyle,"Style","element").
hXstyle:SET-ATTRIBUTE("ss:ID",tt-style.styleName).
FOR EACH tt-StyleElement WHERE tt-StyleElement.styleName =
tt-style.styleName:
hXdoc:CREATE-NODE(hXfont,tt-StyleElement.elementName,"element").
FOR EACH tt-styleElementAttribute WHERE
tt-StyleElementAttribute.styleName = tt-Style.StyleName AND
tt-StyleElementAttribute.elementName = tt-styleElement.elementName:
hXfont:SET-ATTRIBUTE("ss:" + tt-StyleElementAttribute.attributeName,
tt-styleElementAttribute.attributeValue).
END.
hXstyle:APPEND-CHILD(hXfont).
END.
hXstyles:APPEND-CHILD(hXstyle).
END.
hXworkbook:APPEND-CHILD(hXstyles).
DELETE OBJECT hXstyles.
DELETE OBJECT hXstyle.
DELETE OBJECT hXfont.
DELETE OBJECT hXNumberFormat.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
&IF DEFINED(EXCLUDE-MakeDocument) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE MakeDocument Procedure
PROCEDURE MakeDocument :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEF INPUT PARAMETER TABLE-HANDLE FOR hTempTable. /* source data temp-table */
DEF INPUT PARAMETER createHeader AS LOG NO-UNDO. /* add a header row? */
DEF INPUT PARAMETER workSheetName AS CHAR NO-UNDO. /* The name of the worksheet */
DEF INPUT PARAMETER hXdoc AS handle.
hXdoc:ENCODING = "UTF-8".
CREATE X-NODEREF hXpi.
CREATE X-NODEREF hXworkbook.
CREATE X-NODEREF hXworksheet.
CREATE X-NODEREF hXtable.
hXdoc:CREATE-NODE(hXpi,'mso-application',"processing-instruction").
hXpi:NODE-VALUE = 'progid="Excel.Sheet"'.
/* This node will force the .xml file to open in excel. It works from
windows explorer but seems to make no difference when streaming
the file via the web. For web use, I find naming the file .xls works
It can be useful to comment this line so you can easily open the xml
file in IE during debugging */
hXdoc:APPEND-CHILD(hXpi).
/* Make the workbook */
hXdoc:CREATE-NODE(hXworkbook,"Workbook","element").
hXworkbook:SET-ATTRIBUTE("xmlns:html","http://www.w3.org/TR/REC-html40").
hXworkbook:SET-ATTRIBUTE("xmlns:o","urn:schemas-microsoft-com:office:office").
hXworkbook:SET-ATTRIBUTE("xmlns:x","urn:schemas-microsoft-com:office:excel").
hXworkbook:SET-ATTRIBUTE("xmlns:ss","urn:schemas-microsoft-com:office:spreadsheet").
hXworkbook:SET-ATTRIBUTE("xmlns","urn:schemas-microsoft-com:office:spreadsheet").
/* Make the worksheet */
hXdoc:CREATE-NODE(hXworksheet,"Worksheet","element").
hXworkSheet:SET-ATTRIBUTE("ss:Name",worksheetname).
/* Make the table */
hXdoc:CREATE-NODE(hXTable,"Table","element").
RUN createStyles (hXdoc).
RUN createcolumns (hXdoc).
IF createHeader THEN RUN createHeader (hXdoc).
RUN createRows (hXdoc).
hXworksheet:APPEND-CHILD(hXtable).
hXworkbook:APPEND-CHILD(hXworksheet).
hXdoc:APPEND-CHILD(hXworkbook).
DELETE OBJECT hXtable.
DELETE OBJECT hXworksheet.
DELETE OBJECT hXworkbook.
DELETE OBJECT hXpi.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
&IF DEFINED(EXCLUDE-setColumnWidth) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE setColumnWidth Procedure
PROCEDURE setColumnWidth :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEF INPUT PARAMETER p-columnname AS CHAR.
DEFINE INPUT PARAMETER p-columnwidth AS INT.
FIND tt-columnwidth WHERE tt-columnwidth.columnname = p-columnName
NO-ERROR.
IF NOT AVAILABLE tt-columnwidth THEN CREATE tt-columnWidth.
ASSIGN
tt-columnWidth.columnwidth = p-columnWidth
tt-columnWidth.columnName = p-columnname .
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
CREATE WIDGET-POOL.
/*DEF VAR hXdoc AS HANDLE.*/
DEF VAR hXcell AS HANDLE.
/*DEF VAR xXnamespace AS HANDLE.*/
DEF VAR hXworkbook AS HANDLE.
DEF VAR hXstyles AS HANDLE.
DEF VAR hXstyle AS HANDLE.
DEF VAR hXfont AS HANDLE.
DEF VAR hxNumberFormat AS HANDLE.
DEF VAR hXworksheet AS HANDLE.
DEF VAR hXtable AS HANDLE.
DEF VAR hXpi AS HANDLE.
DEF VAR hXrow AS HANDLE.
DEF VAR hXdata AS HANDLE.
DEF VAR hXtext AS HANDLE.
DEF VAR hXcolumn AS HANDLE.
DEFINE VARIABLE hTempTable AS HANDLE NO-UNDO.
DEF TEMP-TABLE tt-style
FIELD styleName AS CHAR.
DEF TEMP-TABLE tt-styleElement
FIELD styleName AS CHAR
FIELD elementName AS CHAR.
DEF TEMP-TABLE tt-styleElementAttribute
FIELD styleName AS CHAR
FIELD elementName AS CHAR
FIELD AttributeName AS CHAR
FIELD AttributeValue AS CHAR.
DEF TEMP-TABLE tt-ColumnStyle
FIELD styleName AS CHAR
FIELD columnName AS CHAR.
DEF TEMP-TABLE tt-columnwidth
FIELD columnName AS CHAR
FIELD columnWidth AS INT.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
/* ******************** Preprocessor Definitions ******************** */
&Scoped-define PROCEDURE-TYPE Procedure
&Scoped-define DB-AWARE no
/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME
/* *********************** Procedure Settings ************************ */
&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
Type: Procedure
Allow:
Frames: 0
Add Fields to: Neither
Other Settings: CODE-ONLY COMPILE
*/
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS
/* ************************* Create Window ************************** */
&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB)
CREATE WINDOW Procedure ASSIGN
HEIGHT = 15
WIDTH = 60.
/* END WINDOW DEFINITION */
*/
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
/* *************************** Main Block *************************** */
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
/* ********************** Internal Procedures *********************** */
&IF DEFINED(EXCLUDE-addStyle) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE addStyle Procedure
PROCEDURE addStyle :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEFINE INPUT PARAMETER p-stylename AS CHAR NO-UNDO.
FIND tt-style WHERE tt-Style.styleName = p-styleName NO-ERROR.
IF NOT AVAILABLE tt-Style THEN DO:
CREATE tt-Style.
tt-style.styleName = p-stylename.
END.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
&IF DEFINED(EXCLUDE-addStyleElement) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE addStyleElement Procedure
PROCEDURE addStyleElement :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEFINE INPUT PARAMETER p-stylename AS CHAR NO-UNDO.
DEF INPUT PARAMETER p-elementname AS CHAR NO-UNDO.
FIND tt-styleElement WHERE tt-styleElement.styleName = p-styleName
AND tt-StyleElement.elementName = p-elementName NO-ERROR.
IF NOT AVAILABLE tt-styleElement THEN DO:
CREATE tt-styleElement.
ASSIGN
tt-styleElement.styleName = p-stylename
tt-styleElement.elementName = p-elementName.
END.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
&IF DEFINED(EXCLUDE-addStyleElementAttribute) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE addStyleElementAttribute Procedure
PROCEDURE addStyleElementAttribute :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEFINE INPUT PARAMETER p-stylename AS CHAR NO-UNDO.
DEF INPUT PARAMETER p-elementname AS CHAR NO-UNDO.
DEF INPUT PARAMETER p-attributeName AS CHAR NO-UNDO.
DEF INPUT PARAMETER p-attributeValue AS CHAR NO-UNDO.
FIND tt-styleElementAttribute WHERE tt-styleElementAttribute.styleName = p-styleName
AND tt-StyleElementAttribute.elementName = p-elementName
AND tt-StyleElementAttribute.attributeName = p-attributeName
AND tt-StyleElementAttribute.AttributeValue = p-attributeValue
NO-ERROR.
IF NOT AVAILABLE tt-styleElementAttribute THEN DO:
CREATE tt-styleElementAttribute.
ASSIGN
tt-styleElementAttribute.styleName = p-stylename
tt-styleElementAttribute.elementName = p-elementName
tt-StyleElementAttribute.attributeName = p-attributeName
tt-StyleElementAttribute.AttributeValue = p-attributeValue
.
END.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
&IF DEFINED(EXCLUDE-assignStyleToColumn) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE assignStyleToColumn Procedure
PROCEDURE assignStyleToColumn :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEF INPUT PARAMETER p-StyleName AS CHAR.
DEF INPUT PARAMETER p-columnName AS CHAR NO-UNDO.
FIND tt-columnStyle WHERE
tt-ColumnStyle.styleName = p-StyleName
AND tt-ColumnStyle.columnName = p-columnName NO-ERROR.
IF NOT AVAILABLE tt-columnStyle THEN DO:
CREATE tt-columnStyle.
ASSIGN
tt-columnStyle.stylename = p-styleName
tt-columnStyle.columnName = p-columnName.
END.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
&IF DEFINED(EXCLUDE-createColumns) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE createColumns Procedure
PROCEDURE createColumns :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEF VAR hBuff AS HANDLE.
DEF VAR i AS INT NO-UNDO.
DEF VAR decstring AS CHAR NO-UNDO.
DEF VAR hyperlinknumber AS INT NO-UNDO.
DEF VAR vChars AS INT NO-UNDO.
DEF VAR charsToPoints AS INT INIT 6.
DEF INPUT PARAMETER hXdoc AS HANDLE.
hBuff = hTempTable:DEFAULT-BUFFER-HANDLE.
CREATE X-NODEREF hXcolumn.
DO i = 1 TO hBuff:NUM-FIELDS:
/* If the column-label is set to <skip> then skip the column from the
data export */
IF hBuff:BUFFER-FIELD(i):COLUMN-LABEL = "<SKIP>" THEN
NEXT.
hXdoc:CREATE-NODE(hXcolumn,"Column","element").
hyperLinkNumber =
LOOKUP(hBuff:BUFFER-FIELD(i):NAME,hbuff:BUFFER-FIELD("hyperlink_info"):LABEL)
NO-ERROR.
/* If we find a custom style for this column apply it */
FIND tt-columnstyle WHERE tt-columnStyle.columnName =
string(hBuff:BUFFER-FIELD(i):NAME) NO-ERROR.
IF AVAILABLE tt-columnstyle THEN DO:
hxColumn:SET-ATTRIBUTE("ss:StyleID",tt-columnStyle.styleName).
END.
/* If no custom style and this column gets hyperlinked, apply
the hyperlink style */
ELSE IF hyperlinkNumber GT 0 AND hyperLinkNumber NE ? THEN DO:
hXColumn:SET-ATTRIBUTE("ss:StyleID","Hyperlink").
END.
/* Otherwise, figure out what style to apply based upon the data type */
ELSE DO:
CASE hBuff:BUFFER-FIELD(i):DATA-TYPE:
WHEN "date" THEN DO:
hxColumn:SET-ATTRIBUTE("ss:StyleID","Date").
END.
WHEN "datetime" THEN DO:
hxColumn:SET-ATTRIBUTE("ss:StyleID","DateTime").
END.
WHEN "datetime-tz" THEN DO:
hxColumn:SET-ATTRIBUTE("ss:StyleID","DateTime").
END.
WHEN "DECIMAL" THEN DO:
decstring = ENTRY(2,hBuff:BUFFER-FIELD(i):FORMAT,".") NO-ERROR.
IF hBuff:BUFFER-FIELD(i):DECIMALS EQ 2
OR decstring EQ "99"
OR decstring EQ "99)"
THEN
hxColumn:SET-ATTRIBUTE("ss:StyleID","Decimal2").
ELSE hxColumn:SET-ATTRIBUTE("ss:StyleID","Default").
END.
WHEN "logical" THEN DO:
hxColumn:SET-ATTRIBUTE("ss:StyleID","Logical").
END.
OTHERWISE DO:
hxColumn:SET-ATTRIBUTE("ss:StyleID","Default").
END.
END CASE.
END.
/* autofitwidth only works for numbers and dates */
IF hBuff:BUFFER-FIELD(i):DATA-TYPE NE "CHARACTER" THEN
hXcolumn:SET-ATTRIBUTE("AutoFitWidth","1").
/* It's a character, use the format attribute to set the width */
ELSE DO:
vChars = LENGTH(STRING(" ",hBuff:BUFFER-FIELD(i):FORMAT)) NO-ERROR.
IF vChars NE ? THEN
hXcolumn:SET-ATTRIBUTE("ss:Width",STRING(vChars * charsToPoints)).
END.
/* This is an alternate way to set the column width and depends upon the
use of the setColumnWidth procedure */
FIND tt-columnWidth WHERE tt-columnwidth.columnName =
string(hBuff:BUFFER-FIELD(i):NAME) NO-ERROR.
IF AVAILABLE tt-columnwidth THEN
hXcolumn:SET-ATTRIBUTE("ss:Width",string(tt-columnwidth.columnwidth)).
hXtable:APPEND-CHILD(hXcolumn).
END. /* 1 to num-fields */
DELETE OBJECT hXcolumn.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
&IF DEFINED(EXCLUDE-createHeader) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE createHeader Procedure
PROCEDURE createHeader :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEF VAR hBuff AS HANDLE.
DEF VAR i AS INT NO-UNDO.
DEF INPUT PARAMETER hXdoc AS HANDLE.
hBuff = hTempTable:DEFAULT-BUFFER-HANDLE.
CREATE X-NODEREF hXrow.
CREATE X-NODEREF hXcell.
CREATE X-NODEREF hXdata.
CREATE X-NODEREF hXtext.
hXdoc:CREATE-NODE(hXrow,"Row","element").
hXrow:SET-ATTRIBUTE("ss:StyleID","Header").
DO i = 1 TO hBuff:NUM-FIELDS:
/* If the column-label is set to <skip> then skip the column from the
data export */
IF hBuff:BUFFER-FIELD(i):COLUMN-LABEL = "<SKIP>" THEN
NEXT.
hXdoc:CREATE-NODE(hXcell,"Cell","element").
hXdoc:CREATE-NODE(hXdata,"Data","element").
hXdata:SET-ATTRIBUTE("ss:Type","String").
hXdoc:CREATE-NODE(hXtext,"","text").
hXtext:NODE-VALUE = hBuff:BUFFER-FIELD(i):COLUMN-LABEL.
hXdata:APPEND-CHILD(hXtext).
hXCell:APPEND-CHILD(hXdata).
hxRow:APPEND-CHILD(hXcell).
END.
hXtable:APPEND-CHILD(hXrow).
DELETE OBJECT hXtext.
DELETE OBJECT hXdata.
DELETE OBJECT hXcell.
DELETE OBJECT hXrow.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
&IF DEFINED(EXCLUDE-createRows) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE createRows Procedure
PROCEDURE createRows :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEF VAR hBuff AS HANDLE.
DEF VAR hQuery AS HANDLE.
DEF VAR i AS INT NO-UNDO.
DEF VAR hyperlinkNumber AS INT NO-UNDO.
DEF VAR testNum AS DEC NO-UNDO.
DEF INPUT PARAMETER hXdoc AS HANDLE.
hBuff = hTempTable:DEFAULT-BUFFER-HANDLE.
CREATE QUERY hQuery.
hQuery:SET-BUFFERS(hBuff).
hQuery:QUERY-PREPARE("for each " + hTempTable:NAME).
hQuery:QUERY-OPEN.
CREATE X-NODEREF hXrow.
CREATE X-NODEREF hXcell.
CREATE X-NODEREF hXdata.
CREATE X-NODEREF hXtext.
REPEAT:
hQuery:GET-NEXT().
IF hQuery:QUERY-OFF-END THEN LEAVE.
hXdoc:CREATE-NODE(hXrow,"Row","element").
DO i = 1 TO hBuff:NUM-FIELDS:
IF hBuff:BUFFER-FIELD(i):COLUMN-LABEL = "<SKIP>" THEN
NEXT.
hXdoc:CREATE-NODE(hXcell,"Cell","element").
hXdoc:CREATE-NODE(hXdata,"Data","element").
hXdoc:CREATE-NODE(hXtext,"","text").
/* Handle the Progress unknown value for any data type */
IF hBuff:BUFFER-FIELD(i):BUFFER-VALUE EQ ?
THEN do:
hXtext:NODE-VALUE = "?".
hXdata:SET-ATTRIBUTE("ss:Type","String").
END.
ELSE DO:
CASE hBuff:BUFFER-FIELD(i):DATA-TYPE:
WHEN "date" THEN do:
hXtext:NODE-VALUE =
ISO-DATE(hBuff:BUFFER-FIELD(i):BUFFER-VALUE).
hXdata:SET-ATTRIBUTE("ss:Type","DateTime").
END.
WHEN "datetime" THEN DO:
hXtext:NODE-VALUE =
ISO-DATE(hBuff:BUFFER-FIELD(i):BUFFER-VALUE).
hXdata:SET-ATTRIBUTE("ss:Type","DateTime").
END.
WHEN "datetime-tz" THEN DO:
hXtext:NODE-VALUE =
ISO-DATE(hBuff:BUFFER-FIELD(i):BUFFER-VALUE).
hXdata:SET-ATTRIBUTE("ss:Type","DateTime").
END.
WHEN "decimal" THEN DO:
hXtext:NODE-VALUE = hBuff:BUFFER-FIELD(i):BUFFER-VALUE.
hXdata:SET-ATTRIBUTE("ss:Type","Number").
END.
WHEN "Integer" THEN DO:
hXtext:NODE-VALUE = hBuff:BUFFER-FIELD(i):BUFFER-VALUE.
hXdata:SET-ATTRIBUTE("ss:Type","Number").
END.
WHEN "logical" THEN DO:
hXtext:NODE-VALUE = string(int(hBuff:BUFFER-FIELD(i):BUFFER-VALUE)).
hXdata:SET-ATTRIBUTE("ss:Type","Number").
END.
OTHERWISE do:
hXtext:NODE-VALUE = hBuff:BUFFER-FIELD(i):BUFFER-VALUE.
/* See if the format says change this to a number if possible */
IF hBuff:BUFFER-FIELD(i):FORMAT = "xlNumber" THEN DO:
testNum = DEC(hBuff:BUFFER-FIELD(i):BUFFER-VALUE) NO-ERROR.
IF NOT ERROR-STATUS:ERROR THEN
hXdata:SET-ATTRIBUTE("ss:Type","Number").
ELSE
hXdata:SET-ATTRIBUTE("ss:Type","String").
END.
ELSE
hXdata:SET-ATTRIBUTE("ss:Type","String").
END.
END CASE.
END.
hyperLinkNumber =
LOOKUP(hBuff:BUFFER-FIELD(i):NAME,hbuff:BUFFER-FIELD("hyperlink_info"):LABEL)
NO-ERROR.
IF hyperlinkNumber GT 0 AND hyperLinkNumber NE ? THEN DO:
IF entry(hyperlinkNumber, hbuff:BUFFER-FIELD("hyperlink_info"):BUFFER-VALUE) NE "" THEN
DO:
/*hXcell:SET-ATTRIBUTE("ss:StyleID","Hyperlink").*/
hXcell:SET-ATTRIBUTE("ss:HRef",
entry(hyperlinkNumber,hbuff:BUFFER-FIELD
("hyperlink_info"):BUFFER-VALUE)).
END.
ELSE
hXcell:SET-ATTRIBUTE("ss:StyleID","Default").
END.
hXdata:APPEND-CHILD(hXtext).
hXCell:APPEND-CHILD(hXdata).
hxRow:APPEND-CHILD(hXcell).
END. /* 1 to num-fields */
hXtable:APPEND-CHILD(hXrow).
END. /* repeat */
DELETE OBJECT hXrow.
DELETE OBJECT hXcell.
DELETE OBJECT hXdata.
DELETE OBJECT hXtext.
hQuery:QUERY-CLOSE().
DELETE OBJECT hQuery.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
&IF DEFINED(EXCLUDE-createStyles) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE createStyles Procedure
PROCEDURE createStyles :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEF INPUT PARAMETER hXdoc AS HANDLE.
CREATE X-NODEREF hXstyles.
CREATE X-NODEREF hXstyle.
CREATE X-NODEREF hXfont.
CREATE X-NODEREF hXNumberFormat.
hXdoc:CREATE-NODE(hXstyles,"Styles","element").
/* Header Style */
hXdoc:CREATE-NODE(hXstyle,"Style","element").
hXstyle:SET-ATTRIBUTE("ss:ID","Header").
hXdoc:CREATE-NODE(hXfont,"Font","element").
hXfont:SET-ATTRIBUTE("ss:Bold","1").
hXstyle:APPEND-CHILD(hXfont).
hXdoc:CREATE-NODE(hXfont,"Alignment","element").
hXfont:SET-ATTRIBUTE("ss:WrapText","1").
hXstyle:APPEND-CHILD(hXfont).
hXstyles:APPEND-CHILD(hXstyle).
/* Default Style */
hXdoc:CREATE-NODE(hXstyle,"Style","element").
hXstyle:SET-ATTRIBUTE("ss:ID","Default").
hXstyles:APPEND-CHILD(hXstyle).
/* Date Style */
hXdoc:CREATE-NODE(hXstyle,"Style","element").
hXstyle:SET-ATTRIBUTE("ss:ID","Date").
hXdoc:CREATE-NODE(hXNumberFormat,"NumberFormat","element").
hXNumberFormat:SET-ATTRIBUTE("ss:Format","[ENG][$-409]d\-mmm\-yyyy;@").
hXstyle:APPEND-CHILD(hXNumberFormat).
hXstyles:APPEND-CHILD(hXstyle).
/* DateTime Style */
hXdoc:CREATE-NODE(hXstyle,"Style","element").
hXstyle:SET-ATTRIBUTE("ss:ID","DateTime").
hXdoc:CREATE-NODE(hXNumberFormat,"NumberFormat","element").
hXNumberFormat:SET-ATTRIBUTE("ss:Format","[ENG][$-409]d\-mmm\-yyyy\ hh:mm;@").
hXstyle:APPEND-CHILD(hXNumberFormat).
hXstyles:APPEND-CHILD(hXstyle).
/* Time Style */
/* CREATE X-NODEREF hXstyle.*/
/* hXdoc:CREATE-NODE(hXstyle,"Style","element").*/
/* hXstyle:SET-ATTRIBUTE("ss:ID","Time").*/
/* CREATE X-NODEREF hXNumberFormat.*/
/* hXdoc:CREATE-NODE(hXNumberFormat,"NumberFormat","element").*/
/* hXNumberFormat:SET-ATTRIBUTE("ss:Format","Long Time").*/
/* hXstyle:APPEND-CHILD(hXNumberFormat).*/
/* hXstyles:APPEND-CHILD(hXstyle).*/
/* Two Decimals Style */
hXdoc:CREATE-NODE(hXstyle,"Style","element").
hXstyle:SET-ATTRIBUTE("ss:ID","Decimal2").
hXdoc:CREATE-NODE(hXNumberFormat,"NumberFormat","element").
hXNumberFormat:SET-ATTRIBUTE("ss:Format","#,##0.00_);[Red]\(#,##0.00\)").
hXstyle:APPEND-CHILD(hXNumberFormat).
hXstyles:APPEND-CHILD(hXstyle).
/* Logical Style */
hXdoc:CREATE-NODE(hXstyle,"Style","element").
hXstyle:SET-ATTRIBUTE("ss:ID","Logical").
hXdoc:CREATE-NODE(hXNumberFormat,"NumberFormat","element").
hXNumberFormat:SET-ATTRIBUTE("ss:Format","Yes/No").
hXstyle:APPEND-CHILD(hXNumberFormat).
hXstyles:APPEND-CHILD(hXstyle).
/* Hyperlink Style */
hXdoc:CREATE-NODE(hXstyle,"Style","element").
hXstyle:SET-ATTRIBUTE("ss:ID","Hyperlink").
hXdoc:CREATE-NODE(hXfont,"Font","element").
hXfont:SET-ATTRIBUTE("ss:Color","#0000FF").
hXfont:SET-ATTRIBUTE("ss:Underline","Single").
hXstyle:APPEND-CHILD(hXfont).
hXstyles:APPEND-CHILD(hXstyle).
FOR EACH tt-Style:
hXdoc:CREATE-NODE(hXstyle,"Style","element").
hXstyle:SET-ATTRIBUTE("ss:ID",tt-style.styleName).
FOR EACH tt-StyleElement WHERE tt-StyleElement.styleName =
tt-style.styleName:
hXdoc:CREATE-NODE(hXfont,tt-StyleElement.elementName,"element").
FOR EACH tt-styleElementAttribute WHERE
tt-StyleElementAttribute.styleName = tt-Style.StyleName AND
tt-StyleElementAttribute.elementName = tt-styleElement.elementName:
hXfont:SET-ATTRIBUTE("ss:" + tt-StyleElementAttribute.attributeName,
tt-styleElementAttribute.attributeValue).
END.
hXstyle:APPEND-CHILD(hXfont).
END.
hXstyles:APPEND-CHILD(hXstyle).
END.
hXworkbook:APPEND-CHILD(hXstyles).
DELETE OBJECT hXstyles.
DELETE OBJECT hXstyle.
DELETE OBJECT hXfont.
DELETE OBJECT hXNumberFormat.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
&IF DEFINED(EXCLUDE-MakeDocument) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE MakeDocument Procedure
PROCEDURE MakeDocument :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEF INPUT PARAMETER TABLE-HANDLE FOR hTempTable. /* source data temp-table */
DEF INPUT PARAMETER createHeader AS LOG NO-UNDO. /* add a header row? */
DEF INPUT PARAMETER workSheetName AS CHAR NO-UNDO. /* The name of the worksheet */
DEF INPUT PARAMETER hXdoc AS handle.
hXdoc:ENCODING = "UTF-8".
CREATE X-NODEREF hXpi.
CREATE X-NODEREF hXworkbook.
CREATE X-NODEREF hXworksheet.
CREATE X-NODEREF hXtable.
hXdoc:CREATE-NODE(hXpi,'mso-application',"processing-instruction").
hXpi:NODE-VALUE = 'progid="Excel.Sheet"'.
/* This node will force the .xml file to open in excel. It works from
windows explorer but seems to make no difference when streaming
the file via the web. For web use, I find naming the file .xls works
It can be useful to comment this line so you can easily open the xml
file in IE during debugging */
hXdoc:APPEND-CHILD(hXpi).
/* Make the workbook */
hXdoc:CREATE-NODE(hXworkbook,"Workbook","element").
hXworkbook:SET-ATTRIBUTE("xmlns:html","http://www.w3.org/TR/REC-html40").
hXworkbook:SET-ATTRIBUTE("xmlns:o","urn:schemas-microsoft-com:office:office").
hXworkbook:SET-ATTRIBUTE("xmlns:x","urn:schemas-microsoft-com:office:excel").
hXworkbook:SET-ATTRIBUTE("xmlns:ss","urn:schemas-microsoft-com:office:spreadsheet").
hXworkbook:SET-ATTRIBUTE("xmlns","urn:schemas-microsoft-com:office:spreadsheet").
/* Make the worksheet */
hXdoc:CREATE-NODE(hXworksheet,"Worksheet","element").
hXworkSheet:SET-ATTRIBUTE("ss:Name",worksheetname).
/* Make the table */
hXdoc:CREATE-NODE(hXTable,"Table","element").
RUN createStyles (hXdoc).
RUN createcolumns (hXdoc).
IF createHeader THEN RUN createHeader (hXdoc).
RUN createRows (hXdoc).
hXworksheet:APPEND-CHILD(hXtable).
hXworkbook:APPEND-CHILD(hXworksheet).
hXdoc:APPEND-CHILD(hXworkbook).
DELETE OBJECT hXtable.
DELETE OBJECT hXworksheet.
DELETE OBJECT hXworkbook.
DELETE OBJECT hXpi.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
&IF DEFINED(EXCLUDE-setColumnWidth) = 0 &THEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE setColumnWidth Procedure
PROCEDURE setColumnWidth :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEF INPUT PARAMETER p-columnname AS CHAR.
DEFINE INPUT PARAMETER p-columnwidth AS INT.
FIND tt-columnwidth WHERE tt-columnwidth.columnname = p-columnName
NO-ERROR.
IF NOT AVAILABLE tt-columnwidth THEN CREATE tt-columnWidth.
ASSIGN
tt-columnWidth.columnwidth = p-columnWidth
tt-columnWidth.columnName = p-columnname .
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ENDIF
Сразу предупреждаю, что это не готовая программа - это одна из возможных реализаций того алгоритма, что я говорил.
Кусок вставки таблицы - не стал оформлять в виде процедуры, чтобы как-то выделить.
Замену любых других полей не стал писать, т.к. это просто ... надо просто tt-hierarhy.TagText заменить на нужное значение да и все.
Запихивание иерархии в файл - тоже не стал писать, т.к. лень, а суть такая же как и загрузка - ток наоборот. Если очень надо - то напишу.
Ну и похорошему тогда надо всю библиотеку строить вокруг этой иерархии (чтоб сразу в нее добавлять что надо, а потом скопом скидывать в файл) ...
Ну и обработку ошибок - тож не рисовал, бо лень.
Почему-то не получилось сюда вставить текст полностью.
Вот тут можно скачать:
Кусок вставки таблицы - не стал оформлять в виде процедуры, чтобы как-то выделить.
Замену любых других полей не стал писать, т.к. это просто ... надо просто tt-hierarhy.TagText заменить на нужное значение да и все.
Запихивание иерархии в файл - тоже не стал писать, т.к. лень, а суть такая же как и загрузка - ток наоборот. Если очень надо - то напишу.
Ну и похорошему тогда надо всю библиотеку строить вокруг этой иерархии (чтоб сразу в нее добавлять что надо, а потом скопом скидывать в файл) ...
Ну и обработку ошибок - тож не рисовал, бо лень.
Почему-то не получилось сюда вставить текст полностью.
Вот тут можно скачать:
Да причем здесь этот шаблон ... там может быть все что угодно написано ...
главное, чтобы в одной из ячеек было написано [TA:TABLE]
И если это имеет место - то содержимое меняется на таблицу tt-test (смещая все остальное вниз соответствующим образом).
Этот пример делает только это и больше ничего.
У меня не было цели написать готовую программу (для этого надо еще много чего туда написать) ... этот кусок демонстрирует реализацию только того алгоритма, что я описывал и все ...
главное, чтобы в одной из ячеек было написано [TA:TABLE]
И если это имеет место - то содержимое меняется на таблицу tt-test (смещая все остальное вниз соответствующим образом).
Этот пример делает только это и больше ничего.
У меня не было цели написать готовую программу (для этого надо еще много чего туда написать) ... этот кусок демонстрирует реализацию только того алгоритма, что я описывал и все ...