1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:

Type
  TImpIOleContainer = class(TObject, IOleContainer)
   protected
      m_cRef: DWORD;
   public
      function _AddRef: Integer; overload; stdcall;
      function _Release: Integer; overload; stdcall;

      constructor Create; virtual;
      destructor Destroy; override;

      function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;

      function ParseDisplayName(const bc: IBindCtx; pszDisplayName: POleStr;
       out chEaten: Longint; out mkOut: IMoniker): HResult; stdcall;

      function EnumObjects(grfFlags: Longint; out Enum: IEnumUnknown): 
HResult;
         stdcall;
      function LockContainer(fLock: BOOL): HResult; stdcall;
 end;

const
 IID_IUnknown : TGUID = '{00000000-0000-0000-C000-000000000046}';
 IID_IOleContainer : TGUID = '{0000011B-0000-0000-C000-000000000046}';                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:

constructor TImpIOleContainer.Create;
begin
   inherited;
   m_cRef := 0;
end;

destructor TImpIOleContainer.Destroy;
begin
  inherited;
end;

function TImpIOleContainer.EnumObjects(grfFlags: Integer;
  out Enum: IEnumUnknown): HResult;
begin
  Result := E_NOINTERFACE;
end;

function TImpIOleContainer.LockContainer(fLock: BOOL): HResult;
begin
   Result := E_NOINTERFACE;
end;

function TImpIOleContainer.ParseDisplayName(const bc: IBindCtx;
  pszDisplayName: POleStr; out chEaten: Integer;
  out mkOut: IMoniker): HResult;
begin
  Result := E_NOINTERFACE;
end;

function TImpIOleContainer.QueryInterface(const IID: TGUID;
  out Obj): HResult;

begin
   If (IsEqualGUID(IID, IID_IOleContainer)) Then
      begin
        GetInterface(IID_IOleContainer, Obj);
        Result := S_OK;
        Exit;
      end
      else
      If (IsEqualGUID(IID, IID_IUnknown)) Then
      begin
         GetInterface(IID_IUnknown, Obj);
         Result := S_OK;
         Exit;
      end;

   Result := E_NOINTERFACE;
end;

function TImpIOleContainer._AddRef: Integer;
begin
  Inc(m_cRef);
  Result := m_cRef;
end;

function TImpIOleContainer._Release: Integer;
begin
   If m_cRef > 0 Then
      Dec(m_cRef)
      else
        m_cRef := 0;
   Result := m_cRef;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:

function TOleControl.GetContainer(out container: IOleContainer): HResult;
Var
 pIContainer : TImpIOleContainer;

begin
   pIContainer := TImpIOleContainer.Create;
   If (pIContainer <> NIL) Then
     begin
      Result := pIContainer.QueryInterface(IID_IOleContainer, container);
      Exit;
     end;
   container := NIL;
   Result := E_NOINTERFACE;
//  Result := E_NOINTERFACE;<<-- das stand dort vorher drinne und gab besagte Meldung aus
end;                    

1:
2:
3:
4:

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleServer, ExtDlgs, OleCtrls, DHTMLEDLib_TLB, ActiveX, ExtCtrls, SHDocVw, MSHTML_TLB, ActnList,
  StdCtrls, Menus, ComCtrls;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:

  TMain = class(TForm,IHTMLEditDesigner,IHTMLEditHost)
...
    // *** Implementation of IHTMLHost
    function SnapRect(const pIElement: IHTMLElement; var prcNew: tagRECT; eHandle: _ELEMENT_CORNER): HResult; stdcall;
    // *** Implementation of IHTMLEditDesigner ***
    function PreHandleEvent(inEvtDispId: Integer; const pIEventObj: IHTMLEventObj): HResult; stdcall;
    function PostHandleEvent(inEvtDispId: Integer; const pIEventObj: IHTMLEventObj): HResult; stdcall;
    function TranslateAccelerator(inEvtDispId: Integer; const pIEventObj: IHTMLEventObj): HResult; stdcall;
    function PostEditorEventNotify(inEvtDispId: Integer; const pIEventObj: IHTMLEventObj): HResult; stdcall;
