mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-22 16:19:36 +02:00
anchordocking: started tests
git-svn-id: trunk@58002 -
This commit is contained in:
parent
3df9ef6440
commit
ed0e36b971
7
.gitattributes
vendored
7
.gitattributes
vendored
@ -540,6 +540,13 @@ components/anchordocking/restoredebugger/ADRestoreDebugger.lpr svneol=native#tex
|
||||
components/anchordocking/restoredebugger/adlayoutviewer.pas svneol=native#text/plain
|
||||
components/anchordocking/restoredebugger/mainunit.lfm svneol=native#text/plain
|
||||
components/anchordocking/restoredebugger/mainunit.pas svneol=native#text/plain
|
||||
components/anchordocking/tests/TestAnchorDocking.ico -text svneol=unset#image/ico
|
||||
components/anchordocking/tests/TestAnchorDocking.lpi svneol=native#text/plain
|
||||
components/anchordocking/tests/TestAnchorDocking.lpr svneol=native#text/plain
|
||||
components/anchordocking/tests/TestAnchorDocking.res -text
|
||||
components/anchordocking/tests/simplefrm.lfm svneol=native#text/plain
|
||||
components/anchordocking/tests/simplefrm.pas svneol=native#text/plain
|
||||
components/anchordocking/tests/testadrestore.pas svneol=native#text/plain
|
||||
components/cairocanvas/Makefile svneol=native#text/plain
|
||||
components/cairocanvas/Makefile.compiled svneol=native#text/plain
|
||||
components/cairocanvas/Makefile.fpc svneol=native#text/plain
|
||||
|
BIN
components/anchordocking/tests/TestAnchorDocking.ico
Normal file
BIN
components/anchordocking/tests/TestAnchorDocking.ico
Normal file
Binary file not shown.
After Width: | Height: | Size: 134 KiB |
73
components/anchordocking/tests/TestAnchorDocking.lpi
Normal file
73
components/anchordocking/tests/TestAnchorDocking.lpi
Normal file
@ -0,0 +1,73 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="11"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="TestAnchorDocking"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
<Modes Count="0"/>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="AnchorDocking"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="fpcunittestrunner"/>
|
||||
</Item2>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="TestAnchorDocking.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="testadrestore.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="TestADRestore"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="TestAnchorDocking"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
15
components/anchordocking/tests/TestAnchorDocking.lpr
Normal file
15
components/anchordocking/tests/TestAnchorDocking.lpr
Normal file
@ -0,0 +1,15 @@
|
||||
program TestAnchorDocking;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
Interfaces, Forms, GuiTestRunner, TestADRestore, anchordockpkg;
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TGuiTestRunner, TestRunner);
|
||||
Application.Run;
|
||||
end.
|
||||
|
BIN
components/anchordocking/tests/TestAnchorDocking.res
Normal file
BIN
components/anchordocking/tests/TestAnchorDocking.res
Normal file
Binary file not shown.
4307
components/anchordocking/tests/simplefrm.lfm
Normal file
4307
components/anchordocking/tests/simplefrm.lfm
Normal file
File diff suppressed because it is too large
Load Diff
84
components/anchordocking/tests/simplefrm.pas
Normal file
84
components/anchordocking/tests/simplefrm.pas
Normal file
@ -0,0 +1,84 @@
|
||||
unit SimpleFrm;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LCLProc, FileUtil, Forms, Controls, Graphics, Dialogs,
|
||||
StdCtrls;
|
||||
|
||||
type
|
||||
|
||||
{ TSimpleForm }
|
||||
|
||||
TSimpleForm = class(TForm)
|
||||
Memo1: TMemo;
|
||||
procedure FormPaint(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
SimpleForm: TSimpleForm;
|
||||
|
||||
function CreateSimpleForm(Name, Title: string; NewBounds: TRect;
|
||||
DisableAutoSizing: boolean): TSimpleForm;
|
||||
|
||||
implementation
|
||||
|
||||
function CreateSimpleForm(Name, Title: string; NewBounds: TRect;
|
||||
DisableAutoSizing: boolean): TSimpleForm;
|
||||
begin
|
||||
// first check if the form already exists
|
||||
// the LCL Screen has a list of all existing forms.
|
||||
// Note: Remember that the LCL allows as form names only standard
|
||||
// pascal identifiers and compares them case insensitive
|
||||
Result:=TSimpleForm(Screen.FindForm(Name));
|
||||
if Result is TSimpleForm then begin
|
||||
if DisableAutoSizing then
|
||||
Result.DisableAutoSizing;
|
||||
exit;
|
||||
end;
|
||||
|
||||
// create it
|
||||
Result:=TSimpleForm(TSimpleForm.NewInstance);
|
||||
Result.DisableAutoSizing;
|
||||
Result.Create(Application);
|
||||
Result.Caption:=Title;
|
||||
Result.Name:=Name;
|
||||
Result.Memo1.Lines.Text:=Name;
|
||||
Result.BoundsRect:=NewBounds;
|
||||
if not DisableAutoSizing then
|
||||
Result.EnableAutoSizing;
|
||||
end;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TSimpleForm }
|
||||
|
||||
procedure TSimpleForm.FormPaint(Sender: TObject);
|
||||
var
|
||||
s: TCaption;
|
||||
W, H: Integer;
|
||||
begin
|
||||
if Memo1.Visible then exit;
|
||||
with Canvas do begin
|
||||
Pen.Color:=clRed;
|
||||
MoveTo(0,0);
|
||||
LineTo(ClientWidth-1,0);
|
||||
LineTo(ClientWidth-1,ClientHeight-1);
|
||||
LineTo(0,ClientHeight-1);
|
||||
LineTo(0,0);
|
||||
LineTo(ClientWidth-1,ClientHeight-1);
|
||||
s:=Caption;
|
||||
W:=TextWidth(s);
|
||||
H:=TextWidth(s);
|
||||
TextOut((ClientWidth-W) div 2,(ClientHeight-H) div 2,s);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
135
components/anchordocking/tests/testadrestore.pas
Normal file
135
components/anchordocking/tests/testadrestore.pas
Normal file
@ -0,0 +1,135 @@
|
||||
unit TestADRestore;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
fpcunit, testregistry,
|
||||
Controls, Forms, StdCtrls, ExtCtrls,
|
||||
AnchorDocking,
|
||||
SimpleFrm;
|
||||
|
||||
type
|
||||
|
||||
{ TMainBar }
|
||||
|
||||
TMainBar = class(TCustomForm)
|
||||
BtnPanel: TPanel;
|
||||
NewBtn: TButton;
|
||||
public
|
||||
end;
|
||||
|
||||
{ TCustomTestADRestore }
|
||||
|
||||
TCustomTestADRestore = class(TTestCase)
|
||||
private
|
||||
FMainBar: TMainBar;
|
||||
protected
|
||||
procedure SetUp; override;
|
||||
procedure TearDown; override;
|
||||
procedure DockMasterCreateControl(Sender: TObject; aName: string; var
|
||||
AControl: TControl; DoDisableAutoSizing: boolean);
|
||||
public
|
||||
procedure CreateMainBar(DisabledAutoSize: boolean);
|
||||
property MainBar: TMainBar read FMainBar;
|
||||
end;
|
||||
|
||||
{ TTestADRestore }
|
||||
|
||||
TTestADRestore = class(TCustomTestADRestore)
|
||||
published
|
||||
procedure TestNoDock;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TCustomTestADRestore }
|
||||
|
||||
procedure TCustomTestADRestore.SetUp;
|
||||
begin
|
||||
DockMaster.OnCreateControl:=@DockMasterCreateControl;
|
||||
//DockMaster.OnShowOptions:=@ShowAnchorDockOptions;
|
||||
end;
|
||||
|
||||
procedure TCustomTestADRestore.TearDown;
|
||||
begin
|
||||
DockMaster.OnCreateControl:=nil;
|
||||
FreeAndNil(FMainBar);
|
||||
end;
|
||||
|
||||
procedure TCustomTestADRestore.DockMasterCreateControl(Sender: TObject;
|
||||
aName: string; var AControl: TControl; DoDisableAutoSizing: boolean);
|
||||
|
||||
procedure CreateForm(Caption: string; NewBounds: TRect);
|
||||
begin
|
||||
AControl:=CreateSimpleForm(aName,Caption,NewBounds,DoDisableAutoSizing);
|
||||
end;
|
||||
|
||||
begin
|
||||
if aName='CodeExplorer' then
|
||||
CreateForm('Code Explorer',Bounds(700,230,100,250))
|
||||
else if aName='FPDocEditor' then
|
||||
CreateForm('FPDoc Editor',Bounds(200,720,300,100))
|
||||
else if aName='Messages' then
|
||||
CreateForm('Messages',Bounds(230,650,350,100))
|
||||
else if aName='ObjectInspector' then
|
||||
CreateForm('Object Inspector',Bounds(10,200,100,350))
|
||||
else if aName='SourceEditor1' then
|
||||
CreateForm('Source Editor 1',Bounds(230,200,400,400))
|
||||
else if aName='SourceEditor2' then
|
||||
CreateForm('Source Editor 2',Bounds(260,230,350,350))
|
||||
else if aName='ProjectInspector' then
|
||||
CreateForm('Project Inspector',Bounds(10,230,150,250))
|
||||
else if aName='DebugOutput' then
|
||||
CreateForm('Debug Output',Bounds(400,400,350,150));
|
||||
end;
|
||||
|
||||
procedure TCustomTestADRestore.CreateMainBar(DisabledAutoSize: boolean);
|
||||
begin
|
||||
FMainBar:=TMainBar(TMainBar.NewInstance);
|
||||
FMainBar.DisableAutoSizing;
|
||||
try
|
||||
with FMainBar do begin
|
||||
Create(Application);
|
||||
Name:='MainBar';
|
||||
Caption:='Main Bar';
|
||||
SetBounds(10,11,600,100);
|
||||
Visible:=true;
|
||||
end;
|
||||
|
||||
FMainBar.BtnPanel:=TPanel.Create(FMainBar);
|
||||
with FMainBar.BtnPanel do begin
|
||||
Parent:=FMainBar;
|
||||
Name:='BtnPanel';
|
||||
Caption:='';
|
||||
AutoSize:=true;
|
||||
Align:=alLeft;
|
||||
end;
|
||||
|
||||
FMainBar.NewBtn:=TButton.Create(FMainBar);
|
||||
with FMainBar.NewBtn do begin
|
||||
Parent:=FMainBar.BtnPanel;
|
||||
Name:='NewBtn';
|
||||
AutoSize:=true;
|
||||
end;
|
||||
|
||||
DockMaster.MakeDockSite(FMainBar,[akBottom],admrpChild);
|
||||
finally
|
||||
if not DisabledAutoSize then
|
||||
FMainBar.EnableAutoSizing;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TTestADRestore }
|
||||
|
||||
procedure TTestADRestore.TestNoDock;
|
||||
begin
|
||||
CreateMainBar(false);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TCustomTestADRestore);
|
||||
end.
|
||||
|
Loading…
Reference in New Issue
Block a user