First I want to thank you, for the great feedback of my last post, all your comments and issue reports were very useful.

Motivation

While I was working on my favorite personal project And I realized which the TWebBrowser embedded in one of my forms doesn’t look very nice when the VCL Styles are enabled. So I decide write a fix.

My main goal was skin the scrollbars of the TWebBrowser component which by default uses the native windows look and feel.

This task involve many challenges like determine which WebBrowser events modify the position and visibility of the scrollbars, get the bounds of the original scrollbars, paint the skinned scrollbars, scroll the WebBrowser control, and so on. So I will try to explain briefly how was done.

The work begin

The first task was hook the TWebBrowser component to check which events and windows messages of the TWebBrowser modify the scrollbars visibility and position. So after of write a little helper application to do this, was determined that the events are :

• OnDocumentComplete
• OnNavigateComplete2
• OnBeforeNavigate2
• OnCommandStateChange
• OnProgressChange

And also the WMSIZE message.

The events

In order to intercept these TWebbrowser events we can’t assign a event handler directly because these will not be fired if the same events are assigned by the user. So the solution was override the InvokeEvent method which is part of the TOleControl control (and which is the parent class of the TWebbrowser component).

Here’s how it looks the overridden InvokeEvent method

procedure TVclStylesWebBrowser.InvokeEvent(DispID: TDispID; var Params: TDispParams);
var
  ArgCount  : Integer;
  LVarArray : Array of OleVariant;
  LIndex    : Integer;
begin
  inherited; //call the original implementation of InvokeEvent
  ArgCount := Params.cArgs;
  SetLength(LVarArray, ArgCount);
  //store the paramaters in an variant array for an more easy access to the values
  for LIndex := Low(LVarArray) to High(LVarArray) do
    LVarArray[High(LVarArray)-LIndex] := OleVariant(TDispParams(Params).rgvarg^[LIndex]);

  //call the private impkemenation of each event
  case DispID of
    252: DoNavigateComplete2(Self,
                              LVarArray[0] {const IDispatch},
                              LVarArray[1] {const OleVariant});

    259: DoDocumentComplete(Self,
                             LVarArray[0] {const IDispatch},
                             LVarArray[1] {const OleVariant});

    250: DoBeforeNavigate2(Self,
                            LVarArray[0] {const IDispatch},
                            LVarArray[1] {const OleVariant},
                            LVarArray[2] {const OleVariant},
                            LVarArray[3] {const OleVariant},
                            LVarArray[4] {const OleVariant},
                            LVarArray[5] {const OleVariant},
                            WordBool((TVarData(LVarArray[6]).VPointer)^) {var WordBool});

    105:DoCommandStateChange(Self,
                               LVarArray[0] {Integer},
                               LVarArray[1] {WordBool});

    108:DoProgressChange(Self,
                           LVarArray[0] {Integer},
                           LVarArray[1] {Integer});

  end;

  SetLength(LVarArray, 0);
end;

Additionally each local event implementation call the ResizeScrollBars method to change the visibility of the scrollbars and calculate the current position

