TChromium ChromeTabs Not Working

问题

I want do a Tabs for my TChromium.
I have this:

   Browsers: array[0..1000] of TChromium;

And this ChromeTabs procedures:

    procedure TForm1.ChromeTabsActiveTabChanged(Sender: TObject; ATab: TChromeTab);
    var
    c:integer;
    begin
    for c := 0 to ChromeTabs.Tabs.Count do
       if browsers[c]<>NIL then
        if c=ChromeTabs.ActiveTabIndex then browsers[c].Visible:=true else browsers[c].visible:=false;
    end;



procedure TForm1.ChromeTabsButtonAddClick(Sender: TObject;
  var Handled: Boolean);
begin
browsers[ChromeTabs.ActiveTabIndex]:=TChromium.Create(Chromium);
browsers[ChromeTabs.ActiveTabIndex].OnAddressChange:=Chromium.OnAddressChange;
browsers[ChromeTabs.ActiveTabIndex].OnAfterCreated:=Chromium.OnAfterCreated;
browsers[ChromeTabs.ActiveTabIndex].OnBeforeContextMenu:=Chromium.OnBeforeContextMenu;
browsers[ChromeTabs.ActiveTabIndex].OnBeforePopup:=Chromium.OnBeforePopup;
browsers[ChromeTabs.ActiveTabIndex].OnLoadEnd:=Chromium.OnLoadEnd;
browsers[ChromeTabs.ActiveTabIndex].OnLoadError:=Chromium.OnLoadError;
browsers[ChromeTabs.ActiveTabIndex].OnLoadingStateChange:=Chromium.OnLoadingStateChange;
browsers[ChromeTabs.ActiveTabIndex].OnProcessMessageReceived:=Chromium.OnProcessMessageReceived;
browsers[ChromeTabs.ActiveTabIndex].OnStatusMessage:=Chromium.OnStatusMessage;
browsers[ChromeTabs.ActiveTabIndex].DefaultEncoding:=Chromium.DefaultEncoding;

browsers[ChromeTabs.ActiveTabIndex].parent:=Form1;
browsers[ChromeTabs.ActiveTabIndex].Align:=alClient;
browsers[ChromeTabs.ActiveTabIndex].Show;
browsers[ChromeTabs.ActiveTabIndex].Load(Chromium.DefaultUrl);
end;



procedure TForm1.ChromeTabsButtonCloseTabClick(Sender: TObject;
  ATab: TChromeTab; var Close: Boolean);
begin
browsers[ATab.Index].Destroy;
Close:=True;
end;

Chromium object is my default Browser, i placed on my Form.

So, when i'm trying to close one of the Tab, it gives Access Violation Error sometimes.
When i'm trying to load an Url from Adress_Line, it gives Access Violation Error.
Also, when i opening 2 or more Tabs, they look bad, like this - http://s43.radikal.ru/i101/1307/99/650e18d5e190.jpg

