VPF::Перемещение вкладок TabSheet - Форум программистов

Borland_Delphi_6

Дата 30.3.2005, 15:12 (ссылка)

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

Загрузка ...

LoneLINEss

Профиль
Группа: Участник Клуба
Сообщений: 2509
Регистрация: 5.11.2002
Где: in fortune dreams ...

Репутация: нет
Всего: 20

Как организовать перемещение вкладок TabSheet при помощи мыши, как это сделано в MyIE, FireFox, Opera, etc?

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

Blind Guardian Fan :: BMSTU Student :: A polar bear is a rectangular bear after a coordinate transform.

Мои фотографии

Snowy

Дата 30.3.2005, 15:42 (ссылка)

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

Загрузка ...

Эксперт

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

Репутация: 192
Всего: 484

В Opera нет вкладок.
Это самостоятельные окошки. Типа TPanel, только вид изменен.
Поэтому их так легко таскать куда угодно.

Vit

Дата 30.3.2005, 16:09 (ссылка)

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

Загрузка ...

Vitaly Nevzorov

Профиль
Группа: Экс. модератор
Сообщений: 10964
Регистрация: 25.3.2002
Где: Chicago

Репутация: 48
Всего: 207

TTabSheet таскается точно так же как и любые другие компоненты: onDragDrop/onDragOver

В DRKB подробно описано
Добавлено @ 16:11

Код


procedure TMainForm.PageControlDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  if Source is TDragControlObject then 
     PageControl.Pages[PageControl.ActivePageIndex].PageIndex:=PageControl.IndexOfTabAt(x,y);
end;

procedure TMainForm.PageControlDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept:=(Source is TDragControlObject);
end;

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

With the best wishes, Vit
I have done so much with so little for so long that I am now qualified to do anything with nothing
Самый большой Delphi FAQ на русском языке здесь: www.drkb.ru

Borland_Delphi_6

Дата 1.4.2005, 16:34 (ссылка)

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

Загрузка ...

LoneLINEss

Профиль
Группа: Участник Клуба
Сообщений: 2509
Регистрация: 5.11.2002
Где: in fortune dreams ...

Репутация: нет
Всего: 20

Чего-то нифига не драг-н-дропится smile

Если в DRKB есть статья на тему, можно выложить здесь ее полный вариант?

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

Blind Guardian Fan :: BMSTU Student :: A polar bear is a rectangular bear after a coordinate transform.

Мои фотографии

Vit

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

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

Загрузка ...

Vitaly Nevzorov

Профиль
Группа: Экс. модератор
Сообщений: 10964
Регистрация: 25.3.2002
Где: Chicago

Репутация: 48
Всего: 207

DragMode в Automatic поставлен?

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

Vit

Дата 1.4.2005, 18:44 (ссылка)

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

Загрузка ...

Vitaly Nevzorov

Профиль
Группа: Экс. модератор
Сообщений: 10964
Регистрация: 25.3.2002
Где: Chicago

Репутация: 48
Всего: 207

Вот тебе пример и на уничтожение tab и на перетягивание:

