git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2390 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
dopi
parent
bac149645a
commit
ff6f4c52a7
BIN
components/tdi/Demo/TDIDemo.ico
Normal file
BIN
components/tdi/Demo/TDIDemo.ico
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 134 KiB |
111
components/tdi/Demo/TDIDemo.lpi
Normal file
111
components/tdi/Demo/TDIDemo.lpi
Normal file
@ -0,0 +1,111 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="TDIDemo"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<XPManifest>
|
||||
<DpiAware Value="True"/>
|
||||
</XPManifest>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="TDI"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
</RequiredPackages>
|
||||
<Units Count="3">
|
||||
<Unit0>
|
||||
<Filename Value="TDIDemo.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="TDIDemo"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="mainform.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Main"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="MainForm"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="uform1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="uForm1"/>
|
||||
</Unit2>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="TDIDemo"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="4">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
<Enabled Value="False"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
<Enabled Value="False"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
<Enabled Value="False"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<Name Value="EInvalidOperation"/>
|
||||
<Enabled Value="False"/>
|
||||
</Item4>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
21
components/tdi/Demo/TDIDemo.lpr
Normal file
21
components/tdi/Demo/TDIDemo.lpr
Normal file
@ -0,0 +1,21 @@
|
||||
program TDIDemo;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, uMainForm
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource := True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TfMainForm, fMainForm) ;
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
632
components/tdi/Demo/TDIDemo.lps
Normal file
632
components/tdi/Demo/TDIDemo.lps
Normal file
@ -0,0 +1,632 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectSession>
|
||||
<PathDelim Value="\"/>
|
||||
<Version Value="9"/>
|
||||
<BuildModes Active="Default"/>
|
||||
<Units Count="61">
|
||||
<Unit0>
|
||||
<Filename Value="TDIDemo.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="TDIDemo"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="36" Y="18"/>
|
||||
<UsageCount Value="84"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="mainform.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Main"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="MainForm"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="10" Y="8"/>
|
||||
<UsageCount Value="84"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="uform1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="uForm1"/>
|
||||
<EditorIndex Value="1"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="24"/>
|
||||
<CursorPos X="15" Y="35"/>
|
||||
<UsageCount Value="84"/>
|
||||
<Loaded Value="True"/>
|
||||
<LoadedDesigner Value="True"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="umainform.pas"/>
|
||||
<ComponentName Value="fMainForm"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="uMainForm"/>
|
||||
<IsVisibleTab Value="True"/>
|
||||
<EditorIndex Value="0"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="29"/>
|
||||
<CursorPos X="23" Y="36"/>
|
||||
<UsageCount Value="42"/>
|
||||
<Loaded Value="True"/>
|
||||
<LoadedDesigner Value="True"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<UnitName Value="TDIClass"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="237"/>
|
||||
<CursorPos X="18" Y="249"/>
|
||||
<UsageCount Value="42"/>
|
||||
<Bookmarks Count="3">
|
||||
<Item0 X="17" Y="728" ID="3"/>
|
||||
<Item1 X="1" Y="687" ID="1"/>
|
||||
<Item2 X="3" Y="649" ID="2"/>
|
||||
</Bookmarks>
|
||||
<Loaded Value="True"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
<Filename Value="..\tdinotebookclass.pas"/>
|
||||
<UnitName Value="TDINoteBookClass"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="1" Y="10"/>
|
||||
<UsageCount Value="4"/>
|
||||
</Unit5>
|
||||
<Unit6>
|
||||
<Filename Value="C:\lazarus\lcl\include\customnotebook.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="740"/>
|
||||
<CursorPos X="1" Y="751"/>
|
||||
<UsageCount Value="18"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<Filename Value="C:\lazarus\lcl\include\control.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="2124"/>
|
||||
<CursorPos X="1" Y="2135"/>
|
||||
<UsageCount Value="11"/>
|
||||
</Unit7>
|
||||
<Unit8>
|
||||
<Filename Value="..\tdireg.pas"/>
|
||||
<UnitName Value="TDIReg"/>
|
||||
<EditorIndex Value="6"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="23" Y="5"/>
|
||||
<UsageCount Value="26"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit8>
|
||||
<Unit9>
|
||||
<Filename Value="..\..\..\TOOLS\DJ_FormPrincipal.pas"/>
|
||||
<ComponentName Value="FormDJ_Main"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="DJ_FormPrincipal"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="130"/>
|
||||
<CursorPos X="37" Y="146"/>
|
||||
<UsageCount Value="35"/>
|
||||
</Unit9>
|
||||
<Unit10>
|
||||
<Filename Value="C:\lazarus\lcl\stdctrls.pp"/>
|
||||
<UnitName Value="StdCtrls"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1126"/>
|
||||
<CursorPos X="3" Y="1137"/>
|
||||
<UsageCount Value="9"/>
|
||||
</Unit10>
|
||||
<Unit11>
|
||||
<Filename Value="C:\lazarus\lcl\buttons.pp"/>
|
||||
<UnitName Value="Buttons"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="173"/>
|
||||
<CursorPos X="14" Y="184"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit11>
|
||||
<Unit12>
|
||||
<Filename Value="..\..\..\TOOLS\DJ_FormPrincipal.lfm"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="2191"/>
|
||||
<CursorPos X="1" Y="2212"/>
|
||||
<UsageCount Value="7"/>
|
||||
<DefaultSyntaxHighlighter Value="LFM"/>
|
||||
</Unit12>
|
||||
<Unit13>
|
||||
<Filename Value="..\..\..\ACBr\trunk\Fontes\ACBrTEFD\ACBrTEFD.pas"/>
|
||||
<UnitName Value="ACBrTEFD"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="349"/>
|
||||
<CursorPos X="22" Y="12"/>
|
||||
<UsageCount Value="6"/>
|
||||
</Unit13>
|
||||
<Unit14>
|
||||
<Filename Value="umainform.lfm"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="2229"/>
|
||||
<CursorPos X="1" Y="2239"/>
|
||||
<ExtraEditorCount Value="1"/>
|
||||
<ExtraEditor1>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="2474"/>
|
||||
<CursorPos X="32" Y="2480"/>
|
||||
</ExtraEditor1>
|
||||
<UsageCount Value="10"/>
|
||||
<DefaultSyntaxHighlighter Value="LFM"/>
|
||||
</Unit14>
|
||||
<Unit15>
|
||||
<Filename Value="..\tdiconst.pas"/>
|
||||
<UnitName Value="TDIConst"/>
|
||||
<EditorIndex Value="5"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="17" Y="9"/>
|
||||
<UsageCount Value="39"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit15>
|
||||
<Unit16>
|
||||
<Filename Value="C:\lazarus\lcl\controls.pp"/>
|
||||
<UnitName Value="Controls"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="2104"/>
|
||||
<CursorPos X="21" Y="2123"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit16>
|
||||
<Unit17>
|
||||
<Filename Value="C:\lazarus\lcl\graphics.pp"/>
|
||||
<UnitName Value="Graphics"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1466"/>
|
||||
<CursorPos X="3" Y="1477"/>
|
||||
<UsageCount Value="6"/>
|
||||
</Unit17>
|
||||
<Unit18>
|
||||
<Filename Value="C:\lazarus\components\lazcontrols\extendednotebook.pas"/>
|
||||
<UnitName Value="ExtendedNotebook"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="35"/>
|
||||
<CursorPos X="3" Y="57"/>
|
||||
<UsageCount Value="20"/>
|
||||
</Unit18>
|
||||
<Unit19>
|
||||
<Filename Value="C:\lazarus\lcl\comctrls.pp"/>
|
||||
<UnitName Value="ComCtrls"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="218"/>
|
||||
<CursorPos X="3" Y="218"/>
|
||||
<UsageCount Value="22"/>
|
||||
</Unit19>
|
||||
<Unit20>
|
||||
<Filename Value="C:\lazarus\lcl\include\pagecontrol.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="22"/>
|
||||
<CursorPos X="1" Y="34"/>
|
||||
<UsageCount Value="16"/>
|
||||
</Unit20>
|
||||
<Unit21>
|
||||
<Filename Value="..\..\..\ACBr\trunk\Fontes\ACBrComum\ACBrAAC.pas"/>
|
||||
<UnitName Value="ACBrAAC"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<UsageCount Value="5"/>
|
||||
</Unit21>
|
||||
<Unit22>
|
||||
<Filename Value="..\..\..\ACBr\trunk\Fontes\ACBrComum\ACBrPAFClass.pas"/>
|
||||
<UnitName Value="ACBrPAFClass"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="241"/>
|
||||
<CursorPos X="17" Y="252"/>
|
||||
<UsageCount Value="5"/>
|
||||
</Unit22>
|
||||
<Unit23>
|
||||
<Filename Value="C:\lazarus\lcl\include\bitbtn.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="67"/>
|
||||
<CursorPos X="40" Y="79"/>
|
||||
<UsageCount Value="7"/>
|
||||
</Unit23>
|
||||
<Unit24>
|
||||
<Filename Value="C:\lazarus\lcl\menus.pp"/>
|
||||
<UnitName Value="Menus"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="110"/>
|
||||
<CursorPos X="3" Y="118"/>
|
||||
<UsageCount Value="8"/>
|
||||
</Unit24>
|
||||
<Unit25>
|
||||
<Filename Value="C:\lazarus\lcl\include\menuitem.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1085"/>
|
||||
<CursorPos X="1" Y="1103"/>
|
||||
<UsageCount Value="9"/>
|
||||
</Unit25>
|
||||
<Unit26>
|
||||
<Filename Value="C:\lazarus\lcl\include\buttons.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="234"/>
|
||||
<CursorPos X="42" Y="254"/>
|
||||
<UsageCount Value="7"/>
|
||||
</Unit26>
|
||||
<Unit27>
|
||||
<Filename Value="C:\lazarus\lcl\actnlist.pas"/>
|
||||
<UnitName Value="ActnList"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="365"/>
|
||||
<CursorPos X="1" Y="378"/>
|
||||
<UsageCount Value="7"/>
|
||||
</Unit27>
|
||||
<Unit28>
|
||||
<Filename Value="C:\lazarus\lcl\extctrls.pp"/>
|
||||
<UnitName Value="ExtCtrls"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1144"/>
|
||||
<CursorPos X="19" Y="1161"/>
|
||||
<UsageCount Value="7"/>
|
||||
</Unit28>
|
||||
<Unit29>
|
||||
<Filename Value="C:\lazarus\lcl\include\buttonglyph.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="209"/>
|
||||
<CursorPos X="61" Y="219"/>
|
||||
<UsageCount Value="7"/>
|
||||
</Unit29>
|
||||
<Unit30>
|
||||
<Filename Value="C:\lazarus\lcl\alllclunits.pp"/>
|
||||
<UnitName Value="alllclunits"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="19"/>
|
||||
<CursorPos X="1" Y="34"/>
|
||||
<UsageCount Value="7"/>
|
||||
</Unit30>
|
||||
<Unit31>
|
||||
<Filename Value="C:\lazarus\lcl\arrow.pp"/>
|
||||
<UnitName Value="Arrow"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="69"/>
|
||||
<CursorPos X="1" Y="87"/>
|
||||
<UsageCount Value="7"/>
|
||||
</Unit31>
|
||||
<Unit32>
|
||||
<Filename Value="C:\lazarus\lcl\customdrawndrawers.pas"/>
|
||||
<UnitName Value="customdrawndrawers"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="402"/>
|
||||
<CursorPos X="3" Y="404"/>
|
||||
<UsageCount Value="7"/>
|
||||
</Unit32>
|
||||
<Unit33>
|
||||
<Filename Value="C:\lazarus\lcl\interfaces\wince\wincewsfactory.pas"/>
|
||||
<UnitName Value="WinCEWSFactory"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="503"/>
|
||||
<CursorPos X="23" Y="514"/>
|
||||
<UsageCount Value="7"/>
|
||||
</Unit33>
|
||||
<Unit34>
|
||||
<Filename Value="C:\lazarus\lcl\widgetset\wsmenus.pp"/>
|
||||
<UnitName Value="WSMenus"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="196"/>
|
||||
<CursorPos X="3" Y="200"/>
|
||||
<UsageCount Value="7"/>
|
||||
</Unit34>
|
||||
<Unit35>
|
||||
<Filename Value="C:\lazarus\lcl\widgetset\wsfactory.pas"/>
|
||||
<UnitName Value="WSFactory"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="89"/>
|
||||
<CursorPos X="10" Y="100"/>
|
||||
<UsageCount Value="7"/>
|
||||
</Unit35>
|
||||
<Unit36>
|
||||
<Filename Value="C:\lazarus\lcl\include\menu.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="72"/>
|
||||
<CursorPos X="8" Y="82"/>
|
||||
<UsageCount Value="7"/>
|
||||
</Unit36>
|
||||
<Unit37>
|
||||
<Filename Value="C:\lazarus\fpc\2.6.0\source\rtl\objpas\classes\classesh.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1535"/>
|
||||
<CursorPos X="5" Y="1546"/>
|
||||
<UsageCount Value="8"/>
|
||||
</Unit37>
|
||||
<Unit38>
|
||||
<Filename Value="C:\lazarus\lcl\registerlcl.pas"/>
|
||||
<UnitName Value="RegisterLCL"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="50"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<UsageCount Value="7"/>
|
||||
</Unit38>
|
||||
<Unit39>
|
||||
<Filename Value="C:\lazarus\lcl\imglist.pp"/>
|
||||
<UnitName Value="ImgList"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="47"/>
|
||||
<CursorPos X="12" Y="58"/>
|
||||
<UsageCount Value="7"/>
|
||||
</Unit39>
|
||||
<Unit40>
|
||||
<Filename Value="C:\lazarus\lcl\include\custompage.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="151"/>
|
||||
<CursorPos X="1" Y="166"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit40>
|
||||
<Unit41>
|
||||
<Filename Value="C:\lazarus\lcl\lclclasses.pp"/>
|
||||
<UnitName Value="LCLClasses"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="137"/>
|
||||
<CursorPos X="1" Y="149"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit41>
|
||||
<Unit42>
|
||||
<Filename Value="C:\lazarus\lcl\buttonpanel.pas"/>
|
||||
<UnitName Value="ButtonPanel"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="183"/>
|
||||
<CursorPos X="45" Y="194"/>
|
||||
<UsageCount Value="9"/>
|
||||
</Unit42>
|
||||
<Unit43>
|
||||
<Filename Value="..\..\..\ACBr\trunk\Fontes\ACBrSerial\ACBrECF.pas"/>
|
||||
<UnitName Value="ACBrECF"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="5128"/>
|
||||
<CursorPos X="1" Y="5148"/>
|
||||
<UsageCount Value="8"/>
|
||||
</Unit43>
|
||||
<Unit44>
|
||||
<Filename Value="C:\lazarus\lcl\include\wincontrol.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="4516"/>
|
||||
<CursorPos X="3" Y="4521"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit44>
|
||||
<Unit45>
|
||||
<Filename Value="..\..\..\djpdv\djmonitor\DAV.pas"/>
|
||||
<ComponentName Value="frDAV"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Dav"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="997"/>
|
||||
<CursorPos X="3" Y="999"/>
|
||||
<UsageCount Value="8"/>
|
||||
</Unit45>
|
||||
<Unit46>
|
||||
<Filename Value="C:\lazarus\lcl\include\customform.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="2132"/>
|
||||
<CursorPos X="3" Y="2132"/>
|
||||
<UsageCount Value="11"/>
|
||||
</Unit46>
|
||||
<Unit47>
|
||||
<Filename Value="C:\lazarus\lcl\include\screen.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="978"/>
|
||||
<CursorPos X="1" Y="989"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit47>
|
||||
<Unit48>
|
||||
<Filename Value="C:\lazarus\lcl\forms.pp"/>
|
||||
<UnitName Value="Forms"/>
|
||||
<EditorIndex Value="3"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="697"/>
|
||||
<CursorPos X="3" Y="708"/>
|
||||
<UsageCount Value="13"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit48>
|
||||
<Unit49>
|
||||
<Filename Value="C:\lazarus\lcl\lclmessageglue.pas"/>
|
||||
<UnitName Value="LCLMessageGlue"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="116"/>
|
||||
<CursorPos X="1" Y="128"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit49>
|
||||
<Unit50>
|
||||
<Filename Value="C:\lazarus\lcl\interfaces\win32\win32pagecontrol.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="254"/>
|
||||
<CursorPos X="1" Y="262"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit50>
|
||||
<Unit51>
|
||||
<Filename Value="C:\lazarus\lcl\interfaces\win32\win32wsforms.pp"/>
|
||||
<UnitName Value="Win32WSForms"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="361"/>
|
||||
<CursorPos X="1" Y="375"/>
|
||||
<UsageCount Value="8"/>
|
||||
</Unit51>
|
||||
<Unit52>
|
||||
<Filename Value="C:\lazarus\lcl\widgetset\wslclclasses.pp"/>
|
||||
<UnitName Value="WSLCLClasses"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="421"/>
|
||||
<CursorPos X="3" Y="414"/>
|
||||
<UsageCount Value="8"/>
|
||||
</Unit52>
|
||||
<Unit53>
|
||||
<Filename Value="C:\lazarus\lcl\lclproc.pas"/>
|
||||
<UnitName Value="LCLProc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="851"/>
|
||||
<CursorPos X="1" Y="865"/>
|
||||
<UsageCount Value="9"/>
|
||||
</Unit53>
|
||||
<Unit54>
|
||||
<Filename Value="C:\lazarus\lcl\include\tabsheet.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="49"/>
|
||||
<CursorPos X="3" Y="69"/>
|
||||
<UsageCount Value="9"/>
|
||||
</Unit54>
|
||||
<Unit55>
|
||||
<Filename Value="C:\lazarus\lcl\include\winapi.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="314"/>
|
||||
<CursorPos X="30" Y="322"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit55>
|
||||
<Unit56>
|
||||
<Filename Value="C:\lazarus\lcl\interfaces\win32\win32callback.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="211"/>
|
||||
<CursorPos X="14" Y="214"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit56>
|
||||
<Unit57>
|
||||
<Filename Value="..\..\..\..\TOOLS\DJ_FormPrincipal.pas"/>
|
||||
<ComponentName Value="FormDJ_Main"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="DJ_FormPrincipal"/>
|
||||
<EditorIndex Value="4"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="132"/>
|
||||
<CursorPos X="1" Y="154"/>
|
||||
<UsageCount Value="12"/>
|
||||
<Loaded Value="True"/>
|
||||
<LoadedDesigner Value="True"/>
|
||||
</Unit57>
|
||||
<Unit58>
|
||||
<Filename Value="C:\lazarus\fpc\2.6.0\source\rtl\objpas\sysutils\sysstrh.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="208"/>
|
||||
<CursorPos X="30" Y="219"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit58>
|
||||
<Unit59>
|
||||
<Filename Value="C:\lazarus\fpc\2.6.0\source\rtl\objpas\sysutils\sysstr.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1803"/>
|
||||
<CursorPos X="3" Y="1806"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit59>
|
||||
<Unit60>
|
||||
<Filename Value="C:\lazarus\lcl\include\customcontrol.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="79"/>
|
||||
<CursorPos X="15" Y="90"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit60>
|
||||
</Units>
|
||||
<General>
|
||||
<ActiveWindowIndexAtStart Value="0"/>
|
||||
</General>
|
||||
<JumpHistory Count="25" HistoryIndex="24">
|
||||
<Position1>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="606" Column="1" TopLine="594"/>
|
||||
</Position1>
|
||||
<Position2>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="608" Column="1" TopLine="594"/>
|
||||
</Position2>
|
||||
<Position3>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="609" Column="1" TopLine="594"/>
|
||||
</Position3>
|
||||
<Position4>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="611" Column="1" TopLine="594"/>
|
||||
</Position4>
|
||||
<Position5>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="612" Column="1" TopLine="594"/>
|
||||
</Position5>
|
||||
<Position6>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="611" Column="1" TopLine="594"/>
|
||||
</Position6>
|
||||
<Position7>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="612" Column="1" TopLine="594"/>
|
||||
</Position7>
|
||||
<Position8>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="609" Column="37" TopLine="584"/>
|
||||
</Position8>
|
||||
<Position9>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="615" Column="19" TopLine="593"/>
|
||||
</Position9>
|
||||
<Position10>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="1" Column="1" TopLine="1"/>
|
||||
</Position10>
|
||||
<Position11>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="222" Column="9" TopLine="203"/>
|
||||
</Position11>
|
||||
<Position12>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="229" Column="1" TopLine="209"/>
|
||||
</Position12>
|
||||
<Position13>
|
||||
<Filename Value="uform1.pas"/>
|
||||
<Caret Line="69" Column="25" TopLine="47"/>
|
||||
</Position13>
|
||||
<Position14>
|
||||
<Filename Value="umainform.pas"/>
|
||||
<Caret Line="91" Column="83" TopLine="82"/>
|
||||
</Position14>
|
||||
<Position15>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="58" Column="15" TopLine="47"/>
|
||||
</Position15>
|
||||
<Position16>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="254" Column="3" TopLine="248"/>
|
||||
</Position16>
|
||||
<Position17>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="221" Column="1" TopLine="211"/>
|
||||
</Position17>
|
||||
<Position18>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="8" Column="38" TopLine="1"/>
|
||||
</Position18>
|
||||
<Position19>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="252" Column="1" TopLine="241"/>
|
||||
</Position19>
|
||||
<Position20>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="256" Column="1" TopLine="241"/>
|
||||
</Position20>
|
||||
<Position21>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="54" Column="1" TopLine="45"/>
|
||||
</Position21>
|
||||
<Position22>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="188" Column="1" TopLine="178"/>
|
||||
</Position22>
|
||||
<Position23>
|
||||
<Filename Value="..\tdiclass.pas"/>
|
||||
<Caret Line="225" Column="1" TopLine="215"/>
|
||||
</Position23>
|
||||
<Position24>
|
||||
<Filename Value="umainform.pas"/>
|
||||
<Caret Line="1" Column="1" TopLine="1"/>
|
||||
</Position24>
|
||||
<Position25>
|
||||
<Filename Value="umainform.pas"/>
|
||||
<Caret Line="40" Column="48" TopLine="29"/>
|
||||
</Position25>
|
||||
</JumpHistory>
|
||||
</ProjectSession>
|
||||
</CONFIG>
|
||||
BIN
components/tdi/Demo/TDIDemo.res
Normal file
BIN
components/tdi/Demo/TDIDemo.res
Normal file
Binary file not shown.
52
components/tdi/Demo/uform1.lfm
Normal file
52
components/tdi/Demo/uform1.lfm
Normal file
@ -0,0 +1,52 @@
|
||||
object Form1: TForm1
|
||||
Left = 623
|
||||
Height = 300
|
||||
Top = 319
|
||||
Width = 500
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 300
|
||||
ClientWidth = 500
|
||||
Color = clScrollBar
|
||||
Constraints.MaxHeight = 300
|
||||
Constraints.MaxWidth = 500
|
||||
Constraints.MinHeight = 200
|
||||
Constraints.MinWidth = 300
|
||||
OnClose = FormClose
|
||||
OnCloseQuery = FormCloseQuery
|
||||
OnDestroy = FormDestroy
|
||||
LCLVersion = '1.1'
|
||||
object Button1: TButton
|
||||
Left = 376
|
||||
Height = 25
|
||||
Top = 248
|
||||
Width = 86
|
||||
AutoSize = True
|
||||
Caption = 'Close Form'
|
||||
OnClick = Button1Click
|
||||
TabOrder = 2
|
||||
end
|
||||
object Edit1: TEdit
|
||||
Left = 40
|
||||
Height = 23
|
||||
Top = 24
|
||||
Width = 82
|
||||
TabOrder = 0
|
||||
Text = 'Edit1'
|
||||
end
|
||||
object Edit2: TEdit
|
||||
Left = 40
|
||||
Height = 23
|
||||
Top = 56
|
||||
Width = 82
|
||||
OnExit = Edit2Exit
|
||||
TabOrder = 1
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 51
|
||||
Height = 16
|
||||
Top = 268
|
||||
Width = 35
|
||||
Caption = 'Label1'
|
||||
ParentColor = False
|
||||
end
|
||||
end
|
||||
80
components/tdi/Demo/uform1.pas
Normal file
80
components/tdi/Demo/uform1.pas
Normal file
@ -0,0 +1,80 @@
|
||||
unit uForm1 ;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls ;
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
Button1 : TButton ;
|
||||
Edit1 : TEdit ;
|
||||
Edit2 : TEdit ;
|
||||
Label1 : TLabel ;
|
||||
procedure Button1Click(Sender : TObject) ;
|
||||
procedure Edit2Exit(Sender : TObject) ;
|
||||
procedure FormClose(Sender : TObject ; var CloseAction : TCloseAction) ;
|
||||
procedure FormCloseQuery(Sender : TObject ; var CanClose : boolean) ;
|
||||
procedure FormDestroy(Sender : TObject) ;
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end ;
|
||||
|
||||
var
|
||||
Form1 : TForm1 ;
|
||||
|
||||
implementation
|
||||
|
||||
Uses uMainForm;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.Button1Click(Sender : TObject) ;
|
||||
begin
|
||||
// You can close Forms from Inside, TDI will detect and close the parent Page //
|
||||
Close ;
|
||||
end;
|
||||
|
||||
procedure TForm1.Edit2Exit(Sender : TObject) ;
|
||||
begin
|
||||
if Edit2.Text = '' then
|
||||
begin
|
||||
Label1.Caption := 'Edit2 cant be empty';
|
||||
ShowMessage( 'Edit2 cant be empty' );
|
||||
Edit2.SetFocus;
|
||||
end ;
|
||||
end;
|
||||
|
||||
procedure TForm1.FormClose(Sender : TObject ; var CloseAction : TCloseAction) ;
|
||||
begin
|
||||
CloseAction := caFree;
|
||||
fMainForm.mEvents.Lines.Add( 'Form1.Close' );
|
||||
end;
|
||||
|
||||
procedure TForm1.FormCloseQuery(Sender : TObject ; var CanClose : boolean) ;
|
||||
begin
|
||||
if Edit2.Text = '' then
|
||||
begin
|
||||
CanClose := False;
|
||||
ShowMessage( 'Remember... Edit2 cant be empty' );
|
||||
Edit2.Text := 'Ok, fixed';
|
||||
end ;
|
||||
fMainForm.mEvents.Lines.Add( 'Form1.CloseQuery: '+BoolToStr(CanClose,'True','False') );
|
||||
end;
|
||||
|
||||
procedure TForm1.FormDestroy(Sender : TObject) ;
|
||||
begin
|
||||
fMainForm.mEvents.Lines.Add( 'Form1.Destroy' );
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
2499
components/tdi/Demo/umainform.lfm
Normal file
2499
components/tdi/Demo/umainform.lfm
Normal file
File diff suppressed because it is too large
Load Diff
121
components/tdi/Demo/umainform.pas
Normal file
121
components/tdi/Demo/umainform.pas
Normal file
@ -0,0 +1,121 @@
|
||||
unit uMainForm ;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
|
||||
ComCtrls, Buttons, StdCtrls, ExtCtrls, TDIClass , types;
|
||||
|
||||
type
|
||||
|
||||
{ TfMainForm }
|
||||
|
||||
TfMainForm = class(TForm)
|
||||
Button1 : TButton ;
|
||||
Button2 : TButton ;
|
||||
cbxBackgroundCorner : TComboBox ;
|
||||
Edit1 : TEdit ;
|
||||
Edit2 : TEdit ;
|
||||
Edit3 : TEdit ;
|
||||
Edit4 : TEdit ;
|
||||
Image1 : TImage ;
|
||||
ImageList1 : TImageList ;
|
||||
Label1 : TLabel ;
|
||||
MainMenu1 : TMainMenu ;
|
||||
mEvents : TMemo ;
|
||||
MenuItem1 : TMenuItem ;
|
||||
MenuItem2 : TMenuItem ;
|
||||
miExit : TMenuItem ;
|
||||
miForm2 : TMenuItem ;
|
||||
miForm1 : TMenuItem ;
|
||||
pBottom : TPanel ;
|
||||
Splitter1 : TSplitter ;
|
||||
StatusBar1 : TStatusBar ;
|
||||
TabSheet1 : TTabSheet ;
|
||||
TabSheet2 : TTabSheet ;
|
||||
TDINoteBook1 : TTDINoteBook ;
|
||||
procedure cbxBackgroundCornerChange(Sender : TObject) ;
|
||||
procedure FormClose(Sender : TObject ; var CloseAction : TCloseAction) ;
|
||||
procedure FormCloseQuery(Sender : TObject ; var CanClose : boolean) ;
|
||||
procedure FormCreate(Sender : TObject) ;
|
||||
procedure miExitClick(Sender : TObject) ;
|
||||
procedure miForm1Click(Sender : TObject) ;
|
||||
procedure TDINoteBook1Change(Sender : TObject) ;
|
||||
private
|
||||
{ private declarations }
|
||||
Procedure ShowNewControl(Sender: TObject);
|
||||
|
||||
public
|
||||
{ public declarations }
|
||||
end ;
|
||||
|
||||
var
|
||||
fMainForm : TfMainForm ;
|
||||
|
||||
implementation
|
||||
|
||||
Uses uForm1 ;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TfMainForm }
|
||||
|
||||
procedure TfMainForm.FormCreate(Sender : TObject) ;
|
||||
begin
|
||||
// This will show how TDI can preserve ActiveControl in Forms, when Changing Pages //
|
||||
Screen.OnActiveControlChange := @ShowNewControl;
|
||||
|
||||
cbxBackgroundCorner.ItemIndex := Integer(TDINoteBook1.BackgroundCorner);
|
||||
end;
|
||||
|
||||
procedure TfMainForm.cbxBackgroundCornerChange(Sender : TObject) ;
|
||||
begin
|
||||
TDINoteBook1.BackgroundCorner := TTDIBackgroundCorner( cbxBackgroundCorner.ItemIndex );
|
||||
end;
|
||||
|
||||
procedure TfMainForm.FormClose(Sender : TObject ; var CloseAction : TCloseAction
|
||||
) ;
|
||||
begin
|
||||
Screen.OnActiveControlChange := nil;
|
||||
end;
|
||||
|
||||
procedure TfMainForm.FormCloseQuery(Sender : TObject ; var CanClose : boolean) ;
|
||||
begin
|
||||
CanClose := TDINoteBook1.CanCloseAllPages;
|
||||
end;
|
||||
|
||||
procedure TfMainForm.miExitClick(Sender : TObject) ;
|
||||
begin
|
||||
Close;
|
||||
end;
|
||||
|
||||
procedure TfMainForm.miForm1Click(Sender : TObject) ;
|
||||
begin
|
||||
// You can Use Form Types //
|
||||
TDINoteBook1.CreateFormInNewPage( TForm1, 3 );
|
||||
end;
|
||||
|
||||
procedure TfMainForm.TDINoteBook1Change(Sender : TObject) ;
|
||||
begin
|
||||
mEvents.Lines.Add('OnChange');
|
||||
end;
|
||||
|
||||
procedure TfMainForm.ShowNewControl(Sender : TObject) ;
|
||||
var
|
||||
ControlCaption : String ;
|
||||
begin
|
||||
|
||||
if Assigned( Screen.ActiveControl ) then
|
||||
ControlCaption := Screen.ActiveControl.ClassName + ' - '+
|
||||
Screen.ActiveControl.Name
|
||||
else
|
||||
ControlCaption := 'nil' ;
|
||||
|
||||
StatusBar1.Panels[1].Text := ControlCaption;
|
||||
mEvents.Lines.Add( 'New Control: '+ControlCaption );
|
||||
end ;
|
||||
|
||||
end.
|
||||
|
||||
10
components/tdi/read-me.txt
Normal file
10
components/tdi/read-me.txt
Normal file
@ -0,0 +1,10 @@
|
||||
What is TDI ?
|
||||
Please see:
|
||||
http://en.wikipedia.org/wiki/Tab_%28GUI%29
|
||||
|
||||
This is a very alfa post...
|
||||
I will write a Page on Wiki, and adjust all files for LGPL License
|
||||
|
||||
Author:
|
||||
Daniel Simões de Almeida
|
||||
daniel@djsystem.com.br
|
||||
53
components/tdi/tdi.lpk
Normal file
53
components/tdi/tdi.lpk
Normal file
@ -0,0 +1,53 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<PathDelim Value="\"/>
|
||||
<Name Value="TDI"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Files Count="3">
|
||||
<Item1>
|
||||
<Filename Value="tdiclass.pas"/>
|
||||
<UnitName Value="TDIClass"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Filename Value="tdiconst.pas"/>
|
||||
<UnitName Value="TDIConst"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Filename Value="tdireg.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="TDIReg"/>
|
||||
</Item3>
|
||||
</Files>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<RequiredPkgs Count="3">
|
||||
<Item1>
|
||||
<PackageName Value="LazControls"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item3>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
21
components/tdi/tdi.pas
Normal file
21
components/tdi/tdi.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 TDI ;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
TDIClass, TDIConst, TDIReg, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register ;
|
||||
begin
|
||||
RegisterUnit('TDIReg', @TDIReg.Register) ;
|
||||
end ;
|
||||
|
||||
initialization
|
||||
RegisterPackage('TDI', @Register) ;
|
||||
end.
|
||||
791
components/tdi/tdiclass.pas
Normal file
791
components/tdi/tdiclass.pas
Normal file
@ -0,0 +1,791 @@
|
||||
unit TDIClass ;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, ComCtrls, ExtCtrls, Menus,
|
||||
ExtendedNotebook, Buttons, Graphics ;
|
||||
|
||||
type
|
||||
|
||||
ETDIError = class( Exception ) ;
|
||||
|
||||
TTDICloseTabButtom = (tbNone, tbMenu, tbButtom ) ;
|
||||
TTDIBackgroundCorner = (coTopLeft, coTopRight, coBottomLeft, coBottomRight);
|
||||
|
||||
{ TTDIAction }
|
||||
|
||||
TTDIAction = class( TPersistent )
|
||||
private
|
||||
FCaption : String ;
|
||||
FImageIndex : Integer ;
|
||||
public
|
||||
Constructor Create ;
|
||||
published
|
||||
property Caption : String read FCaption write FCaption ;
|
||||
property ImageIndex : Integer read FImageIndex write FImageIndex ;
|
||||
end ;
|
||||
|
||||
{ TTDIActions }
|
||||
|
||||
TTDIActions = Class( TPersistent )
|
||||
private
|
||||
FCloseAllTabs : TTDIAction ;
|
||||
FCloseTab : TTDIAction ;
|
||||
FTabsMenu : TTDIAction ;
|
||||
public
|
||||
Constructor Create ;
|
||||
Destructor Destroy ; override;
|
||||
published
|
||||
property TabsMenu : TTDIAction read FTabsMenu write FTabsMenu ;
|
||||
property CloseTab : TTDIAction read FCloseTab write FCloseTab ;
|
||||
property CloseAllTabs : TTDIAction read FCloseAllTabs write FCloseAllTabs ;
|
||||
end ;
|
||||
|
||||
{ TTDIPage }
|
||||
|
||||
TTDIPage = class(TTabSheet)
|
||||
private
|
||||
fsFormInPage : TForm ;
|
||||
fsLastActiveControl: TWinControl;
|
||||
|
||||
procedure OnResizeTDIPage(Sender : TObject) ;
|
||||
|
||||
procedure SetFormInPage(AValue : TForm) ;
|
||||
protected
|
||||
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||
|
||||
public
|
||||
constructor Create(TheOwner: TComponent ); override;
|
||||
|
||||
procedure RestoreLastFocusedControl ;
|
||||
|
||||
property FormInPage : TForm read fsFormInPage write SetFormInPage ;
|
||||
property LastActiveControl : TWinControl read fsLastActiveControl write fsLastActiveControl ;
|
||||
end ;
|
||||
|
||||
{ TTDINoteBook }
|
||||
|
||||
TTDINoteBook = class(TExtendedNotebook)
|
||||
private
|
||||
FBackgroundImage : TImage ;
|
||||
FCloseTabButtom : TTDICloseTabButtom ;
|
||||
FFixedPages : Integer ;
|
||||
FMainMenu : TMainMenu ;
|
||||
FBackgroundCorner : TTDIBackgroundCorner ;
|
||||
FTDIActions : TTDIActions ;
|
||||
|
||||
procedure SetBackgroundImage(AValue : TImage) ;
|
||||
procedure SetBackgroundCorner(AValue : TTDIBackgroundCorner) ;
|
||||
procedure SetCloseTabButtom(AValue : TTDICloseTabButtom) ;
|
||||
procedure SetMainMenu(AValue : TMainMenu) ;
|
||||
private
|
||||
FCloseBitBtn : TBitBtn ;
|
||||
FCloseMenuItem : TMenuItem ;
|
||||
FCloseMenuItem2 : TMenuItem ;
|
||||
FCloseAllTabsMenuItem : TMenuItem ;
|
||||
FRestoreActiveControl : Boolean ;
|
||||
FTabsMenuItem : TMenuItem ;
|
||||
FTimerRestoreLastControl : TTimer;
|
||||
FVerifyIfCanChangePage : Boolean ;
|
||||
|
||||
procedure CreateCloseBitBtn ;
|
||||
procedure CreateCloseMenuItem ;
|
||||
procedure CreateTabsMenuItem ;
|
||||
|
||||
procedure ShowCloseButtom ;
|
||||
procedure HideCloseButtom ;
|
||||
procedure DrawBackgroundImage ;
|
||||
|
||||
procedure CloseTabClicked( Sender: TObject );
|
||||
procedure CloseAllTabsClicked( Sender: TObject );
|
||||
procedure SelectTabByMenu( Sender: TObject );
|
||||
procedure DropDownTabsMenu( Sender: TObject );
|
||||
|
||||
procedure TimerRestoreLastFocus( Sender: TObject );
|
||||
|
||||
protected
|
||||
function CanChange: Boolean; override;
|
||||
procedure DoChange; override;
|
||||
procedure Loaded; override;
|
||||
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||
|
||||
public
|
||||
constructor Create(TheOwner: TComponent ); override;
|
||||
destructor Destroy ; override;
|
||||
|
||||
procedure CreateFormInNewPage( AFormClass: TFormClass; ImageIndex : Integer = -1 ) ;
|
||||
procedure ShowForInNewPage( AForm: TForm; ImageIndex : Integer = -1 );
|
||||
|
||||
Function CanCloseAllPages: Boolean ;
|
||||
Function CanCloseAPage( APageIndex: Integer): Boolean;
|
||||
procedure CheckInterface;
|
||||
|
||||
published
|
||||
property BackgroundImage : TImage read FBackgroundImage
|
||||
write SetBackgroundImage ;
|
||||
property BackgroundCorner : TTDIBackgroundCorner read FBackgroundCorner
|
||||
write SetBackgroundCorner default coBottomRight ;
|
||||
property MainMenu : TMainMenu read FMainMenu write SetMainMenu ;
|
||||
property CloseTabButtom : TTDICloseTabButtom read FCloseTabButtom
|
||||
write SetCloseTabButtom default tbMenu ;
|
||||
|
||||
property TDIActions : TTDIActions read FTDIActions write FTDIActions ;
|
||||
|
||||
property RestoreActiveControl : Boolean read FRestoreActiveControl
|
||||
write FRestoreActiveControl default True;
|
||||
property VerifyIfCanChangePage : Boolean read FVerifyIfCanChangePage
|
||||
write FVerifyIfCanChangePage default True;
|
||||
property FixedPages : Integer read FFixedPages write FFixedPages default 0;
|
||||
end ;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
Uses TDIConst ;
|
||||
|
||||
{ TTDIAction }
|
||||
|
||||
constructor TTDIAction.Create ;
|
||||
begin
|
||||
FCaption := '';
|
||||
FImageIndex := -1;
|
||||
end ;
|
||||
|
||||
{ TTDIActions }
|
||||
|
||||
constructor TTDIActions.Create ;
|
||||
begin
|
||||
FCloseAllTabs := TTDIAction.Create;
|
||||
FCloseAllTabs.Caption := sActionCloseAllTabs;
|
||||
|
||||
FCloseTab := TTDIAction.Create;
|
||||
FCloseTab.Caption := sActionCloseTab;
|
||||
|
||||
FTabsMenu := TTDIAction.Create;
|
||||
FTabsMenu.Caption := sActionTabsMenu;
|
||||
end ;
|
||||
|
||||
destructor TTDIActions.Destroy ;
|
||||
begin
|
||||
FCloseAllTabs.Free;
|
||||
FCloseTab.Free;
|
||||
FTabsMenu.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end ;
|
||||
|
||||
{ TTDIPage }
|
||||
|
||||
constructor TTDIPage.Create(TheOwner : TComponent) ;
|
||||
begin
|
||||
inherited Create(TheOwner) ;
|
||||
|
||||
Self.Parent := TWinControl( TheOwner ) ;
|
||||
Self.OnResize := @OnResizeTDIPage ;
|
||||
|
||||
fsLastActiveControl := nil ;
|
||||
end ;
|
||||
|
||||
procedure TTDIPage.RestoreLastFocusedControl ;
|
||||
begin
|
||||
if Assigned( fsLastActiveControl ) then
|
||||
begin
|
||||
if fsLastActiveControl <> Screen.ActiveControl then
|
||||
begin
|
||||
if fsLastActiveControl.Visible and fsLastActiveControl.Enabled then
|
||||
begin
|
||||
try
|
||||
fsLastActiveControl.SetFocus ;
|
||||
//FormInPage.ActiveControl := fsLastActiveControl;
|
||||
except
|
||||
end ;
|
||||
end ;
|
||||
end
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ No LastActiveControle ? Ok, if current Screen control isn't on Tab,
|
||||
go to first Control on Tab... }
|
||||
if not Self.ContainsControl( Screen.ActiveControl ) then
|
||||
Self.SelectNext( Self, True, True);
|
||||
end
|
||||
end ;
|
||||
|
||||
procedure TTDIPage.SetFormInPage(AValue : TForm) ;
|
||||
begin
|
||||
fsFormInPage := AValue ;
|
||||
|
||||
// Adjusting Page Caption and Color as the Form //
|
||||
Caption := fsFormInPage.Caption;
|
||||
//Color := fsFormInPage.Color;
|
||||
|
||||
// Adjusting AForm Border Style and Align //
|
||||
fsFormInPage.BorderStyle := bsNone ;
|
||||
//fsFormInPage.Align := alClient ;
|
||||
|
||||
// Change Form Parent to the Page //
|
||||
fsFormInPage.Parent := Self;
|
||||
//fsFormInPage.FreeNotification(Self); // This cause a SIGSEGV, when Form is Closed from inside
|
||||
|
||||
// Show the Form //
|
||||
fsFormInPage.Visible := True ;
|
||||
|
||||
// Saving the ActiveControl on the Form //
|
||||
fsLastActiveControl := fsFormInPage.ActiveControl;
|
||||
end ;
|
||||
|
||||
procedure TTDIPage.Notification(AComponent : TComponent ; Operation : TOperation
|
||||
) ;
|
||||
begin
|
||||
inherited Notification(AComponent, Operation) ;
|
||||
|
||||
if (fsFormInPage <> nil) and
|
||||
(Operation = opRemove) and
|
||||
(AComponent = fsFormInPage) then
|
||||
fsFormInPage := nil;
|
||||
end ;
|
||||
|
||||
procedure TTDIPage.OnResizeTDIPage(Sender : TObject) ;
|
||||
begin
|
||||
if not Assigned(fsFormInPage) then exit ;
|
||||
|
||||
{ If Form has MaxConstrains and doesn't fit all the Screen, Centralize on
|
||||
TabSheet }
|
||||
if (fsFormInPage.Width < Width) and (fsFormInPage.Height < Height) then
|
||||
begin
|
||||
fsFormInPage.Align := alNone;
|
||||
|
||||
if (fsFormInPage.Width < Width) then
|
||||
fsFormInPage.Left := Trunc( (Width - fsFormInPage.Width) / 2 );
|
||||
|
||||
if (fsFormInPage.Height < Height) then
|
||||
fsFormInPage.Top := Trunc( (Height - fsFormInPage.Height) / 2 );
|
||||
end
|
||||
else
|
||||
fsFormInPage.Align := alClient;
|
||||
end ;
|
||||
|
||||
{ TTDINoteBook }
|
||||
|
||||
constructor TTDINoteBook.Create(TheOwner : TComponent) ;
|
||||
begin
|
||||
inherited Create(TheOwner) ;
|
||||
|
||||
FCloseTabButtom := tbMenu;
|
||||
FBackgroundCorner := coBottomRight;
|
||||
FFixedPages := 0;
|
||||
FRestoreActiveControl := True;
|
||||
FVerifyIfCanChangePage := True;
|
||||
FBackgroundImage := nil;
|
||||
FCloseBitBtn := nil;
|
||||
FCloseMenuItem := nil;
|
||||
FCloseMenuItem2 := nil;
|
||||
FCloseAllTabsMenuItem := nil;
|
||||
FTabsMenuItem := nil;
|
||||
FTDIActions := TTDIActions.Create;
|
||||
|
||||
{ This is ugly, I know... but I didn't find a best solution to restore Last
|
||||
Focused Control of TDIPage }
|
||||
FTimerRestoreLastControl := TTimer.Create(Self);
|
||||
FTimerRestoreLastControl.Enabled := False;
|
||||
FTimerRestoreLastControl.Interval := 10;
|
||||
FTimerRestoreLastControl.OnTimer := @TimerRestoreLastFocus;
|
||||
end ;
|
||||
|
||||
destructor TTDINoteBook.Destroy ;
|
||||
begin
|
||||
if Assigned( FCloseBitBtn ) then
|
||||
FCloseBitBtn.Free ;
|
||||
|
||||
{ // Don't Destroy MenuItens... They will be destroyed by MainMenu //
|
||||
|
||||
if Assigned( FCloseMenuItem ) then
|
||||
FCloseMenuItem.Free ;
|
||||
|
||||
if Assigned( FTabsMenuItem ) then
|
||||
begin
|
||||
FTabsMenuItem.Free ;
|
||||
FCloseMenuItem2.Free;
|
||||
FCloseAllTabsMenuItem.Free;
|
||||
end ;
|
||||
}
|
||||
|
||||
FTDIActions.Free;
|
||||
|
||||
FTimerRestoreLastControl.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.CreateCloseBitBtn ;
|
||||
begin
|
||||
if FCloseBitBtn <> nil then exit;
|
||||
|
||||
FCloseBitBtn := TBitBtn.Create( Self ) ;
|
||||
with FCloseBitBtn do
|
||||
begin
|
||||
Name := 'CloseBitBtn';
|
||||
Caption := 'X';
|
||||
Visible := False ;
|
||||
Parent := Nil;
|
||||
Height := 22;
|
||||
Width := 22;
|
||||
Layout := blGlyphTop;
|
||||
OnClick := @CloseTabClicked;
|
||||
TabStop := False;
|
||||
AnchorSideTop.Control := Self;
|
||||
AnchorSideRight.Control := Self;
|
||||
AnchorSideRight.Side := asrBottom;
|
||||
Anchors := [akTop, akRight]
|
||||
end ;
|
||||
|
||||
if Self.Owner is TWinControl then
|
||||
FCloseBitBtn.Parent := TWinControl(Self.Owner) ;
|
||||
|
||||
// Seting Image to FCloseBitBtn //;
|
||||
if Assigned( Images ) and (FTDIActions.CloseTab.ImageIndex > -1) then
|
||||
begin
|
||||
Images.GetBitmap( FTDIActions.CloseTab.ImageIndex, FCloseBitBtn.Glyph );
|
||||
FCloseBitBtn.Caption := '';
|
||||
end ;
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.CreateCloseMenuItem ;
|
||||
begin
|
||||
if FCloseMenuItem <> nil then exit;
|
||||
|
||||
if not Assigned( FMainMenu ) then
|
||||
raise ETDIError.Create( sMainMenuNotAssigned );
|
||||
|
||||
FCloseMenuItem := TMenuItem.Create( FMainMenu );
|
||||
with FCloseMenuItem do
|
||||
begin
|
||||
Name := 'miTDICloseButtom';
|
||||
if (TDIActions.CloseTab.ImageIndex < 0) or
|
||||
(not Assigned( FMainMenu.Images )) or
|
||||
(TDIActions.CloseTab.ImageIndex >= Images.Count) then
|
||||
Caption := 'X'
|
||||
else
|
||||
begin
|
||||
Caption := '' ;
|
||||
ImageIndex := TDIActions.CloseTab.ImageIndex;
|
||||
end ;
|
||||
|
||||
RightJustify := True ;
|
||||
OnClick := @CloseTabClicked;
|
||||
end ;
|
||||
|
||||
FMainMenu.Items.Add( FCloseMenuItem );
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.CreateTabsMenuItem ;
|
||||
Var
|
||||
NewMenuItem : TMenuItem;
|
||||
begin
|
||||
if FTabsMenuItem <> nil then exit;
|
||||
|
||||
if not Assigned( FMainMenu ) then
|
||||
raise ETDIError.Create( sMainMenuNotAssigned );
|
||||
|
||||
// Creating entry on MainMenu //
|
||||
FTabsMenuItem := TMenuItem.Create( FMainMenu );
|
||||
with FTabsMenuItem do
|
||||
begin
|
||||
Name := 'miTDITabsMenuItem';
|
||||
Caption := TDIActions.TabsMenu.Caption;
|
||||
ImageIndex := TDIActions.TabsMenu.ImageIndex;
|
||||
RightJustify := True ;
|
||||
OnClick := @DropDownTabsMenu;
|
||||
|
||||
end ;
|
||||
FMainMenu.Items.Add( FTabsMenuItem );
|
||||
|
||||
// Creating Sub-Menu options //
|
||||
|
||||
// Creating a Separator //
|
||||
NewMenuItem := TMenuItem.Create( FTabsMenuItem );
|
||||
with NewMenuItem do
|
||||
begin
|
||||
Name := 'miTDISeparator';
|
||||
Caption := '-';
|
||||
end ;
|
||||
FTabsMenuItem.Add(NewMenuItem);
|
||||
|
||||
// Creating Close Tab MenuItem //
|
||||
FCloseMenuItem2 := TMenuItem.Create( FTabsMenuItem );
|
||||
with FCloseMenuItem2 do
|
||||
begin
|
||||
Name := 'miTDICloseTab';
|
||||
Caption := TDIActions.CloseTab.Caption;
|
||||
ImageIndex := TDIActions.CloseTab.ImageIndex;
|
||||
OnClick := @CloseTabClicked;
|
||||
end ;
|
||||
FTabsMenuItem.Add(FCloseMenuItem2);
|
||||
|
||||
// Creating Close All Tabs MenuItem //
|
||||
FCloseAllTabsMenuItem := TMenuItem.Create( FTabsMenuItem );
|
||||
with FCloseAllTabsMenuItem do
|
||||
begin
|
||||
Name := 'miTDICloseAllTabs';
|
||||
Caption := TDIActions.CloseAllTabs.Caption;
|
||||
ImageIndex := TDIActions.CloseAllTabs.ImageIndex;
|
||||
OnClick := @CloseAllTabsClicked;
|
||||
end ;
|
||||
FTabsMenuItem.Add(FCloseAllTabsMenuItem);
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.SetBackgroundImage(AValue : TImage) ;
|
||||
begin
|
||||
if FBackgroundImage = AValue then Exit ;
|
||||
FBackgroundImage := AValue ;
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.SetBackgroundCorner(AValue : TTDIBackgroundCorner) ;
|
||||
begin
|
||||
if FBackgroundCorner = AValue then Exit ;
|
||||
FBackgroundCorner := AValue ;
|
||||
|
||||
if Visible then
|
||||
DrawBackgroundImage;
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.SetCloseTabButtom(AValue : TTDICloseTabButtom) ;
|
||||
begin
|
||||
if FCloseTabButtom = AValue then Exit ;
|
||||
|
||||
if (AValue = tbButtom) and (not (Owner is TWinControl)) then
|
||||
raise ETDIError.Create( sOwnerIsNotWinControl ) ;
|
||||
|
||||
FCloseTabButtom := AValue ;
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.SetMainMenu(AValue : TMainMenu) ;
|
||||
begin
|
||||
if FMainMenu = AValue then Exit ;
|
||||
FMainMenu := AValue ;
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.CreateFormInNewPage(AFormClass : TFormClass ;
|
||||
ImageIndex : Integer) ;
|
||||
Var
|
||||
NewForm : TForm ;
|
||||
begin
|
||||
NewForm := AFormClass.Create(nil);
|
||||
|
||||
ShowForInNewPage( NewForm, ImageIndex );
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.ShowForInNewPage(AForm : TForm ; ImageIndex : Integer) ;
|
||||
Var
|
||||
NewPage : TTDIPage ;
|
||||
begin
|
||||
Visible := True;
|
||||
|
||||
// Create a new Page
|
||||
NewPage := TTDIPage.Create(Self);
|
||||
NewPage.ImageIndex := ImageIndex;
|
||||
|
||||
// This will call TTDIPage.SetFormInPage, who does the magic //
|
||||
NewPage.FormInPage := AForm;
|
||||
|
||||
// Activate the new Page
|
||||
ActivePage := NewPage;
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.CheckInterface ;
|
||||
begin
|
||||
if ([csDesigning, csDestroying] * ComponentState <> []) then exit ;
|
||||
|
||||
Visible := (PageCount > 0);
|
||||
|
||||
// Checking for Close Buttom visibility //
|
||||
if (FCloseTabButtom <> tbNone) then
|
||||
begin
|
||||
if Visible then
|
||||
ShowCloseButtom
|
||||
else
|
||||
HideCloseButtom;
|
||||
end ;
|
||||
|
||||
// Checking for Tabs Menu visibility //
|
||||
if FTabsMenuItem <> nil then
|
||||
FTabsMenuItem.Visible := Visible ;
|
||||
|
||||
// Drawing Back ground Image //
|
||||
if Visible then
|
||||
DrawBackgroundImage;
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.ShowCloseButtom ;
|
||||
begin
|
||||
case FCloseTabButtom of
|
||||
tbButtom :
|
||||
begin
|
||||
if FCloseBitBtn = nil then
|
||||
CreateCloseBitBtn;
|
||||
|
||||
if not FCloseBitBtn.Visible then
|
||||
begin
|
||||
FCloseBitBtn.Visible := True ;
|
||||
FCloseBitBtn.BringToFront;
|
||||
end ;
|
||||
FCloseBitBtn.Enabled := ( ActivePageIndex >= FFixedPages );
|
||||
end ;
|
||||
|
||||
tbMenu :
|
||||
begin
|
||||
if FCloseMenuItem = nil then
|
||||
CreateCloseMenuItem;
|
||||
|
||||
FCloseMenuItem.Visible := True ;
|
||||
FCloseMenuItem.Enabled := ( ActivePageIndex >= FFixedPages );
|
||||
end ;
|
||||
end ;
|
||||
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.HideCloseButtom ;
|
||||
begin
|
||||
if FCloseBitBtn <> nil then
|
||||
FCloseBitBtn.Visible := False;
|
||||
if FCloseMenuItem <> nil then
|
||||
FCloseMenuItem.Visible := False;
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.CloseTabClicked(Sender : TObject) ;
|
||||
begin
|
||||
if CanCloseAPage( ActivePageIndex ) then
|
||||
RemovePage( ActivePageIndex );
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.CloseAllTabsClicked(Sender : TObject) ;
|
||||
Var
|
||||
LastPageCount : Integer ;
|
||||
begin
|
||||
if PageCount < 1 then exit ;
|
||||
|
||||
LastPageCount := -1 ;
|
||||
PageIndex := PageCount-1; // Go to Last page
|
||||
// Close while have pages, and Pages still being closed //
|
||||
while (PageCount > FFixedPages) and (LastPageCount <> PageCount) do
|
||||
begin
|
||||
LastPageCount := PageCount ;
|
||||
CloseTabClicked(Sender);
|
||||
Application.ProcessMessages;
|
||||
end;
|
||||
end ;
|
||||
|
||||
function TTDINoteBook.CanCloseAllPages : Boolean ;
|
||||
Var
|
||||
I : Integer ;
|
||||
begin
|
||||
Result := True;
|
||||
if PageCount < 1 then exit ;
|
||||
|
||||
I := 0;
|
||||
while Result and ( I < PageCount ) do
|
||||
begin
|
||||
Result := CanCloseAPage( I );
|
||||
Inc(I)
|
||||
end ;
|
||||
end ;
|
||||
|
||||
function TTDINoteBook.CanCloseAPage(APageIndex : Integer) : Boolean ;
|
||||
begin
|
||||
Result := True;
|
||||
|
||||
if Pages[APageIndex] is TTDIPage then
|
||||
with TTDIPage(Pages[APageIndex]) do
|
||||
begin
|
||||
if Assigned( FormInPage ) then
|
||||
Result := FormInPage.CloseQuery;
|
||||
end ;
|
||||
end ;
|
||||
|
||||
|
||||
procedure TTDINoteBook.SelectTabByMenu(Sender : TObject) ;
|
||||
begin
|
||||
if Sender is TMenuItem then
|
||||
ActivePageIndex := TMenuItem(Sender).Tag;
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.DropDownTabsMenu(Sender : TObject) ;
|
||||
Var
|
||||
I : Integer ;
|
||||
NewMenuItem : TMenuItem ;
|
||||
begin
|
||||
// Removing MenuItens until find Separator '-' //
|
||||
NewMenuItem := FTabsMenuItem.Items[0] ;
|
||||
while (NewMenuItem.Caption <> '-') do
|
||||
begin
|
||||
FTabsMenuItem.Remove(NewMenuItem);
|
||||
NewMenuItem.Free ;
|
||||
NewMenuItem := FTabsMenuItem.Items[0] ;
|
||||
end ;
|
||||
|
||||
// Inserting on MenuItens existing Tabs //
|
||||
for I := PageCount-1 downto 0 do
|
||||
begin
|
||||
NewMenuItem := TMenuItem.Create(FTabsMenuItem);
|
||||
NewMenuItem.Caption := Page[I].Caption ;
|
||||
NewMenuItem.ImageIndex := Page[I].ImageIndex ;
|
||||
NewMenuItem.OnClick := @SelectTabByMenu ;
|
||||
NewMenuItem.Tag := I ;
|
||||
NewMenuItem.Checked := (I = PageIndex ) ;
|
||||
|
||||
FTabsMenuItem.Insert(0,NewMenuItem);
|
||||
end ;
|
||||
|
||||
FCloseMenuItem2.Enabled := (PageCount > 0) and
|
||||
(ActivePageIndex >= FFixedPages);
|
||||
FCloseAllTabsMenuItem.Enabled := (PageCount > 0);
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.TimerRestoreLastFocus(Sender : TObject) ;
|
||||
begin
|
||||
FTimerRestoreLastControl.Enabled := False;
|
||||
|
||||
if Assigned( ActivePage ) then
|
||||
if ActivePage is TTDIPage then
|
||||
TTDIPage( ActivePage ).RestoreLastFocusedControl;
|
||||
end ;
|
||||
|
||||
function TTDINoteBook.CanChange : Boolean ;
|
||||
Var
|
||||
AWinControl : TWinControl ;
|
||||
begin
|
||||
Result := True;
|
||||
|
||||
if ([csDesigning, csDestroying] * ComponentState = []) then
|
||||
begin
|
||||
if Assigned( ActivePage ) then
|
||||
begin
|
||||
// Saving Last Active Control in Page //
|
||||
AWinControl := Screen.ActiveControl;
|
||||
|
||||
if ActivePage is TTDIPage then
|
||||
begin
|
||||
if ActivePage.ContainsControl( AWinControl ) then
|
||||
begin
|
||||
TTDIPage( ActivePage ).LastActiveControl := AWinControl;
|
||||
|
||||
if FVerifyIfCanChangePage then
|
||||
begin
|
||||
{ Try to detect if occurs some exception when leaving current
|
||||
control focus. This may occurs in TWinControl.OnExit Validation }
|
||||
Self.SetFocus;
|
||||
|
||||
{ If steel on same ActiveControl, maybe Focus Control was traped on
|
||||
some OnExit Validation }
|
||||
Result := ( AWinControl <> Screen.ActiveControl );
|
||||
end ;
|
||||
end ;
|
||||
end ;
|
||||
end ;
|
||||
end ;
|
||||
|
||||
Result := Result and (inherited CanChange) ;
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.DoChange ;
|
||||
begin
|
||||
inherited DoChange;
|
||||
|
||||
if ([csDesigning, csDestroying] * ComponentState <> []) then exit ;
|
||||
|
||||
CheckInterface;
|
||||
|
||||
{
|
||||
// This doesn't work on Win32, Focus Control always go to first control on Page //
|
||||
if FRestoreActiveControl then
|
||||
if (ActivePage is TTDIPage) then
|
||||
TTDIPage( ActivePage ).RestoreLastFocusedControl;
|
||||
}
|
||||
|
||||
// This is a ulgy work around.. but it works :) //
|
||||
FTimerRestoreLastControl.Enabled := True;
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.Loaded ;
|
||||
begin
|
||||
inherited Loaded ;
|
||||
|
||||
if ([csDesigning, csDestroying] * ComponentState <> []) then exit ;
|
||||
|
||||
if Assigned( FMainMenu ) then
|
||||
CreateTabsMenuItem;
|
||||
|
||||
CheckInterface;
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.Notification(AComponent : TComponent ;
|
||||
Operation : TOperation) ;
|
||||
begin
|
||||
inherited Notification(AComponent, Operation) ;
|
||||
|
||||
if (Operation = opRemove) then
|
||||
begin
|
||||
if (AComponent = FBackgroundImage) then
|
||||
FBackgroundImage := nil ;
|
||||
|
||||
if (AComponent = FMainMenu) then
|
||||
FMainMenu := nil ;
|
||||
|
||||
|
||||
if ([csDesigning, csDestroying] * ComponentState <> []) then exit ;
|
||||
|
||||
if (AComponent is TForm) then
|
||||
if TForm(AComponent).Parent is TTDIPage then
|
||||
RemovePage( TTDIPage(TForm(AComponent).Parent).PageIndex );
|
||||
end ;
|
||||
end ;
|
||||
|
||||
procedure TTDINoteBook.DrawBackgroundImage ;
|
||||
begin
|
||||
if ([csDesigning, csDestroying] * ComponentState <> []) then exit ;
|
||||
|
||||
if not Assigned( FBackgroundImage ) then exit ;
|
||||
|
||||
if not Assigned( ActivePage ) then exit ;
|
||||
|
||||
FBackgroundImage.Parent := ActivePage;
|
||||
FBackgroundImage.Anchors := [];
|
||||
FBackgroundImage.AnchorSideBottom.Control := nil;
|
||||
FBackgroundImage.AnchorSideTop.Control := nil;
|
||||
FBackgroundImage.AnchorSideRight.Control := nil;
|
||||
FBackgroundImage.AnchorSideLeft.Control := nil;
|
||||
|
||||
if FBackgroundCorner in [coBottomRight, coBottomLeft] then
|
||||
begin
|
||||
FBackgroundImage.AnchorSideBottom.Control := ActivePage;
|
||||
FBackgroundImage.AnchorSideBottom.Side := asrBottom;
|
||||
FBackgroundImage.Anchors := FBackgroundImage.Anchors + [akBottom];
|
||||
end
|
||||
else
|
||||
begin
|
||||
FBackgroundImage.AnchorSideTop.Control := ActivePage;
|
||||
FBackgroundImage.AnchorSideTop.Side := asrTop;
|
||||
FBackgroundImage.Anchors := FBackgroundImage.Anchors + [akTop];
|
||||
end ;
|
||||
|
||||
if FBackgroundCorner in [coBottomRight, coTopRight] then
|
||||
begin
|
||||
FBackgroundImage.AnchorSideRight.Control := ActivePage;
|
||||
FBackgroundImage.AnchorSideRight.Side := asrBottom;
|
||||
FBackgroundImage.Anchors := FBackgroundImage.Anchors + [akRight];
|
||||
end
|
||||
else
|
||||
begin
|
||||
FBackgroundImage.AnchorSideLeft.Control := ActivePage;
|
||||
FBackgroundImage.AnchorSideLeft.Side := asrTop;
|
||||
FBackgroundImage.Anchors := FBackgroundImage.Anchors + [akLeft];
|
||||
end ;
|
||||
|
||||
FBackgroundImage.Visible := True ;
|
||||
end ;
|
||||
|
||||
end.
|
||||
|
||||
20
components/tdi/tdiconst.pas
Normal file
20
components/tdi/tdiconst.pas
Normal file
@ -0,0 +1,20 @@
|
||||
unit TDIConst ;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils ;
|
||||
|
||||
resourcestring
|
||||
sOwnerIsNotWinControl = 'TDINoteBook.Owner is not a TWinControl descendant';
|
||||
sMainMenuNotAssigned = 'TTDINoteBook.MainMenu not assigned';
|
||||
sActionTabsMenu = 'Tabs';
|
||||
sActionCloseTab = 'Close Tab';
|
||||
sActionCloseAllTabs = 'Close All Tabs';
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
|
||||
23
components/tdi/tdireg.pas
Normal file
23
components/tdi/tdireg.pas
Normal file
@ -0,0 +1,23 @@
|
||||
unit TDIReg ;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources ;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
Uses TDIClass ;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('TDI', [ TTDINoteBook ]);
|
||||
end ;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user