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

Trying to emulate OnActivate & OnDeactivate on TDI

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2764 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
dopi
2013-07-13 23:31:38 +00:00
parent ab407ba4e7
commit 339f88d3cd
10 changed files with 488 additions and 486 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -73,7 +73,7 @@
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="9"/>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="TDIDemo"/>

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

File diff suppressed because it is too large Load Diff

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

@ -13,11 +13,13 @@ object Form1: TForm1
Constraints.MinWidth = 300
Font.Height = -12
KeyPreview = True
OnActivate = FormActivate
OnClose = FormClose
OnCloseQuery = FormCloseQuery
OnDeactivate = FormDeactivate
OnDestroy = FormDestroy
OnKeyDown = FormKeyDown
LCLVersion = '0.9.30.4'
LCLVersion = '1.1'
object bClose: TButton
Left = 392
Height = 25
@ -55,9 +57,9 @@ object Form1: TForm1
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
Left = 98
Height = 31
Height = 30
Top = 16
Width = 305
Width = 304
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 +70,9 @@ object Form1: TForm1
AnchorSideTop.Control = bClose
AnchorSideTop.Side = asrCenter
Left = 32
Height = 46
Top = 205
Width = 324
Height = 45
Top = 206
Width = 323
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
@ -90,9 +92,9 @@ object Form1: TForm1
AnchorSideTop.Control = bHide
AnchorSideTop.Side = asrCenter
Left = 16
Height = 16
Top = 163
Width = 364
Height = 15
Top = 164
Width = 363
Caption = 'But, If you Hide the Form, is better you have a way to Show it again :)'
Font.Color = clRed
ParentColor = False
@ -103,9 +105,9 @@ object Form1: TForm1
AnchorSideTop.Control = Edit1
AnchorSideTop.Side = asrCenter
Left = 120
Height = 16
Top = 65
Width = 106
Height = 15
Top = 66
Width = 105
Caption = 'This is a regular Edit'
ParentColor = False
end
@ -113,9 +115,9 @@ object Form1: TForm1
AnchorSideTop.Control = Edit2
AnchorSideTop.Side = asrCenter
Left = 120
Height = 46
Top = 92
Width = 347
Height = 45
Top = 93
Width = 346
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 +126,10 @@ object Form1: TForm1
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Side = asrBottom
AnchorSideBottom.Control = bClose
Left = 379
Height = 16
Top = 194
Width = 112
Left = 380
Height = 15
Top = 195
Width = 111
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 6
Caption = 'This Form use caFree'
@ -138,9 +140,9 @@ object Form1: TForm1
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Side = asrCenter
Left = 35
Height = 16
Height = 15
Top = 264
Width = 431
Width = 430
Caption = 'This Form demonstrate that TDINotebook respects your OnCloseQuery Validation'
ParentColor = False
end

20
components/tdi/Demo/uform1.pas
View File

@ -29,8 +29,10 @@ type
procedure bCloseClick(Sender : TObject) ;
procedure bHideClick(Sender : TObject) ;
procedure Edit2Exit(Sender : TObject) ;
procedure FormActivate(Sender : TObject) ;
procedure FormClose(Sender : TObject ; var CloseAction : TCloseAction) ;
procedure FormCloseQuery(Sender : TObject ; var CanClose : boolean) ;
procedure FormDeactivate(Sender : TObject) ;
procedure FormDestroy(Sender : TObject) ;
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure tShowmeAgainTimer(Sender : TObject) ;
@ -73,10 +75,15 @@ begin
end ;
end;
procedure TForm1.FormActivate(Sender : TObject) ;
begin
fMainForm.AddToLog( 'Form1.OnActivate' );
end;
procedure TForm1.FormClose(Sender : TObject ; var CloseAction : TCloseAction) ;
begin
CloseAction := caFree;
fMainForm.mEvents.Lines.Add( 'Form1.Close' );
fMainForm.AddToLog( 'Form1.OnClose' );
end;
procedure TForm1.FormCloseQuery(Sender : TObject ; var CanClose : boolean) ;
@ -88,18 +95,23 @@ begin
Edit2.Text := 'Ok, fixed';
end ;
fMainForm.mEvents.Lines.Add( 'Form1.CloseQuery: '+BoolToStr(CanClose,'True','False') );
fMainForm.AddToLog( 'Form1.CloseQuery: '+BoolToStr(CanClose,'True','False') );
end;
procedure TForm1.FormDeactivate(Sender : TObject) ;
begin
fMainForm.AddToLog( 'Form1.OnDeactivate' );
end;
procedure TForm1.FormDestroy(Sender : TObject) ;
begin
fMainForm.mEvents.Lines.Add( 'Form1.Destroy' );
fMainForm.AddToLog( 'Form1.OnDestroy' );
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
fMainForm.mEvents.Lines.Add( 'Form1.KeyDown' );
fMainForm.AddToLog( 'Form1.OnKeyDown' );
end;
procedure TForm1.tShowmeAgainTimer(Sender : TObject) ;

