mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-06 18:58:12 +02:00
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:
parent
24d3205a30
commit
180cd262cc
8
.gitattributes
vendored
8
.gitattributes
vendored
@ -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
|
||||
|
BIN
examples/docking/project1.ico
Normal file
BIN
examples/docking/project1.ico
Normal file
Binary file not shown.
After Width: | Height: | Size: 134 KiB |
236
examples/docking/project1.lpi
Normal file
236
examples/docking/project1.lpi
Normal 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>
|
22
examples/docking/project1.lpr
Normal file
22
examples/docking/project1.lpr
Normal 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.
|
||||
|
5222
examples/docking/project1.lrs
Normal file
5222
examples/docking/project1.lrs
Normal file
File diff suppressed because it is too large
Load Diff
26
examples/docking/project1.rc
Normal file
26
examples/docking/project1.rc
Normal 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"
|
40
examples/docking/unit1.lfm
Normal file
40
examples/docking/unit1.lfm
Normal 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
|
15
examples/docking/unit1.lrs
Normal file
15
examples/docking/unit1.lrs
Normal 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
130
examples/docking/unit1.pas
Normal 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.
|
||||
|
Loading…
Reference in New Issue
Block a user