frxrichedit.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

  Result:= nil;
  if Moniker<>nil then begin
    if (Moniker.IsSystemMoniker(Mksys) = 0) and
      (Mksys = MKSYS_GENERICCOMPOSITE) then
    begin
      if Moniker.Enum(True, EnumMoniker)<>0 then Exit;
      EnumMoniker.Next(1, Result, nil);
      ReleaseObject(EnumMoniker);
    end
    else begin
      Result:= Moniker;
    end;
  end;
end;

{ Return length of file moniker piece of the given moniker }

function OleStdGetLenFilePrefixOfMoniker(Moniker:IMoniker):Integer;
var
  MkFirst:IMoniker;
  BindCtx:IBindCtx;
  Mksys:Longint;
  P:PWideChar;
begin
  Result:= 0;
  if Moniker<>nil then begin
    MkFirst:= OleStdGetFirstMoniker(Moniker);
    if MkFirst<>nil then begin
      if (MkFirst.IsSystemMoniker(Mksys) = 0) and
        (Mksys = MKSYS_FILEMONIKER) then
      begin
        if CreateBindCtx(0, BindCtx) = 0 then begin
          if (MkFirst.GetDisplayName(BindCtx, nil, P) = 0) and (P<>nil) then
          begin
            Result:= WStrLen(P);
            CoTaskMemFree(P);
          end;
          ReleaseObject(BindCtx);
        end;
      end;
      ReleaseObject(MkFirst);
    end;
  end;
end;

function CoAllocCStr(const S:string):PChar;
begin
  Result:= StrCopy(CoTaskMemAlloc(Length(S)+1), PChar(S));
end;

function WStrToString(P:PWideChar):string;
begin
  Result:= '';
  if P<>nil then begin
    Result:= WideCharToString(P);
    CoTaskMemFree(P);
  end;
end;

function GetFullNameStr(OleObject:IOleObject):string;
var
  P:PWideChar;
begin
  OleObject.GetUserType(USERCLASSTYPE_FULL, P);
  Result:= WStrToString(P);
end;

function GetShortNameStr(OleObject:IOleObject):string;
var
  P:PWideChar;
begin
  OleObject.GetUserType(USERCLASSTYPE_SHORT, P);
  Result:= WStrToString(P);
end;

function GetDisplayNameStr(OleLink:IOleLink):string;
var
  P:PWideChar;
begin
  OleLink.GetSourceDisplayName(P);
  Result:= WStrToString(P);
end;

function GetVCLFrameForm(Form:TCustomForm):IVCLFrameForm;
begin
  if Form.OleFormObject = nil then TOleForm.Create(Form);
  Result:= Form.OleFormObject as IVCLFrameForm;
end;

function IsFormMDIChild(Form:TCustomForm):Boolean;
begin
  Result:= (Form is TForm) and (TForm(Form).FormStyle = fsMDIChild);
end;

{ Clipboard formats }

var
  CFEmbeddedObject:Integer;
  CFLinkSource:Integer;
  CFRtf:Integer;
  CFRtfNoObjs:Integer;

const
  CF_EMBEDDEDOBJECT = 'Embedded Object';
  CF_LINKSOURCE = 'Link Source';

{************************************************************************}

{ OLE Extensions to the Rich Text Editor }
{ Converted from RICHOLE.H }

{ Structure passed to GetObject and InsertObject }

type
  _ReObject = record
    cbStruct:DWORD; { Size of structure }
    cp:ULONG; { Character position of object }
    clsid:TCLSID; { Class ID of object }
    poleobj:IOleObject; { OLE object interface }
    pstg:IStorage; { Associated storage interface }
    polesite:IOleClientSite; { Associated client site interface }
    sizel:TSize; { Size of object (may be 0,0) }
    dvAspect:Longint; { Display aspect to use }
    dwFlags:DWORD; { Object status flags }
    dwUser:DWORD; { Dword for user's use }
  end;
  TReObject = _ReObject;

const

{ Flags to specify which interfaces should be returned in the structure above }

  REO_GETOBJ_NO_INTERFACES = $00000000;
  REO_GETOBJ_POLEOBJ = $00000001;
  REO_GETOBJ_PSTG = $00000002;
  REO_GETOBJ_POLESITE = $00000004;
  REO_GETOBJ_ALL_INTERFACES = $00000007;

{ Place object at selection }

  REO_CP_SELECTION = ULONG(-1);

{ Use character position to specify object instead of index }

  REO_IOB_SELECTION = ULONG(-1);
  REO_IOB_USE_CP = ULONG(-2);

{ Object flags }

  REO_NULL = $00000000; { No flags }
  REO_READWRITEMASK = $0000003F; { Mask out RO bits }
  REO_DONTNEEDPALETTE = $00000020; { Object doesn't need palette }
  REO_BLANK = $00000010; { Object is blank }
  REO_DYNAMICSIZE = $00000008; { Object defines size always }
  REO_INVERTEDSELECT = $00000004; { Object drawn all inverted if sel }
  REO_BELOWBASELINE = $00000002; { Object sits below the baseline }
  REO_RESIZABLE = $00000001; { Object may be resized }
  REO_LINK = $80000000; { Object is a link (RO) }
  REO_STATIC = $40000000; { Object is static (RO) }
  REO_SELECTED = $08000000; { Object selected (RO) }
  REO_OPEN = $04000000; { Object open in its server (RO) }
  REO_INPLACEACTIVE = $02000000; { Object in place active (RO) }
  REO_HILITED = $01000000; { Object is to be hilited (RO) }
  REO_LINKAVAILABLE = $00800000; { Link believed available (RO) }
  REO_GETMETAFILE = $00400000; { Object requires metafile (RO) }

{ Flags for IRichEditOle.GetClipboardData, }
{ IRichEditOleCallback.GetClipboardData and }
{ IRichEditOleCallback.QueryAcceptData }

  RECO_PASTE = $00000000; { paste from clipboard }
  RECO_DROP = $00000001; { drop }
  RECO_COPY = $00000002; { copy to the clipboard }
  RECO_CUT = $00000003; { cut to the clipboard }
  RECO_DRAG = $00000004; { drag }

{ RichEdit GUIDs }

{ IID_IRichEditOle:TGUID = (
    D1:$00020D00;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
  IID_IRichEditOleCallback:TGUID = (
    D1:$00020D03;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));}

type

{
 * IRichEditOle
 *
 * Purpose:
 * Interface used by the client of RichEdit to perform OLE-related
 * operations.
 *
 * The methods herein may just want to be regular Windows messages.
}

  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:Longint; out reobject:TReObject;
      dwFlags:DWORD):HResult; stdcall;
    function InsertObject(var reobject:TReObject):HResult; stdcall;
    function ConvertObject(iob:Longint; rclsidNew:TIID;
      lpstrUserTypeNew:LPCSTR):HResult; stdcall;
    function ActivateAs(rclsid:TIID; rclsidAs:TIID):HResult; stdcall;
    function SetHostNames(lpstrContainerApp:LPCSTR;
      lpstrContainerObj:LPCSTR):HResult; stdcall;
    function SetLinkAvailable(iob:Longint; fAvailable:BOOL):HResult; stdcall;
    function SetDvaspect(iob:Longint; dvaspect:DWORD):HResult; stdcall;
    function HandsOffStorage(iob:Longint):HResult; stdcall;
    function SaveCompleted(iob:Longint; const stg:IStorage):HResult; stdcall;
    function InPlaceDeactivate:HResult; stdcall;
    function ContextSensitiveHelp(fEnterMode:BOOL):HResult; stdcall;
    function GetClipboardData(var chrg:TCharRange; reco:DWORD;
      out dataobj:IDataObject):HResult; stdcall;
    function ImportDataObject(dataobj:IDataObject; cf:TClipFormat;
      hMetaPict:HGLOBAL):HResult; stdcall;
  end;

{
 * IRichEditOleCallback
 *
 * Purpose:
 * Interface used by the RichEdit to get OLE-related stuff from the
 * application using RichEdit.
}

  IRichEditOleCallback = interface(IUnknown)
    ['{00020d03-0000-0000-c000-000000000046}']
    function GetNewStorage(out stg:IStorage):HResult; stdcall;
    function GetInPlaceContext(out Frame:IOleInPlaceFrame;
      out Doc:IOleInPlaceUIWindow;
      lpFrameInfo:POleInPlaceFrameInfo):HResult; stdcall;
    function ShowContainerUI(fShow:BOOL):HResult; stdcall;
    function QueryInsertObject(const clsid:TCLSID; const stg:IStorage;
      cp:Longint):HResult; stdcall;
    function DeleteObject(const oleobj:IOleObject):HResult; stdcall;
    function QueryAcceptData(const dataobj:IDataObject;
      var cfFormat:TClipFormat; reco:DWORD; fReally:BOOL;
      hMetaPict:HGLOBAL):HResult; stdcall;
    function ContextSensitiveHelp(fEnterMode:BOOL):HResult; stdcall;
    function GetClipboardData(const chrg:TCharRange; reco:DWORD;
      out dataobj:IDataObject):HResult; stdcall;
    function GetDragDropEffect(fDrag:BOOL; grfKeyState:DWORD;
      var dwEffect:DWORD):HResult; stdcall;
    function GetContextMenu(seltype:Word; const oleobj:IOleObject;
      const chrg:TCharRange; out menu:HMENU):HResult; stdcall;
  end;

{************************************************************************}

{ TRichEditOleCallback }

type
  TRichEditOleCallback = class(TObject, IUnknown, IRichEditOleCallback)
  private
    FDocForm:IVCLFrameForm;
    FFrameForm:IVCLFrameForm;
    FAccelTable:HAccel;
    FAccelCount:Integer;
    FAutoScroll:Boolean;
    procedure CreateAccelTable;
    procedure DestroyAccelTable;
    procedure AssignFrame;
  private
    FRefCount:Longint;
    FRichEdit:TRxCustomRichEdit;
  public
    constructor Create(RichEdit:TRxCustomRichEdit);
    destructor Destroy; override;
    function QueryInterface(const iid:TGUID; out Obj):HResult; stdcall;
    function _AddRef:Longint; stdcall;
    function _Release:Longint; stdcall;
    function GetNewStorage(out stg:IStorage):HResult; stdcall;
    function GetInPlaceContext(out Frame:IOleInPlaceFrame;
      out Doc:IOleInPlaceUIWindow;
      lpFrameInfo:POleInPlaceFrameInfo):HResult; stdcall;
    function GetClipboardData(const chrg:TCharRange; reco:DWORD;
      out dataobj:IDataObject):HResult; stdcall;
    function GetContextMenu(seltype:Word; const oleobj:IOleObject;
      const chrg:TCharRange; out menu:HMENU):HResult; stdcall;
    function ShowContainerUI(fShow:BOOL):HResult; stdcall;
    function QueryInsertObject(const clsid:TCLSID; const stg:IStorage;
      cp:Longint):HResult; stdcall;
    function DeleteObject(const oleobj:IOleObject):HResult; stdcall;
    function QueryAcceptData(const dataobj:IDataObject; var cfFormat:TClipFormat;
      reco:DWORD; fReally:BOOL; hMetaPict:HGLOBAL):HResult; stdcall;
    function ContextSensitiveHelp(fEnterMode:BOOL):HResult; stdcall;
    function GetDragDropEffect(fDrag:BOOL; grfKeyState:DWORD;
      var dwEffect:DWORD):HResult; stdcall;
  end;

constructor TRichEditOleCallback.Create(RichEdit:TRxCustomRichEdit);
begin
  inherited Create;
  FRichEdit:= RichEdit;
end;

destructor TRichEditOleCallback.Destroy;
begin
  DestroyAccelTable;
  FFrameForm:= nil;
  FDocForm:= nil;
  inherited Destroy;
end;

function TRichEditOleCallback.QueryInterface(const iid:TGUID; out Obj):HResult;
begin
  if GetInterface(iid, Obj) then Result:= S_OK
  else Result:= E_NOINTERFACE;
end;

function TRichEditOleCallback._AddRef:Longint;
begin
  Inc(FRefCount);
  Result:= FRefCount;
end;

function TRichEditOleCallback._Release:Longint;
begin
  Dec(FRefCount);
  Result:= FRefCount;
end;

procedure TRichEditOleCallback.CreateAccelTable;
var
  Menu:TMainMenu;
begin
  if (FAccelTable = 0) and Assigned(FFrameForm) then begin
    Menu:= FFrameForm.Form.Menu;
    if Menu<>nil then
      Menu.GetOle2AcceleratorTable(FAccelTable, FAccelCount, [0, 2, 4]);
  end;
end;

procedure TRichEditOleCallback.DestroyAccelTable;
begin
  if FAccelTable<>0 then begin
    DestroyAcceleratorTable(FAccelTable);
    FAccelTable:= 0;
    FAccelCount:= 0;
  end;
end;

procedure TRichEditOleCallback.AssignFrame;
begin
  if (GetParentForm(FRichEdit)<>nil) and not Assigned(FFrameForm) and
    FRichEdit.AllowInPlace then
  begin
    FDocForm:= GetVCLFrameForm(ValidParentForm(FRichEdit));
    FFrameForm:= FDocForm;
    if IsFormMDIChild(FDocForm.Form) then
      FFrameForm:= GetVCLFrameForm(Application.MainForm);
  end;
end;

function TRichEditOleCallback.GetNewStorage(
  out stg:IStorage):HResult;
begin
  try
    CreateStorage(stg);
    Result:= S_OK;
  except
    Result:= E_OUTOFMEMORY;
  end;
end;

function TRichEditOleCallback.GetInPlaceContext(
  out Frame:IOleInPlaceFrame;
  out Doc:IOleInPlaceUIWindow;
  lpFrameInfo:POleInPlaceFrameInfo):HResult;
begin
  AssignFrame;
  if Assigned(FFrameForm) and FRichEdit.AllowInPlace then begin
    Frame:= FFrameForm;
    Doc:= FDocForm;
    CreateAccelTable;
    with lpFrameInfo^ do begin
      fMDIApp:= False;
      FFrameForm.GetWindow(hWndFrame);
      hAccel:= FAccelTable;
      cAccelEntries:= FAccelCount;
    end;
    Result:= S_OK;
  end
  else Result:= E_NOTIMPL;
end;

function TRichEditOleCallback.QueryInsertObject(const clsid:TCLSID; const stg:IStorage;
  cp:Longint):HResult;
begin
  Result:= NOERROR;
end;

function TRichEditOleCallback.DeleteObject(const oleobj:IOleObject):HResult;
begin
  if Assigned(oleobj) then oleobj.Close(OLECLOSE_NOSAVE);
  Result:= NOERROR;
end;

function TRichEditOleCallback.QueryAcceptData(const dataobj:IDataObject;
  var cfFormat:TClipFormat; reco:DWORD; fReally:BOOL;
  hMetaPict:HGLOBAL):HResult;
begin
  Result:= S_OK;
end;

function TRichEditOleCallback.ContextSensitiveHelp(fEnterMode:BOOL):HResult;
begin
  Result:= NOERROR;
end;

function TRichEditOleCallback.GetClip