Ver Mensaje Individual
  #6  
Antiguo 01-10-2008
Avatar de cHackAll
[cHackAll] cHackAll is offline
Baneado?
 
Registrado: oct 2006
Posts: 2.159
Reputación: 20
cHackAll Va por buen camino
Código Delphi [-]
//...

uses ActiveX, ComObj, RichEdit;

//...

type
 IRichEditOle = interface(IUnknown)
  ['{00020d00-0000-0000-c000-000000000046}']
  function GetClientSite(out clientSite: IOleClientSite): HRESULT; stdcall;
  function GetObjectCount: HRESULT; stdcall;
  function GetLinkCount: HRESULT; stdcall;
  function GetObject(iob: Integer; out ReObject; dwFlags: Cardinal): HRESULT; stdcall;
 end; // changed !!!

procedure TForm1.JvRichEdit1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var
 RichEdit: TCustomMemo;
 Point: TPoint;
 Value, Index: Integer;
 RichEditOle: IRichEditOle;
 ReObject: record
  cbStruct, cp: Cardinal;
  clsid: TCLSID;
  poleobj: IOleObject;
  pstg: IStorage;
  polesite: IOleClientSite;
  sizel: TSize;
  dvAspect: Integer;
  dwFlags, dwUser: Cardinal;
 end;

begin
 if (Button = mbLeft) and (Sender is TCustomMemo) then
  begin
   RichEdit := Sender as TCustomMemo;
   if RichEdit.SelLength = 1 then
    begin
     Windows.GetCaretPos(Point);
     Value := RichEdit.Perform(EM_CHARFROMPOS, 0, Integer(@Point)) - 1;
     if Value >= 0 then
      begin
       SendMessage(RichEdit.Handle, EM_GETOLEINTERFACE, 0, Integer(@RichEditOle));
       ReObject.cbStruct := SizeOf(ReObject);
       for Index := 0 to RichEditOle.GetObjectCount - 1 do
        begin
         RichEditOle.GetObject(Index, ReObject, 0{REO_GETOBJ_NO_INTERFACES});
         if Integer(ReObject.cp) = Value then // 0j0: funciona con cualquier objeto!
          begin
           ShowMessage('Object ID: ' + IntToStr(Index)); // aquí haces lo que debes hacer...
           RichEdit.SelLength := 0;
           Break;
          end;
        end;
      end;
    end;
  end;
end;

Nota; considerar que en las pruebas se utilizó un componente JEDI, sin embargo debiese funcionar con cualquier componente que utilice interfaces OLE estándares .

Saludos
__________________
RTFM > STFW > Foro > Truco > Post > cHackAll > KeBugCheckEx
Responder Con Cita