Домашняя страничка Алексея Бойко


Программы
Delphi
Pезюме
Письмо
КомпьютерПресс
  



Полезные фишки для Delphi


Тут есть несколько полезных фишек для Delphi. Может кому нибудь пригодятся.




Сохранение отчета QuickReport в документ Word

Генерация отчета по макету в виде документа Word

Запуск программ с передачей консольного ввода и чтением вывода





Сохранение отчета QuickReport в документ Word

Идея состоит в том, чтобы сохранять страницы, сформированные QuickReport-ом в файл формата .WMF, а затем вставлять их через OLE в документ Word в виде картинок. Полученный документ конечно будет трудно редактировать (хотя возможно - встроенным вордовым редактором картинок), но зато достигается 100%-ное соответствие тому что получилось в QR.

uses Windows,SysUtils,QuickRpt,ComObj,Word97;

procedure SaveQuickReport(QR:TQuickRep; FN:string);
var
  i : integer;
  Word : OleVariant;
  TempDir : string;

begin
  SetLength(TempDir,200);
  GetTempPath(199,@TempDir[1]);
  SetLength(TempDir,StrLen(PChar(@TempDir[1])));

  QR.Prepare;
  try
    Word := CreateOLEObject('Word.Application');
    Word.Visible := true;
    Word.Documents.Add;

    for i := QR.QRPrinter.PageCount downto 1 do
    begin
      Application.ProcessMessages;
      DeleteFile(TempDir+'page'+IntToStr(i)+'.wmf');

      QR.QRPrinter.GetPage(i).SaveToFile(
                TempDir+'page'+IntToStr(i)+'.wmf');

      Word.ActiveDocument.Shapes.AddPicture(
                Anchor:=Word.Selection.Range,
                FileName:=TempDir+'page'+IntToStr(i)+'.wmf',
                LinkToFile:=False,
                SaveWithDocument:=True);

      if i>1 then
      begin
        Word.Selection.InsertBreak(Type:=wdPageBreak);
        Word.Selection.HomeKey(Unit:=wdStory);
      end;
    end;

    // Масштабирование картинки.
    // Коэффициенты подобраны экспериментально.

    Word.ActiveDocument.Shapes.SelectAll;
    Word.Selection.ShapeRange.LockAspectRatio := True;
    Word.Selection.ShapeRange.Width := 596.1;
    Word.Selection.ShapeRange.Height := 843.34;

    Word.ActiveDocument.SaveAs(FileName:=FN);
    Word.ActiveDocument.Saved := true;
  finally
    try Word.Quit except end;
    try VarClear(Word); except end;

    // Удаление временных файлов сделано после создания документа,
    // иначе под Win9X иногда наблюдались конфликты, IMXO
    // связанные с тем что Word не успевал выполнить вставку
    // картинки из временного файла.

    for i := 1 to QR.QRPrinter.PageCount do
      DeleteFile(TempDir+'page'+IntToStr(i)+'.wmf');
  end;
end;


Генерация отчета по макету в виде документа Word

Тут идея состоит в том, чтобы в качестве генератора отчетов использовать сам Word. А в качестве макета отчета использовать документ Word в котором расставлены теги. Теги - это некоторый набор зарезервированных слов, которые не встречаются в тексте отчета. Я бы например по аналогии с HTML в качестве тегов предложил брать имена полей данных, заключенные в угловые скобки. В процессе генерации отчета надо брать макет отчета, заменять в нем теги на реальные данные и дописывать в конец сформированного документа. Надо только позаботится о том, чтобы после вставки в макет документа реальных данных не нарушалось его форматирование. Для этого можно пользоваться таблицами, формами Word и т.п. А вот так это реализовано:


uses Windows,SysUtils,Dialogs,Printers,Db,ComObj,Word97;

procedure MakeReport(
              var Query : TDataSet; // Открытый DataSet с данными 
              MaketDoc : string;    // Макет отчета                
              PreviewMode,          // Режим посмотра или печати
              PageBreaks:boolean);  // Экземпляры с новой страницы
var
  Word      : OleVariant;
  DocReport : OleVariant;
  DocMaket  : OleVariant;
  DocTemp   : OleVariant;
  WndReport : OleVariant;
  WndMaket  : OleVariant;
  WndTemp   : OleVariant;
  MaketTemp : string;
  i,Pn      : integer;
begin
  if not FileExists(MaketDoc) then
  begin
    MessageDlg('Файл '+MaketDoc+' не найден',
               mtError,[mbOK],0);
    Exit;
  end;

  // Я копирую макет, так как иногда в случае сбоев
  // при работе с OLE он как-то некорректно закрывался
  // и в результате портился.

  SetLength(MaketTemp,200);
  GetTempPath(199,@MaketTemp[1]);
  SetLength(MaketTemp,StrLen(PChar(@MaketTemp[1])));
  MaketTemp := MaketTemp+ExtractFileName(MaketDoc);
  CopyFile(PChar(MaketDoc),PChar(MaketTemp),false);

  try
    Word := CreateOLEObject('Word.Application');
    Word.Visible := true;

    Word.Documents.Add;
    DocReport := Word.ActiveDocument;
    WndReport := Word.ActiveWindow;
    Word.ActiveWindow.View.Type := wdPageView;

    Word.Documents.Open(MaketTemp);
    DocMaket  := Word.ActiveDocument;
    WndMaket  := Word.ActiveWindow;

    Word.Documents.Add;
    DocTemp   := Word.ActiveDocument;
    WndTemp   := Word.ActiveWindow;

    Query.First;

    while not Query.Eof do
    begin

      // Копирование макета во временный документ

      WndMaket.Activate;
      Word.Selection.WholeStory;
      Word.Selection.Copy;
      WndTemp.Activate;
      Word.Selection.WholeStory;
      Word.Selection.Paste;

      // Заполнение данных

      for i := 0 to Query.Fields.Count-1 do
      begin
        Word.Selection.Find.ClearFormatting;
        Word.Selection.Find.Replacement.ClearFormatting;
        Word.Selection.Find.Text :=
          '<'+Query.Fields[i].FieldName+'>';
        Word.Selection.Find.Replacement.Text :=
          Query.Fields[i].AsString;
        Word.Selection.Find.Forward := true;
        Word.Selection.Find.Wrap := wdFindContinue;
        Word.Selection.Find.Format := false;
        Word.Selection.Find.MatchCase := false;
        Word.Selection.Find.MatchWholeWord := false;
        Word.Selection.Find.MatchWildcards := false;
        Word.Selection.Find.MatchSoundsLike := false;
        Word.Selection.Find.MatchAllWordForms := false;
        Word.Selection.Find.Execute(Replace:=wdReplaceAll);
      end;

      // Добавление в конец отчета

      WndTemp.Activate;
      Word.Selection.WholeStory;
      Word.Selection.Copy;
      WndReport.Activate;
      Word.Selection.Paste;

      // Добавляем PageBreak если надо
      if PageBreaks then
        Word.Selection.InsertBreak(Type:=wdPageBreak);

      Query.Next;
    end;

    Word.Application.Browser.Previous;
    Word.Selection.HomeKey(Unit:=wdStory);

    DocTemp.Saved := true;
    DocTemp.Close;
    DocMaket.Saved := true;
    DocMaket.Close;

    DeleteFile(PChar(MaketTemp));

    if PreviewMode then
    begin
      // Просто оставляем Word с созданным в нем отчетом 
      Word.Visible := true;
    end else
    begin
      // Печатаем отчет, здесь неплохо бы сначала диалог выбора
      // принтера показать (у меня так и было сделано).

      Pn := Printer.PrinterIndex;
      Word.ActivePrinter := Printer.Printers[Printer.PrinterIndex];
      Printer.PrinterIndex := Pn;
      Word.PrintOut(FileName:='',
                    Range:=wdPrintAllDocument,
                    Item:=wdPrintDocumentContent,
                    Copies:=1,Pages:='',
                    PageType:=wdPrintAllPages,
                    Collate:=True,Background:=False,
                    PrintToFile:=False);
      DocReport.Saved := true;
      DocReport.Close;
      Word.Quit;
    end;
  except end;

  try VarClear(Word); except end;
  try VarClear(DocMaket); except end;
  try VarClear(DocTemp); except end;
  try VarClear(DocReport); except end;
  try VarClear(WndMaket); except end;
  try VarClear(WndTemp); except end;
  try VarClear(WndReport); except end;
end;

Данный пример немного упрощенный. По хорошему, при большом общем количестве тегов для ускорения лучше сначала проверить, какие из них реально встречаются в макете. И затем заменять только их.


Запуск программ с передачей консольного ввода и чтением вывода

Это пример запуска консольных программ с передачей ей консольного ввода (как если бы он был введен с клавиатуры после запуска программы) и чтением консольного вывода. Таким способом можно запускать например стандартный виндовый ftp.exe (в невидимом окне) и тем самым отказаться от использования специализированных глючных компонент.

function ExecuteFile(FileName,StdInput: string; TimeOut: integer; var StdOutput:string) : boolean;

