Tabにボタンを追加したい

osakana 2005-06-05 04:01:02 No: 15380

DelphiはDelphiで作られているので探しましたがわかりません。

PageControl1では無いような気がするので
PageControl1DrawTabってのは抜きにして
Delphi2005のフォームやコードが表示されているTabコントロールみたいに
タブに閉じるボタンをつけたいので、コンポーネント名を教えてください。

2005 2005-06-05 04:26:54 No: 15381

http://www.tmssoftware.com/apc.htm
こんなやつですよね？
でも残念ながらこれは商用用途かソースが必要なら有料ですが。

osakana 2005-06-05 07:34:17 No: 15382

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

うーん・・・いいのがみつかるまで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;