examples: add drag-dock example which works with TLazDockTree (just to look at what work now and what needs to be fixed)

git-svn-id: trunk@17856 -
This commit is contained in:
paul 2008-12-18 07:09:43 +00:00
parent 24d3205a30
commit 180cd262cc
9 changed files with 5699 additions and 0 deletions

8
.gitattributes vendored
View File

@ -2061,6 +2061,14 @@ examples/designerbaseclass/example/unit1.lfm svneol=native#text/plain
examples/designerbaseclass/example/unit1.lrs svneol=native#text/plain
examples/designerbaseclass/example/unit1.pas svneol=native#text/plain
examples/dlgform.pp svneol=native#text/pascal
examples/docking/project1.ico -text svneol=unset#image/icon
examples/docking/project1.lpi svneol=native#text/plain
examples/docking/project1.lpr svneol=native#text/pascal
examples/docking/project1.lrs svneol=native#text/pascal
examples/docking/project1.rc svneol=native#text/plain
examples/docking/unit1.lfm svneol=native#text/plain
examples/docking/unit1.lrs svneol=native#text/pascal
examples/docking/unit1.pas svneol=native#text/pascal
examples/dragimagelist/project1.lpi svneol=native#text/plain
examples/dragimagelist/project1.lpr svneol=native#text/pascal
examples/dragimagelist/readme.txt svneol=native#text/plain

Binary file not shown.

After

Width:  |  Height:  |  Size: 134 KiB

View File