15
components/tdi/Demo/uform2.lfm
View File

@ -7,13 +7,16 @@ object Form2: TForm2
ClientHeight = 252
ClientWidth = 499
KeyPreview = True
OnActivate = FormActivate
OnClose = FormClose
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnDeactivate = FormDeactivate
OnDestroy = FormDestroy
OnHide = FormHide
OnKeyDown = FormKeyDown
OnShow = FormShow
LCLVersion = '0.9.30.4'
LCLVersion = '1.1'
object Edit1: TEdit
Left = 48
Height = 23
@ -58,9 +61,9 @@ object Form2: TForm2
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
Left = 44
Height = 31
Height = 30
Top = 16
Width = 411
Width = 410
Alignment = taCenter
Caption = 'This Form does NOT have Max Constraints. It will be Aligned by "alClient". '#13#10'Design forms like this using Anchors to expand controls all over the Page'
Font.Style = [fsBold]
@ -72,10 +75,10 @@ object Form2: TForm2
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = bClose
AnchorSideTop.Side = asrBottom
Left = 349
Height = 16
Left = 350
Height = 15
Top = 223
Width = 118
Width = 117
BorderSpacing.Top = 6
Caption = 'This Form is not Freed'
ParentColor = False

30
components/tdi/Demo/uform2.pas
View File

@ -24,8 +24,11 @@ type
procedure bCloseClick(Sender : TObject) ;
procedure bToggle1Click(Sender : TObject) ;
procedure CheckBox1Change(Sender : TObject) ;
procedure FormActivate(Sender : TObject) ;
procedure FormClose(Sender : TObject ; var CloseAction : TCloseAction) ;
procedure FormCloseQuery(Sender : TObject ; var CanClose : boolean) ;
procedure FormCreate(Sender : TObject) ;
procedure FormDeactivate(Sender : TObject) ;
procedure FormDestroy(Sender : TObject) ;
procedure FormHide(Sender : TObject) ;
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
@ -47,7 +50,7 @@ Uses uMainForm;
procedure TForm2.FormClose(Sender : TObject ; var CloseAction : TCloseAction) ;
begin
fMainForm.mEvents.Lines.Add( 'Form2.Close' );
fMainForm.AddToLog( 'Form2.OnClose' );
end;
procedure TForm2.bCloseClick(Sender : TObject) ;
@ -67,30 +70,45 @@ begin
Edit1.Enabled := CheckBox1.Checked;
end;
procedure TForm2.FormActivate(Sender : TObject) ;
begin
fMainForm.AddToLog( 'Form2.OnActivate' );
end;
procedure TForm2.FormCloseQuery(Sender : TObject ; var CanClose : boolean) ;
begin
fMainForm.mEvents.Lines.Add( 'Form2.CloseQuery: '+BoolToStr(CanClose,'True','False') );
fMainForm.AddToLog( 'Form2.OnCloseQuery: '+BoolToStr(CanClose,'True','False') );
end;
procedure TForm2.FormCreate(Sender : TObject) ;
begin
fMainForm.AddToLog( 'Form2.OnCreate' );
end;
procedure TForm2.FormDeactivate(Sender : TObject) ;
begin
fMainForm.AddToLog( 'Form2.OnDeactivate' );
end;
procedure TForm2.FormDestroy(Sender : TObject) ;
begin
fMainForm.mEvents.Lines.Add( 'Form2.Destroy' );
fMainForm.AddToLog( 'Form2.OnDestroy' );
end;
procedure TForm2.FormHide(Sender : TObject) ;
begin
fMainForm.mEvents.Lines.Add( 'Form2.Hide' );
fMainForm.AddToLog( 'Form2.OnHide' );
end;
procedure TForm2.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
fMainForm.mEvents.Lines.Add( 'Form2.FormKeyDown');
fMainForm.AddToLog( 'Form2.OnKeyDown');
end;
procedure TForm2.FormShow(Sender : TObject) ;
begin
fMainForm.mEvents.Lines.Add( 'Form2.Show' );
fMainForm.AddToLog( 'Form2.OnShow' );
end;
{$R *.lfm}

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

