Форум программистов [Powered by Invision Power Board]

Код


procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if panel1.BevelOuter = bvLowered
  then
    Begin
      panel1.BevelOuter := bvRaised;
      button1.Top := button1.Top - 1;
      Label1.Top := Label1.Top - 1;
    end
  else
   Begin
     panel1.BevelOuter := bvLowered;
     button1.Top := button1.Top + 1;
     Label1.Top := Label1.Top + 1;
   end;
end;

Цитата

Нет получается както некрасиво.

Код


procedure TForm1.TCDrawTab(Control: TCustomTabControl;
  TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
  R: TRect;
begin
  R.Left := Rect.Right-14;
  R.Top := Rect.Top+2;
  R.Right := Rect.Right-6;
  R.Left := Rect.Right-14;
  R.Top := Rect.Top+2;
  R.Right := Rect.Right-6;

  if Active then
  begin
    TC.Canvas.Brush.Color := clBlue;
    TC.Canvas.Font.Color := clWhite;
    R.Bottom := Rect.Bottom-12;
  end
  else
  begin
    TC.Canvas.Brush.Color := clBtnFace;
    TC.Canvas.Font.Color := clBlack;
    R.Bottom := Rect.Bottom-6;
  end;
  TC.Canvas.FillRect(Rect);
  TC.Canvas.TextOut(Rect.Left+4,Rect.Top+4,Tc.Tabs[TabIndex]);
  TC.Canvas.Rectangle(R);
end;

procedure TForm1.TCMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
  R: TRect;
begin
  for i := 0 to TC.Tabs.Count-1 do
  begin
    if PtInREct(TC.TabRect(i),Point(X,Y)) then
    begin
        R.Bottom := TC.TabRect(i).Bottom-12;
        R.Left := TC.TabRect(i).Right-14;
        R.Top := TC.TabRect(i).Top+2;
        R.Right := TC.TabRect(i).Right-6;
        if PtInRect(R,Point(X,Y)) then TC.Tabs.Delete(i);
    end;
  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  TC.TabWidth := 60;
end;

Цитата

TTabControl негодится так как надо всё динамически создавать а я это неумею.

Код


  tabControl1.tabs.add('newTab');

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Tabs, StdCtrls, ComCtrls, ExtCtrls;

type
  TMyTabButton = Class;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TMyTabButton = Class(Tpanel)
                    protected
                       FCaption : AnsiString;
                       Procedure SetCapion(aCaption : AnsiString);
                       Procedure Paint(var Message: TWMPaint); message WM_PAINT;
                    public
                       Property Caption : AnsiString read FCaption write SetCapion;
                       constructor Create(AOwner: TComponent); override;
                       destructor  Destroy;
                     Private
                        textTop  : Integer;
                        textLeft : Integer;
                        b : TButton;
                        cnv : TCanvas;
                 end;

  TMyTabset = Class(Tpanel)
               protected
                 Buttons : TList;
                 Function GetItem(index : integer) : TMyTabButton;
                 Function GetCount : integer;
               public
                 constructor Create(AOwner: TComponent); override;
                 destructor  Destroy;
                 procedure add(aCaption : AnsiString);
                 procedure Insert(index : Integer;aCaption : AnsiString);
                 procedure Delete(index : Integer);
                 procedure Press(Sender: TObject);
                 Property  Items[index : integer] : TMyTabButton read GetItem;
                 Property  Count : integer read GetCount;
  end;


var
  Form1: TForm1;
  t : TMyTabset;

implementation

{$R *.dfm}

constructor TMyTabButton.Create(AOwner: TComponent);
var
  l, W : Integer;
Begin
  inherited Create(AOwner);
  parent := TWinControl(AOwner);
  b := TButton.Create(self);
  b.Parent := TPanel(self);
  FCaption := 'newtab';

  cnv := TCanvas.Create;
  cnv.Handle := GetDC(self.Handle);
  cnv.Brush.Color := clBtnFace;

  Width := cnv.TextWidth(FCaption) + 40;
  Height := 22;

  b.Width := 16;
  b.Height := 16;

  b.Top  := (Height div 2) - (b.Height div 2);
  b.Left := Width - b.Width - 2;

  w := cnv.TextWidth(FCaption);
  l := cnv.TextHeight(FCaption);
  textLeft := (Width div 2) - (w div 2) - 5;
  textTop  := (Height div 2) - (l div 2) - 1;
end;

Procedure TMyTabButton.Paint(var Message: TWMPaint);
Begin
  inherited;
  cnv.TextOut(textLeft, textTop, FCaption);
end;

Procedure TMyTabButton.SetCapion(aCaption : AnsiString);
var
  l, W : Integer;
Begin
  Width := cnv.TextWidth(aCaption) + 30;

  FCaption := aCaption;

  b.Top := (Height div 2) - (b.Height div 2);
  b.Left := Width - b.Width - 2;

  w := cnv.TextWidth(FCaption);
  l := cnv.TextHeight(FCaption);
  textLeft := (Width div 2)  - (w div 2) - 5;
  textTop  := (Height div 2) - (l div 2) - 1;
  repaint;
end;

destructor  TMyTabButton.Destroy;
Begin
  cnv.Free;
  b.Free;
  inherited Destroy;
end;

constructor TMyTabset.Create(AOwner: TComponent); 
Begin
  inherited Create(AOwner);
  parent := TWinControl(AOwner);
  Buttons := TList.Create;
end;

destructor  TMyTabset.Destroy;
Begin
  Buttons.Free;
  inherited Destroy;
end;

procedure TMyTabset.add(aCaption : AnsiString);
var
 Cr  : TMyTabButton;
 aux : TMyTabButton;
Begin
  Cr := TMyTabButton.Create(self);
  Cr.Caption := aCaption;
  Buttons.Add(Pointer(Cr));
  if Buttons.Count > 1
  then
    Begin
      aux := Items[Count - 2];
      Cr.Left := aux.Left + aux.Width;
    end
  else
    Cr.Left := 2;

  Cr.Top := 1;

  Cr.OnClick := self.Press;
  Repaint;
end;

procedure TMyTabset.Insert(index : Integer;aCaption : AnsiString);
Begin

end;

procedure TMyTabset.Delete(index : Integer);
var
 i : integer;
 aux1, aux2 : TMyTabButton;
Begin
  Items[index].Free;
  Buttons.Delete(index);
  
  if Buttons.Count = 0
  then
    exit;
    
  if index <> 0
  then
    For i := index to (Buttons.Count - 1)
    do
      Items[i].Left := Items[i - 1].Left + Items[i - 1].Width
  else
    Begin
      Items[index].Left := 2;
      Items[index].Top  := 1;
      For i := (index + 1) to Count - 1
      do
        Items[i].Left  := Items[i - 1].Left + Items[i - 1].Width;
    end;
end;

Function TMyTabset.GetItem(index : integer) : TMyTabButton;
Begin
  result := TMyTabButton(self.Buttons.Items[index]);
end;

Function TMyTabset.GetCount : integer;
Begin
  Result := buttons.Count;
end;

procedure TMyTabset.Press(Sender: TObject);
var
 i : integer;
begin

 // For i := 0 to self.Buttons.Count
  if TMyTabButton(Sender).BevelOuter = bvLowered
  then
    Begin
      TMyTabButton(Sender).BevelOuter := bvRaised;
      TMyTabButton(Sender).textLeft := TMyTabButton(Sender).textLeft - 1;
      TMyTabButton(Sender).textTop  := TMyTabButton(Sender).textTop  - 1;
      TMyTabButton(Sender).b.Left := TMyTabButton(Sender).b.Left - 1;
      TMyTabButton(Sender).b.top := TMyTabButton(Sender).b.top - 1;
    end
  else
   Begin
     TMyTabButton(Sender).BevelOuter := bvLowered;
     TMyTabButton(Sender).textLeft := TMyTabButton(Sender).textLeft + 1;
     TMyTabButton(Sender).textTop  := TMyTabButton(Sender).textTop  + 1;
     TMyTabButton(Sender).b.Left := TMyTabButton(Sender).b.Left + 1;
     TMyTabButton(Sender).b.top := TMyTabButton(Sender).b.top + 1;
   end;

  repaint;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   t := TMyTabset.Create(self);
   t.add('SomeCaption1');
   t.add('SomeCaption2');
   t.add('SomeCaption3');
   t.add('SomeCaption4');
   t.Top := 10;
   t.Left := 10;
   t.Width := 400;
   t.Height := 24;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  t.Delete(1);
end;

end.

Цитата(ivan219 @ 10.4.2006, 14:31

)

Демо твой код ничего не делает уменя нечего непроисходит и ошибок нет.

Код


type
  TMyTabButton = Class;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TMyTabButton = Class(Tpanel)
                    protected
                       FCaption : AnsiString;
                       Procedure SetCapion(aCaption : AnsiString);
                       Procedure Paint(var Message: TWMPaint); message WM_PAINT;
                    public
                       Property Caption : AnsiString read FCaption write SetCapion;
                       constructor Create(AOwner: TComponent); override;
                       destructor  Destroy;
                     Private
                        textTop  : Integer;
                        textLeft : Integer;
                        b : TButton;
                        cnv : TCanvas;
                 end;

  TMyTabset = Class(Tpanel)
               protected
                 Buttons : TList;
                 Function GetItem(index : integer) : TMyTabButton;
                 Function GetCount : integer;
               public
                 constructor Create(AOwner: TComponent); override;
                 destructor  Destroy;
                 procedure add(aCaption : AnsiString);
                 procedure Insert(index : Integer;aCaption : AnsiString);
                 procedure Delete(index : Integer);
                 procedure Press(Sender: TObject);
                 Property  Items[index : integer] : TMyTabButton read GetItem;
                 Property  Count : integer read GetCount;
  end;


var
  Form1: TForm1;
  t : TMyTabset;

implementation

{$R *.dfm}

constructor TMyTabButton.Create(AOwner: TComponent);
var
  l, W : Integer;
Begin
  inherited Create(AOwner);
  parent := TWinControl(AOwner);
  b := TButton.Create(self);
  b.Parent := TPanel(self);
  FCaption := 'newtab';

  cnv := TCanvas.Create;
  cnv.Handle := GetDC(self.Handle);
  cnv.Brush.Color := clBtnFace;

  Width := cnv.TextWidth(FCaption) + 40;
  Height := 22;

  b.Width := 16;
  b.Height := 16;

  b.Top  := (Height div 2) - (b.Height div 2);
  b.Left := Width - b.Width - 2;

  w := cnv.TextWidth(FCaption);
  l := cnv.TextHeight(FCaption);
  textLeft := (Width div 2) - (w div 2) - 5;
  textTop  := (Height div 2) - (l div 2) - 1;
end;

Procedure TMyTabButton.Paint(var Message: TWMPaint);
Begin
  inherited;
  cnv.TextOut(textLeft, textTop, FCaption);
end;

Procedure TMyTabButton.SetCapion(aCaption : AnsiString);
var
  l, W : Integer;
Begin
  Width := cnv.TextWidth(aCaption) + 30;

  FCaption := aCaption;

  b.Top := (Height div 2) - (b.Height div 2);
  b.Left := Width - b.Width - 2;

  w := cnv.TextWidth(FCaption);
  l := cnv.TextHeight(FCaption);
  textLeft := (Width div 2)  - (w div 2) - 5;
  textTop  := (Height div 2) - (l div 2) - 1;
  repaint;
end;

destructor  TMyTabButton.Destroy;
Begin
  cnv.Free;
  b.Free;
  inherited Destroy;
end;

constructor TMyTabset.Create(AOwner: TComponent); 
Begin
  inherited Create(AOwner);
  parent := TWinControl(AOwner);
  Buttons := TList.Create;
end;

destructor  TMyTabset.Destroy;
Begin
  Buttons.Free;
  inherited Destroy;
end;

procedure TMyTabset.add(aCaption : AnsiString);
var
 Cr  : TMyTabButton;
Begin
  Cr := TMyTabButton.Create(self);
  Cr.Caption := aCaption;
  Buttons.Add(Pointer(Cr));
  if Buttons.Count > 1
  then
    Cr.Left := Items[Count - 2].Left + Items[Count - 2].Width
  else
    Cr.Left := 2;

  Cr.Top := 1;

  Cr.OnClick := self.Press;
  Repaint;
end;

procedure TMyTabset.Insert(index : Integer;aCaption : AnsiString);
var
 Cr  : TMyTabButton;
 i   : Integer;
Begin
  Cr := TMyTabButton.Create(self);
  Cr.Caption := aCaption;
  Cr.Top     := Items[index].Top;
  Cr.Left    := Items[index].Left;
  Buttons.Insert(index, Cr);
  for i := index + 1 to Count - 1
  do
    Items[i].Left := Items[i - 1].Left + Items[i - 1].Width;

  Cr.Top := 1;

  Cr.OnClick := self.Press;
  Repaint;
end;

procedure TMyTabset.Delete(index : Integer);
var
 i : integer;
 aux1, aux2 : TMyTabButton;
Begin
  Items[index].Free;
  Buttons.Delete(index);
  
  if Buttons.Count = 0
  then
    exit;
    
  if index <> 0
  then
    For i := index to (Buttons.Count - 1)
    do
      Items[i].Left := Items[i - 1].Left + Items[i - 1].Width
  else
    Begin
      Items[index].Left := 2;
      Items[index].Top  := 1;
      For i := (index + 1) to Count - 1
      do
        Items[i].Left  := Items[i - 1].Left + Items[i - 1].Width;
    end;
end;

Function TMyTabset.GetItem(index : integer) : TMyTabButton;
Begin
  result := TMyTabButton(self.Buttons.Items[index]);
end;

Function TMyTabset.GetCount : integer;
Begin
  Result := buttons.Count;
end;

procedure TMyTabset.Press(Sender: TObject);
var
 i : integer;
begin
  if TMyTabButton(Sender).BevelOuter = bvLowered
  then
    exit;

  For i := 0 to Count - 1
  do
    if (items[i] <> sender) and (items[i].BevelOuter = bvLowered)
    then
      Begin
        items[i].BevelOuter := bvRaised;
        items[i].textLeft := items[i].textLeft - 1;
        items[i].textTop  := items[i].textTop  - 1;
        items[i].b.Left := items[i].b.Left - 1;
        items[i].b.top  := items[i].b.top  - 1;
      end;

  if TMyTabButton(Sender).BevelOuter = bvRaised
  then
    Begin
      TMyTabButton(Sender).BevelOuter := bvLowered;
      TMyTabButton(Sender).textLeft := TMyTabButton(Sender).textLeft + 1;
      TMyTabButton(Sender).textTop  := TMyTabButton(Sender).textTop  + 1;
      TMyTabButton(Sender).b.Left := TMyTabButton(Sender).b.Left + 1;
      TMyTabButton(Sender).b.top := TMyTabButton(Sender).b.top + 1;
    end;
  repaint;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   t := TMyTabset.Create(self);
   t.BevelOuter := bvNone;
   t.add('SomeCaption1');
   t.add('SomeCaption2');
   t.add('SomeCaption3');
   t.add('SomeCaption4');
   t.Top := 10;
   t.Left := 10;
   t.Width := 500;
   t.Height := 24;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
//  t.Delete(1);
 t.Insert(3, 'inserted');
end;

Цитата(ivan219 @ 13.4.2006, 08:29

)

Ладно новерое они несовместимы т.е. Delphi7 и Delphi2005