...
end

// und die zugehörige Implementation dazu:

function TMain.PostHandleEvent(inEvtDispId: Integer;
  const pIEventObj: IHTMLEventObj): HResult;
begin
  Result := S_FALSE;
end;

function TMain.PreHandleEvent(inEvtDispId: Integer;
  const pIEventObj: IHTMLEventObj): HResult;
begin
  Result := S_FALSE;
end;

function TMain.TranslateAccelerator(inEvtDispId: Integer;
  const pIEventObj: IHTMLEventObj): HResult;
begin
  Result := S_FALSE;
end;

function TMain.PostEditorEventNotify(inEvtDispId: Integer;
  const pIEventObj: IHTMLEventObj): HResult;
begin
  if inEvtDispId = -606 then begin
    sb.Panels[0].Text := IntToStr(pIEventObj.clientX) + ':' + IntToStr(pIEventObj.clientY);
  end;
  Result := S_FALSE;
end;

function TMain.SnapRect(const pIElement: IHTMLElement; var prcNew: tagRECT;
  eHandle: _ELEMENT_CORNER): HResult;
begin
  prcNew.left := 20 * (prcNew.left div 20);
  prcNew.top := 20 * (prcNew.top div 20);
  prcNew.right := 20 * (prcNew.right div 20);
  prcNew.bottom := 20 * (prcNew.bottom div 20);
  Result := S_OK;
end;                    

1:
2:
3:
4:
5:

initialization
OleInitialize(nil);

finalization
OleUninitialize;                    

1:
2:
3:
4:
5:

procedure TMain.FormCreate(Sender: TObject);
begin
  WebEdit.DefaultInterface._AddRef;
...
end;                    

1:
2:
3:
4:
5:
6:
7:

var
  O:OleVariant;
begin
    O:='test.html';
    WebEdit.LoadDocument(O);
    ...
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:

var
  W:WideString;
  F:TextFile;
begin
  S:=WebEdit.DocumentHTML; // gesamter Quelltext, nicht .InnerHTML !!
  AssignFile(F,'Test.html');
  Rewrite(F);
  Writeln(F,S);
  closeFile(F);
end;                    

1:
2:

   StringToWideChar(Filename,Wide,Sizeof(Wide));
  (WebEdit.DOM as IPersistFile).Save(Wide,false);                    

1:
2:
3:
4:

procedure TMain.SaveAsClick(Sender: TObject);
begin
  WebEdit.DOM.execCommand('SaveAs',false,0);
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:

function TMain.GetProperties(const Name: String): OLEVariant;
// liefert einen Rückgabewert, ob in der aktuellen Selektion das Kommando "Name" enthalten ist
// sprich, ist der Text der Selektion "Fett" gibts einen Rückgabewert [fett] 
// d.h. der Buttons "Fett" ist selektiert (Down) wenn der Cursor auf einen Fetten Text geht
 var
  V: OleVariant;
begin
  V := WebEdit.DOM.selection.createRange;
  Result := V.queryCommandValue(Name);
end;


procedure TMain.UpdateButtons;
  function QueryStatus(cmdID: OleVariant): OleVariant;
  // liefert den Status eines Kommandos 
  begin
    Result := WebEdit.QueryStatus(cmdID);
  end;

begin
  // Aktion  = [Kommando erlaubt], simple Bitschieberei
  akAusschneiden.Enabled  := (QueryStatus(DECMD_CUT) and DECMDF_ENABLED) = DECMDF_ENABLED;
  akKopieren.Enabled := (QueryStatus(DECMD_COPY)and DECMDF_ENABLED) = DECMDF_ENABLED;
  akEinfuegen.Enabled:= (QueryStatus(DECMD_PASTE) and DECMDF_ENABLED) = DECMDF_ENABLED;
  akEinfuegenAlsText.Enabled:= (QueryStatus(DECMD_PASTE) and DECMDF_ENABLED) = DECMDF_ENABLED;
  aBold.Enabled := (QueryStatus(DECMD_BOLD) and DECMDF_ENABLED) = DECMDF_ENABLED;
  aBold.Checked := GetProperties('Bold');
  aUnderline.Enabled := (QueryStatus(DECMD_UNDERLINE) and DECMDF_ENABLED) = DECMDF_ENABLED;
  aUnderline.Checked := GetProperties('Underline');
  aItalic.Enabled := (QueryStatus(DECMD_ITALIC) and DECMDF_ENABLED) = DECMDF_ENABLED;
  aItalic.Checked := GetProperties('Italic');
  aLeft.Checked   := (GetProperties('JustifyLeft'));
  aCenter.Checked := (GetProperties('JustifyCenter'));
  aRight.Checked  := (GetProperties('JustifyRight'));
  aUndo.Enabled:= (QueryStatus(DECMD_UNDO) and DECMDF_ENABLED) = DECMDF_ENABLED;
  aRedo.Enabled:= (QueryStatus(DECMD_REDO) and DECMDF_ENABLED) = DECMDF_ENABLED;
  aNumber.Checked:= (QueryStatus(DECMD_ORDERLIST) and DECMDF_LATCHED) = DECMDF_LATCHED;
  aBullet.Checked:= (QueryStatus(DECMD_UNORDERLIST) and DECMDF_LATCHED) = DECMDF_LATCHED;
  aIndent.Enabled:= (QueryStatus(DECMD_INDENT) and DECMDF_ENABLED) = DECMDF_ENABLED;
  aOutdent.Enabled:= (QueryStatus(DECMD_OUTDENT) and DECMDF_ENABLED) = DECMDF_ENABLED;
  aURL.Enabled:=  WebEdit.Dom.queryCommandEnabled('CreateLink');
  aUp.Checked:=(GetProperties('Superscript'));
  aDown.Checked:=(GetProperties('Subscript'));
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:

procedure TMain.SetProperties(const Name: String; Value: OleVariant);
// dem HTMLEditor eine Nachricht schicken.
var
  V: OleVariant;
  S: OleVariant;
begin
  if GetProperties(Name) <> Value then begin // nur wenn sowieso nicht schon gesetzt
    V := WebEdit.DOM.selection.createRange; // Range erstellen
    S := Value; // a bissle rumschieben
    V.execCommand(Name , False, S); // und ab damit
  end;
end;

procedure TMain.aBoldExecute(Sender: TObject);
begin
  SetProperties('Bold',iBold.Down); // Je nach Status des Buttons "Down" Text Fett machen oder Text Fett aufheben
  UpdateButtons; // mir ist noch nichts besseres eingefallen, Buttons aktualisieren
end;
...

// hier zum beispiel Text unterstreichen
procedure TMain.btnUnderlineClick(Sender: TObject);
begin
  SetProperties('Underline',iUnderline.Down);
  UpdateButtons;
end;                    

1:
2:
3:
4:

procedure TMain.WebEditonclick(Sender: TObject);
begin
  UpdateButtons;
end;                    

1:
2:
3:

    while Webedit.Busy do Application.ProcessMessages;
      if not WebEdit.Busy then
        WebEdit.Dom.charset:='iso-8859-1';//'utf-8';//'unicode';                    

1:
2:
3:
4:
5:
6:
7:
8:
9:

function TMain.PostEditorEventNotify(inEvtDispId: Integer;  
  const pIEventObj: IHTMLEventObj): HResult;  
begin  
  if inEvtDispId = -606 then begin  
    // onmousemove  
    sb.Panels[0].Text := IntToStr(pIEventObj.clientX) + ':' + IntToStr(pIEventObj.clientY);  
  end;  
  Result := S_FALSE; 
end;                    

1:
2:
3:
4:

function Tform1.GetHTMLDocument2Ifc: IHTMLDocument2;
begin  
   Result := WebBrowser1.Document as IHTMLDocument2;
end;