Архив для месяца: Июль, 2011

var 
 CW: word;

procedure TForm1.FormCreate(Sender: TObject);
begin
   CW := Get8087CW(); // Запоминаем предыдущее состояние регистра
   System.Set8087CW($133f);  // Выключаем исключения
end; 

procedure TForm1.FormDestroy(Sender: TObject);
begin
   System.Set8087CW(CW); // Восстанавливаем предыдущее значение регистра 
end;



  Но данный способ приемлем если у вас форма с TWebBrowser открыта модально или приложение не большое. В случае же если приложение MDI, большое и пользователь может динамически выполнять скрипты, то ни как не хотелось бы отключать генерацию исключений на все время работы приложения. Но как сделать так, что бы исключения были выключены только для TWebBrowser? 
К счастью для меня TWebBrowser используется у нас для отображения статической HTML разметки и проблема была замечены только когда пользователь трогал полосу прокрутки, потому было решено менять значение управляющего регистра только когда мышь появляется над TWebBrowser и восстанавливать обратно, когда покидает границы компонента.



TEventObject = class(TInterfacedObject,IDispatch)
private
    FOnEvent: TProc;
protected
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(const OnEvent: TProc);
property OnEvent: TProc read FOnEvent write FOnEvent;
end;



var
  webBrowser: IWebBrowser;
  iDocument2: IHTMLDocument2;
  eoMouseLeave, eoMouseEnter: TEventObject;
  iElement2: IHTMLElement2;
  j: Integer;
  CW: Word;

implementation

function TEventObject.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HResult;
begin
if (Dispid = DISPID_VALUE) then
begin
if Assigned(FOnEvent) then
      FOnEvent; // Вызываем обработчик события 
Result := S_OK;
end
else Result := E_NOTIMPL;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
{Создание объектов обработчиков реализующих IDispatch}
  eoMouseEnter := TEventObject.Create(self.OnMouseEnter);
  eoMouseLeave := TEventObject.Create(self.OnMouseLeave);
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
{Устанавливаем обработчики на события после загрузки страницы}
  webBrowser := pDisp as IWebBrowser;
if Assigned(webBrowser.Document) then
begin
    iDocument2 := webBrowser.Document as IHTMLDocument2;
    iDocument2.DesignMode := 'On';

for j:=0 to iDocument2.All.Length-1 do
begin
      iElement2 := iDocument2.All.item(j,EmptyParam) as IHTMLElement2;
      iElement2.AttachEvent('onmouseenter', eomouseEnter);
      iElement2.AttachEvent('onmouseleave', eoMouseLeave);
end;
end;
end;

procedure TForm1.WebBrowser1BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
{отсоединяем обработчики от событий, перед загрузкой новой страницы}  
if Assigned(webBrowser.Document) then
begin
    iDocument2 := webBrowser.Document as IHTMLDocument2;
for j:=0 to iDocument2.All.Length-1 do
begin
      iElement2:=All.item(i,EmptyParam) as IHTMLElement2;
      iElement2.detachEvent('onmouseenter', eoMouseEnter);
      iElement2.detachEvent('onmouseleave', eoMouseLeave);
end;
end;
end;


procedure TForm1.OnMouseEnter;
begin
  CW := Get8087CW();  
  System.Set8087CW($133f); // Отключаем исключения
end;

procedure TForm1.OnMouseLeave;
begin
   System.Set8087CW(CW); // Восстанавливаем значение регистра
end;



  Здесь мы вешаем обработчики на события OnMouseEnter и OnMouseLeave, т.к. MSDN говорит нам, что события не всплывающие(не проходят по всей иерархии DOM до верхнего уровня), то обработчики устанавливаем на все объекты документа.  В качестве обработчика метод IHTMLDocument.AttachEvent просит объект с IDispatch, для этого реализуем TEventObject. И не забываем, что eoMouseEnter, eoMouseleave надо удалить перед закрытием формы.