doublecmd/src/ufileviewnotebook.pas
Denis Bisson 1be586dfa5 ADD: Implementation of the "Favorite Tabs" to save and restore tabs configuration a little more friendly. (Before we could have set tool button with cm_LoadTabs/cm_SaveTabs with a specified filename to do the same but it was less automatic)
ADD: Because of the new "Favorite Tabs", addition of new internal commands: "cm_ConfigFavoriteTabs", "cm_LoadFavoriteTabs", "cm_SaveFavoriteTabs", "cm_ReloadFavoriteTabs", "cm_PreviousFavoriteTabs" and "cm_NextFavoriteTabs" .
ADD: "cm_CloseAllTabs" may now accept parameter "side=" to determine on which panel side it will apply (left, right, active, inactive and both).
ADD: "cm_CloseAllTabs" may now accept parameter "dolocked=" to indicate if it also close locked tabs (true-yes-on-1/false/no-off-0).
ADD: "cm_CloseAllTabs" may now accept parameter "confirmlocked=" to bypass global setting for closing locked tabs (true-yes-on-1/false/no-off-0).
ADD: "cm_CloseDuplicateTabs" also now accept the three above mentioned possible parameters. (So it can be set to close duplicate locked tab, but with keep the locked first if a normal one exists).
ADD: "cm_SaveTabs" and "cm_LoadTabs" may now accept more than a single parameter. For specifying the filename it may be "filename=".
ADD: "cm_SaveTabs" may now accept parameter "savedirhistory=" to indicate if we want to save history or not (default is yes respecting legacy).
ADD: "cm_LoadTabs" may now accept parameter "loadlefto=" and "loadrightto=" to indicate where to load the tabs that were saved in left and right panel. For each, the possible values are left, right, active, inactive, both and none.
ADD: "cm_LoadTabs" may now accept parameter "keep=" to make it not erase the existing tabs when in the notebook when loading the new tabs from file.
ADD: Tabs popup menu and the main menu tabs are now more similar. The term "more similar" stands for the fact that some popup action may apply on an inactive tab we right click on it. So for legacy, this is respected.
ADD: New internal command "cm_ConfigFolderTabs" to bring the configuration of the tabs. Was also matched with TC command "cm_DirTabsConfig" for import/export with TC.
ADD: New internal commands to affect all tabs locked state at once: "cm_SetAllTabsOptionNormal", "cm_SetAllTabsOptionPathLocked", "cm_SetAllTabsOptionPathResets" and "cm_SetAllTabsOptionDirsInNewTab".
ADD: Above mentioned four new commands "side=" to determine on which panel it will apply (left, right, active, inactive and both).
ADD: Regarding the folder tabs configuration, add the option "Keep renamed name when unlocking a tab" (default, for legacy, is false).
ADD: Still with this, add the "Confirm close locked tabs" option with default false for legacy.
ADD: Still with this, add the "Reuse existing tab when possible" option (it was written TODO in the source).
ADD: Still with this, add the "Always show drive letter in tab title" option to make it like TC for those who sometimes work with same folder names in many drives.
ADD: Still with this, add the "Close duplicate tabs when closing application" option. This way it may do a silent clean up when quiting and restarting a session.
ADD: Add an option to configure what it does when double click on a tab. It may now be "Close tab" (default, for legacy), but also "Access Favorite Tabs", "Tabs popup men" and "nothing" for those who hated the tab closed when they double-click on tab by accident.
ADD: Add confirmation dialog when quitting folder tabs configuration without having saved modified settings.
ADD: When closing multiple tabs and there are locked tabs, we may now click "ALL" once to close all at them at once without having to confirm each one.
APD: Update mention to year "2016" in affected source files.
2016-01-30 16:13:42 +00:00

768 lines
21 KiB
ObjectPascal

