prevent closing all the widgets when locked

the editor is still always locked.
This commit is contained in:
Basile Burg 2015-08-31 17:46:06 +02:00
parent 79f70381e4
commit be20059d6b
5 changed files with 24 additions and 16 deletions

View File

@ -6,7 +6,6 @@ inherited CEEditorWidget: TCEEditorWidget
Caption = 'Source editor' Caption = 'Source editor'
ClientHeight = 406 ClientHeight = 406
ClientWidth = 465 ClientWidth = 465
OnCloseQuery = FormCloseQuery
inherited Back: TPanel inherited Back: TPanel
Height = 406 Height = 406
Width = 465 Width = 465

View File

@ -34,7 +34,6 @@ type
macRecorder: TSynMacroRecorder; macRecorder: TSynMacroRecorder;
editorStatus: TStatusBar; editorStatus: TStatusBar;
mnuEditor: TPopupMenu; mnuEditor: TPopupMenu;
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure mnuedCopyClick(Sender: TObject); procedure mnuedCopyClick(Sender: TObject);
procedure mnuedCutClick(Sender: TObject); procedure mnuedCutClick(Sender: TObject);
procedure mnuEditorPopup(Sender: TObject); procedure mnuEditorPopup(Sender: TObject);
@ -81,6 +80,7 @@ type
public public
constructor create(aOwner: TComponent); override; constructor create(aOwner: TComponent); override;
destructor destroy; override; destructor destroy; override;
function closeQuery: boolean; override;
end; end;
implementation implementation
@ -144,11 +144,10 @@ begin
inherited; inherited;
end; end;
procedure TCEEditorWidget.FormCloseQuery(Sender: TObject; var CanClose: boolean); function TCEEditorWidget.closeQuery: boolean;
begin begin
// grants the window not to be undocked. result := inherited;
// additional fix, depend on of http://bugs.freepascal.org/view.php?id=28325 result := result and (Parent = nil);
CanClose := Parent = nil;
end; end;
{$ENDREGION} {$ENDREGION}

View File

@ -154,8 +154,8 @@ var
toolItem: TToolInfo; toolItem: TToolInfo;
begin begin
inherited; inherited;
fModal := true; fIsModal := true;
fDockable := false; fIsDockable := false;
// //
toolItem := TToolInfo.Construct(self, tikRunning, 'dcd-server'); toolItem := TToolInfo.Construct(self, tikRunning, 'dcd-server');
toolItem.Parent := boxTools; toolItem.Parent := boxTools;

View File

@ -66,8 +66,8 @@ var
png: TPortableNetworkGraphic; png: TPortableNetworkGraphic;
begin begin
inherited; inherited;
fDockable := false; fIsDockable := false;
fModal:= true; fIsModal:= true;
fEdOptsSubj := TCEEditableOptionsSubject.create; fEdOptsSubj := TCEEditableOptionsSubject.create;
inspector.CheckboxForBoolean := true; inspector.CheckboxForBoolean := true;
inspector.PropertyEditorHook.AddHandlerModified(@inspectorModified); inspector.PropertyEditorHook.AddHandlerModified(@inspectorModified);

View File

@ -31,10 +31,10 @@ type
procedure updaterAutoProc(Sender: TObject); procedure updaterAutoProc(Sender: TObject);
procedure updaterLatchProc(Sender: TObject); procedure updaterLatchProc(Sender: TObject);
protected protected
fDockable: boolean; fIsDockable: boolean;
fModal: boolean; fIsModal: boolean;
fID: string; fID: string;
// a descendant overrides to implementi a periodic update. // a descendant overrides to implement a periodic update.
procedure updateLoop; virtual; procedure updateLoop; virtual;
// a descendant overrides to implement an imperative update. // a descendant overrides to implement an imperative update.
procedure updateImperative; virtual; procedure updateImperative; virtual;
@ -52,6 +52,8 @@ type
public public
constructor create(aOwner: TComponent); override; constructor create(aOwner: TComponent); override;
destructor destroy; override; destructor destroy; override;
// prevent closing when 'locked' is cjecked in the header context menu
function closeQuery: boolean; override;
// restarts the wait period to the delayed update event. // restarts the wait period to the delayed update event.
// if not re-called during 'updaterByDelayDuration' ms then // if not re-called during 'updaterByDelayDuration' ms then
// 'UpdateByDelay' is called once. // 'UpdateByDelay' is called once.
@ -77,7 +79,7 @@ type
// returns true if one of the three updater is processing. // returns true if one of the three updater is processing.
property updating: boolean read fUpdating; property updating: boolean read fUpdating;
// true by default, allow a widget to be docked. // true by default, allow a widget to be docked.
property isDockable: boolean read fDockable; property isDockable: boolean read fIsDockable;
// not if isDockable, otherwise a the widget is shown as modal form. // not if isDockable, otherwise a the widget is shown as modal form.
property isModal: boolean read getIfModal; property isModal: boolean read getIfModal;
end; end;
@ -118,7 +120,7 @@ var
itm: TmenuItem; itm: TmenuItem;
begin begin
inherited; inherited;
fDockable := true; fIsDockable := true;
fUpdaterAuto := TTimer.Create(self); fUpdaterAuto := TTimer.Create(self);
fUpdaterAuto.Interval := 70; fUpdaterAuto.Interval := 70;
fUpdaterAuto.OnTimer := @updaterAutoProc; fUpdaterAuto.OnTimer := @updaterAutoProc;
@ -144,10 +146,18 @@ begin
inherited; inherited;
end; end;
function TCEWidget.closeQuery: boolean;
begin
result := inherited;
if fIsDockable and (not DockMaster.AllowDragging) and not
(DockMaster.GetAnchorSite(self).GetTopParent = DockMaster.GetAnchorSite(self)) then
result := false;
end;
function TCEWidget.getIfModal: boolean; function TCEWidget.getIfModal: boolean;
begin begin
if isDockable then result := false if isDockable then result := false
else result := fModal; else result := fIsModal;
end; end;
procedure TCEWidget.showWidget; procedure TCEWidget.showWidget;