paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-04 14:14:51 +01:00
Code Issues Packages Projects Releases Wiki Activity

added package anchordockingdsgn

Browse Source 
git-svn-id: trunk@26003 -
This commit is contained in:
mattias 2010-06-09 07:18:54 +00:00
parent 9b2dc8742c
commit 52fc951dbd
5 changed files with 283 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitattributes vendored
View File

@ -2751,6 +2751,9 @@ examples/anchordocking/anchordocking.pas svneol=native#text/plain
examples/anchordocking/anchordockpkg.pas svneol=native#text/plain
examples/anchordocking/anchordockstorage.pas svneol=native#text/plain
examples/anchordocking/anchordockstr.pas svneol=native#text/plain
examples/anchordocking/design/anchordockingdsgn.lpk svneol=native#text/plain
examples/anchordocking/design/anchordockingdsgn.pas svneol=native#text/plain
examples/anchordocking/design/registeranchordocking.pas svneol=native#text/plain
examples/anchordocking/minide/miniide1.lpi svneol=native#text/plain
examples/anchordocking/minide/miniide1.lpr svneol=native#text/plain
examples/anchordocking/minide/simplefrm.lfm svneol=native#text/plain
@ -5120,6 +5123,7 @@ packager/confirmpkglistdlg.pas svneol=native#text/plain
packager/globallinks/README.txt svneol=native#text/plain
packager/globallinks/aggpaslcl-1.lpl svneol=native#text/plain
packager/globallinks/anchordocking-0.lpl svneol=native#text/plain
packager/globallinks/anchordockingdsgn-0.lpl svneol=native#text/plain
packager/globallinks/appforms-0.lpl svneol=native#text/plain
packager/globallinks/cgilaz-0.lpl svneol=native#text/plain
packager/globallinks/chmhelppkg-0.lpl svneol=native#text/plain

53
examples/anchordocking/design/anchordockingdsgn.lpk Normal file
View File

@ -0,0 +1,53 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="3">
<Name Value="AnchorDockingDsgn"/>
<Author Value="Mattias Gaertner mattias@freepascal.org"/>
<CompilerOptions>
<Version Value="8"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="True"/>
</SyntaxOptions>
</Parsing>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Description Value="Installs the anchor docking manager in the IDE
"/>
<License Value="GPL2 as the IDE
"/>
<Version Minor="5"/>
<Files Count="1">
<Item1>
<Filename Value="registeranchordocking.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="RegisterAnchorDocking"/>
</Item1>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="3">
<Item1>
<PackageName Value="IDEIntf"/>
</Item1>
<Item2>
<PackageName Value="AnchorDocking"/>
</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
examples/anchordocking/design/anchordockingdsgn.pas Normal file
View 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 anchordockingdsgn;
interface
uses
RegisterAnchorDocking, LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('RegisterAnchorDocking', @RegisterAnchorDocking.Register);
end;
initialization
RegisterPackage('AnchorDockingDsgn', @Register);
end.

204
examples/anchordocking/design/registeranchordocking.pas Normal file
View File

