paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-14 20:59:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: TTabControl: make tabs drag- and dropable. Issue #24022

Browse Source 
git-svn-id: trunk@53981 -
This commit is contained in:
michl 2017-01-22 22:21:02 +00:00
parent 95a697d5a2
commit 0c438b980e
2 changed files with 43 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/comctrls.pp
View File

@ -726,6 +726,10 @@ type
protected protected
FHandleCreated: TNotifyEvent; FHandleCreated: TNotifyEvent;
procedure CreateHandle; override; procedure CreateHandle; override;
procedure DoStartDrag(var DragObject: TDragObject); override;
procedure DragDrop(Source: TObject; X, Y: Integer); override;
procedure DragOver(Source: TObject; X,Y: Integer; State: TDragState;
var Accept: Boolean); override;
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override; procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
@ -828,6 +832,7 @@ type
procedure CreateWnd; override; procedure CreateWnd; override;
procedure DestroyHandle; override; procedure DestroyHandle; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetDragMode(Value: TDragMode); override;
procedure SetTabIndex(Value: Integer); virtual; procedure SetTabIndex(Value: Integer); virtual;
procedure UpdateTabImages; procedure UpdateTabImages;
procedure ImageListChange(Sender: TObject); procedure ImageListChange(Sender: TObject);

48
lcl/include/tabcontrol.inc
View File

@ -148,20 +148,45 @@ begin
FHandleCreated(self); FHandleCreated(self);
end; end;
procedure TNoteBookStringsTabControl.DoStartDrag(var DragObject: TDragObject);
begin
if (Parent is TTabControl) then
begin
if Assigned(TTabControl(Parent).OnStartDrag) then
TTabControl(Parent).OnStartDrag(Parent, DragObject);
if not Assigned(DragObject) then
DragObject := TDragControlObject.AutoCreate(Parent);
end;
inherited DoStartDrag(DragObject);
end;
procedure TNoteBookStringsTabControl.DragDrop(Source: TObject; X, Y: Integer);
begin
inherited DragDrop(Source, X, Y);
if (Parent is TTabControl) and Assigned(TTabControl(Parent).OnDragDrop) then
TTabControl(Parent).OnDragDrop(Parent, Source, X, Y);
end;
procedure TNoteBookStringsTabControl.DragOver(Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
inherited DragOver(Source, X, Y, State, Accept);
if (Parent is TTabControl) and Assigned(TTabControl(Parent).OnDragOver) then
TTabControl(Parent).OnDragOver(Parent, Source, X, Y, State, Accept);
end;
procedure TNoteBookStringsTabControl.MouseDown(Button: TMouseButton; procedure TNoteBookStringsTabControl.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); Shift: TShiftState; X, Y: Integer);
begin begin
inherited MouseDown(Button, Shift, X, Y); inherited MouseDown(Button, Shift, X, Y);
if Assigned(Parent) and (Parent is TTabControl) if (Parent is TTabControl) and Assigned(TTabControl(Parent).OnMouseDown) then
and Assigned(TTabControl(Parent).OnMouseDown) then
TTabControl(Parent).OnMouseDown(Parent, Button, Shift, X, Y); TTabControl(Parent).OnMouseDown(Parent, Button, Shift, X, Y);
end; end;
procedure TNoteBookStringsTabControl.MouseMove(Shift: TShiftState; X, Y: Integer); procedure TNoteBookStringsTabControl.MouseMove(Shift: TShiftState; X, Y: Integer);
begin begin
inherited MouseMove(Shift, X, Y); inherited MouseMove(Shift, X, Y);
if Assigned(Parent) and (Parent is TTabControl) if (Parent is TTabControl) and Assigned(TTabControl(Parent).OnMouseMove) then
and Assigned(TTabControl(Parent).OnMouseMove) then
TTabControl(Parent).OnMouseMove(Parent, Shift, X, Y); TTabControl(Parent).OnMouseMove(Parent, Shift, X, Y);
end; end;
@ -169,24 +194,21 @@ procedure TNoteBookStringsTabControl.MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); Shift: TShiftState; X, Y: Integer);
begin begin
inherited MouseUp(Button, Shift, X, Y); inherited MouseUp(Button, Shift, X, Y);
if Assigned(Parent) and (Parent is TTabControl) if (Parent is TTabControl) and Assigned(TTabControl(Parent).OnMouseUp) then
and Assigned(TTabControl(Parent).OnMouseUp) then
TTabControl(Parent).OnMouseUp(Parent, Button, Shift, X, Y); TTabControl(Parent).OnMouseUp(Parent, Button, Shift, X, Y);
end; end;
procedure TNoteBookStringsTabControl.MouseEnter; procedure TNoteBookStringsTabControl.MouseEnter;
begin begin
inherited MouseEnter; inherited MouseEnter;
if Assigned(Parent) and (Parent is TTabControl) if (Parent is TTabControl) and Assigned(TTabControl(Parent).OnMouseEnter) then
and Assigned(TTabControl(Parent).OnMouseEnter) then
TTabControl(Parent).OnMouseEnter(Parent); TTabControl(Parent).OnMouseEnter(Parent);
end; end;
procedure TNoteBookStringsTabControl.MouseLeave; procedure TNoteBookStringsTabControl.MouseLeave;
begin begin
inherited MouseLeave; inherited MouseLeave;
if Assigned(Parent) and (Parent is TTabControl) if (Parent is TTabControl) and Assigned(TTabControl(Parent).OnMouseLeave) then
and Assigned(TTabControl(Parent).OnMouseLeave) then
TTabControl(Parent).OnMouseLeave(Parent); TTabControl(Parent).OnMouseLeave(Parent);
end; end;
@ -624,6 +646,12 @@ begin
Images := nil; Images := nil;
end; end;
procedure TTabControl.SetDragMode(Value: TDragMode);
begin
inherited SetDragMode(Value);
TTabControlNoteBookStrings(FTabs).NoteBook.SetDragMode(Value);
end;
procedure TTabControl.SetTabIndex(Value: Integer); procedure TTabControl.SetTabIndex(Value: Integer);
begin begin
TTabControlStrings(FTabs).TabIndex:=Value; TTabControlStrings(FTabs).TabIndex:=Value;