pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2408 8e941d3f-bd1b-0410-a28a-d453659cc2b4

Browse Source
This commit is contained in:
dopi
2012-04-25 14:26:34 +00:00
parent 8a7eabb7e2
commit caaed89c99
7 changed files with 463 additions and 379 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
components/tdi/Demo/TDIDemo.lpi
View File

@ -86,6 +86,9 @@
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<UseHeaptrc Value="True"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>

11
components/tdi/Demo/TDIDemo.lpr
View File

@ -7,13 +7,20 @@ uses
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, uMainForm, uForm2
Forms, uMainForm, uForm2, sysutils
{ you can add units after this };
{$R *.res}
var
HeapTraceFile : String ;
begin
RequireDerivedFormResource := True;
HeapTraceFile := ExtractFilePath(ParamStr(0))+ 'heaptrclog.trc' ;
DeleteFile( HeapTraceFile );
SetHeapTraceOutput( HeapTraceFile );
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TfMainForm, fMainForm) ;
Application.CreateForm(TForm2, Form2) ;

684
components/tdi/Demo/TDIDemo.lps
View File

File diff suppressed because it is too large Load Diff

45
components/tdi/Demo/uform1.lfm
View File

@ -20,9 +20,9 @@ object Form1: TForm1
LCLVersion = '1.1'
object bClose: TButton
Left = 392
Height = 27
Height = 25
Top = 216
Width = 70
Width = 86
AutoSize = True
Caption = 'Close Form'
OnClick = bCloseClick
@ -30,7 +30,7 @@ object Form1: TForm1
end
object Edit1: TEdit
Left = 24
Height = 25
Height = 23
Top = 62
Width = 82
TabOrder = 0
@ -38,11 +38,12 @@ object Form1: TForm1
end
object Edit2: TEdit
Left = 24
Height = 25
Height = 23
Top = 104
Width = 82
OnExit = Edit2Exit
TabOrder = 1
Text = 'e'
end
object Label1: TLabel
Left = 144
@ -54,10 +55,10 @@ object Form1: TForm1
object Label2: TLabel
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
Left = 74
Height = 39
Left = 98
Height = 31
Top = 16
Width = 353
Width = 305
Alignment = taCenter
Caption = 'This Form has Max Constraints.'#13#10'It will be centralized on Tab Sheet if it is smaller than it'
Font.Style = [fsBold]
@ -68,9 +69,9 @@ object Form1: TForm1
AnchorSideTop.Control = bClose
AnchorSideTop.Side = asrCenter
Left = 32
Height = 52
Top = 203
Width = 323
Height = 46
Top = 205
Width = 324
Caption = 'You can Close or Hide your Forms the same way you used to.'#13#10'No Special method is necessary. TDINotebook will detect by '#13#10'internal Notification and Close the Tab Sheet'
ParentColor = False
end
@ -78,9 +79,9 @@ object Form1: TForm1
AnchorSideLeft.Control = bClose
AnchorSideLeft.Side = asrCenter
Left = 394
Height = 27
Height = 25
Top = 159
Width = 66
Width = 82
AutoSize = True
Caption = 'Hide Form'
OnClick = bHideClick
@ -90,9 +91,9 @@ object Form1: TForm1
AnchorSideTop.Control = bHide
AnchorSideTop.Side = asrCenter
Left = 16
Height = 18
Height = 16
Top = 163
Width = 409
Width = 364
Caption = 'But, If you Hide the Form, is better you have a way to Show it again :)'
Font.Color = clRed
ParentColor = False
@ -104,7 +105,7 @@ object Form1: TForm1
AnchorSideTop.Side = asrCenter
Left = 120
Height = 16
Top = 66
Top = 65
Width = 106
Caption = 'This is a regular Edit'
ParentColor = False
@ -113,9 +114,9 @@ object Form1: TForm1
AnchorSideTop.Control = Edit2
AnchorSideTop.Side = asrCenter
Left = 120
Height = 52
Top = 90
Width = 344
Height = 46
Top = 92
Width = 347
Caption = 'This Edit has a OnExit Validation, who doesn''t allow Page Change'#13#10' if this Edit is empty, and the focus is on it... '#13#10'This can be disabled changing the property "VerifyIfCanChange"'
ParentColor = False
end
@ -124,10 +125,10 @@ object Form1: TForm1
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Side = asrBottom
AnchorSideBottom.Control = bClose
Left = 371
Left = 379
Height = 16
Top = 194
Width = 113
Width = 112
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 6
Caption = 'This Form use caFree'
@ -137,10 +138,10 @@ object Form1: TForm1
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Side = asrCenter
Left = 33
Left = 35
Height = 16
Top = 264
Width = 434
Width = 431
Caption = 'This Form demonstrate that TDINotebook respects your OnCloseQuery Validation'
ParentColor = False
end