@ -11,7 +11,6 @@ object fMainForm: TfMainForm
OnClose = FormClose
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnDestroy = FormDestroy
OnKeyDown = FormKeyDown
LCLVersion = '1.1'
object StatusBar1: TStatusBar
@ -75,10 +74,10 @@ object fMainForm: TfMainForm
object Label2: TLabel
AnchorSideLeft.Control = tsFixed
AnchorSideLeft.Side = asrCenter
Left = 163
Height = 31
Left = 164
Height = 30
Top = 312
Width = 244
Width = 243
Alignment = taCenter
Caption = 'This is a Fixed Page, and cannot be closed.'#13#10'You can configure it on "FixedPages" Property'
ParentColor = False
@ -125,9 +124,9 @@ object fMainForm: TfMainForm
end
object Label1: TLabel
Left = 22
Height = 16
Height = 15
Top = 1
Width = 101
Width = 100
Caption = 'BackgroundCorner'
ParentColor = False
end
@ -146,9 +145,9 @@ object fMainForm: TfMainForm
end
object Label3: TLabel
Left = 182
Height = 16
Height = 15
Top = 1
Width = 59
Width = 58
Caption = 'FixedPages'
ParentColor = False
end

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

@ -42,7 +42,6 @@ type
procedure FormClose(Sender : TObject ; var CloseAction : TCloseAction) ;
procedure FormCloseQuery(Sender : TObject ; var CanClose : boolean) ;
procedure FormCreate(Sender : TObject) ;
procedure FormDestroy(Sender : TObject) ;
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure MenuItem3Click(Sender : TObject) ;
procedure miExitClick(Sender : TObject) ;
@ -59,6 +58,7 @@ type
public
{ public declarations }
procedure AddToLog( AStr: String) ;
end ;
var
@ -84,15 +84,10 @@ begin
end;
end;
procedure TfMainForm.FormDestroy(Sender : TObject) ;
begin
mEvents.Lines.Add('fMainForm.Destroy');
end;
procedure TfMainForm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
mEvents.Lines.Add('fMainForm.FormKeyDown');
AddToLog('fMainForm.OnKeyDown');
end;
procedure TfMainForm.MenuItem3Click(Sender : TObject) ;
@ -159,18 +154,18 @@ end;
procedure TfMainForm.TDINoteBook1Change(Sender : TObject) ;
begin
mEvents.Lines.Add('OnChange');
AddToLog('TDINoteBook1.OnChange');
end;
procedure TfMainForm.TDINoteBook1CloseTabClicked(Sender : TObject) ;
begin
mEvents.Lines.Add( 'TDINoteBook1.OnCloseTabClicked' );
AddToLog( 'TDINoteBook1.OnCloseTabClicked' );
end;
procedure TfMainForm.TDINoteBook1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
mEvents.Lines.Add( 'TDINoteBook1.OnMouseDown' );
AddToLog( 'TDINoteBook1.OnMouseDown' );
end;
procedure TfMainForm.ShowNewControl(Sender : TObject) ;
@ -185,7 +180,14 @@ begin
ControlCaption := 'nil' ;
StatusBar1.Panels[1].Text := ControlCaption;
mEvents.Lines.Add( 'New Control: '+ControlCaption );
AddToLog( 'Screen.OnActiveControlChange: '+ControlCaption );
end ;
procedure TfMainForm.AddToLog(AStr : String) ;
begin
if ([csDesigning, csDestroying] * ComponentState <> []) then exit ;
mEvents.Lines.Add( AStr ) ;
end ;
end.

5
components/tdi/tdi.lpk
View File

