Abas (TTabSheet) com botão fechar

Delphi

25/09/2009

Alguém sabe como colocar um botão ´fechar´ no ´topo´ de cada tabSheet de um page control, parecido com as abas do Mozilla?

OBS: Não é dentro da aba mas sim lá em cima do lado do Caption.


Diegotiemann

Diegotiemann

Curtidas 0

Respostas

Djfabioninja

Djfabioninja

25/09/2009

Fala Diego! blz?

Cara, assim de cara, voce poderia por um label tipo um ´X´ e programar o evento OnClick da label pra setar a propriedade visible da tab como false....

não serve?

Espero ter ajudado...

qualquer coisa.... msn: djfabioninja@hotmail.com


GOSTEI 0
Diegotiemann

Diegotiemann

25/09/2009

A hist´ria do label até funciona, mas preciso, mas quando for necessário criar as abas dinamicamente, dai como fica?


GOSTEI 0
Diegotiemann

Diegotiemann

25/09/2009

Pessoal consegui desenvolver um componente, me baseando no código do TLabelEdit (Paleta Additional) dei a ele o nome de TbtnTabSheet.

Mas faltam um pequeno detalhe, tenho que adicionar um espaço em branco no final do Caption para que o botão não sobrescreva o caption.


Abaixo está o código do componente, estou ajustando o caption na procedure onShow, mas o evento onShow é acionando quando a aba recebe o foco, portanto o modo que eu fiz não é o correto pois a aba pode ser criada e adiciona a um PageControl sem necessáriamente receber o foco e nesse caso o botão fechar sobreescre o caption.

unit uBtnTabSheet;

interface

uses
 Classes, Controls, ComCtrls, SysUtils, StdCtrls, Buttons, Types;

Type

  TCustumTabBtn  = class(TSpeedButton)
  private
    FbtnTab: TTabSheet;
    procedure SetbtnTab(const Value: TTabSheet);
  published
    public
      procedure Click; Override;
      property btnTab    :TTabSheet read FbtnTab write SetbtnTab;
  end;

 TBtnTabSheet  = class(TTabSheet)
    private
       FBtn: TCustumTabBtn;
       procedure SetupInternalBtn;
       procedure SetBtnPosition;
   protected
      procedure SetParent(AParent: TWinControl); override;
      procedure DoShow; override;
       procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    public
      constructor Create(AOwner: TComponent); override;
       procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer); override;
 end;

 procedure Register;

implementation

procedure Register;
begin
 //RegisterComponents(´Diego Tiemann´, [TBtnTabSheet]);
end;

{ TBtnTabSheet }

constructor TBtnTabSheet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  //Chama a procedure que cria o BitBtn
  SetupInternalBtn;
end;

procedure TBtnTabSheet.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FBtn) and (Operation = opRemove) then
    FBtn := nil;
  end;

procedure TBtnTabSheet.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited;
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  //Chama a procedure que ajusta a posição do BitBtn
  SetBtnPosition;
end;

procedure TBtnTabSheet.SetBtnPosition;
var
 rec: TRect;
begin
  if not Assigned(PageControl) then
    exit;
  //aqui pego o rect da aba (bem lé em cima o cabeçalho)
  Rec := self.PageControl.TabRect(self.PageIndex);
  Fbtn.SetBounds(rec.Right-FBtn.Width, rec.Top, Fbtn.Width, Fbtn.Height);
 end;

procedure TBtnTabSheet.SetParent(AParent: TWinControl);
begin
  inherited;
  inherited SetParent(AParent);
  if FBtn = nil then
     exit;
     
  FBtn.Parent  := AParent;
  FBtn.Visible := True;
end;

procedure TBtnTabSheet.SetupInternalBtn;
begin
 if Assigned(FBtn) then
   exit;
  FBtn := TCustumTabBtn.Create(Self);
  FBtn.FreeNotification(Self);
  FBtn.Caption :=´X´;
  FBtn.Height  :=20;
  FBtn.Width   :=19;
  FBtn.Flat    :=True;
  FBtn.btnTab  :=Self;
end;

procedure TBtnTabSheet.DoShow;
begin
  inherited;
  {Aqui colocao um espaço no final do caption para o botão
  não sobreescrever o texto }   
  if Pos(´      ´, Caption)=0 then
    Caption :=Caption+´      ´;
  SetBtnPosition;
end;

{ TCustumTabBtn }
procedure TCustumTabBtn.Click;
begin
  inherited;
  if Assigned(FbtnTab) then
    FbtnTab.Destroy;
end;

procedure TCustumTabBtn.SetbtnTab(const Value: TTabSheet);
begin
  FbtnTab := Value;
end;

end.



Para testar o componente depois de instalado, coloque o códico abaixo em um botão e clique diversas vezes:


var
 tab :TBtnTabSheet;
begin  
   tab                            :=TBtnTabSheet.Create(PageControl1);
   tab.Caption                :=FrmCadPropriedade.Caption;
   tab.PageControl          :=PageControl1;



GOSTEI 0
POSTAR