Советы по Delphi
Парсер печатных текстовых форм
Slava Kostin пишет:
Для себя недавно написал. А вдруг, кому пригодится? Часто приходится генерировать формы в текстовые файлы, заполнять поля кучей всяких значений. Приведенный ниже модуль помогает мне упростить свою жизнь. Для удобства использования я все оформил в виде одной функции.
Сначала приведу пример формы с комментариями для ее использования, затем - собственно юнит PrintForm.
Итак, форма:
;Строки комментариев должны начинаться со знака ";". ;В одной строке не должно быть более одной команды
;Секции могут следовать в любом порядке. ;Конечный вид формы будет сформирован путем конкатенации всех секций !FORM. ;Значения полей будут подставляться в форму в том порядке, в котором они ;встречаются в тексте файла-определения формы. При этом играет роль только ;порядок перечисления полей, а располагать эти описания можно в любом месте ;формы. В поля форму будут подставляться параметры, определенные в виде
; !FIELD[n](a)
; где n - порядковый номер параметра ; a - выравнивание (может принимать значения "c", "l", "r")
;Знакоместа для полей просматриваются слева направо и сверху вниз
!DEFINE Mask="$"
!FORM----------------------------------------------------------------- !FORM¬ Бланк учета отгрузки товара За $$ месяц ¬ !FORM¬ ¬ !FORM¬ Товар: $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ¬ !FORM¬ Стоимость единицы товара: $$$$$$$$$$ ¬
!FIELD[1](l) ;Месяц является первым из параметров !FIELD[2](l) ;Наименование товара !FIELD[3](c) ;Стоимость выравниваем по правому краю
;Предположим, что в дальнейшей части формы необходимо вывести символ "$" ;Для этого переопределим маску:
!DEFINE Mask="#"
;И продолжаем определение формы:
!FORM¬ Количество единиц товара: ###### штук ¬ !FORM¬ Общая сумма в рублях: ######## руб. ¬ !FORM¬ Общая сумма в долларах: ###### $ ¬ !FORML---------------------------------------------------------------- !FIELD[4](r) ;Количество единиц товара !FIELD[5](r) ;Общая сумма в рублях !FIELD[6](r) ;Общая сумма в долларах А это сам unit:
|
unit PrintForm; interface uses SysUtils; {Процедура, осуществляющая запись формы, определенной пользователем. Данные для заполнения этой формы берутся из архива FormData. FormFile - файл с шаблоном формы, оформленным особым образом (см. файл printform.frm) OutFile - файл, в котором будет сохранена заполненная форма Пример использования функции: var FormData: array [0..6] of String; begin FormData[1] := '03'; FormData[2] := 'Потники сушеные в контейнерах'; CharToOem(PChar(FormData[2]), PChar(FormData[2])); FormData[3] := '10000'; FormData[4] := '9'; FormData[5] := '90000'; FormData[6] := '69,23'; PrnForm(FormData, 'D:\MyProg\Forms\fillform.frm', 'D:\MyProg\Forms\_out.frm'); end. } function PrnForm(FormData: array of String; FormFile, OutFile: String): Integer; implementation {Автор: Slava Kostin} {Возвращаемые значения: 0 - все в порядке 1 - не найден файл формы 2 - обнаружена неизвестная команда 3 - неверный числовой параметр 4 - некорректный символ выравнивания -255 - произошла какая-то непонятная ошибка } function PrnForm(FormData: array of String; FormFile, OutFile: String): Integer; const COMMENT = ';'; //Символ комментария const INT_MASK = 0; //Внутренний (для функции) символ, считающийся //маской. Шаблон формы не должен содержать //ни одного символа с кодом, равным INT_MASK. const COMMANDS_QUANTITY = 3; //Количество обрабатываемых команд //Массив имен обрабатываемых команд в теле шаблона формы: const COMMANDS: array [0..COMMANDS_QUANTITY - 1] of String = ( '!DEFINE', '!FORM', '!FIELD' ); var frm_f, out_f: TextFile; i, fld_idx: Integer; isDigit: Boolean; msg, str, param: String; Mask: Char; outform, flds: array of String; align: array of Char; //Функция, возвращающая подстроку строки str, заключенную между //последовательностями символов LeftDelim слева и RightDelim справа function GetWordLimited(str: String; LeftDelim, RightDelim: String): String; begin Result := Copy(str, Pos(LeftDelim, str) + 1, LastDelimiter(RightDelim, str) - Pos(LeftDelim, str) - 1); end; //Данная процедура заменяет текущие символы маски в строке str //на внутренние символы маски для дальнейшей обработки procedure ReplaceMask(var str: String; Mask: Char); var i: Integer; begin for i := 1 to Length(str) do if str[i] = Mask then str[i] := Char(INT_MASK); end; //Центрирование строки str. Длина строки, которая должна быть //получена, задается параметром w. function CenterString(str: String; w: Integer): String; var i: Integer; begin Result := str; if w <= Length(str) then Exit; for i := 1 to (Trunc(w / 2)) do begin Insert(' ', str, 1); str := str + ' '; end; if Length(str) > w then SetLength(str, w); Result := str; end; //Функция, осуществляющая выравнивание содержимого поля //в соответствии с типом выравнивания: // L - по левому краю, // R - по правому краю, // C - по центру function AlignField(fld_idx, w: Integer): String; begin Result := ''; if fld_idx >= Length(flds) then Exit; case align[fld_idx] of 'L': Result := Format('%-' + IntToStr(w) + 's', [flds[fld_idx]]); 'R': Result := Format('%' + IntToStr(w) + 's', [flds[fld_idx]]); 'C': Result := CenterString(flds[fld_idx], w); else Exception.Create('1'); end; end; //Данная функция заменяет первую маску в строке на значение //соответствующего поля. Если строка не содержит маски, //функция возвращает false. При успешной замене - true function PutOneField(var str: String; fld_idx: Integer): Boolean; var first, last: Integer; begin Result := false; first := Pos(Char(INT_MASK), str); if (fld_idx >= Length(flds)) or (first = 0) then Exit; last := first; while (last < Length(str)) and (str[last] = Char(INT_MASK)) do Inc(last); str := Copy(str, 1, first - 1) + AlignField(fld_idx, last - first) + Copy(str, last, Length(str) - last + 1); Result := true; end; //Тело основной функции begin Result := 0; Mask := Char(INT_MASK); try if not FileExists(FormFile) then Exception.Create('1'); AssignFile(frm_f, FormFile); Reset(frm_f); AssignFile(out_f, OutFile); if not FileExists(OutFile) then Rewrite(out_f) else Append(out_f); while not Eof(frm_f) do begin ReadLn(frm_f, str); if Pos(COMMENT, str) <> 0 then //Обрубаем комментарии SetLength(str, Pos(COMMENT, str) - 1); str := Trim(str); if Length(str) > 0 then begin i := 0; while i < COMMANDS_QUANTITY do //Определение команды begin if UpperCase(Copy(str, 1, Length(COMMANDS[i]))) = COMMANDS[i] then Break; Inc(i); end; param := ''; //Когда команда определена, совершаем необходимые действия, //выбор которых производится в зависимости от порядкового //номера данной команды в массиве команд case i of 0: begin //Обработка команды !DEFINE param := UpperCase(Trim(Copy(str, Length(COMMANDS[i]) + 1, Pos('=', str) - Length(COMMANDS[i]) - 1))); if param = 'MASK' then Mask := GetWordLimited(str, '"', '"')[1]; end; 1: begin //Обработка команды !FORM Delete(str, 1, Length(COMMANDS[i])); ReplaceMask(str, Mask); SetLength(outform, Length(outform) + 1); outform[Length(outform) - 1] := str; end; 2: begin //Обработка команды !FIELD Delete(str, 1, Length(COMMANDS[i])); SetLength(flds, Length(flds) + 1); flds[Length(flds) - 1] := FormData[StrToInt(GetWordLimited(str, '[', ']'))]; SetLength(align, Length(align) + 1); align[Length(align) - 1] := UpperCase(GetWordLimited(str, '(', ')'))[1]; end; else Exception.Create('2'); //Если код команды не опознан - выходим с исключением end; end; end; //Шаблон формы и значения полей в том порядке, в котором //они встречаются в шаблоне, считаны целиком. //Далее производится подстановка значений полей на места масок //в шаблоне формы и запись формы в выходной файл: fld_idx := 0; for i := 0 to Length(outform) - 1 do begin while PutOneField(outform[i], fld_idx) do Inc(fld_idx); WriteLn(out_f, outform[i]); end; Close(out_f); Close(frm_f); except //Обработка ошибок, возникших при работе функции on E: EConvertError do //Ошибка преобразования типов begin Result := 3; end; //Все остальные типы ошибок идентифицируются по номеру. //Функция по окончании работы возвращает номер ошибки //(или 0, если в процессе работы не было ошибок) on E: Exception do begin msg := String(E.Message); isDigit := true; for i := 1 to Length(msg) do if not (msg[i] in [Char('0')..Char('9')]) then begin isDigit := false; Break; end; if not isDigit then begin Result := -255; Exit; end; Result := StrToInt(msg); end; end; end; end. |
[001897]
