FirefoxのようなTPageControlのTTabsheetに閉じるボタンを実装するにはどうすればよいですか?
編集:
Delphiバージョン:Delphi 2010
OS:WindowsXP以降
FirefoxのようなTPageControlのTTabsheetに閉じるボタンを実装するにはどうすればよいですか?
編集:
Delphiバージョン:Delphi 2010
OS:WindowsXP以降
テーマのサポート(Windows, UxTheme, Themes
ユニットを含む)が追加されました!
type
TFormMain = class(TForm)
{...}
private
FCloseButtonsRect: array of TRect;
FCloseButtonMouseDownIndex: Integer;
FCloseButtonShowPushed: Boolean;
{...}
end;
{...}
procedure TFormMain.FormCreate(Sender: TObject);
var
I: Integer;
begin
PageControlCloseButton.TabWidth := 150;
PageControlCloseButton.OwnerDraw := True;
//should be done on every change of the page count
SetLength(FCloseButtonsRect, PageControlCloseButton.PageCount);
FCloseButtonMouseDownIndex := -1;
for I := 0 to Length(FCloseButtonsRect) - 1 do
begin
FCloseButtonsRect[I] := Rect(0, 0, 0, 0);
end;
end;
procedure TFormMain.PageControlCloseButtonDrawTab(Control: TCustomTabControl;
TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
CloseBtnSize: Integer;
PageControl: TPageControl;
TabCaption: TPoint;
CloseBtnRect: TRect;
CloseBtnDrawState: Cardinal;
CloseBtnDrawDetails: TThemedElementDetails;
begin
PageControl := Control as TPageControl;
if InRange(TabIndex, 0, Length(FCloseButtonsRect) - 1) then
begin
CloseBtnSize := 14;
TabCaption.Y := Rect.Top + 3;
if Active then
begin
CloseBtnRect.Top := Rect.Top + 4;
CloseBtnRect.Right := Rect.Right - 5;
TabCaption.X := Rect.Left + 6;
end
else
begin
CloseBtnRect.Top := Rect.Top + 3;
CloseBtnRect.Right := Rect.Right - 5;
TabCaption.X := Rect.Left + 3;
end;
CloseBtnRect.Bottom := CloseBtnRect.Top + CloseBtnSize;
CloseBtnRect.Left := CloseBtnRect.Right - CloseBtnSize;
FCloseButtonsRect[TabIndex] := CloseBtnRect;
PageControl.Canvas.FillRect(Rect);
PageControl.Canvas.TextOut(TabCaption.X, TabCaption.Y, PageControl.Pages[TabIndex].Caption);
if not UseThemes then
begin
if (FCloseButtonMouseDownIndex = TabIndex) and FCloseButtonShowPushed then
CloseBtnDrawState := DFCS_CAPTIONCLOSE + DFCS_PUSHED
else
CloseBtnDrawState := DFCS_CAPTIONCLOSE;
Windows.DrawFrameControl(PageControl.Canvas.Handle,
FCloseButtonsRect[TabIndex], DFC_CAPTION, CloseBtnDrawState);
end
else
begin
Dec(FCloseButtonsRect[TabIndex].Left);
if (FCloseButtonMouseDownIndex = TabIndex) and FCloseButtonShowPushed then
CloseBtnDrawDetails := ThemeServices.GetElementDetails(twCloseButtonPushed)
else
CloseBtnDrawDetails := ThemeServices.GetElementDetails(twCloseButtonNormal);
ThemeServices.DrawElement(PageControl.Canvas.Handle, CloseBtnDrawDetails,
FCloseButtonsRect[TabIndex]);
end;
end;
end;
procedure TFormMain.PageControlCloseButtonMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
I: Integer;
PageControl: TPageControl;
begin
PageControl := Sender as TPageControl;
if Button = mbLeft then
begin
for I := 0 to Length(FCloseButtonsRect) - 1 do
begin
if PtInRect(FCloseButtonsRect[I], Point(X, Y)) then
begin
FCloseButtonMouseDownIndex := I;
FCloseButtonShowPushed := True;
PageControl.Repaint;
end;
end;
end;
end;
procedure TFormMain.PageControlCloseButtonMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
PageControl: TPageControl;
Inside: Boolean;
begin
PageControl := Sender as TPageControl;
if (ssLeft in Shift) and (FCloseButtonMouseDownIndex >= 0) then
begin
Inside := PtInRect(FCloseButtonsRect[FCloseButtonMouseDownIndex], Point(X, Y));
if FCloseButtonShowPushed <> Inside then
begin
FCloseButtonShowPushed := Inside;
PageControl.Repaint;
end;
end;
end;
procedure TFormMain.PageControlCloseButtonMouseLeave(Sender: TObject);
var
PageControl: TPageControl;
begin
PageControl := Sender as TPageControl;
FCloseButtonShowPushed := False;
PageControl.Repaint;
end;
procedure TFormMain.PageControlCloseButtonMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
PageControl: TPageControl;
begin
PageControl := Sender as TPageControl;
if (Button = mbLeft) and (FCloseButtonMouseDownIndex >= 0) then
begin
if PtInRect(FCloseButtonsRect[FCloseButtonMouseDownIndex], Point(X, Y)) then
begin
ShowMessage('Button ' + IntToStr(FCloseButtonMouseDownIndex + 1) + ' pressed!');
FCloseButtonMouseDownIndex := -1;
PageControl.Repaint;
end;
end;
end;
次のようになります:
他の回答が示唆しているように、これを自分で実装することはしばしば良い考えです。ただし、すでにRaize Componentsを使用している場合に備えて、この機能は「そのまま」サポートされています。を設定して、イベントTRzPageControl.ShowCloseButtonOnActiveTab := true
を処理するだけです。OnClose
コンポーネントは、さまざまなタブのレイアウト/方向/形状/色の配置を処理します。
[ただ幸せな顧客]
私が過去に行ったことは、TPageControlの右上隅にグラフィック付きのTBitBtnを配置することです。TBitBtnの親であるトリックはTPageControlと同じであるため、実際にはタブシートの1つにはありません。次に、そのボタンでもクリックします。
PageControl1.ActivePage.Free;
現在のTTabControlが解放されると、それを所有するTPageControlに通知します。
この例を少し変更しました:-作成されたクラスTCloseTabSheet-このクラスにはプロパティOnClose:TNotifyEventがあり、割り当てられた場合に呼び出されます-TPageControlのTabSheetがそのクラスでない場合、閉じるボタンはありません-ボタンの場合示した。閉じるボタンを押すと、OnCloseが呼び出されます。これで、配列FCloseButtonsRectを制御する必要がなくなり、このRectがTCloseTabSheetに格納されます。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, Themes, Math, ExtCtrls, StdCtrls;
type TCloseTabSheet=class(TTabSheet)
private
protected
FCloseButtonRect: TRect;
FOnClose: TNotifyEvent;
procedure DoClose; virtual;
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
property OnClose:TNotifyEvent read FOnClose write FOnClose;
end;
type
TMainForm = class(TForm)
PageControlCloseButton: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
procedure FormCreate(Sender: TObject);
procedure PageControlCloseButtonDrawTab(Control: TCustomTabControl; TabIndex: Integer;
const Rect: TRect; Active: Boolean);
procedure PageControlCloseButtonMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure PageControlCloseButtonMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
procedure PageControlCloseButtonMouseLeave(Sender: TObject);
procedure PageControlCloseButtonMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure CloseTabeProc(Sender: TObject);
private
FCloseButtonMouseDownTab: TCloseTabSheet;
FCloseButtonShowPushed: Boolean;
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
constructor TCloseTabSheet.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
FCloseButtonRect:=Rect(0, 0, 0, 0);
end;
destructor TCloseTabSheet.Destroy;
begin
inherited Destroy;
end;
procedure TCloseTabSheet.DoClose;
begin
if Assigned(FOnClose) then FOnClose(Self);
Free;
end;
procedure TMainForm.CloseTabeProc(Sender: TObject);
begin
ShowMessage('close');
end;
procedure TMainForm.FormCreate(Sender: TObject);
var I: Integer;
NT:TCloseTabSheet;
begin
PageControlCloseButton.TabWidth := 150;
PageControlCloseButton.OwnerDraw := True;
NT:=TCloseTabSheet.Create(PageControlCloseButton);
NT.Caption:='TabSheet4';
NT.PageControl:=PageControlCloseButton;
NT.OnClose:=CloseTabeProc;
FCloseButtonMouseDownTab := nil;
end;
procedure TMainForm.PageControlCloseButtonDrawTab(Control: TCustomTabControl;
TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
CloseBtnSize: Integer;
PageControl: TPageControl;
TabSheet:TCloseTabSheet;
TabCaption: TPoint;
CloseBtnRect: TRect;
CloseBtnDrawState: Cardinal;
CloseBtnDrawDetails: TThemedElementDetails;
begin
PageControl := Control as TPageControl;
TabCaption.Y := Rect.Top + 3;
if Active then
begin
CloseBtnRect.Top := Rect.Top + 4;
CloseBtnRect.Right := Rect.Right - 5;
TabCaption.X := Rect.Left + 6;
end
else
begin
CloseBtnRect.Top := Rect.Top + 3;
CloseBtnRect.Right := Rect.Right - 5;
TabCaption.X := Rect.Left + 3;
end;
if PageControl.Pages[TabIndex] is TCloseTabSheet then
begin
TabSheet:=PageControl.Pages[TabIndex] as TCloseTabSheet;
CloseBtnSize := 14;
CloseBtnRect.Bottom := CloseBtnRect.Top + CloseBtnSize;
CloseBtnRect.Left := CloseBtnRect.Right - CloseBtnSize;
TabSheet.FCloseButtonRect := CloseBtnRect;
PageControl.Canvas.FillRect(Rect);
PageControl.Canvas.TextOut(TabCaption.X, TabCaption.Y,
PageControl.Pages[TabIndex].Caption);
if not ThemeServices.ThemesEnabled then
begin
if (FCloseButtonMouseDownTab = TabSheet) and FCloseButtonShowPushed then
CloseBtnDrawState := DFCS_CAPTIONCLOSE + DFCS_PUSHED
else
CloseBtnDrawState := DFCS_CAPTIONCLOSE;
Windows.DrawFrameControl(PageControl.Canvas.Handle,
TabSheet.FCloseButtonRect, DFC_CAPTION, CloseBtnDrawState);
end
else
begin
Dec(TabSheet.FCloseButtonRect.Left);
if (FCloseButtonMouseDownTab = TabSheet) and FCloseButtonShowPushed then
CloseBtnDrawDetails := ThemeServices.GetElementDetails(twCloseButtonPushed)
else
CloseBtnDrawDetails := ThemeServices.GetElementDetails(twCloseButtonNormal);
ThemeServices.DrawElement(PageControl.Canvas.Handle, CloseBtnDrawDetails,
TabSheet.FCloseButtonRect);
end;
end else begin
PageControl.Canvas.FillRect(Rect);
PageControl.Canvas.TextOut(TabCaption.X, TabCaption.Y,
PageControl.Pages[TabIndex].Caption);
end;
end;
procedure TMainForm.PageControlCloseButtonMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
I: Integer;
PageControl: TPageControl;
TabSheet:TCloseTabSheet;
begin
PageControl := Sender as TPageControl;
if Button = mbLeft then
begin
for I := 0 to PageControl.PageCount - 1 do
begin
if not (PageControl.Pages[i] is TCloseTabSheet) then Continue;
TabSheet:=PageControl.Pages[i] as TCloseTabSheet;
if PtInRect(TabSheet.FCloseButtonRect, Point(X, Y)) then
begin
FCloseButtonMouseDownTab := TabSheet;
FCloseButtonShowPushed := True;
PageControl.Repaint;
end;
end;
end;
end;
procedure TMainForm.PageControlCloseButtonMouseLeave(Sender: TObject);
var
PageControl: TPageControl;
begin
PageControl := Sender as TPageControl;
FCloseButtonShowPushed := False;
PageControl.Repaint;
end;
procedure TMainForm.PageControlCloseButtonMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
PageControl: TPageControl;
Inside: Boolean;
begin
PageControl := Sender as TPageControl;
if (ssLeft in Shift) and Assigned(FCloseButtonMouseDownTab) then
begin
Inside := PtInRect(FCloseButtonMouseDownTab.FCloseButtonRect, Point(X, Y));
if FCloseButtonShowPushed <> Inside then
begin
FCloseButtonShowPushed := Inside;
PageControl.Repaint;
end;
end;
end;
procedure TMainForm.PageControlCloseButtonMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
PageControl: TPageControl;
begin
PageControl := Sender as TPageControl;
if (Button = mbLeft) and Assigned(FCloseButtonMouseDownTab) then
begin
if PtInRect(FCloseButtonMouseDownTab.FCloseButtonRect, Point(X, Y)) then
begin
FCloseButtonMouseDownTab.DoClose;
FCloseButtonMouseDownTab := nil;
PageControl.Repaint;
end;
end;
end;
end.