MOZILLA FIREFOX EN DELPHI

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.

Télécharger le zip

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." :)