12
components/tdi/Demo/umainform.lfm
View File

@ -165,6 +165,18 @@ object fMainForm: TfMainForm
TabOrder = 2
Value = 1
end
object Button1: TButton
AnchorSideTop.Control = pBottom
AnchorSideTop.Side = asrCenter
Left = 304
Height = 25
Top = 13
Width = 85
AutoSize = True
Caption = 'Free Form2'
OnClick = Button1Click
TabOrder = 3
end
end
object mEvents: TMemo
Left = 584

16
components/tdi/Demo/umainform.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
ComCtrls, Buttons, StdCtrls, ExtCtrls, Spin, TDIClass , types, IpHtml;
ComCtrls, Buttons, StdCtrls, ExtCtrls, Spin, TDIClass, IpHtml;
type
@ -14,6 +14,7 @@ type
TfMainForm = class(TForm)
bToggleLog : TButton ;
Button1 : TButton ;
cbxBackgroundCorner : TComboBox ;
Image1 : TImage ;
ImageList1 : TImageList ;
@ -36,6 +37,7 @@ type
tsFixed : TTabSheet ;
TDINoteBook1 : TTDINoteBook ;
procedure bToggleLogClick(Sender : TObject) ;
procedure Button1Click(Sender : TObject) ;
procedure cbxBackgroundCornerChange(Sender : TObject) ;
procedure FormClose(Sender : TObject ; var CloseAction : TCloseAction) ;
procedure FormCloseQuery(Sender : TObject ; var CanClose : boolean) ;
@ -91,6 +93,8 @@ end;
procedure TfMainForm.MenuItem3Click(Sender : TObject) ;
begin
if not Assigned( Form2 ) then
Form2 := TForm2.Create(Self);
Form2.Show;
end;
@ -109,6 +113,12 @@ begin
bToggleLog.Caption := '< Show Log' ;
end;
procedure TfMainForm.Button1Click(Sender : TObject) ;
begin
Form2.Free;
Form2 := nil;
end;
procedure TfMainForm.FormClose(Sender : TObject ; var CloseAction : TCloseAction
) ;
begin
@ -133,7 +143,9 @@ end;
procedure TfMainForm.miForm2Click(Sender : TObject) ;
begin
TDINoteBook1.ShowFormInNewPage( Form2, 4 );
if not Assigned( Form2 ) then
Form2 := TForm2.Create(Self);
TDINoteBook1.ShowFormInPage( Form2, 4 );
end;
procedure TfMainForm.seFixedPagesChange(Sender : TObject) ;

71
components/tdi/tdiclass.pas
View File

@ -6,7 +6,10 @@ interface
uses
Classes, SysUtils, Forms, Controls, ComCtrls, ExtCtrls, Menus,
ExtendedNotebook, Buttons, Graphics ;
ExtendedNotebook, Buttons, Graphics, LMessages ;
const
TDIM_CLOSEPAGE = LM_INTERFACELAST + 500;
type
@ -75,6 +78,7 @@ type
public
constructor Create(TheOwner: TComponent ); override;
destructor Destroy ; override;
procedure RestoreLastFocusedControl ;
@ -139,6 +143,8 @@ type
procedure Loaded; override;
procedure RemovePage(Index: Integer); override;
procedure msg_ClosePage(var Msg: TLMessage); message TDIM_CLOSEPAGE;
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
@ -150,7 +156,7 @@ type
procedure DoCloseTabClicked(APage: TCustomPage); override;
procedure CreateFormInNewPage( AFormClass: TFormClass; ImageIndex : Integer = -1 ) ;
procedure ShowFormInNewPage( AForm: TForm; ImageIndex : Integer = -1 );
procedure ShowFormInPage( AForm: TForm; ImageIndex : Integer = -1 );
Function FindFormInPages( AForm: TForm): Integer ;
Function CanCloseAllPages: Boolean ;
@ -223,6 +229,8 @@ begin
FCloseAllTabs.Free;
FCloseTab.Free;
FTabsMenu.Free;
FNextTab.Free;
FPreviousTab.Free;
inherited Destroy;
end ;
@ -239,6 +247,11 @@ begin
fsLastActiveControl := nil ;
end ;
destructor TTDIPage.Destroy ;
begin
inherited Destroy ;
end ;
procedure TTDIPage.RestoreLastFocusedControl ;
begin
if Assigned( fsLastActiveControl ) then
@ -284,7 +297,6 @@ begin
// 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 ;
@ -339,6 +351,8 @@ end ;
procedure TTDIPage.OnFormClose(Sender : TObject ; var CloseAction : TCloseAction
) ;
var
Msg: TLMessage;
begin
if Assigned( fsFormOldCloseEvent ) then
fsFormOldCloseEvent( Sender, CloseAction );
@ -348,9 +362,13 @@ begin
fsFormInPage := nil;
// This will force this page be killed by TTDINoteBook.Notification();
if Assigned( Parent ) then
Parent.RemoveComponent( Self );
begin
Msg.msg := TDIM_CLOSEPAGE;
Msg.lParam := PageIndex;
Parent.Dispatch( Msg );
end ;
end ;
procedure TTDIPage.SaveFormProperties ;
@ -652,12 +670,12 @@ procedure TTDINoteBook.CreateFormInNewPage(AFormClass : TFormClass ;
Var
NewForm : TForm ;
begin
NewForm := AFormClass.Create(nil);
NewForm := AFormClass.Create(Application);
ShowFormInNewPage( NewForm, ImageIndex );
ShowFormInPage( NewForm, ImageIndex );
end ;
procedure TTDINoteBook.ShowFormInNewPage(AForm : TForm ; ImageIndex : Integer) ;
procedure TTDINoteBook.ShowFormInPage(AForm : TForm ; ImageIndex : Integer) ;
Var
NewPage : TTDIPage ;
AlreadyExistingPage : Integer ;
@ -910,7 +928,7 @@ begin
if FNextMenuItem <> nil then
with FNextMenuItem do
begin
Enabled := (PageCount > 0);
Enabled := (PageCount > 1);
Caption := TDIActions.NextTab.Caption;
Visible := TDIActions.NextTab.Visible;
ImageIndex := TDIActions.NextTab.ImageIndex;
@ -919,7 +937,7 @@ begin
if FPreviousMenuItem <> nil then
with FPreviousMenuItem do
begin
Enabled := (PageCount > 0);
Enabled := (PageCount > 1);
Caption := TDIActions.PreviousTab.Caption;
Visible := TDIActions.PreviousTab.Visible;
ImageIndex := TDIActions.PreviousTab.ImageIndex;
@ -1017,35 +1035,26 @@ end ;
procedure TTDINoteBook.RemovePage(Index : Integer) ;
Var
CanRemovePage : Boolean ;
LastPageCount : Integer ;
APage : TTabSheet;
begin
CanRemovePage := True;
CanRemovePage := True;
FIsRemovingAPage := True;
APage := Pages[Index] ;
try
if ([csDesigning, csDestroying] * ComponentState = []) then
if Pages[Index] is TTDIPage then
with TTDIPage(Pages[Index]) do
if APage is TTDIPage then
with TTDIPage(APage) do
begin
if Assigned( FormInPage ) then
begin
{ // This code is ok, but calls CloseQuery twice //
CanRemovePage := FormInPage.CloseQuery ;
if CanRemovePage then
FormInPage.Close ;
}
LastPageCount := PageCount;
CanRemovePage := False;
FormInPage.Close ;
CanRemovePage := (LastPageCount = PageCount ) and // Page wasn't removed by Notification ?
( (not Assigned(FormInPage)) or // Form Isn't valid ?
( not FormInPage.Showing ) // Form is not showing ?
);
end ;
end ;
if CanRemovePage then
begin
inherited RemovePage(Index) ;
inherited RemovePage(APage.PageIndex) ;
if PageCount < 1 then // On this case, DoChange is not fired //
CheckInterface;
@ -1055,6 +1064,11 @@ begin
end ;
end ;
procedure TTDINoteBook.msg_ClosePage(var Msg : TLMessage) ;
begin
RemovePage( Msg.lParam );
end ;
procedure TTDINoteBook.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var
@ -1118,10 +1132,7 @@ begin
else if ([csDesigning, csDestroying] * ComponentState <> []) then
else if (AComponent is TForm) then
RemoveInvalidPages
else if (AComponent is TTDIPage) and (not FIsRemovingAPage) then
RemovePage( TTDIPage( AComponent ).PageIndex ) ;
RemoveInvalidPages ;
end ;
end ;