profdhtmledit.pas

Prof DHTML Edit 2.0.3.7 for delphi

unit ProfDHTMLEdit;  { Version 2.0.3.7 }

{ Uncomment the following line if you need to use version 1 of the component (TProfDHTMLEdit) }
// {$DEFINE SUPPORT_VERSION_1}

{$TYPEDADDRESS ON}
{$WRITEABLECONST ON}
{$BOOLEVAL OFF}
{$EXTENDEDSYNTAX ON}
{$LONGSTRINGS ON}
{$IFDEF BCB}{$ObjExportAll On}{$ENDIF}


interface

uses
  AxCtrls,
  ActiveX,
  Classes,
  Windows,
  Controls,
  Menus,
  Messages,
  Graphics,
  SysUtils
{$IFNDEF VER100}{$IFNDEF VER110}
  , RichEdit
{$ENDIF}{$ENDIF}
  ;

{$IFDEF BCB}
{$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IBindCtx)'}
{$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IEnumUnknown)'}
{$IFNDEF VER180}{$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IOleCommandTarget)'}{$ENDIF}
{$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDropTarget)'}
{$HPPEMIT '' }
{$ENDIF}


type


  IDocHostUIHandler = interface;

  DOCHOSTUIINFO = packed record
    cbSize: ULONG;
    dwFlags: DWORD;
    dwDoubleClick: DWORD;
    pchHostCss: PWideChar;
    pchHostNS: PWideChar;
  end;

  IDocHostUIHandler = interface(IUnknown)
    ['{BD3F23C0-D43E-11CF-893B-00AA00BDCE1A}']
    function ShowContextMenu(
            { [in] } dwID: DWORD;
            { [in] } ppt: PPOINT;
            { [in] } const pcmdtReserved: IUnknown;
            { [in] } const pdispReserved: IDispatch): HRESULT; stdcall;
    function GetHostInfo(
            { [out][in] } var pInfo: DOCHOSTUIINFO): HRESULT; stdcall;
    function ShowUI(
            { [in] } dwID: DWORD;
            { [in] } const pActiveObject: IOleInPlaceActiveObject;
            { [in] } const pCommandTarget: IOleCommandTarget;
            { [in] } const pFrame: IOleInPlaceFrame;
            { [in] } const pDoc: IOleInPlaceUIWindow): HRESULT; stdcall;
    function HideUI: HRESULT; stdcall;
    function UpdateUI: HRESULT; stdcall;
    function EnableModeless(
            { [in] } fEnable: BOOL): HRESULT; stdcall;
    function OnDocWindowActivate(
            { [in] } fActivate: BOOL): HRESULT; stdcall;
    function OnFrameWindowActivate(
            { [in] } fActivate: BOOL): HRESULT; stdcall;
    function ResizeBorder(
            { [in] } prcBorder: PRECT;
            { [in] } const pUIWindow: IOleInPlaceUIWindow;
            { [in] } fRameWindow: BOOL): HRESULT; stdcall;
    function TranslateAccelerator(
            { [in] } lpMsg: PMSG;
            { [in] } pguidCmdGroup: PGUID;
            { [in] } nCmdID: DWORD): HRESULT; stdcall;
    function GetOptionKeyPath(
            { [out] } out pchKey: PWideChar;
            { [in] }  dw: DWORD): HRESULT; stdcall;
    function GetDropTarget(
            { [in] }  const pDropTarget: IDropTarget;
            { [out] } out ppDropTarget: IDropTarget): HRESULT; stdcall;
    function GetExternal(
            { [out] } out ppDispatch: IDispatch): HRESULT; stdcall;
    function TranslateUrl(
            { [in] }  dwTranslate: DWORD;
            { [in] }  pchURLIn: PWideChar;
            { [out] } out ppchURLOut: PWideChar): HRESULT; stdcall;
    function FilterDataObject(
            { [in] }  const pDO: IDataObject;
            { [out] } out ppDORet: IDataObject): HRESULT; stdcall;
  end;


  TProfOleControl = class;

  TProfEventDispatch = class(TObject, IUnknown, IDispatch)
  private
    FControl: TProfOleControl;
    function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT; stdcall;
  public
    constructor Create(Control: TProfOleControl);
  end;


  PControlData2 = ^TControlData2;
  TControlData2 = record
    ClassID: TGUID;
    EventIID: TGUID;
    EventCount: Integer;
    EventDispIDs: Pointer;
    LicenseKey: Pointer;
    Flags: DWORD;
    Version: Integer;
    FontCount: Integer;
    FontIDs: PDispIDList;
    PictureCount: Integer;
    PictureIDs: PDispIDList;
    Reserved: Integer;
    InstanceCount: Integer;
    EnumPropDescs: TList;
    FirstEventOfs: Cardinal;
  end;

  TProfOleControl = class(TWinControl,
   IUnknown, IOleClientSite, IOleControlSite, IOleInPlaceSite, IOleInPlaceFrame,
   IDispatch, IPropertyNotifySink, ISimpleFrameSite, IOleContainer)
  private
    FControlData: PControlData2;
    FRefCount: Integer;
    FEventDispatch: TProfEventDispatch;
    FObjectData: HGLOBAL;
    FPersistStream: IPersistStreamInit;
    FControlDispatch: IDispatch;
    FPropBrowsing: IPerPropertyBrowsing;
    FOleInPlaceObject: IOleInPlaceObject;
    FOleInPlaceActiveObject: IOleInPlaceActiveObject;
    FPropConnection: Integer;
    FEventsConnection: Integer;
    FMiscStatus: Integer;
    FWindowHandle: HWnd;

    procedure CreateControl;
    procedure CreateInstance;
    procedure CreateStorage;
    procedure DestroyControl;
    procedure DestroyStorage;
    procedure GetEventMethod(DispID: TDispID; var Method: TMethod);
    function GetMainMenu: TMainMenu;
    procedure HookControlWndProc;
    procedure ReadData(Stream: TStream);
    procedure SetUIActive(Active: Boolean);
    procedure WriteData(Stream: TStream);
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure CMDocWindowActivate(var Message: TMessage); message CM_DOCWINDOWACTIVATE;
    procedure CMUIActivate(var Message: TMessage); message CM_UIACTIVATE;
    procedure CMUIDeactivate(var Message: TMessage); message CM_UIDEACTIVATE;
    procedure InvokeEvent(DispID: TDispID; var Params: TDispParams);
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    function SaveObject: HRESULT; stdcall;
    function GetMoniker(dwAssign: Integer; dwWhichMoniker: Integer; out mk: IMoniker): HRESULT; stdcall;
    function GetContainer(out container: IOleContainer): HRESULT; stdcall;
    function ShowObject: HRESULT; stdcall;
    function OnShowWindow(fShow: BOOL): HRESULT; stdcall;
    function RequestNewObjectLayout: HRESULT; stdcall;
    function ParseDisplayName(const bc: IBindCtx; pszDisplayName: PWideChar; out chEaten: Integer; out mkOut: IMoniker): HRESULT; stdcall;
    function EnumObjects(grfFlags: Integer; out Enum: IEnumUnknown): HRESULT; stdcall;
    function LockContainer(fLock: BOOL): HRESULT; stdcall;
    function OnControlInfoChanged: HRESULT; stdcall;
    function LockInPlaceActive(fLock: BOOL): HRESULT; stdcall;
    function GetExtendedControl(out disp: IDispatch): HRESULT; stdcall;
    function TransformCoords(var ptlHimetric: TPoint; var ptfContainer: TPointF; flags: Integer): HRESULT; stdcall;
    function IOleControlSite.TranslateAccelerator = OleControlSite_TranslateAccelerator;
    function OleControlSite_TranslateAccelerator(msg: PMsg; grfModifiers: Integer): HRESULT; stdcall;
    function OnFocus(fGotFocus: BOOL): HRESULT; virtual; stdcall;
    function ShowPropertyFrame: HRESULT; stdcall;
    function ContextSensitiveHelp(fEnterMode: BOOL): HRESULT; stdcall;
    function IOleInPlaceSite.GetWindow = OleInPlaceSite_GetWindow;
    function OleInPlaceSite_GetWindow(out wnd: HWND): HRESULT; stdcall;
    function CanInPlaceActivate: HRESULT; stdcall;
    function OnInPlaceActivate: HRESULT; stdcall;
    function OnUIActivate: HRESULT; stdcall;
    function GetWindowContext(out frame: IOleInPlaceFrame; out doc: IOleInPlaceUIWindow; out rcPosRect: TRect; out rcClipRect: TRect; out frameInfo: TOleInPlaceFrameInfo): HRESULT; stdcall;
    function Scroll(scrollExtent: TPoint): HRESULT; stdcall;
    function OnUIDeactivate(fUndoable: BOOL): HRESULT; stdcall;
    function OnInPlaceDeactivate: HRESULT; stdcall;
    function DiscardUndoState: HRESULT; stdcall;
    function DeactivateAndUndo: HRESULT; stdcall;
    function OnPosRectChange(const rcPosRect: TRect): HRESULT; stdcall;
    function GetBorder(out rectBorder: TRect): HRESULT; stdcall;
    function RequestBorderSpace(const borderwidths: TRect): HRESULT; stdcall;
    function SetBorderSpace(pborderwidths: PRect): HRESULT; stdcall;
    function SetActiveObject(const activeObject: IOleInPlaceActiveObject; pszObjName: PWideChar): HRESULT; stdcall;
    function IOleInPlaceFrame.GetWindow = OleInPlaceFrame_GetWindow;
    function OleInPlaceFrame_GetWindow(out wnd: HWND): HRESULT; stdcall;
    function InsertMenus(hmenuShared: HMENU; var menuWidths: TOleMenuGroupWidths): HRESULT; stdcall;
    function SetMenu(hmenuShared: HMENU; holemenu: HMENU; hwndActiveObject: HWND): HRESULT; stdcall;
    function RemoveMenus(hmenuShared: HMENU): HRESULT; stdcall;
    function SetStatusText(pszStatusText: PWideChar): HRESULT; stdcall;
    function EnableModeless(fEnable: BOOL): HRESULT; stdcall;
    function IOleInPlaceFrame.TranslateAccelerator = OleInPlaceFrame_TranslateAccelerator;
    function OleInPlaceFrame_TranslateAccelerator(var msg: TMsg; wID: Word): HRESULT; stdcall;
    function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall;
    function PreMessageFilter(wnd: HWND; msg, wp, lp: Integer; out res: Integer; out Cookie: Integer): HRESULT; stdcall;
    function PostMessageFilter(wnd: HWND; msg, wp, lp: Integer; out res: Integer; Cookie: Integer): HRESULT; stdcall;
    function SuppressException(E: Exception): Boolean;
    function OnChanged(dispid: TDispID): HRESULT; stdcall; { IPropertyNotifySink }
    function OnRequestEdit(dispid: TDispID): HRESULT; stdcall; { IPropertyNotifySink }
    procedure InitControlData; virtual; abstract;
  protected
    FOleObject: IOleObject;
    FOleControl: IOleControl;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT; stdcall; { protected for calling "inherited" in any descendants }
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    procedure DestroyWindowHandle; override;
    procedure SetName(const Value: TComponentName); override;
    procedure SetParent(AParent: TWinControl); override;
    function PaletteChanged(Foreground: Boolean): Boolean; override;
    procedure DefineProperties(Filer: TFiler); override;
    function QueryInterface(const IID: TGUID; out Obj): HRESULT; {$IFNDEF VER100}{$IFNDEF VER110} override;{$ELSE}stdcall;{$ENDIF}{$ELSE}stdcall;{$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DefaultHandler(var Message); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  end;


  THTMLAlign = (haDefault, haLeft, haRight, haCenter);
  THTMLVAlign = (haVDefault, haTop, haMiddle, haBottom, haBaseline);

  TProfDHTMLEditTableAttrs = class(TPersistent)
  private
    FBackground: TFileName;
    FBgColor: TColor;
    FBorderColor: TColor;
    FWidth: Word;
    FAlign: THTMLAlign;
    FWidthInPercent: Boolean;
    FBorderSize: Byte;
    FCellSpacing: Byte;
    FCellPadding: Byte;
  public
    constructor Create;
  published
    property Align: THTMLAlign read FAlign write FAlign default haDefault;
    property Background: TFileName read FBackground write FBackground;
    property BgColor: TColor read FBgColor write FBgColor default clNone;
    property BorderColor: TColor read FBorderColor write FBorderColor default clNone;
    property BorderSize: Byte read FBorderSize write FBorderSize default 1;
    property CellPadding: Byte read FCellPadding write FCellPadding default 1;
    property CellSpacing: Byte read FCellSpacing write FCellSpacing default 1;
    property Width: Word read FWidth write FWidth default 75;
    property WidthInPercent: Boolean read FWidthInPercent write FWidthInPercent default True;
  end;

  TProfDHTMLEditTableCellAttrs = class(TPersistent)
  private
    FBackground: TFileName;
    FClassName: WideString;