TPageControl 上有多个 TWebBrowser 时, 如何协调 Back、Forward - 回复 "飘逸的蓝" 的问题

问题来源: http://www.cnblogs.com/del/archive/2007/12/13/993840.html#1804933

---

代码:

---

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleCtrls, SHDocVw, ComCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    PageControl1: TPageControl;
    procedure CommandStateChange(ASender: TObject; Command: Integer; Enable: WordBool);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PageControl1Changing(Sender: TObject; var AllowChange: Boolean);
    procedure PageControl1Change(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  TabSheetArr  : array[0..2] of TTabSheet;
  WebBrowserArr: array[0..2] of TWebBrowser;
  BoolArr      : array[0..2] of record B,F: Boolean end;
  WebActive: TWebBrowser;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  Button1.Caption := 'Go';
  Button1.Default := True;
  Button2.Caption := 'Back';
  Button3.Caption := 'Forward';
  Button2.Enabled := False;
  Button3.Enabled := False;
  Edit1.Text := 'http://del.cnblogs.com';

  for i := 0 to Length(TabSheetArr) - 1 do
  begin
    TabSheetArr[i] := TTabSheet.Create(PageControl1);
    TabSheetArr[i].PageControl := PageControl1;
    TabSheetArr[i].Caption := 'TabSheet' + IntToStr(i+1);
    WebBrowserArr[i] := TWebBrowser.Create(TabSheetArr[i]);
    TWinControl(WebBrowserArr[i]).Parent := TabSheetArr[i];
    WebBrowserArr[i].Align := alClient;
  end;
  PageControl1.ActivePageIndex := 0;
  WebActive := WebBrowserArr[0];
  WebActive.Navigate(Edit1.Text);
  WebActive.OnCommandStateChange := CommandStateChange;
end;

procedure TForm1.PageControl1Changing(Sender: TObject;
  var AllowChange: Boolean);
var
  i: Integer;
begin
  i := PageControl1.ActivePageIndex;
  BoolArr[i].B := Button2.Enabled;
  BoolArr[i].F := Button3.Enabled;
end;

procedure TForm1.PageControl1Change(Sender: TObject);
var
  i: Integer;
begin
  i := PageControl1.ActivePageIndex;
  WebActive := WebBrowserArr[i];
  Edit1.Text := WebActive.LocationURL;
  WebActive.OnCommandStateChange := CommandStateChange;
  Button2.Enabled := BoolArr[i].B;
  Button3.Enabled := BoolArr[i].F;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WebActive.Navigate(Edit1.Text);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  WebActive.GoBack;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  WebActive.GoForward;
end;

procedure TForm1.CommandStateChange(ASender: TObject; Command: Integer; Enable: WordBool);
begin
  case Command of
    CSC_NAVIGATEBACK   : Button2.Enabled := Enable;
    CSC_NAVIGATEFORWARD: Button3.Enabled := Enable;
  end;
end;

end.

窗体:

---

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 388
  ClientWidth = 737
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 737
    Height = 30
    Align = alTop
    Caption = 'Panel1'
    TabOrder = 0
    DesignSize = (
      737
      30)
    object Edit1: TEdit
      Left = 8
      Top = 5
      Width = 425
      Height = 21
      TabOrder = 0
      Text = 'Edit1'
    end
    object Button1: TButton
      Left = 439
      Top = 2
      Width = 66
      Height = 25
      Caption = 'Button1'
      TabOrder = 1
      OnClick = Button1Click
    end
    object Button2: TButton
      Left = 574
      Top = 2
      Width = 75
      Height = 25
      Anchors = [akTop, akRight]
      Caption = 'Button2'
      TabOrder = 2
      OnClick = Button2Click
    end
    object Button3: TButton
      Left = 655
      Top = 2
      Width = 75
      Height = 25
      Anchors = [akTop, akRight]
      Caption = 'Button3'
      TabOrder = 3
      OnClick = Button3Click
    end
  end
  object PageControl1: TPageControl
    Left = 0
    Top = 30
    Width = 737
    Height = 358
    Align = alClient
    TabOrder = 1
    OnChange = PageControl1Change
    OnChanging = PageControl1Changing
  end
end

把上面的例子全部改成动态建立的方法(在之前的窗体上多加一个 Button4 用于添加页面):

---

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleCtrls, SHDocVw, ComCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    PageControl1: TPageControl;
    Button4: TButton;
    procedure CommandStateChange(ASender: TObject; Command: Integer; Enable: WordBool);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PageControl1Changing(Sender: TObject; var AllowChange: Boolean);
    procedure PageControl1Change(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    procedure GetBackForwardBool;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  TabSheetArr  : array of TTabSheet;
  WebBrowserArr: array of TWebBrowser;
  BoolArr      : array of record B,F: Boolean end;
  WebActive: TWebBrowser;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  Button1.Caption := 'Go';
  Button1.Default := True;
  Button2.Caption := 'Back';
  Button3.Caption := 'Forward';
  Button2.Enabled := False;
  Button3.Enabled := False;

  Button4.Caption := 'AddPage';
  Button4.Click;
  WebActive := WebBrowserArr[0];
  WebActive.OnCommandStateChange := CommandStateChange;
end;

procedure TForm1.GetBackForwardBool;
begin
  BoolArr[PageControl1.ActivePageIndex].B := Button2.Enabled;
  BoolArr[PageControl1.ActivePageIndex].F := Button3.Enabled;
end;

procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean);
begin
  GetBackForwardBool;
end;

procedure TForm1.PageControl1Change(Sender: TObject);
var
  i: Integer;
begin
  i := PageControl1.ActivePageIndex;
  WebActive := WebBrowserArr[i];
  Edit1.Text := WebActive.LocationURL;
  WebActive.OnCommandStateChange := CommandStateChange;
  Button2.Enabled := BoolArr[i].B;
  Button3.Enabled := BoolArr[i].F;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WebActive.Navigate(Edit1.Text);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  WebActive.GoBack;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  WebActive.GoForward;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  n: Integer;
begin
  n := Length(TabSheetArr);
  if n > 0 then GetBackForwardBool;
  SetLength(TabSheetArr, n+1);
  SetLength(WebBrowserArr, n+1);
  SetLength(BoolArr, n+1);

  TabSheetArr[n] := TTabSheet.Create(PageControl1);
  TabSheetArr[n].PageControl := PageControl1;
  TabSheetArr[n].Caption := 'TabSheet' + IntToStr(n+1);
  WebBrowserArr[n] := TWebBrowser.Create(TabSheetArr[n]);
  TWinControl(WebBrowserArr[n]).Parent := TabSheetArr[n];
  WebBrowserArr[n].Align := alClient;
  PageControl1.ActivePageIndex := n;
  PageControl1.OnChange(PageControl1);
end;

procedure TForm1.CommandStateChange(ASender: TObject; Command: Integer; Enable: WordBool);
begin
  case Command of
    CSC_NAVIGATEBACK   : Button2.Enabled := Enable;
    CSC_NAVIGATEFORWARD: Button3.Enabled := Enable;
  end;
end;

end.

posted on 2010-04-19 22:58  万一  阅读(4575)  评论(20)  编辑  收藏

标签：end,Sender,WebActive,Back,TObject,TForm1,TWebBrowser,TPageControl,procedure
来源： https://blog.51cto.com/u_14617575/2745743