Не знаю, поможет или нет, но одно время мне необходимо было запретить изменение размеров для изображений в TWebBrowser в DesignMode. Сделал так:
| Код |
THTMLEventNotifyEvent =
procedure(EventObject: IHTMLEventObj; EventType: string) of object;
THTMLEvent = class(TInterfacedObject, IDispatch)
private
FDocument: IHTMLDocument2;
FOnEvent: THTMLEventNotifyEvent;
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;
procedure DoEvent;
public
constructor Create(Document: IHTMLDocument2);
property OnEvent: THTMLEventNotifyEvent
read FOnEvent
write FOnEvent;
end;
implementation
function THTMLEvent.GetTypeInfoCount(out Count: Integer): HResult;
begin
Result := E_NOTIMPL
end;
function THTMLEvent.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
Result := E_NOTIMPL
end;
function THTMLEvent.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL
end;
function THTMLEvent.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult,
ExcepInfo, ArgErr: Pointer): HResult;
begin
DoEvent;
Result := S_OK;
end;
constructor THTMLEvent.Create(Document: IHTMLDocument2);
begin
inherited Create;
FDocument := Document;
FOnEvent := nil;
end;
procedure THTMLEvent.DoEvent;
var
EventObj: IHTMLEventObj;
EventType: string;
begin
if Assigned(FOnEvent) then
begin
EventObj := nil;
EventType := '';
if Assigned(FDocument) and Assigned(FDocument.parentWindow) then
begin
EventObj := FDocument.parentWindow.event;
if Assigned(EventObj) then
EventType := EventObj.type_;
end;
FOnEvent(EventObj, EventType);
end;
end;
|
| Код |
procedure TfrmMain.RegEvent(tag: IHTMLElement);
begin
EventHandler := THTMLEvent.Create(Editor);
EventHandler.OnEvent := KeyEvent;
(tag as IHTMLElement3).onresizestart := EventHandler as IDispatch;
end;
procedure TfrmMain.KeyEvent(EventObject: IHTMLEventObj; EventType: string);
begin
EventObject.cancelBubble := true;
EventObject.returnValue := false
end;
procedure TfrmMain.LockImages;
var
Index: Integer;
tag: IHTMLElement;
begin
if Editor.images.length <= 0 then Exit;
for Index := 0 to Editor.Images.Length - 1 do
begin
tag := IHTMLElement(Editor.images.item(Index, 0));
RegEvent(tag);
end;
end;
|
У меня работает. |