Работая эникеем в турфирме, мне пару лет назад пришлось столкнуться с забавной (на первый взгляд) схемой выставления счёта клиенту:
Менеджер формирует счёт в виде Word документа => Распечатывает его => Расписывается => Ставит печать => Отдаёт секретарю => Секретарь сканирует документ => Отправляет менеджеру => Менеджер отправляет счёт клиенту.
В сезон, когда поток таких счетов увеличивался в разы, данный процесс мог затянуться на довольно большое время.
Решение, как обычно, лежало на поверхности — найти конвертор Doc в JPEG (или GIF).
Не тут-то было: программа либо стоит денег (например UDC — $200-$500), которые в принципе на ПО не выделяют, либо она сложна для конечного пользователя. К тому-же на документы нужно ставить печать и подпись, желательно уникальную для каждого пользователя.
В общем, пришлось решать самостоятельно. Код на Delphi. Работоспособность проверена на Office 2003.
Итак, входные параметры:
имя doc файла, флажки «выходной файл цветной/чб», «печать и подпись нужны/не нужны», status — компонент, которому передаётся лог.
function ConvertMSWORDToImages(const AFileName: string; need_stamp, gray: boolean; status: TStatusBar): Integer;
var
lWord: Variant;
lFN: string;
lPages: Variant;
lPageNum: Integer;
lPage: Variant;
lRect: Variant;
lRange: Variant;
i, j, k: longword;
lBmp, podp, stamp: TBitmap;
lMF: TMetafile;
lJPG: TJPEGimage;
imgw, podp_x_offset, podp_y_offset, stamp_x_offset, stamp_y_offset: integer;
ini: TIniFile;
uname: string;
begin
Result := -1;
status.SimpleText:='Подключаемся к Word...';
lWord := CreateOleObject( 'Word.Application' );
status.SimpleText:='Подключились к Word...';
//Готовим поверхности
lBmp := TBitmap.Create;
stamp := TBitmap.Create;
podp := TBitmap.Create;
lMF := TMetafile.Create;
//Читаем конфигурацию из ini файла
ini := TIniFile.Create(ExtractFilePath(Application.ExeName)+'/config.ini');
uname := ini.ReadString('User','name','test');
stamp.LoadFromFile(ExtractFilePath(Application.ExeName)+ini.ReadString(uname,'stamp','stamp.bmp'));
stamp.Transparent:=true;
stamp.TransparentColor:=stamp.Canvas.Pixels[10,10];
stamp.TransparentMode:= tmAuto;
stamp_x_offset := ini.ReadInteger(uname, 'stamp_x_offset', 200);
stamp_y_offset := ini.ReadInteger(uname, 'stamp_y_offset', 0);
podp.LoadFromFile(ExtractFilePath(Application.ExeName)+ini.ReadString(uname, 'podpis', 'podp.bmp'));
podp.Transparent:=true;
podp.TransparentColor:=podp.Canvas.Pixels[10,10];
podp.TransparentMode:= tmAuto;
podp_x_offset := ini.ReadInteger(uname, 'podp_x_offset', 150);
podp_y_offset := ini.ReadInteger(uname, 'podp_y_offset', 180);
imgw:=ini.ReadInteger(uname,'imgw',800);
lJPG := TJPEGimage.Create;
lJPG.Grayscale:=gray;
lJPG.CompressionQuality:=ini.ReadInteger(uname, 'quality', 60);
try
status.SimpleText:='Загружаем документ...';
lWord.Documents.Open(FileName := AFileName, ReadOnly := True );
status.SimpleText:='Документ загружен...';
lPages := lWord.ActiveDocument.ActiveWindow.Panes.Item(1).Pages;
//Цикл по страницам
for i := 1 to lPages.Count do
begin
status.SimpleText:='Обработка страницы '+inttostr(i)+'...';
lPage := lPages.Item(i);
try lPage:=lPages.Item(i); except end;
if>@lPage<>Nil then
//Цикл по блокам на странице
for j := 1 to lPage.Rectangles.Count do
begin
try
lRect := lPage.Rectangles.Item(j);
lRange := lRect.Range;
if @lRange=Nil then break;
except
end;
//Непосредственно преобразование
try
//Копируем блок в буфер как изображение
lRange.CopyAsPicture;
if Clipboard.HasFormat(CF_METAFILEPICT) then
begin
lMF.Assign( Clipboard );
if not lMF.Empty then
begin
lBmp.Width:=lMF.Width;
lBmp.Width:=imgw;
lBmp.Height:=round((lMF.Height/lMF.Width)*imgw)+stamp.Height-100;
//Копируем содержимое буфера в Bitmap
lBmp.Canvas.StretchDraw(rect(0,0,imgw,round((lMF.Height/lMF.Width)*imgw)), lMF );
if need_stamp then
begin
lBmp.Canvas.Draw(stamp_x_offset,lBmp.Height-stamp.Height-stamp_y_offset,stamp);
lBmp.Canvas.Draw(podp_x_offset,lBmp.Height-podp_y_offset,podp);
end;
ljpg.Assign(lbmp);
FrmConv.sd.FileName:=Format( '%s%s_%d%d.jpg', [ExtractFilePath(AFileName), stringreplace(ExtractFileName(AFileName),ExtractFileExt(AFileName),'',[rfReplaceAll]), i,j]);
//Всё. Сохраняем блок в файл.
if ((j=1) and (i=1)) then FrmConv.sd.Execute;
try
ljpg.SaveToFile(stringreplace(FrmConv.sd.FileName,'.jpg','',[rfReplaceAll])+'.jpg');
except
end;
lMF.Clear;
lBmp.Canvas.FillRect(rect(0,0,lbmp.Width,lbmp.Height));
end;
end;
except
end;
end;
end;
finally
lBmp.Free;
lMF.Free;
ljpg.Free;
lWord.Quit;
lWord := Unassigned;
end;
status.SimpleText:='Преобразование успешно завершено';
ShowMessage('Преобразование успешно завершено');
end;
Результат получается такой
Возможно, это очередное изобретение велосипеда, но данной утилитой пользуется несколько «не очень технологичных» фирм. Код крайне далёк от идеала, плохо работает со сложными по структуре документами, но определённое количество времени и нервов он всё-таки экономит.
Компилированный файл