Код


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    PageControl1: TPageControl;
    procedure Button2Click(Sender: TObject);
    procedure WebBrowser1NavigateComplete2(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure PageControlDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure PageControlDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure WebBrowser1DocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure FormCreate(Sender: TObject);
    procedure PageControl1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PageControl1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
  public
    { Public declarations }
  end;


var
  Form1: TForm1;
  i:integer;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
  var t:TTabSheet;
begin
  t:=TTabSheet.Create(Form1);
  t.PageControl:=PageControl1;
  t.DragMode:=dmAutomatic;
  t.Tag:=integer(TWebBrowser.Create(Form1));
  inc(i);
  t.Caption:='Untitled '+inttostr(i);
  TOleControl(t.Tag).Parent:=t;
  TWebBrowser(t.Tag).align:=alClient;
  TWebBrowser(t.Tag).Visible:=true;
  TWebBrowser(t.Tag).OnNavigateComplete2:=WebBrowser1NavigateComplete2;
  TWebBrowser(t.Tag).OnDocumentComplete:=WebBrowser1DocumentComplete;
  TWebBrowser(t.Tag).GoHome;

end;

procedure TForm1.WebBrowser1NavigateComplete2(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  Edit1.Text:=URL;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if PageControl1.ActivePage=nil then exit;
  TWebBrowser(PageControl1.ActivePage.Tag).free;
  PageControl1.ActivePage.Free;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  if PageControl1.ActivePage=nil then exit;
  TWebBrowser(PageControl1.ActivePage.Tag).GoHome;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  if PageControl1.ActivePage=nil then exit;
  TWebBrowser(PageControl1.ActivePage.Tag).GoBack;

end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  if PageControl1.ActivePage=nil then exit;
  TWebBrowser(PageControl1.ActivePage.Tag).GoForward;

end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  if PageControl1.ActivePage=nil then exit;
  TWebBrowser(PageControl1.ActivePage.Tag).Refresh;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if PageControl1.ActivePage=nil then exit;
  TWebBrowser(PageControl1.ActivePage.Tag).Navigate(Edit1.Text);

end;

procedure TForm1.PageControl1Change(Sender: TObject);
begin
  Edit1.Text:=TWebBrowser(PageControl1.ActivePage.Tag).LocationURL;
end;

procedure TForm1.PageControlDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  if (Source is TPageControl) and ((PageControl1.ActivePageIndex<>PageControl1.IndexOfTabAt(x,y))) then
    begin
     PageControl1.ActivePage.PageIndex:=PageControl1.IndexOfTabAt(x,y);
     PageControl1.EndDrag(true);
     PageControl1.tag:=0;
    end;
  PageControl1Change(nil);
end;

procedure TForm1.PageControlDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept:=(Source is TPageControl);
end;


procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  Edit1.Text:=URL;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  i:=0;
end;

procedure TForm1.PageControl1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if PageControl1.tag=1 then
    PageControl1.EndDrag(false);
  PageControl1.tag:=0;
end;

procedure TForm1.PageControl1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if PageControl1.tag<>1 then
    PageControl1.BeginDrag(true);
  PageControl1.tag:=1;
end;

end.

Форма:

Код


object Form1: TForm1
  Left = 248
  Top = 139
  Width = 696
  Height = 480
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Shell Dlg 2'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 688
    Height = 79
    Align = alTop
    TabOrder = 0
    object Edit1: TEdit
      Left = 8
      Top = 8
      Width = 281
      Height = 21
      BevelInner = bvNone
      BevelKind = bkSoft
      BevelOuter = bvNone
      TabOrder = 0
    end
    object Button1: TButton
      Left = 296
      Top = 8
      Width = 75
      Height = 25
      Caption = 'Navigate'
      TabOrder = 1
      OnClick = Button1Click
    end
    object Button2: TButton
      Left = 16
      Top = 48
      Width = 75
      Height = 25
      Caption = 'New Page'
      TabOrder = 2
      OnClick = Button2Click
    end
    object Button3: TButton
      Left = 96
      Top = 48
      Width = 75
      Height = 25
      Caption = 'Close Page'
      TabOrder = 3
      OnClick = Button3Click
    end
    object Button4: TButton
      Left = 176
      Top = 48
      Width = 75
      Height = 25
      Caption = 'Home'
      TabOrder = 4
      OnClick = Button4Click
    end
    object Button5: TButton
      Left = 256
      Top = 48
      Width = 75
      Height = 25
      Caption = 'Back'
      TabOrder = 5
      OnClick = Button5Click
    end
    object Button6: TButton
      Left = 336
      Top = 48
      Width = 75
      Height = 25
      Caption = 'Forward'
      TabOrder = 6
      OnClick = Button6Click
    end
    object Button7: TButton
      Left = 416
      Top = 48
      Width = 75
      Height = 25
      Caption = 'Refresh'
      TabOrder = 7
      OnClick = Button7Click
    end
  end
  object PageControl1: TPageControl
    Left = 0
    Top = 79
    Width = 688
    Height = 374
    Align = alClient
    TabOrder = 1
    OnDragDrop = PageControlDragDrop
    OnDragOver = PageControlDragOver
    OnMouseDown = PageControl1MouseDown
    OnMouseUp = PageControl1MouseUp
  end
end

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

Vit

Дата 1.4.2005, 18:48 (ссылка)

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

Загрузка ...

Vitaly Nevzorov

Профиль
Группа: Экс. модератор
Сообщений: 10964
Регистрация: 25.3.2002
Где: Chicago

Репутация: 48
Всего: 207

Вот проект целиком:

Присоединённый файл ( Кол-во скачиваний: 58 )

Project1.ZIP

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

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