@ -0,0 +1,236 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="6"/>
<General>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
<Icon Value="0"/>
<UseXPManifest Value="True"/>
<ActiveEditorIndexAtStart Value="1"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
<Language Value=""/>
<CharSet Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="15">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="project1"/>
<CursorPos X="54" Y="4"/>
<TopLine Value="1"/>
<EditorIndex Value="1"/>
<UsageCount Value="78"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<ComponentName Value="Form1"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<ResourceFilename Value="unit1.lrs"/>
<UnitName Value="Unit1"/>
<CursorPos X="16" Y="61"/>
<TopLine Value="53"/>
<EditorIndex Value="0"/>
<UsageCount Value="78"/>
<Bookmarks Count="1">
<Item0 X="18" Y="72" ID="1"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\..\..\lazarus\lcl\ldocktree.pas"/>
<UnitName Value="LDockTree"/>
<CursorPos X="84" Y="1598"/>
<TopLine Value="1564"/>
<UsageCount Value="38"/>
<Bookmarks Count="1">
<Item0 X="18" Y="1302" ID="2"/>
</Bookmarks>
</Unit2>
<Unit3>
<Filename Value="..\..\..\lazarus\lcl\include\control.inc"/>
<CursorPos X="1" Y="1377"/>
<TopLine Value="1360"/>
<UsageCount Value="38"/>
</Unit3>
<Unit4>
<Filename Value="..\..\..\lazarus\lcl\include\wincontrol.inc"/>
<CursorPos X="13" Y="7000"/>
<TopLine Value="6978"/>
<UsageCount Value="38"/>
</Unit4>
<Unit5>
<Filename Value="..\..\..\lazarus\lcl\controls.pp"/>
<UnitName Value="Controls"/>
<CursorPos X="5" Y="1890"/>
<TopLine Value="1873"/>
<UsageCount Value="38"/>
</Unit5>
<Unit6>
<Filename Value="..\..\..\lazarus\lcl\include\customform.inc"/>
<CursorPos X="1" Y="2175"/>
<TopLine Value="2158"/>
<UsageCount Value="38"/>
</Unit6>
<Unit7>
<Filename Value="..\..\..\lazarus\lcl\include\scrollingwincontrol.inc"/>
<CursorPos X="7" Y="58"/>
<TopLine Value="49"/>
<UsageCount Value="38"/>
</Unit7>
<Unit8>
<Filename Value="..\..\..\lazarus\lcl\include\dockzone.inc"/>
<CursorPos X="41" Y="249"/>
<TopLine Value="226"/>
<UsageCount Value="35"/>
</Unit8>
<Unit9>
<Filename Value="..\..\..\lazarus\lcl\lclproc.pas"/>
<UnitName Value="LCLProc"/>
<CursorPos X="1" Y="1497"/>
<TopLine Value="1480"/>
<UsageCount Value="34"/>
</Unit9>
<Unit10>
<Filename Value="..\..\..\lazarus\lcl\include\docktree.inc"/>
<CursorPos X="3" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="37"/>
</Unit10>
<Unit11>
<Filename Value="..\..\..\lazarus\lcl\extctrls.pp"/>
<UnitName Value="ExtCtrls"/>
<CursorPos X="5" Y="452"/>
<TopLine Value="441"/>
<UsageCount Value="9"/>
</Unit11>
<Unit12>
<Filename Value="..\..\..\lazarus\lcl\include\customsplitter.inc"/>
<CursorPos X="3" Y="35"/>
<TopLine Value="1"/>
<UsageCount Value="9"/>
</Unit12>
<Unit13>
<Filename Value="..\..\..\lazarus\lcl\helpintfs.pas"/>
<UnitName Value="HelpIntfs"/>
<CursorPos X="38" Y="402"/>
<TopLine Value="386"/>
<UsageCount Value="10"/>
</Unit13>
<Unit14>
<Filename Value="..\..\..\lazarus\lcl\lazhelphtml.pas"/>
<UnitName Value="LazHelpHTML"/>
<CursorPos X="3" Y="52"/>
<TopLine Value="35"/>
<UsageCount Value="10"/>
</Unit14>
</Units>
<JumpHistory Count="14" HistoryIndex="13">
<Position1>
<Filename Value="unit1.pas"/>
<Caret Line="74" Column="14" TopLine="52"/>
</Position1>
<Position2>
<Filename Value="unit1.pas"/>
<Caret Line="95" Column="16" TopLine="78"/>
</Position2>
<Position3>
<Filename Value="unit1.pas"/>
<Caret Line="25" Column="34" TopLine="1"/>
</Position3>
<Position4>
<Filename Value="unit1.pas"/>
<Caret Line="71" Column="23" TopLine="37"/>
</Position4>
<Position5>
<Filename Value="unit1.pas"/>
<Caret Line="8" Column="1" TopLine="1"/>
</Position5>
<Position6>
<Filename Value="unit1.pas"/>
<Caret Line="69" Column="1" TopLine="47"/>
</Position6>
<Position7>
<Filename Value="unit1.pas"/>
<Caret Line="67" Column="15" TopLine="50"/>
</Position7>
<Position8>
<Filename Value="unit1.pas"/>
<Caret Line="9" Column="47" TopLine="1"/>
</Position8>
<Position9>
<Filename Value="unit1.pas"/>
<Caret Line="67" Column="13" TopLine="50"/>
</Position9>
<Position10>
<Filename Value="unit1.pas"/>
<Caret Line="67" Column="13" TopLine="50"/>
</Position10>
<Position11>
<Filename Value="unit1.pas"/>
<Caret Line="9" Column="60" TopLine="1"/>
</Position11>
<Position12>
<Filename Value="unit1.pas"/>
<Caret Line="16" Column="33" TopLine="1"/>
</Position12>
<Position13>
<Filename Value="unit1.pas"/>
<Caret Line="69" Column="22" TopLine="52"/>
</Position13>
<Position14>
<Filename Value="unit1.pas"/>
<Caret Line="16" Column="52" TopLine="15"/>
</Position14>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<PathDelim Value="\"/>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,22 @@
program project1;
{$mode objfpc}{$H+}
{$apptype console} // to read debug output on windows
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms
{ you can add units after this }, Unit1, LResources;
{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}
begin
{$I project1.lrs}
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,26 @@
#define RT_MANIFEST 24
#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1
#define ISOLATIONAWARE_MANIFEST_RESOURCE_ID 2
#define ISOLATIONAWARE_NOSTATICIMPORT_MANIFEST_RESOURCE_ID 3
CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST MOVEABLE PURE
{
"<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>"
"<assembly xmlns=""urn:schemas-microsoft-com:asm.v1"" manifestVersion=""1.0"">"
"<assemblyIdentity version=""1.0.0.0"" processorArchitecture=""*"" name=""CompanyName.ProductName.YourApp"" type=""win32""/>"
"<description>Your application description here.</description>"
"<dependency>"
"<dependentAssembly>"
"<assemblyIdentity type=""win32"" name=""Microsoft.Windows.Common-Controls"" version=""6.0.0.0"" processorArchitecture=""*"" publicKeyToken=""6595b64144ccf1df"" language=""*""/>"
"</dependentAssembly>"
"</dependency>"
"<trustInfo xmlns=""urn:schemas-microsoft-com:asm.v3"">"
"<security>"
"<requestedPrivileges>"
"<requestedExecutionLevel level=""asInvoker"" uiAccess=""false""/>"
"</requestedPrivileges>"
"</security>"
"</trustInfo>"
"</assembly>"
}
MAINICON ICON "project1.ico"

View File

@ -0,0 +1,40 @@
object Form1: TForm1
Left = 290
Height = 302
Top = 175
Width = 449
AutoSize = True
Caption = 'Form1'
DockSite = True
Menu = MainMenu1
OnDockOver = FormDockOver
UseDockManager = True
LCLVersion = '0.9.27'
object MainMenu1: TMainMenu
left = 421
top = 48
object MenuItem1: TMenuItem
Caption = 'Create New Form'
RightJustify = False
ShowAlwaysCheckable = False
OnClick = MenuItem1Click
end
object MenuItem2: TMenuItem
Caption = 'Dump Layout'
RightJustify = False
ShowAlwaysCheckable = False
OnClick = MenuItem2Click
end
end
object HTMLHelpDatabase1: THTMLHelpDatabase
AutoRegister = True
left = 421
top = 77
end
object HTMLBrowserHelpViewer1: THTMLBrowserHelpViewer
BrowserParams = '%s'
AutoRegister = True
left = 421
top = 106
end
end

