Accueil > > > MOZILLA FIREFOX EN DELPHI
MOZILLA FIREFOX EN DELPHI
Information sur la source
Attention: ce code a été marqué comme suspect par un admin, il peut donc être dangereux. Ce code a été laissé sur le site dans un but pédagogique, ne l'exécutez pas si vous ne comprenez pas son contenu!
Description
Hello, Oui vous avez bien lu "Mozilla Firefox en Delphi" :), j'était a la recherche d'un TWebBrowser non basé sur IE et je suis tombé sur ça ! Je n'ai pas pour habitude de poster une source qui n'est pas de moi mais là, vu la qualité du code, je me permets. Les notes données a cette source ne seront pas destinées a moi bien sur, j'ai en avance félicité par mail le créateur de la source : Dave Murray <irongut at vodafone dot net> Le composant TMozillaControl est donc là pour les personnes qui sont allergiques à I.E. et qui ne veulent donc pas utiliser le TWebBrowser. De toute façon, je vois mal qqn faire un MOzilla avec un TWebBrowser.. lol
Source
- MainForm.pas :
-
- unit MainForm;
- {Main Form unit for Gecko Browser, a demo of embedding Gecko in Delphi 5+ apps}
- {v1.0 Written by Dave Murray <irongut@vodafone.net>, October - November 2003}
- {v1.1 Written by Dave Murray, March 2004}
- {v1.2 Written by Dave Murray, April + July 2004}
- {Gecko Browser v1.2 was written using Mozilla ActiveX Control v1.7.1}
-
- (* ***** BEGIN LICENSE BLOCK *****
- * Version: MPL 1.1/GPL 2.0/LGPL 2.1
- *
- * The contents of this file are subject to the Mozilla Public License Version
- * 1.1 (the "License"); you may not use this file except in compliance with
- * the License. You may obtain a copy of the License at
- * http://www.mozilla.org/MPL/
- *
- * Software distributed under the License is distributed on an "AS IS" basis,
- * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
- * for the specific language governing rights and limitations under the
- * License.
- *
- * The Original Code is Gecko Browser framework.
- *
- * The Initial Developer of the Original Code is
- * Conspiracy Software.
- * Portions created by the Initial Developer are Copyright (C) 2003 - 2004
- * the Initial Developer. All Rights Reserved.
- *
- * Contributor(s):
- * Dave Murray <irongut@vodafone.net>
- * Sterling Bates <sblistserv@bigbangco.com>
- *
- * Alternatively, the contents of this file may be used under the terms of
- * either the GNU General Public License Version 2 or later (the "GPL"), or
- * the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
- * in which case the provisions of the GPL or the LGPL are applicable instead
- * of those above. If you wish to allow use of your version of this file only
- * under the terms of either the GPL or the LGPL, and not to allow others to
- * use your version of this file under the terms of the MPL, indicate your
- * decision by deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL or the LGPL. If you do not delete
- * the provisions above, a recipient may use your version of this file under
- * the terms of any one of the MPL, the GPL or the LGPL.
- *
- * ***** END LICENSE BLOCK ***** *)
-
-
- interface
-
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, ComCtrls, StdCtrls, ToolWin, ExtCtrls, ImgList, Menus, OleCtrls,
- ActiveX, MOZILLACONTROLLib_TLB;
-
- type
- TfrmMain = class(TForm)
- mnmnuMain: TMainMenu;
- mFile: TMenuItem;
- mOpen: TMenuItem;
- mSaveAs: TMenuItem;
- N1: TMenuItem;
- mPageSetup: TMenuItem;
- mPrintPreview: TMenuItem;
- mPrint: TMenuItem;
- N2: TMenuItem;
- mExit: TMenuItem;
- mEdit: TMenuItem;
- mCopy: TMenuItem;
- mClearSelection: TMenuItem;
- mSelectAll: TMenuItem;
- N4: TMenuItem;
- mPreferences: TMenuItem;
- mGo: TMenuItem;
- mBack: TMenuItem;
- mForward: TMenuItem;
- mStop: TMenuItem;
- mReload: TMenuItem;
- N3: TMenuItem;
- mHome: TMenuItem;
- mHelp: TMenuItem;
- mAbout: TMenuItem;
- pnlBtnNav: TPanel;
- tlbrButtons: TToolBar;
- tlbtnBack: TToolButton;
- tlbtnForward: TToolButton;
- tlbtnStop: TToolButton;
- tlbtnReload: TToolButton;
- tlbtnHome: TToolButton;
- tlbtnSplit1: TToolButton;
- tlbtnPrint: TToolButton;
- tlbtnSplit2: TToolButton;
- tlbtnProperties: TToolButton;
- tlbtnSplit3: TToolButton;
- edtAddress: TEdit;
- pnlThrobber: TPanel;
- nmtThrobber: TAnimate;
- pnlBrowser: TPanel;
- stsbrStatus: TStatusBar;
- imglstMainMenu: TImageList;
- imglstButtons: TImageList;
- imglstButtonsHot: TImageList;
- imglstButtonsDisabled: TImageList;
- prgrssbrProgress: TProgressBar;
- mzGecko: TMozillaBrowser;
- {### FORM METHODS ###}
- procedure FormCreate(Sender: TObject);
- procedure FormShow(Sender: TObject);
- {### MENUITEM METHODS}
- procedure mOpenClick(Sender: TObject);
- procedure mSaveAsClick(Sender: TObject);
- procedure mPageSetupClick(Sender: TObject);
- procedure mPrintPreviewClick(Sender: TObject);
- procedure mPrintClick(Sender: TObject);
- procedure mExitClick(Sender: TObject);
- procedure mCopyClick(Sender: TObject);
- procedure mClearSelectionClick(Sender: TObject);
- procedure mSelectAllClick(Sender: TObject);
- procedure mPreferencesClick(Sender: TObject);
- procedure mBackClick(Sender: TObject);
- procedure mForwardClick(Sender: TObject);
- procedure mStopClick(Sender: TObject);
- procedure mReloadClick(Sender: TObject);
- procedure mHomeClick(Sender: TObject);
- procedure mAboutClick(Sender: TObject);
- {### MOZILLA CONTROL METHODS ###}
- procedure mzGeckoStatusTextChange(Sender: TObject; const Text: WideString);
- procedure mzGeckoProgressChange(Sender: TObject; Progress, ProgressMax: Integer);
- procedure mzGeckoCommandStateChange(Sender: TObject; Command: Integer; Enable: WordBool);
- procedure mzGeckoDownloadBegin(Sender: TObject);
- procedure mzGeckoDownloadComplete(Sender: TObject);
- {### MISC METHODS ###}
- procedure edtAddressKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- private
- { Private declarations }
- function CharReplace(var S: AnsiString; const Search, Replace: AnsiChar): Integer;
- public
- { Public declarations }
- end;
-
- var
- frmMain: TfrmMain;
-
- implementation
-
- {$R *.dfm}
-
- uses CommCtrl, Globals, OpenForm, PrefsForm;
-
-
- var
- ON_START : boolean;
-
-
- {### FORM METHODS ###}
-
-
- procedure TfrmMain.FormCreate(Sender: TObject);
- {initialise...}
- begin
- {setup window}
- Application.Title := PROGRAM_TITLE;
- Self.Caption := PROGRAM_TITLE;
- {move progress bar to status bar's first panel}
- prgrssbrProgress.Parent := stsbrStatus;
- prgrssbrProgress.Top := 2;
- prgrssbrProgress.Left := 2;
- prgrssbrProgress.Height := stsbrStatus.Height - 2;
- prgrssbrProgress.Width := stsbrStatus.Panels[0].Width - 2;
- prgrssbrProgress.Position := 0;
- prgrssbrProgress.Refresh;
- {setup vars}
- ON_START := true;
- end; {procedure TfrmMain.FormCreate}
-
- procedure TfrmMain.FormShow(Sender: TObject);
- {navigate to start page if first show}
- begin
- if ON_START then begin
- ON_START := false;
- {show start page}
- case START_TYPE of
- // 0 : {blank page}
- 1 : mzGecko.Navigate(WideString(HOME_ADDRESS)); {home page}
- 2 : mzGecko.Navigate(WideString(START_ADDRESS)); {custom start page}
- end; {case START_TYPE..}
- end; {if ON_START..}
- end; {procedure TfrmMain.FormShow}
-
-
- {### MENUITEM METHODS}
-
-
- procedure TfrmMain.mOpenClick(Sender: TObject);
- {open web page from URL or file}
- var
- Address : string;
- frmOpen: TfrmOpen;
- begin
- {show open page dialog - frmOpen}
- frmOpen := TfrmOpen.Create(self);
- try
- if (frmOpen.ShowModal = mrOk) then begin
- {retrieve address}
- Address := frmOpen.edtURL.Text;
- if not(trim(Address) = '') then begin
- {navigate to address}
- CharReplace(Address, '\', '/'); {correct bug with relative links + images}
- mzGecko.Navigate(WideString(Address));
- end; {if not(Address = ''..}
- end; {if mrOk..}
- finally
- {free dialog}
- frmOpen.Free;
- end; {try..finally..}
- end; {procedure TfrmMain.mOpenClick}
-
- procedure TfrmMain.mSaveAsClick(Sender: TObject);
- {show Save As dialog}
- {Control <= v1.6: OLECMDEXECOPT_PROMPTUSER causes EOleException due to bug in flag
- tests, use OLECMDEXECOPT_DODEFAULT instead; Bugzilla 2250454.
- Control v1.7: Flag tests fixed so can use OLECMDEXECOPT_PROMPTUSER; Bugzilla 2250454
- fixed.}
- var
- PageFilename : OleVariant;
- begin
- try
- {ensure not busy}
- if not(mzGecko.Busy) then begin
- PageFilename := mzGecko.LocationName + '.html';
- {show save as dialog}
- mzGecko.ExecWB(OLECMDID_SAVEAS, OLECMDEXECOPT_PROMPTUSER {OLECMDEXECOPT_DODEFAULT}, PageFilename);
- end; {if not Busy..}
- except
- {handle exceptions}
- on E : Exception do
- MessageDlg('ERROR: Unable to show Save As dialog. ' + #13 + E.ClassName
- + ': ' + E.Message + '.', mtError, [mbOk], 0);
- end; {try..except..}
- end; {procedure TfrmMain.mSaveAsClick}
-
- procedure TfrmMain.mPageSetupClick(Sender: TObject);
- {show Page Setup dialog}
- {Control <= v1.6: OLECMDEXECOPT_PROMPTUSER causes EOleException due to bug in flag tests,
- use OLECMDEXECOPT_DODEFAULT instead + get 'not implemented' dialog; Bugzilla 2250454.
- Control v1.7: Flag tests fixed so can use OLECMDEXECOPT_PROMPTUSER and Page Setup
- has been implemented; Bugzilla 2250454 fixed.}
- begin
- try
- {ensure not busy or printing before showing dialog}
- if not(mzGecko.Busy) and (mzGecko.QueryStatusWB(OLECMDID_PAGESETUP) > 0)
- {show page setup dialog}
- then mzGecko.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_PROMPTUSER {OLECMDEXECOPT_DODEFAULT});
- except
- {handle exceptions}
- on E : Exception do
- MessageDlg('ERROR: Unable to show Page Setup dialog. ' + #13 + E.ClassName
- + ': ' + E.Message + '.', mtError, [mbOk], 0);
- end; {try..except..}
- end; {procedure TfrmMain.mPageSetupClick}
-
- procedure TfrmMain.mPrintPreviewClick(Sender: TObject);
- {show Print Preview window}
- {OLECMDID_PRINTPREVIEW not currently supported in Mozilla Control although
- QueryStatusWB returns OLECMDF_SUPPORTED so disable menu item.
- OLECMDID_PRINTPREVIEW not defined in MozillaBrowser.h; Bugzilla 214884.}
- begin
- try
- {ensure not busy or printing before showing dialog}
- if not(mzGecko.Busy) and (mzGecko.QueryStatusWB(OLECMDID_PRINTPREVIEW) > 0)
- {show Print Preview window}
- then mzGecko.ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_PROMPTUSER);
- except
- {handle exceptions}
- on E : Exception do
- MessageDlg('ERROR: Unable to show Print Preview dialog. ' + #13 + E.ClassName
- + ': ' + E.Message + '.', mtError, [mbOk], 0);
- end; {try..except..}
- end; {procedure TfrmMain.mPrintPreviewClick}
-
- procedure TfrmMain.mPrintClick(Sender: TObject);
- {print current page}
- begin
- try
- {ensure not busy or printing before showing dialog}
- if not(mzGecko.Busy) and (mzGecko.QueryStatusWB(OLECMDID_PRINT) > 0)
- {show Print dialog}
- then mzGecko.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER);
- except
- {handle exceptions}
- on E : Exception do
- MessageDlg('ERROR: Unable to show Print dialog. ' + #13 + E.ClassName
- + ': ' + E.Message + '.', mtError, [mbOk], 0);
- end; {try..except..}
- end; {procedure TfrmMain.mPrintClick}
-
- procedure TfrmMain.mExitClick(Sender: TObject);
- {close application}
- begin
- {close frmMain - closes app}
- Self.Close;
- end; {procedure TfrmMain.mExitClick}
-
- procedure TfrmMain.mCopyClick(Sender: TObject);
- {copy selection to clipboard}
- begin
- try
- {copy selection}
- mzGecko.ExecWB(OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT);
- except
- {handle exceptions}
- on E : Exception do begin
- MessageDlg('ERROR Unable to Copy selected text to clipboard.' + #13 + E.ClassName
- + ': ' + E.Message + '.', mtError, [mbOk], 0);
- end; {on Exception..}
- end; {try..except..}
- end; {procedure TfrmMain.mCopyClick}
-
- procedure TfrmMain.mClearSelectionClick(Sender: TObject);
- {clear selection}
- {OLECMDID_CLEARSELECTION not currently supported in Mozilla Control although
- QueryStatusWB returns OLECMDF_SUPPORTED so disable menu item.
- OLECMDID_CLEARSELECTION not defined in MozillaBrowser.h; Bugzilla 214884.}
- begin
- try
- {clear selection}
- mzGecko.ExecWB(OLECMDID_CLEARSELECTION, OLECMDEXECOPT_DODEFAULT);
- except
- {handle exceptions}
- on E : Exception do begin
- MessageDlg('ERROR: Unable to Clear the current selection.' + #13 + E.ClassName
- + ': ' + E.Message + '.', mtError, [mbOk], 0);
- end; {on Exception..}
- end; {try..except..}
- end; {procedure TfrmMain.mClearSelectionClick}
-
- procedure TfrmMain.mSelectAllClick(Sender: TObject);
- {select entire page}
- begin
- try
- {select all}
- mzGecko.ExecWB(OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT);
- except
- {handle exceptions}
- on E : Exception do begin
- MessageDlg('ERROR Unable to Select All text on page.' + #13 + E.ClassName
- + ': ' + E.Message + '.', mtError, [mbOk], 0);
- end; {on Exception..}
- end; {try..except..}
- end; {procedure TfrmMain.mSelectAllClick}
-
- procedure TfrmMain.mPreferencesClick(Sender: TObject);
- {edit Gecko Browser prefs}
- var
- frmPrefs: TfrmPrefs;
- begin
- {show Preferences dialog - frmPrefs}
- frmPrefs := TfrmPrefs.Create(self);
- try
- if (frmPrefs.ShowModal = mrOk) then begin
- {correct addresses}
- CharReplace(START_ADDRESS, '\', '/'); {correct bug with relative links + images}
- CharReplace(HOME_ADDRESS, '\', '/'); {correct bug with relative links + images}
- end; {if mrOk..}
- finally
- {free dialog}
- frmPrefs.Free;
- end; {try..finally..}
- end; {procedure TfrmMain.mPreferencesClick}
-
- procedure TfrmMain.mBackClick(Sender: TObject);
- {go Back a page}
- begin
- {back}
- mzGecko.GoBack;
- end; {procedure TfrmMain.mBackClick}
-
- procedure TfrmMain.mForwardClick(Sender: TObject);
- {go Forward a page}
- begin
- {forward}
- mzGecko.GoForward;
- end; {procedure TfrmMain.mForwardClick}
-
- procedure TfrmMain.mStopClick(Sender: TObject);
- {stop loading page}
- begin
- {stop}
- mzGecko.Stop;
- end; {procedure TfrmMain.mStopClick}
-
- procedure TfrmMain.mReloadClick(Sender: TObject);
- {reload page}
- begin
- {refresh}
- mzGecko.Refresh;
- end; {procedure TfrmMain.mReloadClick}
-
- procedure TfrmMain.mHomeClick(Sender: TObject);
- {go to Home page}
- begin
- {navigate to Gecko Browser Home}
- mzGecko.Navigate(WideString(HOME_ADDRESS));
- end; {procedure TfrmMain.mHomeClick}
-
- procedure TfrmMain.mAboutClick(Sender: TObject);
- {show simple About dialog}
- begin
- MessageDlg(PROGRAM_TITLE + #13 + '(c) 2003 - 2004 Conspiracy Software' + #13
- + 'A demo of embedding Gecko (Mozilla) in Delphi applications.' + #13
- + 'Written by Dave Murray <irongut@vodafone.net>.' + #13
- + PROGRAM_TITLE + ' was written using ' + MOZILLA_VERSION + '.',
- mtInformation, [mbOk], 0);
- end; {procedure TfrmMain.About1Click}
-
-
- {### MOZILLA CONTROL METHODS ###}
-
-
- procedure TfrmMain.mzGeckoStatusTextChange(Sender: TObject; const Text: WideString);
- {show status text in stsbrStatus}
- begin
- stsbrStatus.Panels[1].Text := Text;
- end; {procedure TfrmMain.mzGeckoStatusTextChange}
-
- procedure TfrmMain.mzGeckoProgressChange(Sender: TObject; Progress, ProgressMax: Integer);
- {show download progress}
- begin
- {new code suggested by Sterling Bates, see Bugzilla #225041}
- prgrssbrProgress.Position := Round((Progress / ProgressMax) * 100);
- prgrssbrProgress.Max := 100;
- end; {procedure TfrmMain.mzGeckoProgressChange}
-
- procedure TfrmMain.mzGeckoCommandStateChange(Sender: TObject; Command: Integer; Enable: WordBool);
- {fired when user navigates, use to enable/disable navigation buttons}
- const
- {from SHDocVw.pas}
- CSC_NAVIGATEFORWARD = $00000001;
- CSC_NAVIGATEBACK = $00000002;
- begin
- if (Command = CSC_NAVIGATEFORWARD) then begin
- {enable / disable Forward button + menu item}
- tlbtnForward.Enabled := Enable;
- mForward.Enabled := Enable;
- end {if Command = CSC_NAVIGATEFORWARD}
- else if (Command = CSC_NAVIGATEBACK) then begin
- {enable / disabel Back button + menu item}
- tlbtnBack.Enabled := Enable;
- mBack.Enabled := Enable;
- end; {else if..}
- end; {procedure TfrmMain.mzGeckoCommandStateChange}
-
- procedure TfrmMain.mzGeckoDownloadBegin(Sender: TObject);
- {begining navigation, start throbber}
- begin
- nmtThrobber.Active := true;
- end; {procedure TfrmMain.mzGeckoDownloadBegin}
-
- procedure TfrmMain.mzGeckoDownloadComplete(Sender: TObject);
- {ending navigation, stop throbber + ensure edtAddress shows URL}
- var
- URL : string;
- begin
- URL := mzGecko.LocationURL;
- if not(edtAddress.Text = URL) then edtAddress.Text := URL;
- nmtThrobber.Active := false;
- prgrssbrProgress.Position := 0;
- end; {procedure TfrmMain.mzGeckoDownloadComplete}
-
-
- {### MISC METHODS ###}
-
-
- procedure TfrmMain.edtAddressKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- {navigate to current address}
- begin
- if (Key = VK_RETURN) then mzGecko.Navigate(WideString(edtAddress.Text));
- end; {procedure TfrmMain.edtAddressKeyDown}
-
-
- {### PRIVATE METHODS ###}
-
-
- function TfrmMain.CharReplace(var S: AnsiString; const Search, Replace: AnsiChar): Integer;
- {Reproduced from JEDI Code Library JclStrings.pas for demonstration purposes.}
- {http://www.delphi-jedi.org/}
- var
- P: PAnsiChar;
- begin
- Result := 0;
- if Search <> Replace then begin
- UniqueString(S);
- P := PAnsiChar(S);
- while P^ <> #0 do begin
- if P^ = Search then begin
- P^ := Replace;
- Inc(Result);
- end; {if P^ = ..}
- Inc(P);
- end; {while..}
- end; {if Search <> Replace..}
- end; {function TfrmMain.CharReplace}
-
-
-
-
- initialization
- OleInitialize(nil);
-
- finalization
- OleUninitialize;
-
- end.
MainForm.pas :
unit MainForm;
{Main Form unit for Gecko Browser, a demo of embedding Gecko in Delphi 5+ apps}
{v1.0 Written by Dave Murray <irongut@vodafone.net>, October - November 2003}
{v1.1 Written by Dave Murray, March 2004}
{v1.2 Written by Dave Murray, April + July 2004}
{Gecko Browser v1.2 was written using Mozilla ActiveX Control v1.7.1}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1/GPL 2.0/LGPL 2.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is Gecko Browser framework.
*
* The Initial Developer of the Original Code is
* Conspiracy Software.
* Portions created by the Initial Developer are Copyright (C) 2003 - 2004
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
* Dave Murray <irongut@vodafone.net>
* Sterling Bates <sblistserv@bigbangco.com>
*
* Alternatively, the contents of this file may be used under the terms of
* either the GNU General Public License Version 2 or later (the "GPL"), or
* the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
* in which case the provisions of the GPL or the LGPL are applicable instead
* of those above. If you wish to allow use of your version of this file only
* under the terms of either the GPL or the LGPL, and not to allow others to
* use your version of this file under the terms of the MPL, indicate your
* decision by deleting the provisions above and replace them with the notice
* and other provisions required by the GPL or the LGPL. If you do not delete
* the provisions above, a recipient may use your version of this file under
* the terms of any one of the MPL, the GPL or the LGPL.
*
* ***** END LICENSE BLOCK ***** *)
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, ToolWin, ExtCtrls, ImgList, Menus, OleCtrls,
ActiveX, MOZILLACONTROLLib_TLB;
type
TfrmMain = class(TForm)
mnmnuMain: TMainMenu;
mFile: TMenuItem;
mOpen: TMenuItem;
mSaveAs: TMenuItem;
N1: TMenuItem;
mPageSetup: TMenuItem;
mPrintPreview: TMenuItem;
mPrint: TMenuItem;
N2: TMenuItem;
mExit: TMenuItem;
mEdit: TMenuItem;
mCopy: TMenuItem;
mClearSelection: TMenuItem;
mSelectAll: TMenuItem;
N4: TMenuItem;
mPreferences: TMenuItem;
mGo: TMenuItem;
mBack: TMenuItem;
mForward: TMenuItem;
mStop: TMenuItem;
mReload: TMenuItem;
N3: TMenuItem;
mHome: TMenuItem;
mHelp: TMenuItem;
mAbout: TMenuItem;
pnlBtnNav: TPanel;
tlbrButtons: TToolBar;
tlbtnBack: TToolButton;
tlbtnForward: TToolButton;
tlbtnStop: TToolButton;
tlbtnReload: TToolButton;
tlbtnHome: TToolButton;
tlbtnSplit1: TToolButton;
tlbtnPrint: TToolButton;
tlbtnSplit2: TToolButton;
tlbtnProperties: TToolButton;
tlbtnSplit3: TToolButton;
edtAddress: TEdit;
pnlThrobber: TPanel;
nmtThrobber: TAnimate;
pnlBrowser: TPanel;
stsbrStatus: TStatusBar;
imglstMainMenu: TImageList;
imglstButtons: TImageList;
imglstButtonsHot: TImageList;
imglstButtonsDisabled: TImageList;
prgrssbrProgress: TProgressBar;
mzGecko: TMozillaBrowser;
{### FORM METHODS ###}
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
{### MENUITEM METHODS}
procedure mOpenClick(Sender: TObject);
procedure mSaveAsClick(Sender: TObject);
procedure mPageSetupClick(Sender: TObject);
procedure mPrintPreviewClick(Sender: TObject);
procedure mPrintClick(Sender: TObject);
procedure mExitClick(Sender: TObject);
procedure mCopyClick(Sender: TObject);
procedure mClearSelectionClick(Sender: TObject);
procedure mSelectAllClick(Sender: TObject);
procedure mPreferencesClick(Sender: TObject);
procedure mBackClick(Sender: TObject);
procedure mForwardClick(Sender: TObject);
procedure mStopClick(Sender: TObject);
procedure mReloadClick(Sender: TObject);
procedure mHomeClick(Sender: TObject);
procedure mAboutClick(Sender: TObject);
{### MOZILLA CONTROL METHODS ###}
procedure mzGeckoStatusTextChange(Sender: TObject; const Text: WideString);
procedure mzGeckoProgressChange(Sender: TObject; Progress, ProgressMax: Integer);
procedure mzGeckoCommandStateChange(Sender: TObject; Command: Integer; Enable: WordBool);
procedure mzGeckoDownloadBegin(Sender: TObject);
procedure mzGeckoDownloadComplete(Sender: TObject);
{### MISC METHODS ###}
procedure edtAddressKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
private
{ Private declarations }
function CharReplace(var S: AnsiString; const Search, Replace: AnsiChar): Integer;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
uses CommCtrl, Globals, OpenForm, PrefsForm;
var
ON_START : boolean;
{### FORM METHODS ###}
procedure TfrmMain.FormCreate(Sender: TObject);
{initialise...}
begin
{setup window}
Application.Title := PROGRAM_TITLE;
Self.Caption := PROGRAM_TITLE;
{move progress bar to status bar's first panel}
prgrssbrProgress.Parent := stsbrStatus;
prgrssbrProgress.Top := 2;
prgrssbrProgress.Left := 2;
prgrssbrProgress.Height := stsbrStatus.Height - 2;
prgrssbrProgress.Width := stsbrStatus.Panels[0].Width - 2;
prgrssbrProgress.Position := 0;
prgrssbrProgress.Refresh;
{setup vars}
ON_START := true;
end; {procedure TfrmMain.FormCreate}
procedure TfrmMain.FormShow(Sender: TObject);
{navigate to start page if first show}
begin
if ON_START then begin
ON_START := false;
{show start page}
case START_TYPE of
// 0 : {blank page}
1 : mzGecko.Navigate(WideString(HOME_ADDRESS)); {home page}
2 : mzGecko.Navigate(WideString(START_ADDRESS)); {custom start page}
end; {case START_TYPE..}
end; {if ON_START..}
end; {procedure TfrmMain.FormShow}
{### MENUITEM METHODS}
procedure TfrmMain.mOpenClick(Sender: TObject);
{open web page from URL or file}
var
Address : string;
frmOpen: TfrmOpen;
begin
{show open page dialog - frmOpen}
frmOpen := TfrmOpen.Create(self);
try
if (frmOpen.ShowModal = mrOk) then begin
{retrieve address}
Address := frmOpen.edtURL.Text;
if not(trim(Address) = '') then begin
{navigate to address}
CharReplace(Address, '\', '/'); {correct bug with relative links + images}
mzGecko.Navigate(WideString(Address));
end; {if not(Address = ''..}
end; {if mrOk..}
finally
{free dialog}
frmOpen.Free;
end; {try..finally..}
end; {procedure TfrmMain.mOpenClick}
procedure TfrmMain.mSaveAsClick(Sender: TObject);
{show Save As dialog}
{Control <= v1.6: OLECMDEXECOPT_PROMPTUSER causes EOleException due to bug in flag
tests, use OLECMDEXECOPT_DODEFAULT instead; Bugzilla 2250454.
Control v1.7: Flag tests fixed so can use OLECMDEXECOPT_PROMPTUSER; Bugzilla 2250454
fixed.}
var
PageFilename : OleVariant;
begin
try
{ensure not busy}
if not(mzGecko.Busy) then begin
PageFilename := mzGecko.LocationName + '.html';
{show save as dialog}
mzGecko.ExecWB(OLECMDID_SAVEAS, OLECMDEXECOPT_PROMPTUSER {OLECMDEXECOPT_DODEFAULT}, PageFilename);
end; {if not Busy..}
except
{handle exceptions}
on E : Exception do
MessageDlg('ERROR: Unable to show Save As dialog. ' + #13 + E.ClassName
+ ': ' + E.Message + '.', mtError, [mbOk], 0);
end; {try..except..}
end; {procedure TfrmMain.mSaveAsClick}
procedure TfrmMain.mPageSetupClick(Sender: TObject);
{show Page Setup dialog}
{Control <= v1.6: OLECMDEXECOPT_PROMPTUSER causes EOleException due to bug in flag tests,
use OLECMDEXECOPT_DODEFAULT instead + get 'not implemented' dialog; Bugzilla 2250454.
Control v1.7: Flag tests fixed so can use OLECMDEXECOPT_PROMPTUSER and Page Setup
has been implemented; Bugzilla 2250454 fixed.}
begin
try
{ensure not busy or printing before showing dialog}
if not(mzGecko.Busy) and (mzGecko.QueryStatusWB(OLECMDID_PAGESETUP) > 0)
{show page setup dialog}
then mzGecko.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_PROMPTUSER {OLECMDEXECOPT_DODEFAULT});
except
{handle exceptions}
on E : Exception do
MessageDlg('ERROR: Unable to show Page Setup dialog. ' + #13 + E.ClassName
+ ': ' + E.Message + '.', mtError, [mbOk], 0);
end; {try..except..}
end; {procedure TfrmMain.mPageSetupClick}
procedure TfrmMain.mPrintPreviewClick(Sender: TObject);
{show Print Preview window}
{OLECMDID_PRINTPREVIEW not currently supported in Mozilla Control although
QueryStatusWB returns OLECMDF_SUPPORTED so disable menu item.
OLECMDID_PRINTPREVIEW not defined in MozillaBrowser.h; Bugzilla 214884.}
begin
try
{ensure not busy or printing before showing dialog}
if not(mzGecko.Busy) and (mzGecko.QueryStatusWB(OLECMDID_PRINTPREVIEW) > 0)
{show Print Preview window}
then mzGecko.ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_PROMPTUSER);
except
{handle exceptions}
on E : Exception do
MessageDlg('ERROR: Unable to show Print Preview dialog. ' + #13 + E.ClassName
+ ': ' + E.Message + '.', mtError, [mbOk], 0);
end; {try..except..}
end; {procedure TfrmMain.mPrintPreviewClick}
procedure TfrmMain.mPrintClick(Sender: TObject);
{print current page}
begin
try
{ensure not busy or printing before showing dialog}
if not(mzGecko.Busy) and (mzGecko.QueryStatusWB(OLECMDID_PRINT) > 0)
{show Print dialog}
then mzGecko.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER);
except
{handle exceptions}
on E : Exception do
MessageDlg('ERROR: Unable to show Print dialog. ' + #13 + E.ClassName
+ ': ' + E.Message + '.', mtError, [mbOk], 0);
end; {try..except..}
end; {procedure TfrmMain.mPrintClick}
procedure TfrmMain.mExitClick(Sender: TObject);
{close application}
begin
{close frmMain - closes app}
Self.Close;
end; {procedure TfrmMain.mExitClick}
procedure TfrmMain.mCopyClick(Sender: TObject);
{copy selection to clipboard}
begin
try
{copy selection}
mzGecko.ExecWB(OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT);
except
{handle exceptions}
on E : Exception do begin
MessageDlg('ERROR Unable to Copy selected text to clipboard.' + #13 + E.ClassName
+ ': ' + E.Message + '.', mtError, [mbOk], 0);
end; {on Exception..}
end; {try..except..}
end; {procedure TfrmMain.mCopyClick}
procedure TfrmMain.mClearSelectionClick(Sender: TObject);
{clear selection}
{OLECMDID_CLEARSELECTION not currently supported in Mozilla Control although
QueryStatusWB returns OLECMDF_SUPPORTED so disable menu item.
OLECMDID_CLEARSELECTION not defined in MozillaBrowser.h; Bugzilla 214884.}
begin
try
{clear selection}
mzGecko.ExecWB(OLECMDID_CLEARSELECTION, OLECMDEXECOPT_DODEFAULT);
except
{handle exceptions}
on E : Exception do begin
MessageDlg('ERROR: Unable to Clear the current selection.' + #13 + E.ClassName
+ ': ' + E.Message + '.', mtError, [mbOk], 0);
end; {on Exception..}
end; {try..except..}
end; {procedure TfrmMain.mClearSelectionClick}
procedure TfrmMain.mSelectAllClick(Sender: TObject);
{select entire page}
begin
try
{select all}
mzGecko.ExecWB(OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT);
except
{handle exceptions}
on E : Exception do begin
MessageDlg('ERROR Unable to Select All text on page.' + #13 + E.ClassName
+ ': ' + E.Message + '.', mtError, [mbOk], 0);
end; {on Exception..}
end; {try..except..}
end; {procedure TfrmMain.mSelectAllClick}
procedure TfrmMain.mPreferencesClick(Sender: TObject);
{edit Gecko Browser prefs}
var
frmPrefs: TfrmPrefs;
begin
{show Preferences dialog - frmPrefs}
frmPrefs := TfrmPrefs.Create(self);
try
if (frmPrefs.ShowModal = mrOk) then begin
{correct addresses}
CharReplace(START_ADDRESS, '\', '/'); {correct bug with relative links + images}
CharReplace(HOME_ADDRESS, '\', '/'); {correct bug with relative links + images}
end; {if mrOk..}
finally
{free dialog}
frmPrefs.Free;
end; {try..finally..}
end; {procedure TfrmMain.mPreferencesClick}
procedure TfrmMain.mBackClick(Sender: TObject);
{go Back a page}
begin
{back}
mzGecko.GoBack;
end; {procedure TfrmMain.mBackClick}
procedure TfrmMain.mForwardClick(Sender: TObject);
{go Forward a page}
begin
{forward}
mzGecko.GoForward;
end; {procedure TfrmMain.mForwardClick}
procedure TfrmMain.mStopClick(Sender: TObject);
{stop loading page}
begin
{stop}
mzGecko.Stop;
end; {procedure TfrmMain.mStopClick}
procedure TfrmMain.mReloadClick(Sender: TObject);
{reload page}
begin
{refresh}
mzGecko.Refresh;
end; {procedure TfrmMain.mReloadClick}
procedure TfrmMain.mHomeClick(Sender: TObject);
{go to Home page}
begin
{navigate to Gecko Browser Home}
mzGecko.Navigate(WideString(HOME_ADDRESS));
end; {procedure TfrmMain.mHomeClick}
procedure TfrmMain.mAboutClick(Sender: TObject);
{show simple About dialog}
begin
MessageDlg(PROGRAM_TITLE + #13 + '(c) 2003 - 2004 Conspiracy Software' + #13
+ 'A demo of embedding Gecko (Mozilla) in Delphi applications.' + #13
+ 'Written by Dave Murray <irongut@vodafone.net>.' + #13
+ PROGRAM_TITLE + ' was written using ' + MOZILLA_VERSION + '.',
mtInformation, [mbOk], 0);
end; {procedure TfrmMain.About1Click}
{### MOZILLA CONTROL METHODS ###}
procedure TfrmMain.mzGeckoStatusTextChange(Sender: TObject; const Text: WideString);
{show status text in stsbrStatus}
begin
stsbrStatus.Panels[1].Text := Text;
end; {procedure TfrmMain.mzGeckoStatusTextChange}
procedure TfrmMain.mzGeckoProgressChange(Sender: TObject; Progress, ProgressMax: Integer);
{show download progress}
begin
{new code suggested by Sterling Bates, see Bugzilla #225041}
prgrssbrProgress.Position := Round((Progress / ProgressMax) * 100);
prgrssbrProgress.Max := 100;
end; {procedure TfrmMain.mzGeckoProgressChange}
procedure TfrmMain.mzGeckoCommandStateChange(Sender: TObject; Command: Integer; Enable: WordBool);
{fired when user navigates, use to enable/disable navigation buttons}
const
{from SHDocVw.pas}
CSC_NAVIGATEFORWARD = $00000001;
CSC_NAVIGATEBACK = $00000002;
begin
if (Command = CSC_NAVIGATEFORWARD) then begin
{enable / disable Forward button + menu item}
tlbtnForward.Enabled := Enable;
mForward.Enabled := Enable;
end {if Command = CSC_NAVIGATEFORWARD}
else if (Command = CSC_NAVIGATEBACK) then begin
{enable / disabel Back button + menu item}
tlbtnBack.Enabled := Enable;
mBack.Enabled := Enable;
end; {else if..}
end; {procedure TfrmMain.mzGeckoCommandStateChange}
procedure TfrmMain.mzGeckoDownloadBegin(Sender: TObject);
{begining navigation, start throbber}
begin
nmtThrobber.Active := true;
end; {procedure TfrmMain.mzGeckoDownloadBegin}
procedure TfrmMain.mzGeckoDownloadComplete(Sender: TObject);
{ending navigation, stop throbber + ensure edtAddress shows URL}
var
URL : string;
begin
URL := mzGecko.LocationURL;
if not(edtAddress.Text = URL) then edtAddress.Text := URL;
nmtThrobber.Active := false;
prgrssbrProgress.Position := 0;
end; {procedure TfrmMain.mzGeckoDownloadComplete}
{### MISC METHODS ###}
procedure TfrmMain.edtAddressKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
{navigate to current address}
begin
if (Key = VK_RETURN) then mzGecko.Navigate(WideString(edtAddress.Text));
end; {procedure TfrmMain.edtAddressKeyDown}
{### PRIVATE METHODS ###}
function TfrmMain.CharReplace(var S: AnsiString; const Search, Replace: AnsiChar): Integer;
{Reproduced from JEDI Code Library JclStrings.pas for demonstration purposes.}
{http://www.delphi-jedi.org/}
var
P: PAnsiChar;
begin
Result := 0;
if Search <> Replace then begin
UniqueString(S);
P := PAnsiChar(S);
while P^ <> #0 do begin
if P^ = Search then begin
P^ := Replace;
Inc(Result);
end; {if P^ = ..}
Inc(P);
end; {while..}
end; {if Search <> Replace..}
end; {function TfrmMain.CharReplace}
initialization
OleInitialize(nil);
finalization
OleUninitialize;
end.
Conclusion
Pages web utiles :
http://www.iol.ie/%7Elocka/mozilla/mozilla.htm h ttp://www.paranoia.clara.net/articles/taming_the_l izard_with_delphi.html http://www.paranoia.clara.n et/articles/delphi4_lizard_taming.html
Le composant TMozillaControl, linké sur le premier lien
ps : pour les personnes en xp sp2, ils se peut qu'il y ai des problemes ... : http://blogs.borland.com/abauer/archive/2004/10/ 29/1698.aspx ...mais résolus : http://blogs.borland.com/abauer/archive/2004/11/ 04.aspx
Merci a David Murray, son lien (il m'a demanadé de l'ajouter ici) : >>>> http://delphi.mozdev.org/
Historique
- 08 janvier 2005 12:00:56 :
- 08 janvier 2005 12:58:23 :
- niveau Initié
- 09 janvier 2005 19:41:25 :
- Ajout du lien http://delphi.mozdev.org/
Lien demandé par l'auteur. Il a dit "Thanks for letting me know. Please include a link to the Mozilla-Delphi Project, where the latest source code and article can be found:
http://delphi.mozdev.org/
The code is actually for using the Mozilla ActiveX Control which has the same engine as Firefox.
Thanks,
Dave." :)
Sources du même auteur
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Webbrowser: touche entré [ par AntoineDEL ]
Hella, je vien de finir mon navigateur internet, et lors des béta test je vien de m'appercevoir que l'utilisation de la touche entré est imposible, qu
problème de texte avec webbrowser [ par Also know as ]
Bonjour,Je fais mes premiers pas sous delphi et je suis en train de travailler sous un Navigateur internet.Voiçi mon problème, assez spécial :Quand je
Correspondance selection dans un WebBrowser et source HTML [ par arogues ]
Bonjour,Je cherche à faire un peu comme dans un éditeur de code type FrontPage ou Dreamweaver : lorsque je selctionne du texte (dans le webbrowser), o
viariable avec internet [ par zibong ]
J'aimerai Allé chercher la valeur d'une variable sur un autre PC via internet!Est ce que vous pouriez me donné des lien de source ou m'expliquéj'ai de
Lien internet [ par Dezouille ]
Bonjour a tous les developpeurs,voila ma question.Je voudrais creer une petite applicationqui me permetrais d'afficher des page internet dans un webbr
Webbrowser Accessibilité [ par Encore1ben ]
Bonsoir à tous... Je reviens vers vous, car comme d'habitude, vous assurez toujours avec mes questions tordues ! :) Alors voilà, je développe actuel
Ports Internet [ par Bacterius ]
Bonjour,Est-ce que quelqu'un sait quels sont les ports que l'on doit utiliser pour les composants TCP dans le but d'une application client/serveur?J'a
webBrowser-javascript [ par nosimbio ]
Bonjour,Je ne sais pas comment passer une valeur de variable javascript dans une variable delphi.J'ai un twebbrowser contenant une page internet (en l
un code source de gestion du persinnel [ par sma1007 ]
salut ,tout le mondej'est besoin d'un code source de gestion du personnel ou gestion de congé avec Delphi
impossible de définir correctement la partie à scanner avec DelphiTwain [ par ALSC ]
Bonjour,J'utilise DelphiTwain avec Delphi 7.Mon problème est le suivant :Je n'arrive pas à définir la partie à scanner avec précision en utilisant la
|
Derniers Blogs
TECHDAYS PARIS 2010 : SHAREPOINT 2010 POUR LES DéVELOPPEURSTECHDAYS PARIS 2010 : SHAREPOINT 2010 POUR LES DéVELOPPEURS par ROMELARD Fabrice
Animé par: Laurent Cotton Le développement dans SharePoint 2010 passe par plusieurs axes qui seront évoqués dans cette session, mais plus particulièrement les développements simples lié au besoin Business Business Connectivity Services Ce BCS es...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice TECHDAYS PARIS 2010 : PLEINIèRE DERNIER JOURTECHDAYS PARIS 2010 : PLEINIèRE DERNIER JOUR par ROMELARD Fabrice
Cette session est la dernière pleinière de ces 3 jours de TechDays Paris 2010. Généralement, cette troisième journée est plus axée sur l'avenir vu par Microsoft. Après un retour sur l'avenir vu par la Science Fiction ou par ...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice UNE JOLIE-HORLOGE ET PAS QU'UN PEU !UNE JOLIE-HORLOGE ET PAS QU'UN PEU ! par neodante
Pour les possesseurs d'iPhone, ça y est Bijin Tokei - qui se traduit littéralement en Français par " Jolie Horloge " - est arrivé et GRATUITEMENT s'il vous plaît ! Après la version Tokyo, Hokkaido, night club, racing, Gal, "pour les mademoiselles'", . voi...
Cliquez pour lire la suite de l'article par neodante TECHDAYS PARIS 2010 : CONNECTEZ VOS DONNéES à SHAREPOINT 2010 AVEC LES BUSINESS CONNECTIVITY SERVICESTECHDAYS PARIS 2010 : CONNECTEZ VOS DONNéES à SHAREPOINT 2010 AVEC LES BUSINESS CONNECTIVITY SERVICES par ROMELARD Fabrice
Animé par: Gaetan Bouveret et Julien Chomarat Business Connectivity Services (BCS) est dans SharePoint 2010 la version 2 de Business Data Catalog (BDC dans SharePoint 2007). Il s'agit de la solution permettant de visualiser des données provenan...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice [DIVERS] SUIVRE VOS SéRIES PRéFéRéS SUR LA TOILE[DIVERS] SUIVRE VOS SéRIES PRéFéRéS SUR LA TOILE par orion
Comme de nombreux geek, je suis un grand amateur de série TV et je rate régulièrement des épisodes de mes séries préférés. Une solution s'offre à vous avec ce merveilleux site : Tv Gorge - www.tvgorge.com Moteur de recherche à l'appui, vous pouvez ...
Cliquez pour lire la suite de l'article par orion
Forum
RE : SAVEDIALOGRE : SAVEDIALOG par JulioDelphi
Cliquez pour lire la suite par JulioDelphi RE : SAVEDIALOGRE : SAVEDIALOG par zeydounnounou
Cliquez pour lire la suite par zeydounnounou
Logiciels
DB-MAIN (9.1.0)DB-MAIN (9.1.0)DB-MAIN is a data-modeling and data-architecture tool. It is designed to help developers and anal... Cliquez pour télécharger DB-MAIN Xilisoft DPG Convertisseur (5.1.37.0120)XILISOFT DPG CONVERTISSEUR (5.1.37.0120)Xilisoft DPG Convertisseur offre aux fans de Nintendo DS une bonne solution leur permettant de dé... Cliquez pour télécharger Xilisoft DPG Convertisseur GraphicsGale (2.01.01)GRAPHICSGALE (2.01.01)GraphicsGale est un logiciel de PixelArt avec de nombreuse fonctionnalités permettant de réalisé ... Cliquez pour télécharger GraphicsGale Architecte 3D (Platinum 2010)ARCHITECTE 3D (PLATINUM 2010)Architecte 3D Platinium vous permet de concevoir facilement les plans votre future maison, de l'é... Cliquez pour télécharger Architecte 3D TeamViewer 5 (TeamViewer 5)TEAMVIEWER 5 (TEAMVIEWER 5)Dépanner un ami,expliquer une manipulation devient un jeu d'enfant.
Prise en main d'un autre ord... Cliquez pour télécharger TeamViewer 5
|