Tabにボタンを追加したい (ID:15382)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

そういうのです(^_^)
ぇ〜    有償ですかぁ〜
無償はないのかなぁ〜

うーん・・・  いいのがみつかるまでDrawTabで我慢しまーす

閉じれればいいので  即席ラーメンがわりにさっきかいてみました。
でも右端のタブが対応できないので難点。

if not (isLeft) then
      R.Left := R.Right - (Haba + WMargin)*(Index+1)
    else
      R.Left := R.Left + Haba * Index + WMargin*(Index+1);

Dec(Haba, DecHaba);
  R.Right := R.Left + Haba;
  Inc(R.Top, (R.Bottom - R.Top - Haba) div 2);
  R.Bottom := R.Top + Haba;

Result := R;
end;

procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;
  TabIndex: Integer; const Rect: TRect;
  Active: Boolean);
  var
   old_BrushColor : TColor;
   R,R_Text : TRect;
   const
     WMargin = 4;
begin
  // Rectは  Activeかどうかでサイズが変わるので
  // Control.TabRect(TabIndex);  を使う
  old_BrushColor := Control.Canvas.Brush.Color;
  if Active then
  Control.Canvas.Brush.Color := $00CCFFCC
   else
  Control.Canvas.Brush.Color := $ffffcc;
//
  R := Control.TabRect(TabIndex);
  R_Text := R;
  Control.Canvas.FillRect(R);
  R := MakeTabButtonRect(Control.TabRect(TabIndex),
       False,0,0 ,WMargin,6);
  R_Text.Right := r.Left - WMargin;

Control.Canvas.TextRect(R_Text,R_Text.Left+4,R_Text.Top + 2 ,
             TPageControl(Control).Pages[TabIndex].Caption);
  Inc(R.Right);
  Inc(R.Bottom);
  Control.Canvas.Rectangle(R);
  Control.Canvas.Polyline([R.TopLeft,R.BottomRight]);
  Control.Canvas.Polyline([Point(R.Left,R.Bottom-1),Point(R.Right,R.Top-1)]);
//
  Control.Canvas.Brush.Color := old_BrushColor;
end;

function  PtVisibleRect(ARect : TRect; X, Y : integer) : Boolean;
begin
  Result :=
    (ARect.Left<=X)and(x <= ARect.Right)
    and
    (ARect.top <= Y)and(Y <= ARect.Bottom);
end;

procedure TForm1.PageControl1MouseUp(Sender: TObject;
  Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var
    i : integer;
    ATabSheet : TTabSheet;
    R : TRect;
begin
  if (mbLeft <> Button) then Exit;
  if (ssMiddle in Shift)or(ssRight in Shift) then Exit;

i := PageControl1.IndexOfTabAt(X,Y);
  if i < 0 then exit;
   // 端っこだと勝手にタブが移動して変わることがある
  ATabSheet := PageControl1.Pages[i];
  R := MakeTabButtonRect(TPageControl(Sender).TabRect(i),
       False,0,0 ,4,6);
  if PtVisibleRect(R,X,Y) then
  begin
    ATabSheet := TPageControl(Sender).Pages[i];
    TabSheetCustumCloseEvent(ATabSheet);
  end;
end;

←解決時は質問者本人がここをチェックしてください。

戻る