Delphi/C++ Builder の PageControl で TabPosition を tpBottom にする

今更だけど PageControl (TPageControl) で TabPosition を tpBottom にする
(おかしくなるのは知っていたけど、タブを下へ付けることがこれまで無かったので)


TabPositiontpTop の場合

TabPositiontpBottom にしてみる
上用のタブがそのまま下へ移動する...これじゃない感

対策1
uses に UxTheme を追加して、フォームのOnShowイベント辺りで SetWindowTheme を使って、PageControl のテーマを解除する
※ OnShowイベントへ記述したのは、フォームのドッキングなどで、テーマが戻ってしまうため
procedure TForm1.FormShow(Sender: TObject);
begin
    SetWindowTheme(PageControl1.Handle, '', '');
end;
その結果が、こんな感じ
シンプルだし、これでいいのかも...

対策2
PageControl の OwnerDraw プロパティを True にして、自前でタブを描画(OnDrawTabイベント)する
procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean);
var TabRect: TRect;
    PageControl: TPageControl;
begin
    // OwnerDraw = True の場合
    PageControl := TPageControl(Control);
    TabRect := Rect;

    // 背景を塗りつぶす
    if Active then begin
        PageControl.Canvas.Brush.Color := clWindow; // アクティブ色
    end
    else begin
        PageControl.Canvas.Brush.Color := clBtnFace; // 非アクティブ色
    end;
    PageControl.Canvas.FillRect(Rect);

    // 文字を書き込む
    PageControl.Canvas.Font.Color := clWindowText; // 文字色
    DrawText(PageControl.Canvas.Handle, pChar(PageControl.Pages[TabIndex].Caption), -1, TabRect, DT_WORDBREAK or DT_NOCLIP or DT_CENTER or DT_SINGLELINE or DT_VCENTER);
end;
上記のコードで描画したものがコレ

まぁ、サードパーティのコンポーネントを使えば済む話だけど、基本は標準コントロールでという方は多いハズ

コメント