[delphi-users:2962] PageControlにclose buttonを付ける。

[kotto]

こんにちは、いつもお世話になってます。稲富です。

今回はPageControlに「閉じるボタン」を付けたくて、ネットで探してましたら、こちらを見つけました。

http://stackoverflow.com/questions/10531153/close-button-of-a-tabsheet-not-supporting-vcl-styles

アンサーのソースを貼り付けたのですが、どのように、createすれば良いのか分かりません（滝汗）

普通buttonとかだと。

Button1:=TButton.create(Form1);
Button1.Parent:=Form1;
Button1.Visible:=True;

みたいな感じで良いと思うのですが、

TabControlStyleHookBtnClose:=TTabControlStyleHookBtnClose.Create(Form1);

この後に、visibleもparentもプロパティに見つからないので、どのようにすれば良いか分かりません（汗）

初歩的なことだと思いますが、どうぞよろしくお願いします。




貼り付けたコードは以下のコードです。

uses
  Vcl.Styles,
  Vcl.Themes;

type
  TTabControlStyleHookBtnClose = class(TTabControlStyleHook)
  private
    FHotIndex       : Integer;
    FWidthModified  : Boolean;
    procedure WMMouseMove(var Message: TMessage); message WM_MOUSEMOVE;
    procedure WMLButtonUp(var Message: TWMMouse); message WM_LBUTTONUP;
    function GetButtonCloseRect(Index: Integer):TRect;
  strict protected
    procedure DrawTab(Canvas: TCanvas; Index: Integer); override;
    procedure MouseEnter; override;
    procedure MouseLeave; override;
  public
    constructor Create(AControl: TWinControl); override;
  end;

constructor TTabControlStyleHookBtnClose.Create(AControl: TWinControl);
begin
  inherited;
  FHotIndex:=-1;
  FWidthModified:=False;
end;

procedure TTabControlStyleHookBtnClose.DrawTab(Canvas: TCanvas; Index: Integer);
var
  Details : TThemedElementDetails;
  ButtonR : TRect;
  FButtonState: TThemedWindow;
begin
  inherited;

  if (FHotIndex>=0) and (Index=FHotIndex) then
   FButtonState := twSmallCloseButtonHot
  else
  if Index = TabIndex then
   FButtonState := twSmallCloseButtonNormal
  else
   FButtonState := twSmallCloseButtonDisabled;

  Details := StyleServices.GetElementDetails(FButtonState);

  ButtonR:= GetButtonCloseRect(Index);
  if ButtonR.Bottom - ButtonR.Top > 0 then
   StyleServices.DrawElement(Canvas.Handle, Details, ButtonR);
end;

procedure TTabControlStyleHookBtnClose.WMLButtonUp(var Message: TWMMouse);
Var
  LPoint : TPoint;
  LIndex : Integer;
begin
  LPoint:=Message.Pos;
  for LIndex := 0 to TabCount-1 do
   if PtInRect(GetButtonCloseRect(LIndex), LPoint) then
   begin
      if Control is TPageControl then
      begin
        TPageControl(Control).Pages[LIndex].Parent:=nil;
        TPageControl(Control).Pages[LIndex].Free;
      end;
      break;
   end;
end;

procedure TTabControlStyleHookBtnClose.WMMouseMove(var Message: TMessage);
Var
  LPoint : TPoint;
  LIndex : Integer;
  LHotIndex : Integer;
begin
  inherited;
  LHotIndex:=-1;
  LPoint:=TWMMouseMove(Message).Pos;
  for LIndex := 0 to TabCount-1 do
   if PtInRect(GetButtonCloseRect(LIndex), LPoint) then
   begin
      LHotIndex:=LIndex;
      break;
   end;

   if (FHotIndex<>LHotIndex) then
   begin
     FHotIndex:=LHotIndex;
     Invalidate;
   end;
end;

function TTabControlStyleHookBtnClose.GetButtonCloseRect(Index: Integer): TRect;
var
  FButtonState: TThemedWindow;
  Details : TThemedElementDetails;
  R, ButtonR : TRect;
begin
  R := TabRect[Index];
  if R.Left < 0 then Exit;

  if TabPosition in [tpTop, tpBottom] then
  begin
    if Index = TabIndex then
      InflateRect(R, 0, 2);
  end
  else
  if Index = TabIndex then
    Dec(R.Left, 2)
  else
    Dec(R.Right, 2);

  Result := R;
  FButtonState := twSmallCloseButtonNormal;

  Details := StyleServices.GetElementDetails(FButtonState);
  if not StyleServices.GetElementContentRect(0, Details, Result, ButtonR) then
    ButtonR := Rect(0, 0, 0, 0);

  Result.Left :=Result.Right - (ButtonR.Width) - 5;
  Result.Width:=ButtonR.Width;