@ -0,0 +1,204 @@
{ Installs anchor docking manager in the Lazarus IDE.
Copyright (C) 2010 Mattias Gaertner mattias@freepascal.org
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version with the following modification:
As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,and
to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify
this library, you may extend this exception to your version of the library,
but you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your 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 Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit RegisterAnchorDocking;
{$mode objfpc}{$H+}
interface
uses
Math, Classes, SysUtils, LCLProc, Forms, Controls, FileUtil,
BaseIDEIntf, LazConfigStorage, LazIDEIntf, IDEWindowIntf, AnchorDocking;
const
DefaultConfigFileName = 'anchordocklayout.xml';
type
{ TIDEAnchorDockMaster }
TIDEAnchorDockMaster = class(TIDEDockMaster)
private
procedure DockMasterCreateControl(Sender: TObject; aName: string;
var AControl: TControl; DoDisableAutoSizing: boolean);
procedure GetDefaultBounds(AForm: TCustomForm; out Creator: TIDEWindowCreator;
out NewBounds: TRect; out DockSiblingName: string; out DockAlign: TAlign);
public
constructor Create;
destructor Destroy; override;
procedure MakeIDEWindowDockSite(AForm: TCustomForm); override;
procedure MakeIDEWindowDockable(AControl: TWinControl); override;
function GetDefaultLayoutFilename: string;
procedure LoadDefaultLayout; override;
procedure SaveDefaultLayout;
procedure ShowForm(AForm: TCustomForm; BringToFront: boolean); override;
procedure CloseAll; override;
procedure OnIDEClose(Sender: TObject);
end;
var
IDEAnchorDockMaster: TIDEAnchorDockMaster = nil;
procedure Register;
implementation
procedure Register;
begin
end;
{ TIDEAnchorDockMaster }
procedure TIDEAnchorDockMaster.DockMasterCreateControl(Sender: TObject;
aName: string; var AControl: TControl; DoDisableAutoSizing: boolean);
begin
debugln(['TIDEAnchorDockMaster.DockMasterCreateControl CtrlName="',dbgstr(AName),'"']);
AControl:=IDEWindowCreators.GetForm(aName,true,DoDisableAutoSizing);
debugln(['TIDEAnchorDockMaster.DockMasterCreateControl Result=',DbgSName(AControl)]);
end;
procedure TIDEAnchorDockMaster.GetDefaultBounds(AForm: TCustomForm; out
Creator: TIDEWindowCreator; out NewBounds: TRect; out
DockSiblingName: string; out DockAlign: TAlign);
begin
NewBounds:=Rect(0,0,0,0);
DockSiblingName:='';
DockAlign:=alNone;
Creator:=IDEWindowCreators.FindWithName(AForm.Name);
if Creator=nil then exit;
if Creator.OnGetLayout<>nil then
Creator.OnGetLayout(Self,AForm.Name,NewBounds,DockSiblingName,DockAlign)
else begin
Creator.GetDefaultBounds(AForm,NewBounds);
DockSiblingName:=Creator.DockSibling;
DockAlign:=Creator.DockAlign;
end;
NewBounds.Left:=Min(10000,Max(-10000,NewBounds.Left));
NewBounds.Top:=Min(10000,Max(-10000,NewBounds.Top));
NewBounds.Right:=Max(NewBounds.Left+100,NewBounds.Right);
NewBounds.Bottom:=Max(NewBounds.Top+100,NewBounds.Bottom);
end;
constructor TIDEAnchorDockMaster.Create;
begin
IDEAnchorDockMaster:=Self;
DockMaster.OnCreateControl:=@DockMasterCreateControl;
end;
destructor TIDEAnchorDockMaster.Destroy;
begin
IDEAnchorDockMaster:=nil;
inherited Destroy;
end;
procedure TIDEAnchorDockMaster.MakeIDEWindowDockSite(AForm: TCustomForm);
begin
DockMaster.MakeDockable(AForm,false);
end;
procedure TIDEAnchorDockMaster.MakeIDEWindowDockable(AControl: TWinControl);
begin
DockMaster.MakeDockable(AControl,false);
end;
function TIDEAnchorDockMaster.GetDefaultLayoutFilename: string;
begin
Result:=AppendPathDelim(LazarusIDE.GetPrimaryConfigPath)+DefaultConfigFileName;
end;
procedure TIDEAnchorDockMaster.LoadDefaultLayout;
var
Filename: String;
Config: TConfigStorage;
begin
Filename:=DefaultConfigFileName;
try
debugln(['TIDEAnchorDockMaster.LoadDefaultLayout ',Filename]);
Config:=GetIDEConfigStorage(Filename,true);
try
DockMaster.LoadLayoutFromConfig(Config);
finally
Config.Free;
end;
except
on E: Exception do begin
DebugLn(['TIDEAnchorDockMaster.LoadDefaultLayout loading ',Filename,' failed: ',E.Message]);
end;
end;
end;
procedure TIDEAnchorDockMaster.SaveDefaultLayout;
var
Filename: String;
Config: TConfigStorage;
begin
Filename:=DefaultConfigFileName;
try
debugln(['TIDEAnchorDockMaster.SaveDefaultLayout ',Filename]);
Config:=GetIDEConfigStorage(Filename,false);
try
DockMaster.SaveLayoutToConfig(Config);
finally
Config.Free;
end;
except
on E: Exception do begin
DebugLn(['TIDEAnchorDockMaster.SaveDefaultLayout saving ',Filename,' failed: ',E.Message]);
end;
end;
end;
procedure TIDEAnchorDockMaster.ShowForm(AForm: TCustomForm;
BringToFront: boolean);
begin
DockMaster.MakeDockable(AForm,true,BringToFront);
end;
procedure TIDEAnchorDockMaster.CloseAll;
begin
DockMaster.CloseAll;
end;
procedure TIDEAnchorDockMaster.OnIDEClose(Sender: TObject);
begin
SaveDefaultLayout;
end;
initialization
// create the dockmaster in the initialization section, so that it is ready
// when the Register procedures of the packages are called.
IDEDockMaster:=TIDEAnchorDockMaster.Create;
finalization
FreeAndNil(IDEDockMaster);
end.

1
packager/globallinks/anchordockingdsgn-0.lpl Normal file
View File

@ -0,0 +1 @@
$(LazarusDir)/examples/anchodocking/design/anchordockingdsgn.lpk