Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2005.08.07;
Скачать: CL | DM;

Вниз

достать картинки из Вордового документа   Найти похожие ветки 

 
_Dragon ©   (2004-10-21 21:53) [0]

Есть документ Ворда, в котором содержится туева хуча картинок. Каким способом с помощью Delphi можно все эти картинки сохранить каждую в отдельный файл???


 
ИМХО ©   (2004-10-22 07:26) [1]

используя OLE-автоматизацию (коллекция Shapes)


 
_Dragon ©   (2004-10-22 23:40) [2]

ну понятно, что через OLE! А каким способом это сделать?


 
vertal ©   (2004-10-23 00:01) [3]

Я решал такую задачу для формата jpeg, могу поделиться кодом:
Примерно так:

Var
MSWOrd:Variant;
Begin
 CoInitialize(Nil);
 MsWord := CreateOleObject("Word.Application");
 MsWord.Documents.Open(FileName:="SomeFile",ConfirmConversions:=False,ReadOnly:=True,AddToRecentFiles:=False,Format:= wdOpenFormatAuto);
 MsWord.ActiveDocument.Shapes(1).Select;
 MsWord.ActiveDocument.Selection.Copy;
 SaveClipboardBitMapImageToJPEGFile("YourFile.jpg");
 MsWord.ActiveDocument.Close(SaveChanges:=wdDoNotSaveChanges);
 MSWord.Quit(SaveChanges:=wdDoNotSaveChanges);
 MSWord:=0;
CoUninitialize();
End;
...
library savejpeg;
uses jpeg,clipbrd,windows,graphics;

Function CheckForMetaFile():LongInt;
Var
 mHDC,rHDC:THandle;
 pMFP:^METAFILEPICT;
 HG:HGLOBAL;
 hBitmap:THandle;
 xWidth,yWidth:LongInt;
 LastObj:HGDIOBJ;
Begin
 Result:=ERROR_SUCCESS;
 if not IsClipboardFormatAvailable(CF_BITMAP)
   and IsClipboardFormatAvailable(CF_METAFILEPICT)then
 Begin
   rHDC:=GetDC(0);
   mHDC:=CreateCompatibleDC(rHDC);
   OpenClipboard(0);
   HG:=GetClipboardData(CF_METAFILEPICT);
   pMFP := GlobalLock(HG);
   SetMapMode(mhdc, pmfp^.mm);
   if (pmfp^.mm=MM_ISOTROPIC)or(pmfp^.mm=MM_ANISOTROPIC)and(pmfp^.xExt>0)then
   Begin
     xWidth:=Integer(Round(pmfp^.xExt * GetDeviceCaps(mhdc, HORZRES) /
       GetDeviceCaps(mhdc, HORZSIZE) / 100));
     yWidth:=Integer(Round(pmfp^.yExt * GetDeviceCaps(mhdc, VERTRES) /
        GetDeviceCaps(mhdc, VERTSIZE) /100));
     hBitmap:=CreateCompatibleBitmap(rHDC,xWidth,yWidth);
     LastObj:=SelectObject(mHDC,hBitmap);
     SetViewportExtEx(mhdc,xWidth,yWidth,Nil);
     PlayMetaFile(mHDC,pMFP^.hMF);
     SelectObject(mHDC,LastObj);
     SetClipboardData(CF_BITMAP,hBitmap);
   End;
    GlobalUnlock(HG);
    CloseClipboard();
    DeleteDC(mHDC);
    ReleaseDC(0,rHDC);
 End;
End;

Function SaveClipboardBitMapImageToJPEGFile(Quality:LongInt;FileName:PChar):
 LongInt;stdcall;
var
 jp: TJPEGImage;
 tp: TPicture;
Begin
 CheckForMetaFile;
 Result:=ERROR_SUCCESS;
 try
   tp:=TPicture.Create;
   try
     tp.RegisterClipboardFormat(cf_BitMap,TBitMap);
     tp.LoadFromClipboardFormat(cf_bitmap,ClipBoard.GetAsHandle(cf_Bitmap),0);
     try
       jp := TJPEGImage.Create;
       try
         jp.CompressionQuality := Quality;
         jp.Assign(tp.Bitmap);
         jp.Compress;
         try
           jp.SaveToFile(FileName);
         except
           Result:=ERROR_FILE_NOT_FOUND;
         end;
       except
         Result:=ERROR_OUTOFMEMORY;
       end;
       jp.Free;
     except
       Result:=ERROR_OUTOFMEMORY;
     end;
     tp.UnregisterGraphicClass(TBitMap);
   except
     Result:=ERROR_OUTOFMEMORY;
   end;
   tp.Free;
 except
   Result:=ERROR_OUTOFMEMORY;
 end;
end;

exports
 SaveClipboardBitMapImageToJPEGFile;
end.


 
_Dragon ©   (2004-10-23 00:09) [4]

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



Страницы: 1 вся ветка

Текущий архив: 2005.08.07;
Скачать: CL | DM;

Наверх




Память: 0.48 MB
Время: 0.062 c
3-1119954763
pashtet
2005-06-28 14:32
2005.08.07
Компонент для выполнения скрипта БД.


3-1119761090
funman
2005-06-26 08:44
2005.08.07
Файлы *.qr2 , чем открыть редактировать?


14-1121287090
Piter
2005-07-14 00:38
2005.08.07
Аналог CreateRemoteThread в *nix


14-1121179495
Кастусик
2005-07-12 18:44
2005.08.07
Хелп. При отладке в Дельфи виснет ХР


14-1121765884
YurikGL
2005-07-19 13:38
2005.08.07
Хранение картинок в базе или в файле IB