end;

procedure TTabControlStyleHookBtnClose.MouseEnter;
begin
  inherited;
  FHotIndex := -1;
end;

procedure TTabControlStyleHookBtnClose.MouseLeave;
begin
  inherited;
  if FHotIndex >= 0 then
  begin
    FHotIndex := -1;
    Invalidate;
  end;
end;

[ナカムラッコ]

中村です。

TButton.Createで指定している引数が「Form1」になっているので、
引数を「表示させたいオブジェクト名」に変更すれば表示されると思います。

例えば、「PageControlの1番目のページ」であれば下記のような感じです。
TabControlStyleHookBtnClose := TTabControlStyleHookBtnClose.Create(PageControl1.Pages[0]);

(TabControlStyleHookBtnCloseクラス自体を確認していないため、保証は出来ませんが…)

---

Date: Wed, 16 Jan 2013 04:09:38 +0900
From: delphi...@freeml.com
To: delphi...@freeml.com
Subject: [delphi-users:2962] PageControlにclose buttonを付ける。

[auemura]

上村です。
StyleHookは、TStyleManager.Engine.RegisterStyleHookを呼び出して登録する必要があるようなので。

TTabControlStyleHookBtnClose を定義してあるユニットの
initialization部で
TStyleManager.Engine.RegisterStyleHook(TCustomTabControl, TTabControlStyleHookBtnClose);
TStyleManager.Engine.RegisterStyleHook(TTabControl, TTabControlStyleHookBtnClose);
finalization部で
TStyleManager.Engine.UnRegisterStyleHook(TCustomTabControl, TTabControlStyleHookBtnClose);
TStyleManager.Engine.UnRegisterStyleHook(TTabControl, TTabControlStyleHookBtnClose);
を実行するようにするか。

プロジェクトソースのスタイルを設定してある場所の下辺りに
TStyleManager.TrySetStyle('Carbon');<--この下
TStyleManager.Engine.RegisterStyleHook(TCustomTabControl, TTabControlStyleHookBtnClose);
TStyleManager.Engine.RegisterStyleHook(TTabControl, TTabControlStyleHookBtnClose);
と、
Application.Run;<--この下
TStyleManager.Engine.UnRegisterStyleHook(TCustomTabControl, TTabControlStyleHookBtnClose);
TStyleManager.Engine.UnRegisterStyleHook(TTabControl, TTabControlStyleHookBtnClose);
を追加するか。
どちらかで良いんじゃないかと思います。




MLホームページ: http://www.freeml.com/delphi-users

----------------------------------------------------------------------
毎日豪華プレゼントキャンペーン開催中！くまポン
http://ad.freeml.com/cgi-bin/sa.cgi?id=jxtPj
------------------------------------------------------[freeml byGMO]--

[ナカムラッコ]

すみません。
質問の意図を分かってませんでした…

2013/01/16 11:51、"auemura" <delphi...@freeml.com> のメッセージ:

MLホームページ: http://www.freeml.com/delphi-users

----------------------------------------------------------------------
いつでもどこでもメールチェック！freemlのスマートフォンアプリ
http://ad.freeml.com/cgi-bin/sa.cgi?id=jxu1L
------------------------------------------------------[freeml byGMO]--

[kotto]

上村さん。

稲富です。

有り難うございます。早速initializationとfinalizationを追加しましたｖ
しかし、相変わらず表示する方法が分かりません（汗）
私の知識不足がやばいです（汗）

MLホームページ: http://www.freeml.com/delphi-users

----------------------------------------------------------------------
ニコラスケイジ主演映画「ゴーストライダー」試写会にご招待
http://ad.freeml.com/cgi-bin/sa.cgi?id=jxy2B
------------------------------------------------------[freeml byGMO]--

[auemura]

上村です。
StyleHookなので、Styleを有効化しないと表示されないと思いますので、プロジェクトオプションのアプリケーション－表示で、デフォルトのスタイルをWindows以外にしたら表示されないでしょうか？

スタイルがWindowsの状態で表示しようと思うとこのStyleHookを使った方法ではダメだと思います。



MLホームページ: http://www.freeml.com/delphi-users

----------------------------------------------------------------------
使い方はいろいろ♪一部のメンバーだけにMLメールを送ろう！
http://ad.freeml.com/cgi-bin/sa.cgi?id=jxyJz
------------------------------------------------------[freeml byGMO]--

[kotto]

上村さん。

稲富です。

スタイルを変えることってできたんですねｖ
ちゃんと表示されました。有り難うございました！！


MLホームページ: http://www.freeml.com/delphi-users

----------------------------------------------------------------------
メンバーで使える掲示板を活用しよう！
http://ad.freeml.com/cgi-bin/sa.cgi?id=jxz4G
------------------------------------------------------[freeml byGMO]--