Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Как из .doc получить картинки?

Автор: splot 29.9.2003, 21:23

Как вордовский документ нарезать на куски и преобразовать их в картику. Текст документа такого вида:
"1.Что такое Windows XP
a) Новая игра, которая не работает б)Вирус
в) Операционная среда г)Операционная система

2. Что такое ....?
а) б)
в) г)

3. "

и так далее. Т.е у нас есть набор из N штук вопросов в текстовом
файле doc, а нужно получить N картинок с этими же вопросами в
jpeg, bmp или gif.

мой e-mail: splot@list.ru Заранее спасибо.

Автор: x77 29.9.2003, 22:23

Распечатать на принтере, разрезать на картинки, и отсканировать. [censored34! Пожалуйста, соблюдайте элементарные правила приличия при общении на форуме] вопрос

)

Автор: x77 29.9.2003, 22:31

писал злобное пиьсмище, хорошо, что слетело...

психиатр! в студию!

Автор: splot 29.9.2003, 22:40

Да, а если у тебя страниц 200 теста? Ты их будешь печатать? А затем целый день резать и еще день сканировать? Вся фишка в том, что всё это - лишь промежуточный материал. В дальнейшем эти файлики надо будет уже использовать в другом приложение. Все должно быть быстро! Ответ твой ничем не помог, вот так то!

Автор: <Spawn> 30.9.2003, 04:58

Открываешь документ:

Код

function ActivateWord():Variant;
var
AppProgID:string;
hRes:HRESULT;
Unknown:IUnknown;
begin
Result:=UnAssigned;
AppProgID:='Word.Application';
hRes:=GetActiveObject(ProgIDToClassID(AppProgID),nil,Unknown);
if hRes=MK_E_UNAVAILABLE then
  Result:=CreateOleObject(AppProgID)
else
  Result:=GetActiveOleObject(AppProgID);
end;

var
Word:Variant;

Word:=ActivateWord;
Word.Open('C:\MyDocument.doc');

2)В цикле разбиваешь этот текст на группы. Я его не видел так что не могу сказать по какому признаку искать разделитель.

3)затем выводишь этот текст, к примеру, на Canvas TBitMap-а и сохраняешь в BMP:

Код

var
BitMap:TBitMap;
begin
try
BitMap:=TBitMap.Create;
//Настраиваешь размер картинки
BitMap.Width:=...
BitMap.Height:=...
//Выводишь твой текст
BitMap.Canvas.TextOut(10,10,...);
BitMap.Canvas.TextOut(10,30,...);
...
//Ну и сохраняешь все это
BitMap.SaveToFile();
finally
FreeAndNil(BitMap);
end;

Автор: splot 30.9.2003, 08:58

За код спасибо! Попробую! А текст должен резаться на куски, содержащие тольео один вопрос. Например первый кусок: "
1.Что такое Windows XP
a) Новая игра, которая не работает б)Вирус
в) Операционная среда г)Операционная система

", затем в другой картинке - другой вопросик.

Автор: x77 30.9.2003, 10:07

splot, извини за резкость, но как ты мог заметить, я и не пытался помочь. меня равно бесят задачи, как некорректно поставленные, так и некорректно решаемые.

Автор: splot 30.9.2003, 18:41

А может быть есть ещё какое-нибудь решение? Подскажите...

Автор: <Spawn> 30.9.2003, 19:07

А чем тебе это не нравится?

Автор: splot 30.9.2003, 19:20

Часто одну и туже проблему можно решить несколькими способами. И знание лишнего способа не помешает. А так, Spawn, твоё решение меня очень даже устраивает.

Автор: Guest 1.10.2003, 16:07

Еще вопросик. Как разрезать текст на куски, если считать, что новый кусок начинается с пустой строки?

Автор: Dmitry V.Abramov 1.10.2003, 16:39

У тебя же написано - "новый кусок начинается с пустой строки". Значит не надо ничего резать. Он у тебя уже порезан. Пустыми строками.

Автор: <Spawn> 2.10.2003, 14:42

Цитата(Guest @ 1.10.2003, 08:07)

Еще вопросик. Как разрезать текст на куски, если считать, что новый кусок начинается с пустой строки?

Ну вот попробуй:

Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActiveX, ComObj, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog: TOpenDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function ActivateWord():Variant;
var
AppProgID:string;
hRes:HRESULT;
Unknown:IUnknown;
begin
Result:=UnAssigned;
AppProgID:='Word.Application';
hRes:=GetActiveObject(ProgIDToClassID(AppProgID),nil,Unknown);
if hRes=MK_E_UNAVAILABLE then
 Result:=CreateOleObject(AppProgID)
else
 Result:=GetActiveOleObject(AppProgID);
end;


procedure TForm1.Button1Click(Sender: TObject);
var
Word:Variant;
Document:Variant;
DocList:TStringList;
i, j, FirstIndex, ImageCount:integer;
BitMap:TBitMap;
begin
if OpenDialog.Execute then
begin
  Word:=ActivateWord;
  Document:=Word.Documents.Open(OpenDialog.FileName);
  try
    DocList:=TStringList.Create;
    DocList.Text:=Document.Range.Text;
    FirstIndex:=0;
    ImageCount:=0;
    for i:=0 to DocList.Count-1 do
      if Length(DocList[i])=0 then
      try
        BitMap:=TBitMap.Create;
        BitMap.Width:=500;
        BitMap.Height:=((i-1)-FirstIndex)*20+30;
        for j:=0 to (i-1)-FirstIndex do
          BitMap.Canvas.TextOut(10, j*20+10, DocList[j+FirstIndex]);
        FirstIndex:=i+1;
        Inc(ImageCount);
        BitMap.SaveToFile(Format('Test%d.bmp',[ImageCount]));
      finally
        FreeAndNil(BitMap);
      end;
  finally
    FreeAndNil(DocList);
    Word.Quit;
    Word:=UnAssigned;
  end;
end;
end;

end.

Тебе нужно будет дополнить этот код проверкой конца всего документа, иначе если последняя строка не будет пустой, то последний блок не сохраниться(или же просто вставь пустую строку в конце). Если же длина пустой строки у тебя не равно 0, то можно проверять на наличие пустого символа в начале строки, т.е.

Код

if CompareStr(DocList[i][1], ' ')=0 then

Автор: Guest 2.10.2003, 16:21

Спасибо тебе ещё раз. Большое спасибо! Сейчас всё попробую.