You've already forked lazarus-ccr
manual docker added
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@708 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
254
components/manualdock/mandocking.pas
Normal file
254
components/manualdock/mandocking.pas
Normal file
@ -0,0 +1,254 @@
|
||||
unit mandocking;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Types,
|
||||
Forms,
|
||||
SysUtils,
|
||||
Controls,
|
||||
ExtCtrls,
|
||||
ProjectIntf,
|
||||
LazIDEIntf,
|
||||
MenuIntf,
|
||||
IDEMsgIntf,
|
||||
SrcEditorIntf,
|
||||
XMLConf;
|
||||
|
||||
procedure Register;
|
||||
|
||||
resourcestring
|
||||
mnuDockMsgWindow = 'Dock "Messages" window';
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
TDockState = record
|
||||
Docked : Boolean;
|
||||
FloatRect : TRect;
|
||||
FloatBrd : TFormBorderStyle;
|
||||
DockSize : TSize;
|
||||
end;
|
||||
|
||||
{ TManualDocker }
|
||||
|
||||
TManualDocker = class(TObject)
|
||||
protected
|
||||
procedure ChangeDocking(DockingEnabled: Boolean);
|
||||
procedure LoadState(cfg: TXMLConfig; var Astate: TDockState; const StateName: string);
|
||||
procedure SaveState(cfg: TXMLConfig; const Astate: TDockState; const StateName: string);
|
||||
procedure LoadStates;
|
||||
procedure SaveStates;
|
||||
|
||||
procedure AllocControls(AParent: TWinControl);
|
||||
procedure RealignControls;
|
||||
procedure UpdateDockState(var astate: TDockState; wnd: TWinControl);
|
||||
public
|
||||
ConfigPath : AnsiString;
|
||||
split : TSplitter;
|
||||
panel : TPanel;
|
||||
MsgWnd : TDockState;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure OnCmdClick(Sender: TObject);
|
||||
function OnProjectOpen(Sender: TObject; AProject: TLazProject): TModalResult;
|
||||
end;
|
||||
|
||||
var
|
||||
cmd : TIDEMenuCommand = nil;
|
||||
docker : TManualDocker = nil;
|
||||
|
||||
const
|
||||
DockCfgRoot = 'ManualDockConfig';
|
||||
DockCfgXML = 'manualdockconfig.xml';
|
||||
MsgDockedName = 'Messages';
|
||||
|
||||
{ TManualDocker }
|
||||
|
||||
function SafeRect(const c: TREct; MinWidth, MinHeight: Integer): TRect;
|
||||
begin
|
||||
Result := c;
|
||||
if Result.Top < 0 then Result.Top := 0;
|
||||
if Result.Left < 0 then Result.Left := 0;
|
||||
if c.Right - c.Left < MinWidth then Result.Right := Result.Left + MinWidth;
|
||||
if c.Bottom - c.Top < MinHeight then Result.Bottom := Result.Top + MinHeight;
|
||||
end;
|
||||
|
||||
function Max(a, b: Integer): Integer;
|
||||
begin
|
||||
if a > b then Result := a
|
||||
else Result := b;
|
||||
end;
|
||||
|
||||
procedure TManualDocker.ChangeDocking(DockingEnabled: Boolean);
|
||||
begin
|
||||
if DockingEnabled then begin
|
||||
if not Assigned(SourceEditorWindow) or not Assigned(IDEMessagesWindow) then Exit;
|
||||
if not Assigned(panel) then AllocControls(SourceEditorWindow);
|
||||
split.visible:=true;
|
||||
panel.visible:=true;
|
||||
with IDEMessagesWindow do
|
||||
if IDEMessagesWindow.Parent = nil then begin
|
||||
MsgWnd.FloatRect := Bounds(Left, Top, Width, Height);
|
||||
MsgWnd.FloatBrd := IDEMessagesWindow.BorderStyle;
|
||||
end;
|
||||
IDEMessagesWindow.Parent := panel;
|
||||
IDEMessagesWindow.Align := alClient;
|
||||
IDEMessagesWindow.BorderStyle := bsNone;
|
||||
IDEMessagesWindow.TabStop := false;
|
||||
panel.Height := MsgWnd.DockSize.cy;
|
||||
end else begin
|
||||
if Assigned(panel) then begin
|
||||
panel.visible := false;
|
||||
UpdateDockState(MsgWnd, panel);
|
||||
end;
|
||||
if Assigned(split) then split.visible := false;
|
||||
IDEMessagesWindow.Parent := nil;
|
||||
with MsgWnd do begin
|
||||
IDEMessagesWindow.BoundsRect := SafeRect(FloatRect,
|
||||
Max(30, IDEMessagesWindow.ClientWidth), Max(30, IDEMessagesWindow.ClientHeight));
|
||||
IDEMessagesWindow.BorderStyle := FloatBrd;
|
||||
end;
|
||||
IDEMessagesWindow.TabStop := true;
|
||||
end;
|
||||
MsgWnd.docked := DockingEnabled;
|
||||
cmd.Checked := DockingEnabled;
|
||||
end;
|
||||
|
||||
constructor TManualDocker.Create;
|
||||
var
|
||||
pths : array [0..1] of String;
|
||||
i : Integer;
|
||||
begin
|
||||
pths[0]:= LazarusIDE.GetPrimaryConfigPath;
|
||||
pths[1]:= LazarusIDE.GetSecondaryConfigPath;
|
||||
for i := 0 to length(pths)-1 do begin
|
||||
try
|
||||
ConfigPath := IncludeTrailingPathDelimiter(pths[i])+DockCfgXML;
|
||||
LoadStates;
|
||||
Break;
|
||||
except
|
||||
end;
|
||||
end;
|
||||
MsgWnd.FloatBrd := bsToolWindow;
|
||||
end;
|
||||
|
||||
destructor TManualDocker.Destroy;
|
||||
begin
|
||||
if Assigned(panel) then UpdateDockState(MsgWnd, panel);
|
||||
SaveStates;
|
||||
split.Free;
|
||||
panel.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TManualDocker.OnCmdClick(Sender: TObject);
|
||||
begin
|
||||
ChangeDocking(not Cmd.Checked );
|
||||
end;
|
||||
|
||||
function TManualDocker.OnProjectOpen(Sender: TObject; AProject: TLazProject): TModalResult;
|
||||
begin
|
||||
if MsgWnd.Docked then ChangeDocking(true);
|
||||
Result := mrOK;
|
||||
end;
|
||||
|
||||
function CreateXMLConfig(const xmlfile: string) : TXMLConfig;
|
||||
begin
|
||||
Result := TXMLConfig.Create(nil);
|
||||
Result.RootName := DockCfgRoot;
|
||||
Result.Filename := xmlfile;
|
||||
end;
|
||||
|
||||
procedure TManualDocker.AllocControls(AParent: TWinControl);
|
||||
begin
|
||||
panel := TPanel.Create(nil);
|
||||
panel.Parent := AParent;
|
||||
panel.BorderStyle := bsNone;
|
||||
|
||||
split := TSplitter.Create(nil);
|
||||
split.Parent := AParent;
|
||||
|
||||
RealignControls;
|
||||
end;
|
||||
|
||||
procedure TManualDocker.RealignControls;
|
||||
begin
|
||||
panel.Align := alClient;
|
||||
split.Align := alClient;
|
||||
panel.Align := alBottom;
|
||||
split.Align := alBottom;
|
||||
end;
|
||||
|
||||
procedure TManualDocker.UpdateDockState(var astate: TDockState; wnd: TWinControl);
|
||||
begin
|
||||
astate.DockSize.cx := wnd.ClientWidth;
|
||||
astate.DockSize.cy := wnd.ClientHeight;
|
||||
end;
|
||||
|
||||
procedure TManualDocker.LoadState(cfg: TXMLConfig; var Astate: TDockState;
|
||||
const StateName: string);
|
||||
begin
|
||||
AState.docked := cfg.GetValue(StateName+'/docked', false);
|
||||
AState.FloatRect.Left := cfg.GetValue(StateName+'/float/left', -1);
|
||||
AState.FloatRect.Top := cfg.GetValue(StateName+'/float/top', -1);
|
||||
AState.FloatRect.Right := cfg.GetValue(StateName+'/float/right', -1);
|
||||
AState.FloatRect.Bottom := cfg.GetValue(StateName+'/float/bottom', -1);
|
||||
AState.DockSize.cx := cfg.GetValue(StateName+'/docked/cx', 30);
|
||||
AState.DockSize.cy := cfg.GetValue(StateName+'/docked/cy', 50);
|
||||
end;
|
||||
|
||||
procedure TManualDocker.SaveState(cfg: TXMLConfig; const Astate: TDockState; const StateName: string);
|
||||
begin
|
||||
cfg.SetValue(StateName+'/docked', AState.docked);
|
||||
cfg.SetValue(StateName+'/float/left', AState.FloatRect.Left);
|
||||
cfg.SetValue(StateName+'/float/top', AState.FloatRect.Top);
|
||||
cfg.SetValue(StateName+'/float/right', AState.FloatRect.Right);
|
||||
cfg.SetValue(StateName+'/float/bottom', AState.FloatRect.Bottom);
|
||||
cfg.SetValue(StateName+'/docked/cx', AState.DockSize.cx);
|
||||
cfg.SetValue(StateName+'/docked/cy', AState.DockSize.cy)
|
||||
end;
|
||||
|
||||
procedure TManualDocker.LoadStates;
|
||||
var
|
||||
cfg : TXMLConfig;
|
||||
begin
|
||||
cfg := CreateXMLConfig(ConfigPath);
|
||||
try
|
||||
LoadState(cfg, MsgWnd, MsgDockedName)
|
||||
finally
|
||||
cfg.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TManualDocker.SaveStates;
|
||||
var
|
||||
cfg : TXMLConfig;
|
||||
begin
|
||||
cfg := CreateXMLConfig(ConfigPath);
|
||||
try
|
||||
try
|
||||
SaveState(cfg, MsgWnd, MsgDockedName)
|
||||
finally
|
||||
cfg.Free;
|
||||
end;
|
||||
except
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
docker := TManualDocker.Create;
|
||||
cmd := RegisterIDEMenuCommand(itmViewMainWindows, 'makeMessagesDocked', mnuDockMsgWindow, @docker.OnCmdClick, nil, nil, '');
|
||||
LazarusIDE.AddHandlerOnProjectOpened(@docker.OnProjectOpen, false);
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
finalization
|
||||
docker.Free;
|
||||
|
||||
end.
|
||||
|
||||
45
components/manualdock/manualdock.lpk
Normal file
45
components/manualdock/manualdock.lpk
Normal file
@ -0,0 +1,45 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<Package Version="3">
|
||||
<Name Value="manualdock"/>
|
||||
<Author Value="Dmitry 'skalogryz' Boyarintsev"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="8"/>
|
||||
<SearchPaths>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Description Value="The extensions adds an ability to dock Messages window to the source editor "/>
|
||||
<Version Major="1"/>
|
||||
<Files Count="1">
|
||||
<Item1>
|
||||
<Filename Value="mandocking.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="mandocking"/>
|
||||
</Item1>
|
||||
</Files>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<RequiredPkgs Count="3">
|
||||
<Item1>
|
||||
<PackageName Value="IDEIntf"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="FCL"/>
|
||||
<MinVersion Major="1" Valid="True"/>
|
||||
</Item3>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)/"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IgnoreBinaries Value="False"/>
|
||||
</PublishOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
21
components/manualdock/manualdock.pas
Normal file
21
components/manualdock/manualdock.pas
Normal file
@ -0,0 +1,21 @@
|
||||
{ This file was automatically created by Lazarus. do not edit!
|
||||
This source is only used to compile and install the package.
|
||||
}
|
||||
|
||||
unit manualdock;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
mandocking, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('mandocking', @mandocking.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterPackage('manualdock', @Register);
|
||||
end.
|
||||
33
components/manualdock/readme.txt
Normal file
33
components/manualdock/readme.txt
Normal file
@ -0,0 +1,33 @@
|
||||
Copyright (c) 2009 Dmitry Boyarintsev
|
||||
You're free to use these sources in anyway you find useful.
|
||||
|
||||
= Manual Docker =
|
||||
|
||||
There's been a lot of patches and wishes for Messages window to be docked
|
||||
at the source editor of Lazarus IDE. All patches were eventually rejected,
|
||||
because Messages window must be dockable by using Docking manager, that's
|
||||
not yet fully implemented for all widgetset.
|
||||
|
||||
Keeping Messages window floating might be very annoying for some people,
|
||||
especially coming from Delphi.
|
||||
|
||||
|
||||
This IDE extension allows Messages window to dock to the source editor.
|
||||
|
||||
|
||||
== Installation ==
|
||||
|
||||
Download the extension sources.
|
||||
Copy the extensions source directory to Lazarus/Components directory.
|
||||
Start Lazarus IDE (if not started)
|
||||
Open installed packages manager Package->Configure installed packages...
|
||||
Select "manualdock 1.0" from "Available packages list"
|
||||
Press "Save and rebuild IDE".
|
||||
[edit]
|
||||
|
||||
== How-to Use ==
|
||||
|
||||
After Lazarus IDE is rebuilt with the extension, you should see
|
||||
an additional menu item at View menu, named "Dock Messages window".
|
||||
|
||||
Selecting this menu item will dock/undock messages window from the source editor.
|
||||
Reference in New Issue
Block a user