home *** CD-ROM | disk | FTP | other *** search
- unit Tabform;
-
- interface
-
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- Forms, Dialogs, Tabs, StdCtrls, ExtCtrls;
-
- type
- TForm1 = class(TForm)
- TabSet1: TTabSet;
- Panel1: TPanel;
- Label1: TLabel;
- procedure TabSet1MouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure TabSet1DragOver(Sender, Source: TObject; X, Y: Integer;
- State: TDragState; var Accept: Boolean);
- procedure TabSet1DragDrop(Sender, Source: TObject; X, Y: Integer);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
- var
- Form1: TForm1;
-
- implementation
-
- {$R *.DFM}
-
- procedure TForm1.TabSet1MouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- var
- DragItem: Integer;
- begin
- if Button = mbLeft then
- begin
- DragItem := TabSet1.ItemAtPos(Point(X, Y));
- if (DragItem > -1) and (DragItem < TabSet1.Tabs.Count) then
- TabSet1.BeginDrag(False);
- end;
- end;
-
- procedure TForm1.TabSet1DragOver(Sender, Source: TObject; X, Y: Integer;
- State: TDragState; var Accept: Boolean);
- var
- DropPos: Integer;
- begin
- if Source = TabSet1 then
- begin
- DropPos := TabSet1.ItemAtPos(Point(X, Y));
- Accept := (DropPos > -1) and (DropPos <> TabSet1.TabIndex) and
- (DropPos < TabSet1.Tabs.Count);
- end
- else Accept := False;
- end;
-
- procedure TForm1.TabSet1DragDrop(Sender, Source: TObject; X, Y: Integer);
- var
- OldPos: Integer;
- NewPos: Integer;
- begin
- if Source = TabSet1 then
- begin
- OldPos := TabSet1.TabIndex;
- NewPos := TabSet1.ItemAtPos(Point(X, Y));
- if (NewPos > -1) and (NewPos <> OldPos) then
- TabSet1.Tabs.Move(OldPos, NewPos);
- end;
- end;
-
- end.
-