28.12.2012, 00:55
общий
это ответ
Здравствуйте, Nike!
Предлагаю следующий вариант решения.
На форме Button1 и Edit1 (для результата)
Исходный файл 1.doc находится на диске C:
Код и описание в приложении.
Основываемся на том, что объекты при создании имеют имена типа "Line 2", "Oval 4" и т.д.
Вопросы - пишите в форум.
Удачи
Приложение:
uses ..., ComObj, StrUtils; // добавляем модули
...
procedure TForm1.Button1Click(Sender: TObject);
var
W, D: variant;
i, j, count_tip: integer;
tip: string;
tip_mas: array of string;
priznak: boolean;
begin
W:= CreateOleObject('Word.Application'); //запускаем Word
W.Visible:= True;
D:= W.Documents.Open('C:\1.doc'); // открываем файл
count_tip:= 0;
SetLength(tip_mas, count_tip); //обнулили массив
for i:= 1 to D.Shapes.Count do // "пробегаем" по объектам Shapes
begin
tip:= D.Shapes.Item(i).Name; // считываем имя
tip:= leftStr(tip, Pos(' ', tip) - 1); // выделяем тип объекта
if count_tip = 0 then // создаем первый элемент массива типов
begin
count_tip:= 1;
SetLength(tip_mas, count_tip);
tip_mas[count_tip-1] := tip;
end;
if count_tip > 0 then // заполняем остальные типы, предварительно "пробежав" по массиву
begin
priznak:= False;
for j:= 0 to count_tip - 1 do
if tip_mas[j] = tip then priznak:= True;
if not priznak then // если совпадений нет - то добавляем тип
begin
count_tip:= count_tip + 1;
SetLength(tip_mas, count_tip);
tip_mas[count_tip-1] := tip;
end;
end;
end;
if count_tip > 0 then //выводим результат
Edit1.Text := IntToStr(count_tip)
else
Edit1.Text := '0';
D.Save; // сохраняем, закрываем, выходим из Word
D.Close;
W.Quit;
W:= UnAssigned;
end;