Новичок
Профиль
Группа: Участник
Сообщений: 16
Регистрация: 24.7.2015
Репутация: нет Всего: нет
|
Здравствуйте! Есть один пример который позволяет добавлять Картинки в RichEdit'e, вместо букв! . Мне необходимо сделать обратный процесс извлечь и сохранить все картинки в какую-нибудь папку. У меня получилось извлечь и сохранить только одну картинку и то с помощью перетаскивания, её на форму. (Код на Delphi 7) Код | unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, RichEdit, ExtDlgs, ComCtrls, ExtCtrls, ActiveX, ComObj, re_bmp;
type TForm1 = class(TForm) Image1: TImage; RichEdit1: TRichEdit; OpenPictureDialog1: TOpenPictureDialog; Button1: TButton; Edit1: TEdit; Button2: TButton; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } public { Public declarations } end;
var Form1: TForm1;
implementation {$R *.dfm}
type TMyDropTarget = class(TInterfacedObject, IDropTarget) protected function DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; function DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; function DragLeave: HResult; stdcall; function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; end; procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then begin Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName); InsertBitmapToRE(RichEdit1.Handle, Image1.Picture.Bitmap.Handle); end; end;
{ TMyDropTarget }
function TMyDropTarget.DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; begin Result := S_OK; end;
function TMyDropTarget.DragLeave: HResult; begin Result := S_OK; end;
function TMyDropTarget.DragOver(grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; begin Result := S_OK; end;
function TMyDropTarget.Drop(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; var IREO:IRichEditOle; ReObject:TReobject; Count:Integer; I:Integer; FMT : FORMATETC; MED : STGMEDIUM; Path:String; dataObj1:IDataObject; bmp:TBitmap; Position:LongInt; BitsLength:UINT; MetaFile:TMetafile; Bits:Pointer; MetafilePictPtr: PMetafilePict; begin Path:='C:\_temp\richedit\'; SendMessage(Form1.RichEdit1.Handle, EM_GETOLEINTERFACE, 0, Longint(@IREO)); Count:=IREO.GetObjectCount;
for I := 0 to Count - 1 do begin
ZeroMemory(@ReObject,SizeOf(ReObject)); ReObject.cbStruct:=SizeOf(ReObject); if Succeeded(IREO.GetObject(I,ReObject, $00000001)) then begin Position:=ReObject.cp; Form1.Edit1.Text:=IntToStr(Position); if ReObject.poleobj.QueryInterface(IDataObject,dataObj1)=S_OK then begin FMT.cfFormat := CF_METAFILEPICT; FMT.ptd := nil; FMT.dwAspect := DVASPECT_CONTENT; FMT.lindex := -1; FMT.tymed := TYMED_MFPICT; if Succeeded(dataObj.GetData(FMT,MED)) then try MetafilePictPtr:=GlobalLock(MED.hMetaFilePict); try BitsLength:=GetMetaFileBitsEx(MetafilePictPtr.hMF,0,nil); GetMem(Bits,BitsLength); try if GetMetaFileBitsEx(MetaFilePictPtr.hMF,BitsLength, Bits) < BitsLength then RaiseLastOSError; MetaFile:=TMetafile.Create; MetaFile.Handle:=SetWinMetaFileBits(BitsLength,Bits,0,MetafilePictPtr^); if (MetaFile.Width<=0) or (MetaFile.Height<=0) then raise Exception.Create('Invalid Metafile-Picture'); bmp:=TBitmap.Create; bmp.Width:=MetaFile.Width; bmp.Height:=MetaFile.Height; bmp.Canvas.StretchDraw(Rect(0,0,bmp.Width,bmp.Height),MetaFile); bmp.SaveToFile(Path+'Img'+IntToStr(I+1)+'.bmp'); finally bmp.Free; MetaFile.Free; FreeMem(Bits,BitsLength); end; finally GlobalUnlock(MED.hMetaFilePict) end; finally ReleaseStgMedium(MED); end; end; end; end; end;
procedure TForm1.FormCreate(Sender: TObject); var I : IDropTarget; begin //Регистрируем окно как получателя перетаскивания OleInitialize(nil); I := TMyDropTarget.Create; OLECheck( CoLockObjectExternal(I, true, false) ); OLECheck( RegisterDragDrop(Handle, I) ); end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin try OLECheck( RevokeDragDrop(Handle) ); except Application.HandleException(Self); end; OleUninitialize; end;
end.
|
Подскажите пожалуйста, как извлечь все картинки при нажатии кнопки, например вот так. (Пробовал не получилось) Код | procedure TForm1.Button2Click(Sender: TObject); var IREO:IRichEditOle; ReObject:TReobject; Count:Integer; I:Integer; FMT : FORMATETC; MED : STGMEDIUM; Path:String; dataObj1:IDataObject; bmp:TBitmap; Position:LongInt; BitsLength:UINT; MetaFile:TMetafile; Bits:Pointer; MetafilePictPtr: PMetafilePict; begin Path:='C:\_temp\richedit\'; SendMessage(Form1.RichEdit1.Handle, EM_GETOLEINTERFACE, 0, Longint(@IREO)); Count:=IREO.GetObjectCount;
for I := 0 to Count - 1 do begin
ZeroMemory(@ReObject,SizeOf(ReObject)); ReObject.cbStruct:=SizeOf(ReObject); if Succeeded(IREO.GetObject(I,ReObject, $00000001)) then begin Position:=ReObject.cp; Form1.Edit1.Text:=IntToStr(Position); if ReObject.poleobj.QueryInterface(IDataObject,dataObj1)=S_OK then begin FMT.cfFormat := CF_METAFILEPICT; FMT.ptd := nil; FMT.dwAspect := DVASPECT_CONTENT; FMT.lindex := -1; FMT.tymed := TYMED_MFPICT; if Succeeded(dataObj1.GetData(FMT,MED)) then try MetafilePictPtr:=GlobalLock(MED.hMetaFilePict); try BitsLength:=GetMetaFileBitsEx(MetafilePictPtr.hMF,0,nil); GetMem(Bits,BitsLength); try if GetMetaFileBitsEx(MetaFilePictPtr.hMF,BitsLength, Bits) < BitsLength then RaiseLastOSError; MetaFile:=TMetafile.Create; MetaFile.Handle:=SetWinMetaFileBits(BitsLength,Bits,0,MetafilePictPtr^); if (MetaFile.Width<=0) or (MetaFile.Height<=0) then raise Exception.Create('Invalid Metafile-Picture'); bmp:=TBitmap.Create; bmp.Width:=MetaFile.Width; bmp.Height:=MetaFile.Height; bmp.Canvas.StretchDraw(Rect(0,0,bmp.Width,bmp.Height),MetaFile); bmp.SaveToFile(Path+'Img'+IntToStr(I+1)+'.bmp'); finally bmp.Free; MetaFile.Free; FreeMem(Bits,BitsLength); end; finally GlobalUnlock(MED.hMetaFilePict) end; finally ReleaseStgMedium(MED); end; end; end; end; end;
|
Это сообщение отредактировал(а) Alexey89 - 8.9.2018, 15:24
|