label Error;

type
  TPipeHandles = (IN_WRITE,  IN_READ,
                  OUT_WRITE, OUT_READ,
                  ERR_WRITE, ERR_READ);

type
  TPipeArray = array [TPipeHandles] of THandle;

var
  i         : integer;
  ph        : TPipeHandles;
  SA        : TSecurityAttributes;
  Pipes     : TPipeArray;
  StartInf  : TStartupInfo;
  ProcInf   : TProcessInformation;
  Buf       : array[0..1000] of byte;
  Bytes     : DWord;
  TimeStart : TDateTime;

begin
  Result := false;
  for ph := Low(TPipeHandles) to High(TPipeHandles) do Pipes[ph] := INVALID_HANDLE_VALUE;

  // Создаем пайпы

  sa.nLength := sizeof(sa);
  sa.bInheritHandle := TRUE;
  sa.lpSecurityDescriptor := nil;

  if not CreatePipe(Pipes[IN_READ],Pipes[IN_WRITE], @sa, 0 ) then goto Error;
  if not CreatePipe(Pipes[OUT_READ],Pipes[OUT_WRITE], @sa, 0 ) then  goto Error;
  if not CreatePipe(Pipes[ERR_READ],Pipes[ERR_WRITE], @sa, 0 ) then  goto Error;

  // Пишем в STDIN

  WriteFile(Pipes[IN_WRITE],PChar(StdInput+^Z)^,Length(stdInput)+1,Bytes,nil);

  // Хендл записи в StdIn надо закрыть - иначе выполняемая
  // программа может не прочитать или прочитать не весь StdIn.

  CloseHandle(Pipes[IN_WRITE]);
  Pipes[IN_WRITE] := INVALID_HANDLE_VALUE;

  FillChar(StartInf,sizeof(TStartupInfo),0);
  StartInf.cb := sizeof(TStartupInfo);
  StartInf.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;

  StartInf.wShowWindow := SW_SHOW; // Или SW_HIDE если надо запустить невидимо

  StartInf.hStdInput := Pipes[IN_READ];
  StartInf.hStdOutput := Pipes[OUT_WRITE];
  StartInf.hStdError := Pipes[ERR_WRITE];

  if not CreateProcess(nil, PChar(FileName), nil,
                       nil, True, NORMAL_PRIORITY_CLASS,
                       nil, nil, StartInf, ProcInf) then goto Error;

  TimeStart := Now;

  repeat
    Application.ProcessMessages;
    i := WaitForSingleObject(ProcInf.hProcess,100);
    if i = WAIT_OBJECT_0 then break;
    if (Now-TimeStart)*SecsPerDay>TimeOut then break;
  until false;

  if i<>WAIT_OBJECT_0 then goto Error;

  // Закрываем хендл записи в STDOUT чтобы прочитать консольный вывод

  CloseHandle(Pipes[OUT_WRITE]);
  Pipes[OUT_WRITE] := INVALID_HANDLE_VALUE;

  // Читаем STDOUT
   
  StdOutput := '';
  repeat
    Bytes:= 0;
    ReadFile(Pipes[OUT_READ],Buf,SizeOf(Buf),Bytes,nil);
    if Bytes=0 then break;
    i := Length(StdOutput);
    SetLength(StdOutput,i+Bytes);
    Move(Buf[0],StdOutput[i+1],Bytes);
  until false;

  for ph := Low(TPipeHandles) to High(TPipeHandles) do
  if Pipes[ph]<>INVALID_HANDLE_VALUE then CloseHandle(Pipes[ph]);

  CloseHandle(ProcInf.hProcess);
  CloseHandle(ProcInf.hThread);
  Result := true;
  Exit;

Error:
  if ProcInf.hProcess<>INVALID_HANDLE_VALUE then
  begin
    CloseHandle(ProcInf.hThread);
    i := WaitForSingleObject(ProcInf.hProcess, 1000);
    CloseHandle(ProcInf.hProcess);
    if i<>WAIT_OBJECT_0 then
    begin
      ProcInf.hProcess := OpenProcess(PROCESS_TERMINATE, FALSE, ProcInf.dwProcessId);
      if ProcInf.hProcess <> 0 then
      begin
        TerminateProcess(ProcInf.hProcess, 0);
        CloseHandle(ProcInf.hProcess);
      end;
    end;
  end;
  for ph := Low(TPipeHandles) to High(TPipeHandles) do
  if Pipes[ph]<>INVALID_HANDLE_VALUE then CloseHandle(Pipes[ph]);
end;