@ -16,7 +16,7 @@
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Version Minor="1"/>
<Version Minor="2"/>
<Files Count="3">
<Item1>
<Filename Value="tdiclass.pas"/>
@ -50,5 +50,8 @@
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<CustomOptions Items="ExternHelp" Version="2">
<_ExternHelp Items="Count"/>
</CustomOptions>
</Package>
</CONFIG>

54
components/tdi/tdiclass.pas
View File

@ -765,7 +765,7 @@ end ;
procedure TTDINoteBook.CheckInterface ;
begin
if ([csDesigning, csDestroying] * ComponentState <> []) then exit ;
if ([csDesigning, csDestroying, csFreeNotification] * ComponentState <> []) then exit ;
Visible := (PageCount > 0);
@ -881,6 +881,8 @@ end ;
procedure TTDINoteBook.RestoreLastFocusedControl ;
begin
if ([csDesigning, csDestroying, csFreeNotification] * ComponentState <> []) then exit ;
FTimerRestoreLastControl.Enabled := True;
end ;
@ -1004,7 +1006,7 @@ Var
begin
Result := True;
if ([csDesigning, csDestroying] * ComponentState = []) then
if ([csDesigning, csDestroying, csFreeNotification] * ComponentState = []) then
begin
if Assigned( ActivePage ) then
begin
@ -1036,13 +1038,47 @@ begin
{$if (lcl_major > 0) or (lcl_release > 30)}
and (inherited CanChange)
{$endif};
// Emulate FormInPage.OnDeactivate //
(*
if Result and (not FIsRemovingAPage) and
([csDesigning, csDestroying, csFreeNotification] * ComponentState = []) then
begin
if (ActivePage is TTDIPage) then
begin
with TTDIPage(ActivePage) do
begin
if Assigned( FormInPage ) then
if ([csDesigning, csDestroying, csFreeNotification] * FormInPage.ComponentState = []) then
if Assigned( FormInPage.OnDeactivate ) then
if FormInPage.Visible then
FormInPage.OnDeactivate( Self );
end ;
end ;
end ;
*)
end ;
procedure TTDINoteBook.DoChange ;
begin
inherited DoChange;
if ([csDesigning, csDestroying] * ComponentState <> []) then exit ;
if ([csDesigning, csDestroying, csFreeNotification] * ComponentState <> []) then exit ;
// Emulate FormInPage.OnActivate //
(*
if (not FIsRemovingAPage) and (ActivePage is TTDIPage) then
begin
with TTDIPage(ActivePage) do
begin
if Assigned( FormInPage ) then
if ([csDesigning, csDestroying, csFreeNotification] * FormInPage.ComponentState = []) then
if Assigned( FormInPage.OnActivate ) then
if FormInPage.Visible then
FormInPage.OnActivate( Self );
end;
end ;
*)
CheckInterface;
@ -1062,7 +1098,7 @@ procedure TTDINoteBook.Loaded ;
begin
inherited Loaded ;
if ([csDesigning, csDestroying] * ComponentState <> []) then exit ;
if ([csDesigning, csDestroying, csFreeNotification] * ComponentState <> []) then exit ;
if Assigned( FMainMenu ) then
CreateTabsMenuItem;
@ -1079,8 +1115,10 @@ begin
FIsRemovingAPage := True;
APage := Pages[Index] ;
try
if ([csDesigning, csDestroying] * ComponentState = []) then
if ([csDesigning, csDestroying, csFreeNotification] * ComponentState = []) then
begin
if APage is TTDIPage then
begin
with TTDIPage(APage) do
begin
if Assigned( FormInPage ) then
@ -1089,6 +1127,8 @@ begin
FormInPage.Close ;
end ;
end ;
end ;
end ;
if CanRemovePage then
begin
@ -1171,7 +1211,7 @@ begin
else if (AComponent = FMainMenu) then
FMainMenu := nil
else if ([csDesigning, csDestroying] * ComponentState <> []) then
else if ([csDesigning, csDestroying, csFreeNotification] * ComponentState <> []) then
else if (AComponent is TForm) then
RemoveInvalidPages ;
@ -1180,7 +1220,7 @@ end ;
procedure TTDINoteBook.DrawBackgroundImage ;
begin
if ([csDesigning, csDestroying] * ComponentState <> []) then exit ;
if ([csDesigning, csDestroying, csFreeNotification] * ComponentState <> []) then exit ;
if not Assigned( FBackgroundImage ) then exit ;