DelphiDeep: enero 2009

Then you have more procedures about to the TWebBrowser component:

Create a TWebBrowser in Runtime
procedure TForm1.Button1Click(Sender: TObject);
var
wb: TWebBrowser;
begin
wb := TWebBrowser.Create(Form1);
TWinControl(wb).Name := 'MyWebBrowser';
TWinControl(wb).Parent := Form1;
wb.Align := alClient;
// TWinControl(wb).Parent := TabSheet1; ( To put it on a TabSheet )
wb.Navigate('http://delphimagic.blogspot.com');
end;

Undo, Redo, Select All
Añadir
uses ActiveX;

y al final de la unit

initialization
OleInitialize(nil);
finalization
OleUninitialize;
// Undo
procedure TForm1.Button2Click(Sender: TObject);
begin
try
WebBrowser1.ExecWB(OLECMDID_UNDO, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;//Redoprocedure TForm1.Button3Click(Sender: TObject);
begin
try
WebBrowser1.ExecWB(OLECMDID_REDO, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;

// Select all
procedure TForm1.Button4Click(Sender: TObject);
begin
try
WebBrowser1.ExecWB(OLECMDID_SELECTALL, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;

Save all images
uses
UrlMon;

function DownloadFile(SourceFile, DestFile: string): Boolean;
begin
try
Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0,
nil) = 0;
except
Result := False;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
k, p: Integer;
Source, dest, ext: string;
begin
for k := 0 to WebBrowser1.OleObject.Document.Images.Length - 1 do
begin
Source := WebBrowser1.OleObject.Document.Images.Item(k).Src;
p := LastDelimiter('.', Source);
ext := UpperCase(Copy(Source, p + 1, Length(Source)));
if (ext = 'GIF') or (ext = 'JPG') then
begin
p := LastDelimiter('/', Source);
dest := ExtractFilePath(ParamStr(0)) + Copy(Source, p + 1,
Length(Source));
DownloadFile(Source, dest);
end;
end;
end;

Zoom in ONE PAGE
procedure TForm1.Button1Click(Sender: TObject);
begin
//75% del tamaño original
WebBrowser1.OleObject.Document.Body.Style.Zoom := 0.75;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//Tamaño original
WebBrowser1.OleObject.Document.Body.Style.Zoom := 1;
end;

Verify that the page is secure (SSL)
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
if Webbrowser1.Oleobject.Document.Location.Protocol = 'https:' then
label1.Caption := 'Página segura'
else
label1.Caption := 'Página no segura';
end;

CHECK THE PAGE IS IN LOCAL DISK
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
if Webbrowser1.Oleobject.Document.Location.Protocol = 'file:' then
begin
label1.Caption := 'El archivo está en el disco local'
end;
end;Related articles
http://delphimagic.blogspot.com/2009/01/trucos-sobre-twebbrowser.html

TWebBrowser is a component that allows us to incorporate a display of web pages within our applications. It depends on the ability of us that we can make an "Internet Explorer", "Firefox", "Opera" ...
In this and subsequent articles I will show some interesting tricks:PROCEDURES ON PRINTING PAGES

PRINT a page without dialog
procedure TForm1.Button1Click(Sender: TObject);
varvaIn, vaOut: OleVariant;
beginWebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER,
vaIn, vaOut);
end;

PRINT a page withodialog
procedure TForm1.Button1Click(Sender: TObject);
varvaIn, vaOut: OleVariant;
beginWebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER,
vaIn, vaOut);
end;

PRINT A PAGE PREVIEWprocedure TForm1.Button1Click(Sender: TObject);
varvaIn, vaOut: OleVariant;
beginWebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINTPREVIEW,
OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
end;

Displays the "Printer Setup"procedure TForm1.Button1Click(Sender: TObject);
varvaIn, vaOut: OleVariant;
beginWebBrowser1.ControlInterface.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_PROMPTUSER,
vaIn, vaOut);
end;

PROCEDURES FOR HANDLING CLIPBOARDañadir

uses ActiveX

initializationOleInitialize(nil);

finalizationOleUninitialize;

Copies selected text to clipboardprocedure TForm1.Button1Click(Sender: TObject);
begin
tryWebBrowser1.ExecWB(OLECMDID_COPY, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;

Cuts the selected text to clipboard
procedure TForm1.Button1Click(Sender: TObject);
begin
tryWebBrowser1.ExecWB(OLECMDID_CUT, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;

Deletes the selected text
procedure TForm1.Button1Click(Sender: TObject);
begin
tryWebBrowser1.ExecWB(OLECMDID_DELETE, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;

VERIFY COMMAND "COPY" is active
procedure TForm1.Button1Click(Sender: TObject);
begin
if Webbrowser1.OleObject.Document.queryCommandEnabled('Copy') thenShowMessage('Copy está activo');
end;

Procedures to implement the buttons "Next, Previous, Stop"
procedure TForm1.ButtonBackClick(Sender: TObject);
beginWebBrowser1.GoBack
end;

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

procedure TForm1.ButtonCancelClick(Sender: TObject);
beginWebBrowser1.Stop;
end;
VARIOUS

GO TO A WEB PAGE
WebBrowser.Navigate( URL.Text );

REPLACE THE IMAGES OF A WEBSITE
procedure TForm1.Button1Click(Sender: TObject);
varli: Word;
begin// Busca todas las imágenes de una páginafor 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;

HIDDEN SCROLL BARS
procedure TForm1.Button1Click(Sender: TObject);
beginWebBrowser1.OleObject.Document.Body.Style.OverflowX := 'hidden';
WebBrowser1.OleObject.Document.Body.Style.OverflowY := 'hidden';
end;
Records a HTML PAGE TO A FILE
usesActiveX, MSHTML_TLB, SHDocVw_TLB,
ComCtrls, OleCtrls;

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

DISABLE POPUP MENUS
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ú quierasHandled := 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;

Related articles
http://delphimagic.blogspot.com/2009/01/trucos-sobre-twebbrowser-ii.html

DelphiDeep

Tips about tWebBrowser ( II )

Tips about tWebBrowser