Please, help me to fix all this problems :(

Thanks.

回答1:

The problem of the access violation exception is caused by calling Destroy method on an object which has been already destroyed. Let me explain the situation.

Imagine that you have 3 tabs with the next indexes and the Browsers array with the following browser instances:

ChromeTabs.Tabs            Browsers
----------------------     ----------------------
Index       Tab name       Index       Browser
----------  ----------     ----------  ----------
0           Tab 1          0           Browser 1
1           Tab 2          1           Browser 2
2           Tab 3          2           Browser 3

Now you click on the middle tab's close button (tab indexed by 1) and in the OnButtonCloseTabClick you run this:

procedure TForm1.ChromeTabsButtonCloseTabClick(Sender: TObject;
  ATab: TChromeTab; var Close: Boolean);
begin
  // the ATab.Index equals 1
  Browsers[ATab.Index].Destroy;
  Close := True;
end;

That will destroy a browser instance called Browser 2 from the above table. That wouldn't be problem when the array would be reindexed as the Tabs collection do. Let's look what happens to the tabs and your array:

ChromeTabs.Tabs            Browsers
----------------------     ----------------------
Index       Tab name       Index       Browser
----------  ----------     ----------  ----------
0           Tab 1          0           Browser 1
1           Tab 3          1           ---        <-- dangling pointer
                           2           Browser 3

As you can see, the Tabs collection has been reindexed after closing the second tab, but your array wasn't. You just destroyed the object instance, but the dangling pointer from that destroyed object is still there, on the same index.

Now if you click the close button of the second tab again (the tab called Tab 3), you'll run the very same code as before in your event handler:

procedure TForm1.ChromeTabsButtonCloseTabClick(Sender: TObject;
  ATab: TChromeTab; var Close: Boolean);
begin
  // as before, the ATab.Index equals 1, but this time you'll get AV
  // since object from element Browsers[1] has been destroyed before
  // and now that element contains just dangling pointer
  Browsers[ATab.Index].Destroy; // <-- 
  Close := True;
end;

But this time you'll get an access violation because object from the Browsers[1] element has been destroyed before.

For your purpose is not array the right type of collection. I would suggest you to use TObjectList<T> generics object list collection. Using that collection I would rewrite your code this way:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  System.Generics.Collections, ChromeTabs, ChromeTabsClasses, cefvcl;

type
  TForm1 = class(TForm)
    ChromeTabs1: TChromeTabs;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ChromeTabs1ButtonAddClick(Sender: TObject;
      var Handled: Boolean);
    procedure ChromeTabs1ButtonCloseTabClick(Sender: TObject;
      ATab: TChromeTab; var Close: Boolean);
    procedure ChromeTabs1ActiveTabChanging(Sender: TObject; AOldTab,
      ANewTab: TChromeTab; var Allow: Boolean);
  private
    FBrowsers: TObjectList<TChromium>;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Tab_Closed:Boolean=False;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  // create instance of the object list and let it manage
  // lifetime of the inserted objects
  FBrowsers := TObjectList<TChromium>.Create;
  FBrowsers.OwnsObjects := True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  // release the object list
  FBrowsers.Free;
end;

procedure TForm1.ChromeTabs1ButtonAddClick(Sender: TObject;
  var Handled: Boolean);
var
  ChromiumInstance: TChromium;
begin
  // create an instance of the browser component and
  // initiliaze its properties - here it's simplified
  ChromiumInstance := TChromium.Create(nil);
  ChromiumInstance.Parent := Self;
  ChromiumInstance.SetBounds(8, 8, 150, 150);
  // now add the new browser instance to the collection
  FBrowsers.Add(ChromiumInstance);
end;

procedure TForm1.ChromeTabs1ButtonCloseTabClick(Sender: TObject;
  ATab: TChromeTab; var Close: Boolean);
begin
  // delete the browser instance from the collection; since we've
  // assigned True to the OwnsObjects property of the collection,
  // we don't need to care of freeing the browser instance
  FBrowsers.Delete(ATab.Index);
  // allow the tab to close
  Close := True;
  //and fix tab close
  Tab_Closed:=True;
end;

procedure TForm1.ChromeTabs1ActiveTabChanging(Sender: TObject; AOldTab,
  ANewTab: TChromeTab; var Allow: Boolean);
begin
  // check if there's an "old tab" and if so, check also if we have its
  // index in the range of our collection; if so, then hide the browser
  if Assigned(AOldTab) and (AOldTab.Index < FBrowsers.Count) then
    FBrowsers[AOldTab.Index].Visible := False;
  // and show the activated tab browser
  If((ChromeTabs.Tabs.Count<>1)) Then
  Begin
  If((ANewTab.Index=(ChromeTabs.Tabs.Count-1)) AND Tab_Closed=True) Then
  FBrowsers[AOldTab.Index].Visible := True
  Else
  FBrowsers[ANewTab.Index].Visible := True;
  End
  Else FBrowsers[ANewTab.Index].Visible := True;
  //Now Tab is not closed
  Tab_Closed:=False;
end;

end.

来源：https://stackoverflow.com/questions/17682829/tchromium-chrometabs-not-working

标签

Delphi

delphi-xe3

tchromium