procedure TVclStylesWebBrowser.DoBeforeNavigate2(Sender: TObject; const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
begin
  ResizeScrollBars;
end;

procedure TVclStylesWebBrowser.DoProgressChange(Sender: TObject; Progress,ProgressMax: Integer);
begin
  ResizeScrollBars;
end;

procedure TVclStylesWebBrowser.DoDocumentComplete(Sender: TObject;const pDisp: IDispatch; const URL: OleVariant);
begin
  ResizeScrollBars;
end;

procedure TVclStylesWebBrowser.DoNavigateComplete2(Sender: TObject;const pDisp:IDispatch;const URL: OleVariant);
begin
  ResizeScrollBars;
end;

Also we need to call the same method when the WM_SIZE message arrives.

procedure TVclStylesWebBrowser.WMSIZE(var Message: TWMSIZE);
begin
  inherited;
  ResizeScrollBars;
end;

The Scrollbars

After of that we need to paint the new Scrollbars using two TScrollBar components (Horizontal and Vertical), these controls are not draw directly over the Twebbrowser canvas rather, they are painted over a TWinControl which is a container for these controls, this container overlaps the original (native) scrollbars, also we need implement WMEraseBkgnd message to use the vcl styles color to fill the background of the container.

This is the definition of the private TWinContainer class.

  TVclStylesWebBrowser = class(SHDocVw.TWebBrowser, IDocHostUIHandler, IDocHostShowUI, IOleCommandTarget)
  strict private
    type
      TWinContainer = class(TWinControl)
        procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
      end;

This is the implementation of the WMEraseBkgnd message

procedure TVclStylesWebBrowser.TWinContainer.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
var
  Details: TThemedElementDetails;
  LCanvas: TCanvas;
begin
  LCanvas := TCanvas.Create;
  try
    LCanvas.Handle := Msg.DC;
    Details.Element := teWindow;
    Details.Part := 0;
    StyleServices.DrawElement(LCanvas.Handle, Details, ClientRect);
  finally
    LCanvas.Free;
  end;
end;

And this is the code of how the TScrollBar components are created

constructor TVclStylesWebBrowser.Create(AOwner: TComponent);
begin
  inherited;
  //Get the scrollbars sizes
  LSM_CXHTHUMB:=GetSystemMetrics(SM_CXHTHUMB);
  LSM_CYVTHUMB:=GetSystemMetrics(SM_CYVTHUMB);
  
  //set the containers to nil
  VScrollBarContainer := nil;
  HScrollBarContainer := nil;

  //create the containers
  ScrollCornerContainer := TWinContainer.Create(Self);
  ScrollCornerContainer.Visible := False;
   
  //create the vertical scroll bar
  VScrollBarContainer := TWinContainer.Create(Self);
  VScrollBarContainer.Visible := True;
  VScrollBar := TScrollBar.Create(Self);
  VScrollBar.Parent   := VScrollBarContainer;
  VScrollBar.Kind     := sbVertical;
  VScrollBar.Visible  := True;
  VScrollBar.Align    := alClient;
  VScrollBar.OnChange := VScrollChange;
  VScrollBar.Enabled  := False;

  //create the horizontal scroll bar
  HScrollBarContainer := TWinContainer.Create(Self);
  HScrollBarContainer.Visible := False;
  HScrollBar := TScrollBar.Create(Self);
  HScrollBar.Parent   := HScrollBarContainer;
  HScrollBar.Visible  := True;
  HScrollBar.Align    := alClient;
  HScrollBar.OnChange := HScrollChange;
end;

As final step of this stage we need handle CM_VISIBLECHANGED message to hide or show the new scrollbars.

procedure TVclStylesWebBrowser.CMVisibleChanged(var MSg: TMessage);
begin
  inherited ;
  VScrollBarContainer.Visible   := Self.Visible;
  HScrollBarContainer.Visible   := Self.Visible;
  ScrollCornerContainer.Visible := Self.Visible;
end;

The ResizeScrollBars method

As you see in some of the above code a call to the ResizeScrollBars method is made, well this is one of the key points of the TVclStylesWebBrowser class, this method change the visibility , recalculate the sizes of the scrollbars and scroll the TWebBrowser.

Take a look to the method implementation

procedure TVclStylesWebBrowser.ResizeScrollBars;
var
  StateVisible   : Boolean;
  DocClientWidth : Integer;
  ScrollWidth    : Integer;
  ScrollHeight   : Integer;
  HPageSize      : Integer;
  VPageSize      : Integer;
  LRect          : TRect;
  IEHWND         : WinApi.Windows.HWND;
begin
  IEHWND:=GetIEHandle;
  //some safety checks before to continue
  if (IEHWND=0) or (VScrollBarContainer = nil) or (HScrollBarContainer = nil) then Exit;

  if not VScrollBarContainer.Visible then
   VScrollBarContainer.Visible := True;

  //the loaded page has body?
  if (Document <> nil) and (IHtmldocument2(Document).Body <> nil) then
   begin
     //get the client width
     DocClientWidth := OleVariant(Document).documentElement.ClientWidth;
     //if the docuemnt has a width larger than 0 
     if (DocClientWidth > 0) then
     begin
       //Get the Scroll Width 
       ScrollWidth:=OleVariant(Document).DocumentElement.scrollWidth;
       if (HScrollBar.Max<>ScrollWidth) and (ScrollWidth>=HScrollBar.PageSize) and (ScrollWidth>=HScrollBar.Min) then
         HScrollBar.Max := ScrollWidth;

       //Get the Scroll Height
       ScrollHeight:=OleVariant(Document).DocumentElement.scrollHeight;
       if (VScrollBar.Max<>ScrollHeight) and (ScrollHeight>=VScrollBar.PageSize) and (ScrollHeight>=VScrollBar.Min) then
         VScrollBar.Max := ScrollHeight;
     end
     else
     //use the body values
     begin
       //Get the Scroll Width        
       ScrollWidth  := IHtmldocument2(Document).Body.getAttribute('ScrollWidth', 0);
       if (HScrollBar.Max<>ScrollWidth) and (ScrollWidth>=HScrollBar.PageSize) and (ScrollWidth>=HScrollBar.Min) then
         HScrollBar.Max := ScrollWidth;

       //Get the Scroll Height
       ScrollHeight:=IHtmldocument2(Document).Body.getAttribute('ScrollHeight', 0);
       if (VScrollBar.Max<>ScrollHeight) and (ScrollHeight>=VScrollBar.PageSize) and (ScrollHeight>=VScrollBar.Min) then
         VScrollBar.Max := ScrollHeight;
     end;

     //Get the height of the page
     if (HScrollBar.Max > Self.Width - LSM_CXHTHUMB) and(HScrollBar.Max > 0) and (HScrollBar.Max <> Self.Width) then
       VPageSize := Self.Height - LSM_CYVTHUMB
     else
       VPageSize := Self.Height;

     //Set the position of the vertical scrollbar
     VScrollBar.PageSize:=VPageSize;
     VScrollBar.SetParams(VScrollBar.Position, 0, VScrollBar.Max);
     VScrollBar.LargeChange := VScrollBar.PageSize;

     //Set the position of the horizontal scrollbar
     HPageSize := Self.Width - LSM_CXHTHUMB;
     HScrollBar.PageSize:=HPageSize;
     HScrollBar.SetParams(HScrollBar.Position, 0, HScrollBar.Max);
     HScrollBar.LargeChange := HScrollBar.PageSize;

     VScrollBar.Enabled := (VPageSize < VScrollBar.Max) and(VScrollBar.PageSize > 0) and (VScrollBar.Max > 0) and (VScrollBar.Max <> Self.Height);

     StateVisible := HScrollBarContainer.Visible;

     //set the visibility of the containers
     if IsWindow(HScrollBarContainer.Handle) then
      HScrollBarContainer.Visible := (HPageSize < HScrollBar.Max) and (HScrollBar.PageSize < HScrollBar.Max) and (HScrollBar.Max > 0) and (HScrollBar.Max <> Self.Width);
     if not StateVisible and HScrollBarContainer.Visible then
       HScrollBarContainer.BringToFront;
   end;
   
   UpdateContainers;
end;

Additional elements

Besides of the scrollbars we need to make small changes to the aspect of the TWebBrowser , for example remove the 3D border, this is made via the IDocHostUIHandler interface and the GetHostInfo function.

function TVclStylesWebBrowser.GetHostInfo(var pInfo: TDocHostUIInfo): HRESULT;
var
  BodyCss   : string;
  ColorHtml : string;
  LColor    : TColor;
begin
  LColor:=StyleServices.GetSystemColor(clWindow);
  ColorHtml:= Format('#%.2x%.2x%.2x',[GetRValue(LColor), GetGValue(LColor), GetBValue(LColor)]) ;
  BodyCss:=Format('BODY {background-color:%s}',[ColorHtml]);

  pInfo.cbSize := SizeOf(pInfo);
  pInfo.dwFlags := 0;
  pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_NO3DBORDER;//disable 3d border
  pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_THEME;//use themes
  if FUseVClStyleBackGroundColor then
  pInfo.pchHostCss :=PWideChar(BodyCss); //use the vcl styles color as background color (this optional and disabled by default)
  Result := S_OK;
  ResizeScrollBars;
end;

A Final touch

While I was wrote this class I decide add two new options to customize the way how the JScript alert messages and Javascript errors are shown, using the IOleCommandTarget and IDocHostShowUI interfaces.

Implementing the IDocHostShowUI.ShowMessage function you can replace the Windows Internet Explorer message box (which is used for Microsoft JScript alerts among other things).

function TVclStylesWebBrowser.ShowMessage(hwnd: THandle; lpstrText, 
  lpstrCaption: POLESTR; dwType: Integer; lpstrHelpFile: POLESTR;
  dwHelpContext: Integer; var plResult: LRESULT): HRESULT;
var
 DlgType: TMsgDlgType;
 Buttons: TMsgDlgButtons;
begin
  Result := E_NOTIMPL;
  if not FCustomizeStdDialogs then exit;

   DlgType:=mtInformation;
  if ((dwType and MB_ICONMASK)=MB_ICONHAND) or ((dwType and MB_ICONMASK)=MB_USERICON) then
   DlgType:=mtCustom
  else
  if (dwType and MB_ICONMASK)=MB_ICONWARNING then
   DlgType:=mtWarning
  else
  if (dwType and MB_ICONMASK)=MB_ICONQUESTION then
   DlgType:=mtConfirmation
  else
  if (dwType and MB_ICONMASK)=MB_ICONEXCLAMATION then
   DlgType:=mtInformation;

  case dwType and MB_TYPEMASK of
    MB_OK:Buttons:=[mbOK];
    MB_OKCANCEL:Buttons:=[mbOK,mbCancel];
    MB_ABORTRETRYIGNORE:Buttons:=[mbAbort,mbRetry,mbIgnore];
    MB_YESNOCANCEL:Buttons:=[mbYes,mbNo,mbCancel];
    MB_YESNO:Buttons:=[mbYes,mbNo];
    MB_RETRYCANCEL:Buttons:=[mbRetry,mbCancel];
  else
    Buttons:=[mbOK];
  end;

  //use the vcl MessageDlg function to show an skinned message box.
  plResult:= MessageDlg(lpstrText, DlgType, Buttons, dwHelpContext);
  Result := S_OK;
end;

Now to customize the message box which shows the javascript errors we must implement the IOleCommandTarget.Exec function (check this article for more info How to handle script errors as a WebBrowser control host)

function TVclStylesWebBrowser.Exec(CmdGroup: PGUID; nCmdID, nCmdexecopt: DWORD;
  const vaIn: OleVariant; var vaOut: OleVariant): HResult;
const
  CGID_DocHostCommandHandler: TGUID = (D1: $F38BC242; D2: $B950; D3: $11D1; D4: ($89, $18, $00, $C0, $4F, $C2, $C8, $36));
var
  LHTMLEventObj : IHTMLEventObj;
  LHTMLWindow2  : IHTMLWindow2;
  LHTMLDocument2: IHTMLDocument2;
  LUnknown      : IUnknown;
  Msg           : string;
  
  function GetPropertyValue(const PropName: WideString): OleVariant;
  var
    LParams    : TDispParams;
    LDispIDs   : Integer;
    Status     : Integer;
    ExcepInfo  : TExcepInfo;
    LName      : PWideChar;
  begin
    ZeroMemory(@LParams, SizeOf(LParams));
    LName := PWideChar(PropName);
    Status := LHTMLEventObj.GetIDsOfNames(GUID_NULL, @LName, 1, LOCALE_SYSTEM_DEFAULT, @LDispIDs);
    if Status = 0 then
    begin
      Status := LHTMLEventObj.Invoke(LDispIDs, GUID_NULL, LOCALE_SYSTEM_DEFAULT, DISPATCH_PROPERTYGET, LParams, @Result, @ExcepInfo, nil);
      if Status <> 0 then DispatchInvokeError(Status, ExcepInfo);
    end
    else
    if Status = DISP_E_UNKNOWNNAME then raise EOleError.CreateFmt('Property "%s" is not supported.', [PropName])
    else
      OleCheck(Status);
  end;

begin
 Result:=S_OK;
   if (CmdGroup <> nil) and IsEqualGuid(CmdGroup^, CGID_DocHostCommandHandler) then
     case nCmdID of
        //intercept the JScript error messages
        OLECMDID_SHOWSCRIPTERROR:
        begin
          if not FCustomizeJSErrorDialog then exit;
          LUnknown := IUnknown(TVarData(vaIn).VUnknown);
          //get an interface to the document which raise the message
          if Succeeded(LUnknown.QueryInterface(IID_IHTMLDocument2, LHTMLDocument2)) then
          begin
            LHTMLWindow2   := LHTMLDocument2.Get_parentWindow;
            if LHTMLWindow2<>nil then
            begin
              LHTMLEventObj := LHTMLWindow2.Get_event;
              if LHTMLEventObj <> nil then
              begin
               //buil the message to show
               Msg:='An error has ocurred in the script in this page'+sLineBreak+
                    'Line  %s'+sLineBreak+
                    'Char  %s'+sLineBreak+
                    'Error %s'+sLineBreak+
                    'Code  %s'+sLineBreak+
                    'URL   %s'+sLineBreak+
                    'Do you want to continue running scripts on this page?';               
               Msg:=Format(Msg,[GetPropertyValue('errorline'), GetPropertyValue('errorCharacter'), GetPropertyValue('errorMessage'), GetPropertyValue('errorCode'), GetPropertyValue('errorUrl')]);
               if MessageDlg(Msg,mtWarning,[mbYes, mbNo],0) =mrYes then
                vaOut := True
               else
                vaOut := False;
               Result:=S_OK;
              end;
            end;
          end;
        end;
     else
        Result:=OLECMDERR_E_NOTSUPPORTED;
     end
   else
     Result:=OLECMDERR_E_UNKNOWNGROUP;
end;

Note : In the end of this entry you can find a very useful collection of resources to customize a WebBrowser control.

How it works?

First the class introduced in this article is not a Vcl Style Hook, because exist some technical limitations to accomplish this, among them is the fact that the TWebBrowser control must implement additional interfaces (IDocHostUIHandler, IDocHostShowUI, IOleCommandTarget), so is necesary modify the original TWebBrowser component.

The recommended way to use the TVclStylesWebBrowser class is add the Vcl.Styles.WebBrowser unit to the uses clause is some point after of the SHDocVw unit and then use an interposer class like so :

TWebBrowser=class(TVclStylesWebBrowser);

Finally, How it looks?

Source Code

The full source code of this article is part of the VCL Styles Utils project, you can check the Vcl.Styles.WebBrowser unit here

Recommended resources about WebBrowser Customization

• MSDN WebBrowser Customization Part 1
• MSDN WebBrowser Customization Part 2
• How to customize the TWebBrowser user interface
• TEmbeddedWB
• MSDN About Scroll Bars (no related to webbrowser but very useful)

A final words

This is part of an open source project, so feel free to post any issue in the issue page of the project, as well if you want participate improving the code or adding new features, let me now.