Графический редактор в Delphi Опции

[TarasBer]

> Ну, как-то вот так (набираю прямо здесь, так что где-то могу и накосячить) :

И тогда можно будет параллельно несколько таких программзапускать и они не будут друг другу мешать?

> Посмотри: С++ Builder6 & Excel

Там как раз всё по-честному сделано.

[IUnknown]

И тогда можно будет параллельно несколько таких программзапускать и они не будут друг другу мешать?

Да, каждая будет работать именно со своим документом.

[RussoTuristo]

С кодом выходят проблемки, файл создается, открывается, но дальше ничего проверить не могу, пара косячков с синтаксисом, не знаю как поправить:

procedure Tf_main.N7Click(Sender: TObject);
var
  i1, i2, j, R: Integer;
  WordApp, Table: Variant;
  fn:string;
begin
if SaveDialog1.Execute then
  begin
  WordApp := CreateOleObject('Word.Application'); // А вот с эти приложением работаем
  WordApp.Visible := True; // Это можно отключить, я включил, чтоб наблюдать за происходящим
  WordApp.Documents.Add; // Новый документ
  WordApp.Selection.Font.Size := 8;
  for j := 0 to ComponentCount - 1 do
    if Components[j] is TEdit then
      with Components[j] as TEdit do
      begin // Saving Edits
     {  WordApp.Selection.TypeText(Edit1.text);
       WordApp.Selection.TypeText(#13#10'new');}
      end
    else
      if Components[j] is TStringGrid then
        with Components[j] as TStringGrid do
        begin // Saving Grigs
          WordApp.ActiveDocument.Tables.Add(WordApp.ActiveDocument.Range,
          RowCount, ColCount);//Ошибка: не удаётся удалить диапазон
          Table := WordApp.ActiveDocument.Tables.Item(1);
          Table.Style := 'Сетка таблицы';
          for i1:=0 to RowCount-1 do
             for i2:=0 to ColCount-1 do
               begin
                Table.Cell(i1+1, i2+1).Range.Text:=Cells[i2, i1];
                WordApp.Visible:=True;
               end;
          WordApp.Selection.TypeText(#13#10'new');
        end
    else
      if Components[j] is TChart then
        with Components[j] as TChart do
        begin // Saving Grigs
         { fn := ExtractFilePath(Application.ExeName) + 'tmp.bmp'; // Тут будет временная картинка
          Chart.SaveToBitmapFile(fn);//Delphi говорит, что нет такого свойства у TChart
          WordApp.Selection.InlineShapes.AddOLEObject(ClassType:='Paint.Picture',
          FileName:=fn, LinkToFile:=False, DisplayAsIcon:=False);
          DeleteFile(fn);
          WordApp.Selection.TypeText(#13#10'new');
        end;   }
        end;
  WordApp.ActiveDocument.SaveAs(SaveDialog1.FileName+'.doc');
  end;
end;

Вызываю процедуру, открывается ворд, начинается заполнение полей таблицы(она встречается первой), таблица полностью заполняется, в первую ячейку кроме её значения записывается какое-то new(как его убрать знаю) и вылетает ошибка: Не удается удалить диапазон. + С TChartoм не знаю что делать, помогите, пожалуйста.

Сообщение отредактировано: RussoTuristo - 10.05.2011 13:31

[IUnknown]

Не знаю, с чем у тебя там проблема, вот этот код работает прекрасно:

procedure Tf_main.N7Click(Sender: TObject);

var
   WordApp, Table : Variant;

   procedure CommentTable(numRows : integer; const s : string);
   begin
      wordapp.selection.MoveDown(wdLine, numRows, EmptyParam);
      wordapp.selection.TypeParagraph;
      wordapp.selection.InsertAfter(Name);
      // снимаем выделение с выведенного текста,
      // чтобы вывод следующей таблицы не затер этот текст
      wordapp.selection.MoveDown(wdLine, 1, EmptyParam);
      wordapp.selection.TypeParagraph;
   end;

var
  i1, i2, j, R: Integer;
  new_doc : Variant;
  fn:string;
  numCols, numRows : Integer;
  s : string;
begin
   if SaveDialog1.Execute then
   begin
      WordApp := CreateOleObject('Word.Application'); // С этим приложением работаем
      WordApp.Visible := True; // Это НЕЛЬЗЯ отключать на Word до 2002, вставка будет работать неправильно!!!
      new_doc := WordApp.Documents.Add; // Новый документ

      for j := 0 to ComponentCount - 1 do
      begin
         if Components[j] is TEdit then
            with Components[j] as TEdit do
            begin // Saving Edits
            (*
               WordApp.Selection.TypeText(Edit1.text);
                  WordApp.Selection.TypeText(#13#10'new');
            *)
            end
         else
            if Components[j] is TStringGrid then
               with Components[j] as TStringGrid do
               begin // Saving Grigs
                  numCols := ColCount;
                  numRows := RowCount;
                  table := new_doc.Tables.Add(WordApp.Selection.Range, numRows, numCols);

                  for i1:=0 to RowCount-1 do
                     for i2:=0 to ColCount-1 do
                     begin
                        Table.Cell(i1+1, i2+1).Range.Text:=Cells[i2, i1];
                     end;

                  Table.Cell(0, 0).Select;
                  // Выводим снизу от таблицы имя компонента.
                  // В принципе, можешь выводить любую информацию.
                  CommentTable(numRows + 1, Name);
               end
            else
               if Components[j] is TChart then
                  begin // Saving Charts
                     fn := ExtractFilePath(Application.ExeName) + 'tmp.bmp';
                     (Components[j] as TChart).SaveToBitmapFile(fn);
                     WordApp.Selection.TypeParagraph;
                     WordApp.Selection.InlineShapes.AddPicture(FileName:=fn,
                        LinkToFile:=False, SaveWithDocument:=True);
                     DeleteFile(fn);
                     wordapp.selection.InsertAfter('Chart : ' + Name);
                     wordapp.selection.MoveDown(wdLine, 1, EmptyParam);
                     WordApp.Selection.TypeParagraph;
                  end;
      end;
      WordApp.ActiveDocument.SaveAs(SaveDialog1.FileName+'.doc');
      WordApp.Quit;
      WordApp := Unassigned;
   end;
end;

(Delphi 2009 + OfficeXP). Если у тебя у Chart-а нет даже метода SaveToBitmapFile - может, это повод задуматься о переходе на более новую версию (или чарта, или Дельфи)? Для Edit-ов доделаешь сам, я не знаю, что тебе там нужно сохранять.

Единственное НО: теперь нельзя оставлять невидимым word application во время сохранения этого отчета (для некоторых версий Word-а). Это баг, сказать "спасибо" за который можно разработчику Оффиса, т.е., MS: MoveDown Method Behaves Incorrectly When Word Is Hidden

Да. И еще: если ты не хочешь, чтоб у тебя в файл забрасывалась таблица, которая в большинстве своем содержит пустые ячейки (а именно это и происходит с GridRoom, там 99 строк, из которых заполнены - всего 4), то или уменьшай RowCount для этого грида, или работай через VarArrayCreate ( как с ним работать - я показывал вот тут: Отчет Excel ), тоже, заполняй только те строки, в которых есть хотя бы одно значение, зачем пустые-то ячейки создавать?

[RussoTuristo]

Спасибо большое, только вот там одна переменная не объявлена: wdLine
Насколько я понял wdLine - значение по умолчанию, но не работает, может для его работы нужно что-нибудь включать в Uses?


Сообщение отредактировано: RussoTuristo - 10.05.2011 17:46

[IUnknown]

Это константа:

const
   wdline = 5;

, ну, или я подключаю Uses ..., WordXP;

[RussoTuristo]

while not TStringGrid.Eof do - не работает, пробовал сделать так, чтобы новая строчка в таблице появлялась после заполнения предыдущей, но тоже что-то так и не нашел нужного свойства.
Помогите, пожалуйста: как сделать чтобы в отчет выводились только заполненные поля?

[IUnknown]

while not TStringGrid.Eof do - не работает

Его там просто нет, поэтому и не работает. Грид - это не файл. Вот так изменяешь кусок, который обрабатывает StringGrid-ы, и все заработает:

            if Components[j] is TStringGrid then
               with Components[j] as TStringGrid do
               begin // Saving Grigs
                  numCols := ColCount;
                  numRows := 0;

                  while Trim(StringReplace(Rows[numRows].Text, #13#10, '', [rfReplaceAll])) <> '' do
                  begin
                     inc(numRows);
                  end;

                  if numRows > 0 then // Пустая таблица? Пропускаем...
                  begin
                     table := new_doc.Tables.Add(WordApp.Selection.Range, numRows, numCols);

                     for i1:=0 to numRows - 1 do
                        for i2:=0 to ColCount-1 do
                        begin
                           Table.Cell(i1+1, i2+1).Range.Text:=Cells[i2, i1];
                        end;

                     Table.Cell(0, 0).Select;
                     // Выводим снизу от таблицы имя компонента.
                     // В принципе, можешь выводить любую информацию.
                     CommentTable(numRows + 1, Name);
                  end
               end

теперь пустые таблицы вообще не выводятся, а заполненные - переносятся в отчет до тех пор, пока не появится первая пустая строка. Как только она появилась - запись заканчивается. Так что если ты планируешь делать таблицы с пустыми строками в середине - то тебе надо сделать чуть-чуть по другому цикл While: идти с конца таблицы, и пока последние строки пустые - уменьшать NumRows.

[RussoTuristo]

Спасибо, огромное!