Mozilla firefox en delphi

Cette source est considérée comme dangereuse, elle a néamoins été gardée dans un but pédagogique :
Cette source est considérée comme dangereuse, elle a néamoins été gardée dans un but pédagogique.

Télécharger le projet
Commenter

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 / Exemple : 


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
http://www.paranoia.clara.net/articles/taming_the_lizard_with_delphi.html
http://www.paranoia.clara.net/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/
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (JulioDelphi)