View File

@ -0,0 +1,15 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TForm1','FORMDATA',[
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'"'#1#6'Height'#3'.'#1#3'Top'#3#175#0#5'Wi'
+'dth'#3#193#1#8'AutoSize'#9#7'Caption'#6#5'Form1'#8'DockSite'#9#4'Menu'#7#9
+'MainMenu1'#10'OnDockOver'#7#12'FormDockOver'#14'UseDockManager'#9#10'LCLVer'
+'sion'#6#6'0.9.27'#0#9'TMainMenu'#9'MainMenu1'#4'left'#3#165#1#3'top'#2'0'#0
+#9'TMenuItem'#9'MenuItem1'#7'Caption'#6#15'Create New Form'#12'RightJustify'
+#8#19'ShowAlwaysCheckable'#8#7'OnClick'#7#14'MenuItem1Click'#0#0#9'TMenuItem'
+#9'MenuItem2'#7'Caption'#6#11'Dump Layout'#12'RightJustify'#8#19'ShowAlwaysC'
+'heckable'#8#7'OnClick'#7#14'MenuItem2Click'#0#0#0#17'THTMLHelpDatabase'#17
+'HTMLHelpDatabase1'#12'AutoRegister'#9#4'left'#3#165#1#3'top'#2'M'#0#0#22'TH'
+'TMLBrowserHelpViewer'#22'HTMLBrowserHelpViewer1'#13'BrowserParams'#6#2'%s'
+#12'AutoRegister'#9#4'left'#3#165#1#3'top'#2'j'#0#0#0
]);

130
examples/docking/unit1.pas Normal file
View File

@ -0,0 +1,130 @@
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
Menus, ExtCtrls, Types, LDockTree, HelpIntfs, LazHelpHTML;
type
{ TForm1 }
TForm1 = class(TForm)
HTMLBrowserHelpViewer1: THTMLBrowserHelpViewer;
HTMLHelpDatabase1: THTMLHelpDatabase;
MainMenu1: TMainMenu;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
procedure FormDockOver(Sender: TObject; Source: TDragDockObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
procedure MenuItem1Click(Sender: TObject);
procedure MenuItem2Click(Sender: TObject);
private
FIndex: Integer;
function NextIndex: String;
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{ TForm1 }
procedure TForm1.MenuItem1Click(Sender: TObject);
var
F: TForm;
Idx: String;
begin
F := TForm.Create(Application);
with F do
begin
DragKind := dkDock;
DragMode := dmAutomatic;
Idx := NextIndex;
Caption := 'New Form ' + Idx;
Name := 'DockForm' + Idx;
with TPanel.Create(F) do
begin
Parent := F;
Align := alClient;
Caption := F.Caption;
end;
Show;
end;
end;
procedure TForm1.MenuItem2Click(Sender: TObject);
var
FileName, err: String;
begin
FileName := ExtractFilePath(ParamStr(0))+'1.html';
TDockTree(DockManager).DumpLayout(FileName);
// how to open it in a cross-platform way?
err := '';
if HelpIntfs.ShowHelp('file:///' + FileName, 'Dock Layout', 'text/html', err) <> shrSuccess then
ShowMessage(err);
end;
procedure TForm1.FormDockOver(Sender: TObject; Source: TDragDockObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
function RectToScreen(R: TRect): TRect;
begin
Result.TopLeft := ClientToScreen(R.TopLeft);
Result.BottomRight := ClientToScreen(R.BottomRight);
end;
var
ChopWidth, ChopHeight: Integer;
Pt: TPoint;
R: TRect;
begin
Accept := True;
ChopWidth := ClientWidth div 3;
ChopHeight := ClientHeight div 3;
Pt := Point(X, Y);
R := Rect(0, 0, ChopWidth, ClientHeight);
if PtInRect(R, Pt) then
begin
Source.DockRect := RectToScreen(R);
Exit;
end;
R := Rect(0, 0, ClientWidth, ChopHeight);
if PtInRect(R, Pt) then
begin
Source.DockRect := RectToScreen(R);
Exit;
end;
R := Rect(ClientWidth - ChopWidth, 0, ClientWidth, ClientHeight);
if PtInRect(R, Pt) then
begin
Source.DockRect := RectToScreen(R);
Exit;
end;
R := Rect(0, ClientHeight - ChopHeight, ClientWidth, ClientHeight);
if PtInRect(R, Pt) then
begin
Source.DockRect := RectToScreen(R);
Exit;
end;
R := Rect(0, 0, ClientWidth, ClientHeight);
Source.DockRect := RectToScreen(R);
end;
function TForm1.NextIndex: String;
begin
Result := IntToStr(FIndex);
inc(FIndex);
end;
initialization
{$I unit1.lrs}
end.