Trucos sobre tWebBrowser

tWebBrowser es un componente de Delphi que nos permite incorporar un visualizador de páginas web dentro de nuestras aplicaciones. Depende de la habilidad de nosotros el que podamos realizar un "Internet Explorer", "Firefox", "Opera"...
En este y posteriores artículos os mostraré algunos trucos interesantes:

PROCEDIMIENTOS SOBRE IMPRESIÓN DE PÁGINAS

IMPRIME UNA PÁGINA SIN VENTANA DE DIÁLOGO
procedure TForm1.Button1Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER,
vaIn, vaOut);
end;

IMPRIME UNA PÁGINA CON VENTANA DE DIÁLOGO
procedure TForm1.Button1Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER,
vaIn, vaOut);
end;

IMPRIME UNA VISTA PREVIA DE LA PÁGINA
procedure TForm1.Button1Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINTPREVIEW,
OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
end;

MUESTRA LA VENTANA "CONFIGURAR IMPRESORA"
procedure TForm1.Button1Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_PROMPTUSER,
vaIn, vaOut);
end;


PROCEDIMIENTOS PARA EL MANEJO DEL CLIPBOARD
añadir

uses ActiveX

initialization
OleInitialize(nil);

finalization
OleUninitialize;

COPIA EL TEXTO SELECCIONADO AL CLIPBOARD
procedure TForm1.Button1Click(Sender: TObject);
begin
try
WebBrowser1.ExecWB(OLECMDID_COPY, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;

CORTA EL TEXTO SELECCIONADO AL CLIPBOARD
procedure TForm1.Button1Click(Sender: TObject);
begin
try
WebBrowser1.ExecWB(OLECMDID_CUT, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;

BORRA EL TEXTO SELECCIONADO
procedure TForm1.Button1Click(Sender: TObject);
begin
try
WebBrowser1.ExecWB(OLECMDID_DELETE, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;


COMPROBAR QUE EL COMANDO "COPY" ESTÁ ACTIVO
procedure TForm1.Button1Click(Sender: TObject);
begin
if Webbrowser1.OleObject.Document.queryCommandEnabled('Copy') then
ShowMessage('Copy está activo');
end;

PROCEDIMIENTOS PARA IMPLEMENTAR LOS BOTONES "Siguiente, Anterior, Stop"
procedure TForm1.ButtonBackClick(Sender: TObject);
begin
WebBrowser1.GoBack
end;

procedure TForm1.ButtonForwardClick(Sender: TObject);
begin
WebBrowser1.GoForward
end;

procedure TForm1.ButtonCancelClick(Sender: TObject);
begin
WebBrowser1.Stop;
end;


VARIOS

IR A UNA PÁGINA WEB
WebBrowser.Navigate( URL.Text );

REEMPLAZAR LAS IMÁGENES DE UNA PÁGINA WEB
procedure TForm1.Button1Click(Sender: TObject);
var
li: Word;
begin
// Busca todas las imágenes de una página
for li := 0 to WebBrowser1.OleObject.Document.Images.Length - 1 do
// y las cambia por "MiImagen.gif"
WebBrowser1.OleObject.Document.Images.Item(0).Src := 'c:\MiImagen.gif';
end;


OCULTA LAS BARRAS DE SCROLL
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.OleObject.Document.Body.Style.OverflowX := 'hidden';
WebBrowser1.OleObject.Document.Body.Style.OverflowY := 'hidden';
end;


GRABA UNA PÁGINA HTML EN UN ARCHIVO
uses
ActiveX, MSHTML_TLB, SHDocVw_TLB,
ComCtrls, OleCtrls;

procedure TForm1.Button1Click(Sender: TObject);
var
HTMLDocument: IHTMLDocument2;
PersistFile: IPersistFile;
begin
HTMLDocument := WebBrowser1.Document as IHTMLDocument2;
PersistFile := HTMLDocument as IPersistFile;
PersistFile.Save(StringToOleStr('c:\MiPaginaWeb.html'), System.True);
end;

DESACTIVA LOS MENUS POPUP
Poner un componente tApplicationEvents en el form y en el evento onMessage poner lo siguiente

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
if (Msg.Message = WM_RBUTTONDOWN) or (Msg.Message = WM_RBUTTONDBLCLK) then
begin
if IsChild(Webbrowser1.Handle, Msg.hwnd) then
begin
// Muestra tu propio popup o lo que tú quieras
Handled := True;
end;
end;
end;

OTRO MÉTODO PARA DESACTIVAR LAS VENTANAS EMERGENTES
En el evento OnNewWindow2 poner lo siguiente:
procedure TForm1.WebBrowserNewWindow2(Sender: TObject;var ppDisp: IDispatch; var Cancel: WordBool);
begin
Cancel := True;
end;