Главная страница
    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.042 c
1-1121508981
286
2005-07-16 14:16
2005.08.07
Проблема с кодировкой


14-1121727655
kaif
2005-07-19 03:00
2005.08.07
А у нас есть такая организация? В США - есть.


14-1121418558
Андрей Жук
2005-07-15 13:09
2005.08.07
Интересно, теперь будут ли книги выпускать на такой бумаге?


6-1114770999
syte_ser78
2005-04-29 14:36
2005.08.07
Сетевой алиасс


3-1120121446
LostDelpher
2005-06-30 12:50
2005.08.07
Как узнать какие команды использует OLE DB





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский