VPF::TRsVistaTabSet - TabSet из проги TheBat - Форум программистов

Akella

Дата 25.12.2010, 09:42 (ссылка)

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

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329

Цитата(Delphist @ 24.12.2010, 21:50)

Цитата(Akella @ 24.12.2010, 18:54

)

Нету времени - найми программиста. Он погуглит и найдёт или сам напишет ;)

нет лишних денег на это

Нет времени на программирование и нет денег, чтобы нанять программиста, и нет желания программировать самому? Ну.... может сменить работу?

Добавлено @ 09:47
Delphist, вон, смотри, тебе готовый компонент ildvild нашёл

~FoX~

Дата 25.12.2010, 09:57 (ссылка)

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

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 13
Всего: 68

PageControl1.OwnerDraw := true;

Код


uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Math, Buttons, ComCtrls;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    procedure PageControl1DrawTab(Control: TCustomTabControl; TabIndex: Integer;
      const Rect: TRect; Active: Boolean);
    procedure PageControl1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    function GetIndexTab( Control : TCustomTabControl; X, Y: Integer; var Index : Integer ) : Boolean;
    procedure DrawButton( Control : TCustomTabControl; Index : Integer; State : Boolean );
    function GetButtonRect( Control : TCustomTabControl; Index : integer) : TRect;

    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}



function TForm1.GetButtonRect( Control : TCustomTabControl; Index : integer) : TRect;
begin
  with Control.TabRect( Index ) do
  begin
    Result.Right := Right - 2;
    Result.Top := Top + 3;
    Result.Bottom := Result.Top + Control.Canvas.TextHeight( '0' );
    Result.Left := Result.Right - ( Result.Bottom - Result.Top );
  end;
end;

function TForm1.GetIndexTab( Control : TCustomTabControl; X, Y: Integer; var Index : Integer ) : Boolean;
begin
  Result := false;
  Index := Control.IndexOfTabAt( X, Y );
  if ( Index >= 0 ) then
    Result := PtInRect( GetButtonRect( Control, Index ), Point( X, Y ));
end;

procedure TForm1.DrawButton( Control : TCustomTabControl; Index : Integer; State : Boolean );
var Rect : TRect;
begin
  Rect := Control.TabRect( Index );
  with Control.Canvas do
  begin
    TextRect( Rect, Rect.Left + 4, Rect.Top + 3,
      ( Control as TPageControl ).Pages[ Index ].Caption );
    Rect := GetButtonRect( Control, Index );
    with DrawButtonFace( Control.Canvas, Rect, 1, bsNew, true, true, false ) do
    begin
      Pen.Color := IfThen( State, clBtnText, clBtnShadow );
      Pen.Width := 2;
      MoveTo( Left + 1, Top + 1 );
      LineTo( Right - 3, Bottom - 3 );
      MoveTo( Right - 3, Top + 1 );
      LineTo( Left + 1, Bottom - 3 );
    end;
  end;
end;

procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;
  TabIndex: Integer; const Rect: TRect; Active: Boolean);
begin
  DrawButton(Control, TabIndex, Active );
end;

procedure TForm1.PageControl1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  TabIndex : integer;

begin
 if GetIndexTab( Sender as TCustomTabControl, X, Y, TabIndex ) then
  begin
    ShowMessage('Close');
  end;
end;

Код не мой, но рабочий 100% - переварить это в компонент думаю не проблема....

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

…множественность никогда не следует полагать без необходимости…

Delphist

Дата 25.12.2010, 11:01 (ссылка)

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

Загрузка ...

Delphist Эксперт

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

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

Цитата(~FoX~ @ 25.12.2010, 10:57

)

Код не мой, но рабочий 100% - переварить это в компонент думаю не проблема....

Спасибо

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

ProcessInfo 1-ая моя программа (аналог spyxx.exe с гораздо большим функц-ом - внедрение dll в адр. простр. процесса, перехват API-функций, разбор приложения на окна мн.др).
Когда-то давным-давно использовал это...

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