{
Double Commander
-------------------------------------------------------------------------
This unit contains TFileViewPage and TFileViewNotebook objects.
Copyright (C) 2016 Alexander Koblov (alexx2000@mail.ru)
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit uFileViewNotebook;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls, ComCtrls, LMessages,
LCLType, LCLVersion, Forms,
uFileView, uFilePanelSelect, uDCVersion, DCXmlConfig;
type
TTabLockState = (
tlsNormal, //<en Default state.
tlsPathLocked, //<en Path changes are not allowed.
tlsPathResets, //<en Path is reset when activating the tab.
tlsDirsInNewTab); //<en Path change opens a new tab.
TFileViewNotebook = class;
{ TFileViewPage }
TFileViewPage = class(TTabSheet)
private
FLockState: TTabLockState;
FLockPath: String; //<en Path on which tab is locked
{$IF DEFINED(LCLQT) and (LCL_FULLVERSION < 093100)}
FSettingCaption: Boolean;
{$ENDIF}
FOnActivate: TNotifyEvent;
FCurrentTitle: String;
FPermanentTitle: String;
procedure AssignPage(OtherPage: TFileViewPage);
procedure AssignProperties(OtherPage: TFileViewPage);
{en
Retrieves the file view on this page.
}
function GetFileView: TFileView;
{en
Retrieves notebook on which this page is.
}
function GetNotebook: TFileViewNotebook;
{en
Frees current file view and assigns a new one.
}
procedure SetFileView(aFileView: TFileView);
procedure SetLockState(NewLockState: TTabLockState);
procedure SetPermanentTitle(AValue: String);
procedure DoActivate;
protected
procedure PaintWindow(DC: HDC); override;
{$IF (DEFINED(LCLQT) and (LCL_FULLVERSION < 093100)) or DEFINED(MSWINDOWS)}
procedure RealSetText(const AValue: TCaption); override;
{$ENDIF}
procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND;
public
constructor Create(TheOwner: TComponent); override;
{$IF DEFINED(LCLQT) and (LCL_FULLVERSION < 093100)}
function HandleObjectShouldBeVisible: boolean; override;
{$ENDIF}
function IsActive: Boolean;
procedure MakeActive;
procedure UpdateTitle;
procedure LoadConfiguration(AConfig: TXmlConfig; ANode: TXmlNode);
procedure SaveConfiguration(AConfig: TXmlConfig; ANode: TXmlNode);
property LockState: TTabLockState read FLockState write SetLockState;
property LockPath: String read FLockPath write FLockPath;
property FileView: TFileView read GetFileView write SetFileView;
property Notebook: TFileViewNotebook read GetNotebook;
property PermanentTitle: String read FPermanentTitle write SetPermanentTitle;
property CurrentTitle: String read FCurrentTitle;
property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
end;
{ TFileViewNotebook }
{$IF (LCL_FULLVERSION >= 1020000)}
TFileViewNotebook = class(TPageControl)
{$ELSE}
TFileViewNotebook = class(TCustomTabControl)
{$ENDIF}
private
FNotebookSide: TFilePanelSelect;
FStartDrag: Boolean;
FDraggedPageIndex: Integer;
FHintPageIndex: Integer;
FLastMouseDownTime: TDateTime;
FLastMouseDownPageIndex: Integer;
function GetActivePage: TFileViewPage;
function GetActiveView: TFileView;
function GetFileViewOnPage(Index: Integer): TFileView;
function GetPage(Index: Integer): TFileViewPage; reintroduce;
procedure DragOverEvent(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure DragDropEvent(Sender, Source: TObject; X, Y: Integer);
protected
procedure DoChange; override;
procedure MouseDown(Button: TMouseButton; 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 WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND;
public
constructor Create(ParentControl: TWinControl;
NotebookSide: TFilePanelSelect); reintroduce;
{$IFDEF MSWINDOWS}
{en
Removes the rectangle of the pages contents from erasing background to reduce flickering.
This is not needed on non-Windows because EraseBackground is not used there.
}
procedure EraseBackground(DC: HDC); override;
procedure WndProc(var Message: TLMessage); override;
{$ENDIF}
function AddPage: TFileViewPage;
function InsertPage(Index: Integer): TFileViewPage; reintroduce;
function NewEmptyPage: TFileViewPage;
function NewPage(CloneFromPage: TFileViewPage): TFileViewPage;
function NewPage(CloneFromView: TFileView): TFileViewPage;
procedure RemovePage(Index: Integer); reintroduce;
procedure RemovePage(var aPage: TFileViewPage);
procedure DestroyAllPages;
procedure ActivatePrevTab;
procedure ActivateNextTab;
property ActivePage: TFileViewPage read GetActivePage;
property ActiveView: TFileView read GetActiveView;
property DoubleClickPageIndex: Integer read FLastMouseDownPageIndex;
property Page[Index: Integer]: TFileViewPage read GetPage;
property View[Index: Integer]: TFileView read GetFileViewOnPage; default;
property Side: TFilePanelSelect read FNotebookSide;
published
property OnDblClick;
property OnChange;
property OnMouseDown;
property OnMouseUp;
end;
implementation
uses
LCLIntf,
LazUTF8,
DCStrUtils,
uGlobs,
uArchiveFileSource
{$IF DEFINED(LCLGTK2)}
, Glib2, Gtk2
{$ENDIF}
{$IF DEFINED(LCLQT) and (LCL_FULLVERSION < 093100)}
, qt4, qtwidgets
{$ENDIF}
{$IF DEFINED(MSWINDOWS)}
, win32proc, Windows, Messages
{$ENDIF}
;
// -- TFileViewPage -----------------------------------------------------------
procedure TFileViewPage.AssignPage(OtherPage: TFileViewPage);
begin
AssignProperties(OtherPage);
SetFileView(nil); // Remove previous view.
OtherPage.FileView.Clone(Self);
end;
procedure TFileViewPage.AssignProperties(OtherPage: TFileViewPage);
begin
FLockState := OtherPage.FLockState;
FLockPath := OtherPage.FLockPath;
FCurrentTitle := OtherPage.FCurrentTitle;
FPermanentTitle := OtherPage.FPermanentTitle;
end;
constructor TFileViewPage.Create(TheOwner: TComponent);
begin
FLockState := tlsNormal;
{$IF DEFINED(LCLQT) and (LCL_FULLVERSION < 093100)}
FSettingCaption := False;
{$ENDIF}
inherited Create(TheOwner);
end;
{$IF DEFINED(LCLQT) and (LCL_FULLVERSION < 093100)}
// On QT after handle is created but before the widget is visible
// setting caption fails unless the notebook and all its parents are
// set as Visible and the current page is the one of which we set caption.
// Overriding HandleObjectShouldBeVisible is a indirect workaround for that
// (see TQtPage.getIndex.CanReturnIndex).
// QT 4.6 or higher needed for this workaround.
function TFileViewPage.HandleObjectShouldBeVisible: boolean;
var
AParent: QTabWidgetH;
begin
if not HandleAllocated then
Result := inherited
else
begin
AParent := TQtPage(Handle).getTabWidget;
Result := (FSettingCaption and ((AParent = nil) or not QWidget_isVisible(AParent))) or
inherited;
end;
end;
{$ENDIF}
{$IF (DEFINED(LCLQT) and (LCL_FULLVERSION < 093100)) or DEFINED(MSWINDOWS)}
procedure TFileViewPage.RealSetText(const AValue: TCaption);
begin
{$IF DEFINED(LCLQT)}
FSettingCaption := True;
{$ENDIF}
inherited;
{$IF DEFINED(MSWINDOWS)}
if HandleAllocated then
LCLControlSizeNeedsUpdate(Parent, True);
{$ENDIF}
{$IF DEFINED(LCLQT)}
FSettingCaption := False;
{$ENDIF}
end;
{$ENDIF}
function TFileViewPage.IsActive: Boolean;
begin
Result := Assigned(Notebook) and (Notebook.PageIndex = PageIndex);
end;
procedure TFileViewPage.LoadConfiguration(AConfig: TXmlConfig; ANode: TXmlNode);
begin
FLockState := TTabLockState(AConfig.GetValue(ANode, 'Options', Integer(tlsNormal)));
FLockPath := AConfig.GetValue(ANode, 'LockPath', '');
FPermanentTitle := AConfig.GetValue(ANode, 'Title', '');
end;
procedure TFileViewPage.SaveConfiguration(AConfig: TXmlConfig; ANode: TXmlNode);
begin
AConfig.AddValueDef(ANode, 'Options', Integer(FLockState), Integer(tlsNormal));
AConfig.AddValueDef(ANode, 'LockPath', FLockPath, '');
AConfig.AddValueDef(ANode, 'Title', FPermanentTitle, '');
end;
procedure TFileViewPage.MakeActive;
var
aFileView: TFileView;
begin
if Assigned(Notebook) then
begin
Notebook.PageIndex := PageIndex;
aFileView := FileView;
if Assigned(aFileView) then
aFileView.SetFocus;
end;
end;
procedure TFileViewPage.PaintWindow(DC: HDC);
begin
// Don't paint anything.
end;
procedure TFileViewPage.UpdateTitle;
{$IFDEF MSWINDOWS}
function LocalGetDriveName(A:string):string;
begin
result:=LowerCase(ExtractFileDrive(A));
if length(result)>2 then // Server path name are shown simply like \: in TC so let's do the same for those who get used to that.
result:='\:'
else
if Lowercase(A) = (result+DirectorySeparator) then
result:=''; //To avoid to get "c:C:" :-)
end;
{$ENDIF}
var
NewCaption: String;
begin
if Assigned(FileView) then
begin
if FPermanentTitle <> '' then
begin
NewCaption := FPermanentTitle;
FCurrentTitle := FPermanentTitle;
end
else
begin
if (FileView.FileSource is TArchiveFileSource) and
(FileView.FileSource.IsPathAtRoot(FileView.CurrentPath)) then
begin
with (FileView.FileSource as TArchiveFileSource) do
NewCaption := ExtractFileName(ArchiveFileName);
end
else
begin
NewCaption := FileView.CurrentPath;
if NewCaption <> '' then
NewCaption := GetLastDir(NewCaption);
end;
FCurrentTitle := NewCaption;
end;
{$IFDEF MSWINDOWS}
if tb_show_drive_letter in gDirTabOptions then
begin
if (FileView.FileSource is TArchiveFileSource) then
with (FileView.FileSource as TArchiveFileSource) do NewCaption := LocalGetDriveName(ArchiveFileName) + NewCaption
else
NewCaption := LocalGetDriveName(FileView.CurrentPath) + NewCaption;
end;
{$ENDIF}
if (FLockState in [tlsPathLocked, tlsPathResets, tlsDirsInNewTab]) and
(tb_show_asterisk_for_locked in gDirTabOptions) then
NewCaption := '*' + NewCaption;
if (tb_text_length_limit in gDirTabOptions) and (UTF8Length(NewCaption) > gDirTabLimit) then
NewCaption := UTF8Copy(NewCaption, 1, gDirTabLimit) + '...';
{$IF DEFINED(LCLGTK2)}
Caption := NewCaption;
{$ELSE}
Caption := StringReplace(NewCaption, '&', '&&', [rfReplaceAll]);
{$ENDIF}
end;
end;
procedure TFileViewPage.WMEraseBkgnd(var Message: TLMEraseBkgnd);
begin
Message.Result := 1;
end;
function TFileViewPage.GetFileView: TFileView;
begin
if ComponentCount > 0 then
Result := TFileView(Components[0])
else
Result := nil;
end;
procedure TFileViewPage.SetFileView(aFileView: TFileView);
var
aComponent: TComponent;
begin
if ComponentCount > 0 then
begin
aComponent := Components[0];
aComponent.Free;
end;
if Assigned(aFileView) then
begin
aFileView.Parent := Self;
end;
end;
function TFileViewPage.GetNotebook: TFileViewNotebook;
begin
Result := Parent as TFileViewNotebook;
end;
procedure TFileViewPage.SetLockState(NewLockState: TTabLockState);
begin
if FLockState = NewLockState then Exit;
if NewLockState in [tlsPathLocked, tlsPathResets, tlsDirsInNewTab] then
begin
LockPath := FileView.CurrentPath;
if (FLockState <> tlsNormal) or (Length(FPermanentTitle) = 0) then
FPermanentTitle := GetLastDir(LockPath);
end
else
begin
LockPath := '';
if not (tb_keep_renamed_when_back_normal in gDirTabOptions) then
FPermanentTitle := '';
end;
FLockState := NewLockState;
UpdateTitle;
end;
procedure TFileViewPage.SetPermanentTitle(AValue: String);
begin
if FPermanentTitle = AValue then Exit;
FPermanentTitle := AValue;
UpdateTitle;
end;
procedure TFileViewPage.DoActivate;
begin
if Assigned(FOnActivate) then
FOnActivate(Self);
end;
// -- TFileViewNotebook -------------------------------------------------------
constructor TFileViewNotebook.Create(ParentControl: TWinControl;
NotebookSide: TFilePanelSelect);
begin
PageClass := TFileViewPage;
inherited Create(ParentControl);
ControlStyle := ControlStyle + [csNoFocus];
Parent := ParentControl;
TabStop := False;
ShowHint := True;
FHintPageIndex := -1;
FNotebookSide := NotebookSide;
FStartDrag := False;
{$IFDEF MSWINDOWS}
// The pages contents are removed from drawing background in EraseBackground.
// But double buffering could be enabled to eliminate flickering of drawing
// the tabs buttons themselves. But currently there's a bug where the buffer
// bitmap is temporarily drawn in different position, probably at (0,0) and
// not where pages contents start (after applying TCM_ADJUSTRECT).
//DoubleBuffered := True;
{$ENDIF}
OnDragOver := @DragOverEvent;
OnDragDrop := @DragDropEvent;
end;
function TFileViewNotebook.GetActivePage: TFileViewPage;
begin
if PageIndex <> -1 then
Result := GetPage(PageIndex)
else
Result := nil;
end;
function TFileViewNotebook.GetActiveView: TFileView;
var
APage: TFileViewPage;
begin
APage := GetActivePage;
if Assigned(APage) then
Result := APage.FileView
else
Result := nil;
end;
function TFileViewNotebook.GetFileViewOnPage(Index: Integer): TFileView;
var
APage: TFileViewPage;
begin
APage := GetPage(Index);
Result := APage.FileView;
end;
function TFileViewNotebook.GetPage(Index: Integer): TFileViewPage;
begin
Result := TFileViewPage(CustomPage(Index));
end;
function TFileViewNotebook.AddPage: TFileViewPage;
begin
Result := InsertPage(PageCount);
end;
function TFileViewNotebook.InsertPage(Index: Integer): TFileViewPage;
begin
Tabs.Insert(Index, '');
Result := GetPage(Index);
ShowTabs:= ((PageCount > 1) or (tb_always_visible in gDirTabOptions)) and gDirectoryTabs;
end;
function TFileViewNotebook.NewEmptyPage: TFileViewPage;
begin
if tb_open_new_near_current in gDirTabOptions then
Result := InsertPage(PageIndex + 1)
else
Result := InsertPage(PageCount);
end;
function TFileViewNotebook.NewPage(CloneFromPage: TFileViewPage): TFileViewPage;
begin
if Assigned(CloneFromPage) then
begin
Result := NewEmptyPage;
Result.AssignPage(CloneFromPage);
end
else
Result := nil;
end;
function TFileViewNotebook.NewPage(CloneFromView: TFileView): TFileViewPage;
begin
if Assigned(CloneFromView) then
begin
Result := NewEmptyPage;
CloneFromView.Clone(Result);
end
else
Result := nil;
end;
procedure TFileViewNotebook.RemovePage(Index: Integer);
begin
{$IFDEF LCLGTK2}
// If removing currently active page, switch to another page first.
// Otherwise there can be no page selected.
if (PageIndex = Index) and (PageCount > 1) then
begin
if Index = PageCount - 1 then
Page[Index - 1].MakeActive
else
Page[Index + 1].MakeActive;
end;
{$ENDIF}
Page[Index].Free;
ShowTabs:= ((PageCount > 1) or (tb_always_visible in gDirTabOptions)) and gDirectoryTabs;
{$IFNDEF LCLGTK2}
// Force-activate current page.
if PageIndex <> -1 then
Page[PageIndex].MakeActive;
{$ENDIF}
end;
procedure TFileViewNotebook.RemovePage(var aPage: TFileViewPage);
begin
RemovePage(aPage.PageIndex);
aPage := nil;
end;
procedure TFileViewNotebook.WMEraseBkgnd(var Message: TLMEraseBkgnd);
begin
inherited WMEraseBkgnd(Message);
// Always set as handled otherwise if not handled Windows will draw background
// with hbrBackground brush of the window class. This might cause flickering
// because later background will be again be erased but with TControl.Brush.
// This is not actually needed on non-Windows because WMEraseBkgnd is not used there.
Message.Result := 1;
end;
procedure TFileViewNotebook.DestroyAllPages;
var
tPage:TFileViewPage;
begin
while PageCount > 0 do
begin
tPage:=Page[0];
if tPage<>nil then FreeAndNil(tPage);
end;
end;
procedure TFileViewNotebook.ActivatePrevTab;
begin
if PageIndex = 0 then
Page[PageCount - 1].MakeActive
else
Page[PageIndex - 1].MakeActive;
end;
procedure TFileViewNotebook.ActivateNextTab;
begin
if PageIndex = PageCount - 1 then
Page[0].MakeActive
else
Page[PageIndex + 1].MakeActive;
end;
procedure TFileViewNotebook.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
{$IF DEFINED(LCLGTK2)}
var
ArrowWidth: Integer;
arrow_spacing: gint = 0;
scroll_arrow_hlength: gint = 16;
{$ENDIF}
begin
inherited;
if Button = mbLeft then
begin
FDraggedPageIndex := TabIndexAtClientPos(Classes.Point(X, Y));
FStartDrag := (FDraggedPageIndex <> -1);
end;
// Emulate double click
if (Button = mbLeft) and Assigned(OnDblClick) then
begin
if ((Now - FLastMouseDownTime) > ((1/86400)*(GetDoubleClickTime/1000))) then
begin
FLastMouseDownTime:= Now;
FLastMouseDownPageIndex:= FDraggedPageIndex;
end
else if (FDraggedPageIndex = FLastMouseDownPageIndex) then
begin
{$IF DEFINED(LCLGTK2)}
gtk_widget_style_get(PGtkWidget(Self.Handle),
'arrow-spacing', @arrow_spacing,
'scroll-arrow-hlength', @scroll_arrow_hlength,
nil);
ArrowWidth:= arrow_spacing + scroll_arrow_hlength;
if (X > ArrowWidth) and (X < ClientWidth - ArrowWidth) then
{$ENDIF}
OnDblClick(Self);
FStartDrag:= False;
FLastMouseDownTime:= 0;
FLastMouseDownPageIndex:= -1;
end;
end;
end;
procedure TFileViewNotebook.MouseMove(Shift: TShiftState; X, Y: Integer);
var
ATabIndex: Integer;
begin
inherited;
if ShowHint then
begin
ATabIndex := TabIndexAtClientPos(Classes.Point(X, Y));
if (ATabIndex >= 0) and (ATabIndex <> FHintPageIndex) then
begin
FHintPageIndex := ATabIndex;
Application.CancelHint;
if (ATabIndex <> PageIndex) and (Length(Page[ATabIndex].LockPath) <> 0) then
Hint := Page[ATabIndex].LockPath
else
Hint := View[ATabIndex].CurrentPath;
end;
end;
if FStartDrag then
begin
FStartDrag := False;
BeginDrag(False);
end;
end;
procedure TFileViewNotebook.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
FStartDrag := False;
end;
procedure TFileViewNotebook.DragOverEvent(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
ATabIndex: Integer;
begin
if (Source is TFileViewNotebook) and (Sender is TFileViewNotebook) then
begin
ATabIndex := TabIndexAtClientPos(Classes.Point(X, Y));
Accept := (Source <> Sender) or
((ATabIndex <> -1) and (ATabIndex <> FDraggedPageIndex));
end
else
Accept := False;
end;
{$IFDEF MSWINDOWS}
procedure TFileViewNotebook.EraseBackground(DC: HDC);
var
ARect: TRect;
SaveIndex: Integer;
Clip: Integer;
begin
if HandleAllocated and (DC <> 0) then
begin
ARect := Classes.Rect(0, 0, Width, Height);
Windows.TabCtrl_AdjustRect(Handle, False, ARect);
SaveIndex := SaveDC(DC);
Clip := ExcludeClipRect(DC, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
if Clip <> NullRegion then
begin
ARect := Classes.Rect(0, 0, Width, Height);
FillRect(DC, ARect, HBRUSH(Brush.Reference.Handle));
end;
RestoreDC(DC, SaveIndex);
end;
end;
procedure TFileViewNotebook.WndProc(var Message: TLMessage);
begin
inherited WndProc(Message);
if Message.Msg = TCM_ADJUSTRECT then
begin
if Message.WParam = 0 then
PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left - 2
else begin
PRect(Message.LParam)^.Left := PRect(Message.LParam)^.Left + 2;
end;
end;
end;
{$ENDIF}
procedure TFileViewNotebook.DragDropEvent(Sender, Source: TObject; X, Y: Integer);
var
SourceNotebook: TFileViewNotebook;
ATabIndex: Integer;
ANewPage, DraggedPage: TFileViewPage;
begin
if (Source is TFileViewNotebook) and (Sender is TFileViewNotebook) then
begin
ATabIndex := TabIndexAtClientPos(Classes.Point(X, Y));
if Source = Sender then
begin
// Move within the same panel.
if ATabIndex <> -1 then
Tabs.Move(FDraggedPageIndex, ATabIndex);
end
else
begin
// Move page between panels.
SourceNotebook := (Source as TFileViewNotebook);
DraggedPage := SourceNotebook.Page[SourceNotebook.FDraggedPageIndex];
if ATabIndex = -1 then
ATabIndex := PageCount;
// Create a clone of the page in the panel.
ANewPage := InsertPage(ATabIndex);
ANewPage.AssignPage(DraggedPage);
ANewPage.MakeActive;
if (ssShift in GetKeyShiftState) and (SourceNotebook.PageCount > 1) then
begin
// Remove page from source panel.
SourceNotebook.RemovePage(DraggedPage);
end;
end;
end;
end;
procedure TFileViewNotebook.DoChange;
begin
inherited DoChange;
ActivePage.DoActivate;
end;
end.