Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Corba";
Текущий архив: 2005.08.07;
Скачать: [xml.tar.bz2];

Вниз

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

 
_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 вся ветка

Форум: "Corba";
Текущий архив: 2005.08.07;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.46 MB
Время: 0.026 c
14-1121313091
Soft
2005-07-14 07:51
2005.08.07
Во Второй Мировой Войне виноват Советский Союз.


3-1119874036
bigcrush
2005-06-27 16:07
2005.08.07
Запрос удаления повторяющихся данных на SQL


9-1113835930
_sHaDe_
2005-04-18 18:52
2005.08.07
Полёт пули(GLScene)


4-1118400248
Андрей Жук
2005-06-10 14:44
2005.08.07
Я чего-то не понимаю?


9-1114070737
Xeno
2005-04-21 12:05
2005.08.07
Вопрос по демке GLScene multiproxy





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский