Reputation: 8043
I'm loading an HTML local file into TWebBrowser
as follows:
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('file:///C:\Tmp\input.html');
end;
In the TWebBrowser.OnDocumentComplete
event handler I'm making it editable:
procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; const URL: OleVariant);
begin
(WebBrowser1.Document as IHTMLDocument2).designMode := 'on';
end;
I need to be notified as soon as the user applies any changes through the TWebBrowser
(i.e: he writes something...) but I can't see any OnChanged
or similar event handler.
I've tried capturing WM_PASTE
and WM_KEYDOWN
but my code is never executed:
TMyWebBrowser = class(TWebBrowser)
public
procedure WM_Paste(var Message: TWMPaste); message WM_PASTE;
procedure WM_KeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
end;
...
procedure TMyWebBrowser.WM_Paste(var Message: TWMPaste);
begin
inherited;
ShowMessage('Paste');
end;
procedure TMyWebBrowser.WM_KEYDOWN(var Message: TWMKeyDown);
begin
inherited;
ShowMessage('KeyDown');
end;
I've also tried setting the WindowProc
property but without any success.
Upvotes: 2
Views: 751
Reputation: 3830
To capture changes to the document in design mode you should use its IMarkupContainer2
interface to register an IHTMLChangeSink
via RegisterForDirtyRange
method. The process is pretty simple - implement IHTMLChangeSink
, obtain IMarkupContainer2
from WebBrowser1.Document
and call its RegisterForDirtyRange
method, but there's a catch.
When you change the designMode
of IHTMLDocument2
, TWebBrowser
control reloads the current document and it loses all registered change sinks. Therefore you should register it after putting the document in design mode. After that you receive change notifications via IHTMLChangeSink.Notify
method.
But there's another catch. Since entering the design mode causes reloading of the document and that in turn causes changing the readyState
property of the document to 'loading'
and then consecutively to 'complete'
. Your change sink will receive those readyState
change notifications. Note that TWebBrowser.OnDocumentComplete
is not invoked after entering design mode. That's why you should ignore any notifications until the document is fully reloaded in design mode.
Another minor complication is that RegisterForDirtyRange
creates a cookie that you need to maintain in order to unregister the change sink. Since you need a class to implement IHTMLChangeSink
anyway, it could also encapsulate the design mode state and change registration.
uses
System.SysUtils, SHDocVw, MSHTML;
const
DesignMode: array[Boolean] of string = ('off', 'on');
type
TWebBrowserDesign = class(TInterfacedObject, IHTMLChangeSink)
private
FDirtyRangeCookie: LongWord;
FDocumentComplete: Boolean;
FHTMLDocument2: IHTMLDocument2;
FMarkupContainer2: IMarkupContainer2;
FOnChange: TProc;
{ IHTMLChangeSink }
function Notify: HResult; stdcall;
public
constructor Create(WebBrowser: TWebBrowser; const AOnChange: TProc);
destructor Destroy; override;
end;
constructor TWebBrowserDesign.Create(WebBrowser: TWebBrowser; const AOnChange: TProc);
begin
inherited Create;
if not Assigned(WebBrowser) then
raise Exception.Create('Web browser control missing.');
if not Supports(WebBrowser.Document, IHTMLDocument2, FHTMLDocument2) then
raise Exception.Create('No HTML document loaded.');
FHTMLDocument2.designMode := DesignMode[True];
if Supports(WebBrowser.Document, IMarkupContainer2, FMarkupContainer2) then
begin
if FMarkupContainer2.RegisterForDirtyRange(Self, FDirtyRangeCookie) <> S_OK then
FDirtyRangeCookie := 0
else
_Release;
end;
FOnChange := AOnChange;
end;
destructor TWebBrowserDesign.Destroy;
begin
if Assigned(FMarkupContainer2) and (FDirtyRangeCookie <> 0) then
FMarkupContainer2.UnRegisterForDirtyRange(FDirtyRangeCookie);
if Assigned(FHTMLDocument2) then
FHTMLDocument2.designMode := DesignMode[False];
inherited;
end;
function TWebBrowserDesign.Notify: HResult;
begin
Result := S_OK;
if not FDocumentComplete then
FDocumentComplete := FHTMLDocument2.readyState = 'complete'
else if Assigned(FOnChange) then
FOnChange();
end;
Note the call to _Release
after registering the change sink. This is to "prevent" markup container from holding strong reference to TWebBrowserDesign
instance. That allows you to control design mode using the lifetime of TWebBrowserDesign
instance:
type
TForm1 = class(TForm)
{ ... }
private
FWebBrowserDesign: IInterface;
{ ... }
end;
procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; const URL: OleVariant);
begin
{ enter design mode }
FWebBrowserDesign := TWebBrowserDesign.Create(WebBrowser1, procedure
begin
ButtonSave.Enabled := True;
end);
end;
procedure TForm1.ButtonSave(Sender: TObject);
begin
{ exit design mode }
FWebBrowserDesign := nil;
ButtonSave.Enabled := False;
end;
Alternatively you can implement change sink as a component.
type
TWebBrowserDesign = class(TComponent, IHTMLChangeSink)
private
FDirtyRangeCookie: LongWord;
FDocumentComplete: Boolean;
FHTMLDocument2: IHTMLDocument2;
FMarkupContainer2: IMarkupContainer2;
FOnChange: TNotifyEvent;
FWebBrowser: TWebBrowser;
procedure EnterDesignMode;
procedure ExitDesignMode;
function GetActive: Boolean;
procedure SetActive(const Value: Boolean);
procedure SetWebBrowser(const Value: TWebBrowser);
{ IHTMLChangeSink }
function Notify: HResult; stdcall;
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
destructor Destroy; override;
published
property Active: Boolean read GetActive write SetActive;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property WebBrowser: TWebBrowser read FWebBrowser write SetWebBrowser;
end;
destructor TWebBrowserDesign.Destroy;
begin
ExitDesignMode;
inherited;
end;
procedure TWebBrowserDesign.EnterDesignMode;
begin
if not Assigned(FWebBrowser) then
raise Exception.Create('Web browser control missing.');
if not Supports(FWebBrowser.Document, IHTMLDocument2, FHTMLDocument2) then
raise Exception.Create('No HTML document loaded.');
try
FHTMLDocument2.designMode := DesignMode[True];
if Supports(FWebBrowser.Document, IMarkupContainer2, FMarkupContainer2) then
begin
if FMarkupContainer2.RegisterForDirtyRange(Self, FDirtyRangeCookie) <> S_OK then
FDirtyRangeCookie := 0;
end;
except
ExitDesignMode;
raise;
end;
end;
procedure TWebBrowserDesign.ExitDesignMode;
begin
if Assigned(FMarkupContainer2) then
begin
if FDirtyRangeCookie <> 0 then
begin
FMarkupContainer2.UnRegisterForDirtyRange(FDirtyRangeCookie);
FDirtyRangeCookie := 0;
end;
FMarkupContainer2 := nil;
end;
if Assigned(FHTMLDocument2) then
begin
FHTMLDocument2.designMode := DesignMode[False];
if not (csDestroying in ComponentState) then
FHTMLDocument2 := nil; { causes AV when its hosting TWebBrowser component is destroying; I didn't dig into details }
end;
FDocumentComplete := False;
end;
function TWebBrowserDesign.GetActive: Boolean;
begin
Result := Assigned(FHTMLDocument2);
end;
procedure TWebBrowserDesign.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (Operation = opRemove) and (AComponent = FWebBrowser) then
WebBrowser := nil;
end;
function TWebBrowserDesign.Notify: HResult;
begin
Result := S_OK;
if not FDocumentComplete then
FDocumentComplete := FHTMLDocument2.readyState = 'complete'
else if Assigned(FOnChange) then
FOnChange(Self);
end;
procedure TWebBrowserDesign.SetActive(const Value: Boolean);
begin
if Active <> Value then
begin
if Value then
EnterDesignMode
else
ExitDesignMode;
end;
end;
procedure TWebBrowserDesign.SetWebBrowser(const Value: TWebBrowser);
begin
if Assigned(FWebBrowser) then
begin
ExitDesignMode;
FWebBrowser.RemoveFreeNotification(Self);
end;
FWebBrowser := Value;
if Assigned(FWebBrowser) then
FWebBrowser.FreeNotification(Self);
end;
If you put such a component in a design-time package and register it within the IDE, then you'll be able to link this component with TWebBrowser
and assign OnChange
event handler in the form designer. Use Active
property in code to enter/exit the design mode.
type
TForm1 = class(TForm)
{ ... }
WebBrowserDesign1: TWebBrowserDesign;
{ ... }
end;
procedure WebBrowserDesign1Change(Sender: TObject);
begin
ButtonSave.Enabled := True;
end;
procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; const URL: OleVariant);
begin
{ enter design mode }
WebBrowserDesign1.Active := True;
end;
procedure TForm1.ButtonSave(Sender: TObject);
begin
{ exit design mode }
WebBrowserDesign1.Active := False;
ButtonSave.Enabled := False;
end;
NB: Similar question has been asked regarding C#/WinForms - How do I detect when the content of a WebBrowser control has changed (in design mode)?
Final note: I'm not convinced that enabling save button after a change is the best UX design. If you think that the code above is worth to achieve your goal then go ahead. This is just a proof of concept and the code hasn't been thoroughly tested. Use it at your own risk.
Upvotes: 2