VPF::Нужен компонент - Форум программистов

ivan219

Дата 10.4.2006, 10:22 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

Репутация: 2
Всего: 12

Мне нужен компонент который былбы как TPageControl; TTabSheet; но чтоб унего был с боку крестик чтоб закрыть страницу т.е. как у Opera 8.5.

Если есть то вышлите на [email protected] ну или ссылку дайте мне очень нужно smile

--------------------

Мой первый сайт и моя первая программа!!!!!

Alexeis

Дата 10.4.2006, 10:47 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

вот платный компонент
Добавлено @ 10:52
Если неохота платить то можно самому нарисовать кнопочку в компоненте TTabSet.

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

ivan219

Дата 10.4.2006, 11:39 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

Репутация: 2
Всего: 12

Нет платить неохота smile

А как нарисовать smile

alexeis1 ты можеш это зделать smile

--------------------

Мой первый сайт и моя первая программа!!!!!

Alexeis

Дата 10.4.2006, 11:47 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Если закладки будут статичными(не будет менятся ширина и количесво, а также компонент не будет перемещатся, то можно просто бросить на закладку кнопку)
Добавлено @ 11:48
я тут посмотрел, вообщем TTabset нормально реализованно только в delphi2006 в семерке они недоделанные.
Добавлено @ 12:01
Я предлагаю совсем отказаться от стандартных закладак и использовать в место этого панельку с кнопкой и лабелом
вот так можно будет рисовать

Код


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;

--------------------

ivan219

Дата 10.4.2006, 12:05 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

Репутация: 2
Всего: 12

Нет они будут менятся и их будет много я уже думал про кнопку но это невыход так как их много я правда зделал одну отдельно но получается некрасиво а закладки как в Opera 8.5 мне нравятся.

А из delphi2006 можено перенести этот компонент в delphi7 smile

и если можно то зделай это может пакетам или отдельным *.pas.
Добавлено @ 12:10
Нет получается както некрасиво.

--------------------

Мой первый сайт и моя первая программа!!!!!

Alexeis

Дата 10.4.2006, 12:25 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Цитата

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

Вместо кнопки можно рисовать TImage; - smile

тогда будет точно красивая

--------------------

Демо

Дата 10.4.2006, 12:42 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 30
Всего: 50

Иcпользуй TTabControl.

Вот пример(естсественно, это лишь схема. Можно отрисовывать и кнопку вместо квадратика. Кроме того, можно использовать метод GetHitTestInfoAt(), чего нет в примере. Кроме того, нужно динамичеси вычислять ширину TTabControl - для свободной обдласти справа):

Код


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;

--------------------

ivan219

Дата 10.4.2006, 13:07 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

Репутация: 2
Всего: 12

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

--------------------

Мой первый сайт и моя первая программа!!!!!

_hunter

Дата 10.4.2006, 13:14 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 8564
Регистрация: 24.6.2003
Где: Europe::Ukraine:: Kiev

Репутация: 15
Всего: 98

учись. к тому же динамически закладки в любом случае создавать придется...

--------------------

Tempora mutantur, et nos mutamur in illis...

Alexeis

Дата 10.4.2006, 13:24 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Цитата

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

Это проще простого smile

Код


  tabControl1.tabs.add('newTab');

--------------------

Alexeis

Дата 10.4.2006, 14:29 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

я начал делать, но когда закончу не знаю.
чтоб облегчить работу привожу набросок

Код


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.

Это сообщение отредактировал(а) alexeis1 - 10.4.2006, 14:54

--------------------

ivan219

Дата 10.4.2006, 14:31 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

Репутация: 2
Всего: 12

Нет я другие компоненты немогу да и незачем мне сечас это делать так как в моей программе куча всяких компонентов ещё много закладок единственное что хочю так это закладки с кнопкой.

Но новерное нечего невыйдет smile

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

--------------------

Мой первый сайт и моя первая программа!!!!!

Демо

Дата 10.4.2006, 14:38 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 30
Всего: 50

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

)

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

Для того, чтобы код что-то делал, надо
1. На форму положить TTabControl и назвать его TC;
2. Привязать соответствующие обработчики на соответствующие события(OnDrawTab, OnMouseUp - для TTabControl, OnCreate - для формы).

Это сообщение отредактировал(а) Демо - 10.4.2006, 14:39

--------------------

ivan219

Дата 10.4.2006, 15:50 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

Репутация: 2
Всего: 12

Я так и зделал я же говорю что ошибок нет т.е. всё компилится но нечего непроисходит как TTabControl был такимже и остался не вкладок нечего и неначто нереагирует.

--------------------

Мой первый сайт и моя первая программа!!!!!

Alexeis

Дата 11.4.2006, 17:25 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

ivan219, говорю же пиши заново целиком вот доработанный вариант

Код


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;

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »