标签：begin end Richedit nil ReObj 插入 cxDBRichEdit1 OleCheck 图标
function TfrmBillattachment.cxRicheditInsertFile(FilePath:string): Boolean; const REO_CP_SELECTION = $FFFFFFFF; REO_IOB_SELECTION = $FFFFFFFF; IID_IUnknown: TGUID = ( D1: $00000000; D2: $0000; D3: $0000; D4: ($C0, $00, $00, $00, $00, $00, $00, $46) ); IID_IOleObject: TGUID = ( D1: $00000112; D2: $0000; D3: $0000; D4: ($C0, $00, $00, $00, $00, $00, $00, $46) ); REO_RESIZABLE = $00000001; // Object may be resized procedure ReleaseObject(var AObj); begin if IUnknown(AObj) <> nil then IUnknown(AObj)._Release; IUnknown(AObj) := nil; end; function GetOleMetaPict(AOleObject:IOleObject; ALable:string):HGlobal; var AClassID: TCLSID; begin Result := 0; OleCheck(AOleObject.GetUserClassID(AClassID)); Result := OleGetIconOfClass(AClassID, PWideChar(WideString(ALable)), False); end; var ReOle: IcxRichEditOle; OleSite: IOleClientSite; Storage: IStorage; SubSTG: IStorage; LockBytes: ILockBytes; OleObject: IOleObject; ReObj: TReObject; TempOle: IUnknown; FormatEtc: TFormatEtc; ASelection: TCharRange; IST :IStream; OST :TOLESTream; FileName :Pchar; FileName2 :array[1..1024] of char; FileM: TmemoryStream; IconMetaPict: HGlobal; begin Result := False; if not FileExists(FilePath) then Exit; if not cxRichEditGetOleInterface(TcxRichInnerEdit(cxDBRichEdit1.InnerControl).Handle,ReOle) then Exit; Assert(ReOle <> nil, 'RichEditOle is null!'); try ReOle.GetClientSite(OleSite); OleCheck(CreateILockBytesOnHGlobal(0, True, LockBytes)); Assert(LockBytes <> nil, 'LockBytes is null!'); OleCheck(StgCreateDocfileOnILockBytes(LockBytes, STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, 0, Storage)); Assert(Storage <> nil, 'Storage is null!'); FormatEtc.dwAspect := DVASPECT_ICON; OleCheck(OleCreateFromFile(GUID_NULL, PWideChar(WideString(FilePath)), IID_IUnknown, 0, @FormatEtc, OleSite, Storage, TempOle)); OleCheck(TempOle.QueryInterface(IID_IOleObject, OleObject)); OleCheck(OleSetContainedObject(OleObject, True)); Assert(OleObject <> nil, 'OleObject is null!'); FillChar(ReObj, Sizeof(ReObj), 0); FileName := PansiCHar(ExtractFileName(FilePath)); olecheck( Storage.CreateStorage('substorage', stgm_create or stgm_write or stgm_share_exclusive, 0,0,subSTG)); //创建IStream //文件名 olecheck(substg.createstream('filename', stgm_create or stgm_write or stgm_share_exclusive, 0,0,IST)); //创建OLEStream OST:=TOLEStream.create(IST); OST.write(FileName^,length(string(FileName))); //写入数据 OST.Free; //文件内容 olecheck(substg.createstream('filecontent', stgm_create or stgm_write or stgm_share_exclusive, 0,0,IST)); //创建OLEStream FileM := TmemoryStream.Create; FileM.LoadFromFile(FilePath); FileM.Position := 0; OST:=TOLEStream.create(IST); OST.CopyFrom(FileM, FileM.size); OST.Free; FileM.Free; ReObj.cbStruct := Sizeof(ReObj); OleCheck(OleObject.GetUserClassID(ReObj.clsid)); ReObj.cp := REO_CP_SELECTION; ReObj.dvaspect := DVASPECT_CONTENT; ReObj.oleobj := OleObject; ReObj.olesite := OleSite; ReObj.stg := Storage; ReObj.dwUser := 0; ReObj.dwFlags := REO_RESIZABLE;//ULong(REO_STATIC) or ULong(REO_BELOWBASELINE); ReObj.sizel.cx := 0; ReObj.sizel.cy := 0; // if cxDBRichEdit1.Lines.Count =0 then // begin //// cxDBRichEdit1.Text := ExtractFileName(FilePath)+'： '; //// cxDBRichEdit1.SelStart := Length(cxDBRichEdit1.Text); // end // else // begin // try // cxDBRichEdit1.Lines.Add(''); // except // end; // end; if TcxRichInnerEdit(cxDBRichEdit1.InnerControl).HandleAllocated then begin SendMessage(TcxRichInnerEdit(cxDBRichEdit1.InnerControl).Handle, EM_SCROLLCARET, 0, 0); end; if TcxRichInnerEdit(cxDBRichEdit1.InnerControl).HandleAllocated then begin SendMessage(TcxRichInnerEdit(cxDBRichEdit1.InnerControl).Handle, EM_EXGETSEL, 0, LPARAM(@ASelection)); ASelection.cpMax := ASelection.cpMin + 1; end; //获取该对象的图标 图片也是一样。不显示图片内容 IconMetaPict := GetOleMetaPict(OleObject, FileName); OleCheck(cxSetDrawAspect(OleObject, True, IconMetaPict, ReObj.dvaspect)); if Succeeded(ReOle.InsertObject(ReObj))then begin // if TcxRichInnerEdit(cxDBRichEdit1.InnerControl).HandleAllocated then // begin // SendMessage(TcxRichInnerEdit(cxDBRichEdit1.InnerControl).Handle, EM_EXSETSEL, 0, LPARAM(@ASelection)); // SendMessage(TcxRichInnerEdit(cxDBRichEdit1.InnerControl).Handle, EM_SCROLLCARET, 0, 0); // end; // ReOle.SetDvaspect(Longint(REO_IOB_SELECTION), ReObj.dvaspect); Result := True; end; // if Pos(ExtractFileExt(FilePath),'.doc,.docx,.xls,.xlsx') >0 then // begin // try // cxDBRichEdit1.Lines.Add(ExtractFileName(FilePath)); // except // end; // end; finally ReleaseObject(OleObject); ZeroMemory(@ReObj,SizeOf(ReObj)); // FileInfo.Free; qry_Data.Tag := 1; end; end;
以下是摘抄dev的处理方式。
function cxSetDrawAspect(AOleObject: IOleObject; AIconic: Boolean;
AIconMetaPict: HGlobal; var ADrawAspect: Cardinal): HResult;
var
AOleCache: IOleCache;
AEnumStatData: IEnumStatData;
AOldAspect: Cardinal;
AAdviseFlags, AConnection: Longint;
ATempMetaPict: HGlobal;
AFormatEtc: TFormatEtc;
AMedium: TStgMedium;
AClassID: TCLSID;
AStatData: TStatData;
AViewObject: IViewObject;
begin
AOldAspect := ADrawAspect;
if AIconic then
begin
ADrawAspect := DVASPECT_ICON;
AAdviseFlags := ADVF_NODATA;
end else
begin
ADrawAspect := DVASPECT_CONTENT;
AAdviseFlags := ADVF_PRIMEFIRST;
end;
if (ADrawAspect <> AOldAspect) or (ADrawAspect = DVASPECT_ICON) then
begin
AOleCache := AOleObject as IOleCache;
if ADrawAspect <> AOldAspect then
begin
OleCheck(AOleCache.EnumCache(AEnumStatData));
if AEnumStatData <> nil then
while AEnumStatData.Next(1, AStatData, nil) = 0 do
if AStatData.formatetc.dwAspect = Integer(AOldAspect) then
AOleCache.Uncache(AStatData.dwConnection);
FillChar(AFormatEtc, SizeOf(FormatEtc), 0);
AFormatEtc.dwAspect := ADrawAspect;
AFormatEtc.lIndex := -1;
OleCheck(AOleCache.Cache(AFormatEtc, AAdviseFlags, AConnection));
if AOleObject.QueryInterface(IViewObject, AViewObject) = 0 then
AViewObject.SetAdvise(ADrawAspect, 0, nil);
end;
if ADrawAspect = DVASPECT_ICON then
begin
ATempMetaPict := 0;
if AIconMetaPict = 0 then
begin
OleCheck(AOleObject.GetUserClassID(AClassID));
ATempMetaPict := OleGetIconOfClass(AClassID, nil, True);
AIconMetaPict := ATempMetaPict;
end;
try
with AFormatEtc do
begin
cfFormat := CF_METAFILEPICT;
ptd := nil;
dwAspect := DVASPECT_ICON;
lindex := -1;
tymed := TYMED_MFPICT;
end;
with AMedium do
begin
tymed := TYMED_MFPICT;
hMetaFilePict := AIconMetaPict;
unkForRelease := nil;
end;
OleCheck(AOleCache.SetData(AFormatEtc, AMedium, False));
finally
DestroyMetaPict(ATempMetaPict);
end;
end;
if ADrawAspect <> DVASPECT_ICON then
AOleObject.Update;
end;
Result := S_OK;
end;
function cxRichEditGetOleInterface(AH: HWnd; out AOleInterface: IcxRichEditOle): Boolean;
begin
Result := SendMessage(AH, EM_GETOLEINTERFACE, 0, LPARAM(@AOleInterface)) <> 0;
end;
function cxRichEditSelectedIsPic(cxRichEdit: TcxRichEdit; out Pic: TPicture; IsOutPic: Boolean=False): Boolean;
var
FRichEditOle: IUnknown;
i: Integer;
AReObject: TReObject;
pDataObject: IDataObject;
fm: TFormatEtc;
em: IEnumFormatEtc;
stg: TStgMedium;
TmpPic1, TmpPic2: TPicture;
g: TGPGraphics;
img: TGPImage;
MemStream: TMemoryStream;
MyIStream: TStreamAdapter;
RootSTG,SubSTG :IStorage;
begin
Result := False;
try
FRichEditOle := nil;
if not cxRichEditGetOleInterface(TcxRichInnerEdit(cxRichEdit.InnerControl).Handle,IcxRichEditOle(FRichEditOle)) then
Exit;
with IcxRichEditOle(FRichEditOle) do
begin
for i := 0 to GetObjectCount -1 do
begin
FillChar(AReObject, SizeOf(AReObject), 0);
AReObject.cbStruct := SizeOf(AReObject);
OleCheck(GetObject(LongInt(i), AReObject, REO_GETOBJ_ALL_INTERFACES));
//不是选中状态跳过
if (AReObject.dwFlags and REO_SELECTED) <> REO_SELECTED then
Continue;
pDataObject := nil;
OleCheck(AReObject.oleobj.QueryInterface(IDataObject, pDataObject));
if pDataObject <> nil then
begin
em := nil;
pDataObject.EnumFormatEtc(DATADIR_GET, em);
if em <> nil then
begin
FillChar(fm, SizeOf(fm), 0);
while em.Next(1, fm, nil) <> S_FALSE do
begin
Result := fm.cfFormat in [CF_BITMAP, CF_DIB, CF_METAFILEPICT];
if not Result then
Break;
end;
end;
end;
end;
end;
if Result and IsOutPic then
begin
TmpPic1 := TPicture.Create;
TmpPic2 := TPicture.Create;
MemStream := TMemoryStream.Create;
if fm.cfFormat in [CF_BITMAP,CF_DIB] then
begin
fm.cfFormat := CF_BITMAP;
fm.ptd := nil;
fm.dwAspect := DVASPECT_CONTENT;
fm.lindex := -1;
fm.tymed := TYMED_GDI;
if Succeeded(pDataObject.GetData(fm, stg)) then
begin
TmpPic1.Bitmap.Handle := stg.hBitmap;
TmpPic2.Bitmap.Width := TmpPic1.Bitmap.Width;
TmpPic2.Bitmap.Height := TmpPic1.Bitmap.Height;
TmpPic2.Bitmap.Canvas.CopyRect(TmpPic1.Bitmap.Canvas.ClipRect, TmpPic1.Bitmap.Canvas, TmpPic1.Bitmap.Canvas.ClipRect);
TmpPic2.Bitmap.SaveToStream(MemStream);
ReleaseStgMedium(stg);
end;
end //图元文件 以emf文件格式存在
else if fm.cfFormat = CF_METAFILEPICT then
begin
SendMessage(TcxRichInnerEdit(cxRichEdit.InnerControl).Handle, WM_COPY, 0, 0);
try
if OpenClipboard(0) then
begin
TmpPic2.Metafile.LoadFromClipboardFormat(0,0,0);
TmpPic2.Metafile.SaveToStream(MemStream);
MemStream.Position := 0;
end;
finally
CloseClipboard;
end;
end;
MyIStream := TStreamAdapter.Create(MemStream);
img := TGPImage.Create(MyIStream);
pic := TPicture.Create;
pic.Bitmap.Width := img.GetWidth;
pic.Bitmap.Height :=img.GetHeight;
g := TGPGraphics.Create(pic.Bitmap.Canvas.Handle);
{ 缩放时的算法模式 }
g.SetInterpolationMode(TInterpolationMode(InterpolationModeHighQualityBicubic));
g.DrawImage(img, MakeRect(0, 0, img.GetWidth, img.GetHeight), 0, 0, img.GetWidth, img.GetHeight, UnitPixel);
g.Free;
img.Free;
FreeAndNil(MemStream);
TmpPic1.Free;
TmpPic2.Free;
end;
finally
em := nil;
pDataObject := nil;
FRichEditOle := nil;
end;
end;
标签：begin,end,Richedit,nil,ReObj,插入,cxDBRichEdit1,OleCheck,图标 来源： https://www.cnblogs.com/BTag/p/15666932.html
本站声明： 1. iCode9 技术分享网（下文简称本站）提供的所有内容，仅供技术学习、探讨和分享； 2. 关于本站的所有留言、评论、转载及引用，纯属内容发起人的个人观点，与本站观点和立场无关； 3. 关于本站的所有言论和文字，纯属内容发起人的个人观点，与本站观点和立场无关； 4. 本站文章均是网友提供，不完全保证技术分享内容的完整性、准确性、时效性、风险性和版权归属；如您发现该文章侵犯了您的权益，可联系我们第一时间进行删除； 5. 本站为非盈利性的个人网站，所有内容不会用来进行牟利，也不会利用任何形式的广告来间接获益，纯粹是为了广大技术爱好者提供技术内容和技术思想的分享性交流网站。