From 26f6b7f3af5f6ee2b1cc84aace920437bd0a81ff Mon Sep 17 00:00:00 2001 From: dopi Date: Sat, 21 Apr 2012 22:57:35 +0000 Subject: [PATCH] git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2400 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/tdi/Demo/TDIDemo.lps | 229 ++++++++++++++++-------------- components/tdi/Demo/uform1.lfm | 47 +++--- components/tdi/Demo/uform1.pas | 7 + components/tdi/Demo/uform2.lfm | 42 +++--- components/tdi/Demo/uform2.pas | 7 + components/tdi/Demo/umainform.lfm | 84 +++++------ components/tdi/Demo/umainform.pas | 16 ++- components/tdi/tdiclass.pas | 90 ++++++++++-- 8 files changed, 320 insertions(+), 202 deletions(-) diff --git a/components/tdi/Demo/TDIDemo.lps b/components/tdi/Demo/TDIDemo.lps index 92b7e543f..bbffe1f0a 100644 --- a/components/tdi/Demo/TDIDemo.lps +++ b/components/tdi/Demo/TDIDemo.lps @@ -4,7 +4,7 @@ - + @@ -12,7 +12,7 @@ - + @@ -23,7 +23,7 @@ - + @@ -34,9 +34,9 @@ - - - + + + @@ -49,9 +49,9 @@ - - - + + + @@ -61,28 +61,28 @@ - - - - + + + + - - - + + + - - - - + + + + @@ -96,12 +96,10 @@ - - @@ -186,12 +184,10 @@ - - @@ -204,22 +200,18 @@ - - - - @@ -425,12 +417,10 @@ - - @@ -442,12 +432,10 @@ - - @@ -516,8 +504,8 @@ - - + + @@ -562,131 +550,164 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - - + + - - + + - - + + - - + + - - + + - + - + - - + + - - + + - - + + - - + + - - + + - - + + - + - - + + - - + + - - + + - + - - + + - - + + - - + + - - + + - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/components/tdi/Demo/uform1.lfm b/components/tdi/Demo/uform1.lfm index 922613c1f..d157724da 100644 --- a/components/tdi/Demo/uform1.lfm +++ b/components/tdi/Demo/uform1.lfm @@ -11,15 +11,18 @@ object Form1: TForm1 Constraints.MaxWidth = 500 Constraints.MinHeight = 200 Constraints.MinWidth = 300 + Font.Height = -12 + KeyPreview = True OnClose = FormClose OnCloseQuery = FormCloseQuery OnDestroy = FormDestroy + OnKeyDown = FormKeyDown LCLVersion = '1.1' object bClose: TButton Left = 392 - Height = 25 + Height = 27 Top = 216 - Width = 86 + Width = 70 AutoSize = True Caption = 'Close Form' OnClick = bCloseClick @@ -27,7 +30,7 @@ object Form1: TForm1 end object Edit1: TEdit Left = 24 - Height = 23 + Height = 25 Top = 62 Width = 82 TabOrder = 0 @@ -35,7 +38,7 @@ object Form1: TForm1 end object Edit2: TEdit Left = 24 - Height = 23 + Height = 25 Top = 104 Width = 82 OnExit = Edit2Exit @@ -51,10 +54,10 @@ object Form1: TForm1 object Label2: TLabel AnchorSideLeft.Control = Owner AnchorSideLeft.Side = asrCenter - Left = 98 - Height = 31 + Left = 74 + Height = 39 Top = 16 - Width = 305 + Width = 353 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] @@ -65,9 +68,9 @@ object Form1: TForm1 AnchorSideTop.Control = bClose AnchorSideTop.Side = asrCenter Left = 32 - Height = 46 - Top = 205 - Width = 324 + Height = 52 + Top = 203 + 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 @@ -75,9 +78,9 @@ object Form1: TForm1 AnchorSideLeft.Control = bClose AnchorSideLeft.Side = asrCenter Left = 394 - Height = 25 + Height = 27 Top = 159 - Width = 82 + Width = 66 AutoSize = True Caption = 'Hide Form' OnClick = bHideClick @@ -87,9 +90,9 @@ object Form1: TForm1 AnchorSideTop.Control = bHide AnchorSideTop.Side = asrCenter Left = 16 - Height = 16 + Height = 18 Top = 163 - Width = 364 + Width = 409 Caption = 'But, If you Hide the Form, is better you have a way to Show it again :)' Font.Color = clRed ParentColor = False @@ -101,7 +104,7 @@ object Form1: TForm1 AnchorSideTop.Side = asrCenter Left = 120 Height = 16 - Top = 65 + Top = 66 Width = 106 Caption = 'This is a regular Edit' ParentColor = False @@ -110,9 +113,9 @@ object Form1: TForm1 AnchorSideTop.Control = Edit2 AnchorSideTop.Side = asrCenter Left = 120 - Height = 46 - Top = 92 - Width = 347 + Height = 52 + Top = 90 + Width = 344 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 @@ -121,10 +124,10 @@ object Form1: TForm1 AnchorSideLeft.Side = asrCenter AnchorSideTop.Side = asrBottom AnchorSideBottom.Control = bClose - Left = 379 + Left = 371 Height = 16 Top = 194 - Width = 112 + Width = 113 Anchors = [akLeft, akBottom] BorderSpacing.Bottom = 6 Caption = 'This Form use caFree' @@ -134,10 +137,10 @@ object Form1: TForm1 AnchorSideLeft.Control = Owner AnchorSideLeft.Side = asrCenter AnchorSideTop.Side = asrCenter - Left = 35 + Left = 33 Height = 16 Top = 264 - Width = 431 + Width = 434 Caption = 'This Form demonstrate that TDINotebook respects your OnCloseQuery Validation' ParentColor = False end diff --git a/components/tdi/Demo/uform1.pas b/components/tdi/Demo/uform1.pas index 8b18b6946..5879a7a04 100644 --- a/components/tdi/Demo/uform1.pas +++ b/components/tdi/Demo/uform1.pas @@ -32,6 +32,7 @@ type procedure FormClose(Sender : TObject ; var CloseAction : TCloseAction) ; procedure FormCloseQuery(Sender : TObject ; var CanClose : boolean) ; procedure FormDestroy(Sender : TObject) ; + procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure tShowmeAgainTimer(Sender : TObject) ; private { private declarations } @@ -95,6 +96,12 @@ begin fMainForm.mEvents.Lines.Add( 'Form1.Destroy' ); end; +procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState + ); +begin + fMainForm.mEvents.Lines.Add( 'Form1.KeyDown' ); +end; + procedure TForm1.tShowmeAgainTimer(Sender : TObject) ; begin tShowmeAgain.Enabled := False; diff --git a/components/tdi/Demo/uform2.lfm b/components/tdi/Demo/uform2.lfm index 933336e9a..b9bf7b75c 100644 --- a/components/tdi/Demo/uform2.lfm +++ b/components/tdi/Demo/uform2.lfm @@ -2,55 +2,57 @@ object Form2: TForm2 Left = 564 Height = 252 Top = 330 - Width = 452 + Width = 499 Caption = 'Form2' ClientHeight = 252 - ClientWidth = 452 + ClientWidth = 499 + KeyPreview = True OnClose = FormClose OnCloseQuery = FormCloseQuery OnDestroy = FormDestroy OnHide = FormHide + OnKeyDown = FormKeyDown OnShow = FormShow LCLVersion = '1.1' object Edit1: TEdit Left = 48 - Height = 23 + Height = 27 Top = 80 - Width = 356 + Width = 403 Anchors = [akTop, akLeft, akRight] TabOrder = 0 Text = 'Edit1' end object Edit2: TEdit Left = 48 - Height = 23 + Height = 27 Top = 120 - Width = 356 + Width = 403 Anchors = [akTop, akLeft, akRight] TabOrder = 1 Text = 'Edit2' end object CheckBox1: TCheckBox Left = 48 - Height = 19 + Height = 21 Top = 152 - Width = 78 + Width = 89 Caption = 'CheckBox1' TabOrder = 2 end object CheckBox2: TCheckBox Left = 48 - Height = 19 + Height = 21 Top = 184 - Width = 78 + Width = 89 Caption = 'CheckBox2' TabOrder = 3 end object bClose: TButton - Left = 318 - Height = 25 - Top = 192 - Width = 86 + Left = 374 + Height = 29 + Top = 188 + Width = 77 Anchors = [akRight, akBottom] AutoSize = True Caption = 'Close Form' @@ -60,10 +62,10 @@ object Form2: TForm2 object Label2: TLabel AnchorSideLeft.Control = Owner AnchorSideLeft.Side = asrCenter - Left = 21 - Height = 31 + Left = 12 + Height = 39 Top = 16 - Width = 411 + Width = 474 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] @@ -75,10 +77,10 @@ object Form2: TForm2 AnchorSideLeft.Side = asrCenter AnchorSideTop.Control = bClose AnchorSideTop.Side = asrBottom - Left = 302 - Height = 16 + Left = 346 + Height = 18 Top = 223 - Width = 118 + Width = 133 BorderSpacing.Top = 6 Caption = 'This Form is not Freed' ParentColor = False diff --git a/components/tdi/Demo/uform2.pas b/components/tdi/Demo/uform2.pas index 7140c814c..1a255159b 100644 --- a/components/tdi/Demo/uform2.pas +++ b/components/tdi/Demo/uform2.pas @@ -25,6 +25,7 @@ type procedure FormCloseQuery(Sender : TObject ; var CanClose : boolean) ; procedure FormDestroy(Sender : TObject) ; procedure FormHide(Sender : TObject) ; + procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormShow(Sender : TObject) ; private { private declarations } @@ -67,6 +68,12 @@ begin fMainForm.mEvents.Lines.Add( 'Form2.Hide' ); end; +procedure TForm2.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState + ); +begin + fMainForm.mEvents.Lines.Add( 'Form2.FormKeyDown'); +end; + procedure TForm2.FormShow(Sender : TObject) ; begin fMainForm.mEvents.Lines.Add( 'Form2.Show' ); diff --git a/components/tdi/Demo/umainform.lfm b/components/tdi/Demo/umainform.lfm index 8914c719c..9bb45cd7e 100644 --- a/components/tdi/Demo/umainform.lfm +++ b/components/tdi/Demo/umainform.lfm @@ -1,22 +1,24 @@ object fMainForm: TfMainForm - Left = 471 + Left = 374 Height = 484 - Top = 200 - Width = 746 + Top = 155 + Width = 799 Caption = 'fMainForm' - ClientHeight = 464 - ClientWidth = 746 + ClientHeight = 461 + ClientWidth = 799 + KeyPreview = True Menu = MainMenu1 OnClose = FormClose OnCloseQuery = FormCloseQuery OnCreate = FormCreate OnDestroy = FormDestroy + OnKeyDown = FormKeyDown LCLVersion = '1.1' object StatusBar1: TStatusBar Left = 0 - Height = 23 - Top = 441 - Width = 746 + Height = 17 + Top = 444 + Width = 799 Panels = < item Text = 'Active Control' @@ -29,9 +31,9 @@ object fMainForm: TfMainForm end object TDINoteBook1: TTDINoteBook Left = 0 - Height = 391 + Height = 394 Top = 0 - Width = 587 + Width = 579 ActivePage = tsFixed Align = alClient Constraints.MinHeight = 300 @@ -42,6 +44,7 @@ object fMainForm: TfMainForm TabOrder = 1 OnChange = TDINoteBook1Change OnCloseTabClicked = TDINoteBook1CloseTabClicked + OnMouseDown = TDINoteBook1MouseDown Options = [nboShowCloseButtons, nboMultiLine, nboKeyboardTabSwitch, nboShowAddTabButton] TabDragMode = dmAutomatic TabDragAcceptMode = dmAutomatic @@ -53,28 +56,29 @@ object fMainForm: TfMainForm TDIActions.CloseTab.ImageIndex = 1 TDIActions.CloseAllTabs.Caption = 'Close All Tabs' TDIActions.CloseAllTabs.ImageIndex = 2 + ClosePageShortCut = 16499 FixedPages = 1 object tsFixed: TTabSheet Caption = 'TTDINotebook Demo' - ClientHeight = 363 - ClientWidth = 579 + ClientHeight = 364 + ClientWidth = 577 ImageIndex = 5 object Label2: TLabel AnchorSideLeft.Control = tsFixed AnchorSideLeft.Side = asrCenter - Left = 167 - Height = 31 + Left = 152 + Height = 39 Top = 312 - Width = 244 + Width = 272 Alignment = taCenter Caption = 'This is a Fixed Page, and cannot be closed.'#13#10'You can configure it on "FixedPages" Property' ParentColor = False end object IpHtmlPanel1: TIpHtmlPanel Left = 0 - Height = 290 + Height = 267 Top = 0 - Width = 579 + Width = 577 Align = alTop FixedTypeface = 'Courier New' DefaultTypeFace = 'default' @@ -87,25 +91,22 @@ object fMainForm: TfMainForm TabOrder = 0 end end - object TabSheet1: TTabSheet - Caption = 'TabSheet1' - end end object pBottom: TPanel Left = 0 Height = 50 - Top = 391 - Width = 746 + Top = 394 + Width = 799 Align = alBottom ClientHeight = 50 - ClientWidth = 746 + ClientWidth = 799 TabOrder = 2 object cbxBackgroundCorner: TComboBox Left = 21 - Height = 23 + Height = 31 Top = 18 Width = 115 - ItemHeight = 15 + ItemHeight = 0 Items.Strings = ( 'coTopLeft' 'coTopRight' @@ -118,19 +119,19 @@ object fMainForm: TfMainForm end object Label1: TLabel Left = 22 - Height = 16 + Height = 18 Top = 1 - Width = 101 + Width = 114 Caption = 'BackgroundCorner' ParentColor = False end object bToggleLog: TButton AnchorSideTop.Control = pBottom AnchorSideTop.Side = asrCenter - Left = 622 - Height = 25 - Top = 13 - Width = 85 + Left = 688 + Height = 29 + Top = 11 + Width = 72 Anchors = [akTop, akRight] AutoSize = True Caption = 'Hide Log >' @@ -139,15 +140,15 @@ object fMainForm: TfMainForm end object Label3: TLabel Left = 182 - Height = 16 + Height = 18 Top = 1 - Width = 59 + Width = 68 Caption = 'FixedPages' ParentColor = False end object seFixedPages: TSpinEdit Left = 184 - Height = 23 + Height = 27 Top = 17 Width = 50 MaxValue = 10 @@ -157,19 +158,20 @@ object fMainForm: TfMainForm end end object mEvents: TMemo - Left = 592 - Height = 391 + Left = 584 + Height = 394 Top = 0 - Width = 154 + Width = 215 Align = alRight Lines.Strings = ( 'Events Log' ) + ScrollBars = ssAutoBoth TabOrder = 4 end object Splitter1: TSplitter - Left = 587 - Height = 391 + Left = 579 + Height = 394 Top = 0 Width = 5 Align = alRight @@ -178,9 +180,9 @@ object fMainForm: TfMainForm object Image1: TImage AnchorSideRight.Side = asrBottom AnchorSideBottom.Side = asrBottom - Left = 485 + Left = 538 Height = 94 - Top = 269 + Top = 266 Width = 94 Anchors = [akRight, akBottom] AutoSize = True diff --git a/components/tdi/Demo/umainform.pas b/components/tdi/Demo/umainform.pas index b861b19f1..459c42daa 100644 --- a/components/tdi/Demo/umainform.pas +++ b/components/tdi/Demo/umainform.pas @@ -33,7 +33,6 @@ type seFixedPages : TSpinEdit ; Splitter1 : TSplitter ; StatusBar1 : TStatusBar ; - TabSheet1 : TTabSheet ; tsFixed : TTabSheet ; TDINoteBook1 : TTDINoteBook ; procedure bToggleLogClick(Sender : TObject) ; @@ -42,6 +41,7 @@ type 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) ; procedure miForm1Click(Sender : TObject) ; @@ -49,6 +49,8 @@ type procedure seFixedPagesChange(Sender : TObject) ; procedure TDINoteBook1Change(Sender : TObject) ; procedure TDINoteBook1CloseTabClicked(Sender : TObject) ; + procedure TDINoteBook1MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); private { private declarations } Procedure ShowNewControl(Sender: TObject); @@ -81,6 +83,12 @@ begin mEvents.Lines.Add('fMainForm.Destroy'); end; +procedure TfMainForm.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + mEvents.Lines.Add('fMainForm.FormKeyDown'); +end; + procedure TfMainForm.MenuItem3Click(Sender : TObject) ; begin Form2.Show; @@ -143,6 +151,12 @@ begin mEvents.Lines.Add( 'TDINoteBook1.OnCloseTabClicked' ); end; +procedure TfMainForm.TDINoteBook1MouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + mEvents.Lines.Add( 'TDINoteBook1.OnMouseDown' ); +end; + procedure TfMainForm.ShowNewControl(Sender : TObject) ; var ControlCaption : String ; diff --git a/components/tdi/tdiclass.pas b/components/tdi/tdiclass.pas index 529dee75b..5195b62d4 100644 --- a/components/tdi/tdiclass.pas +++ b/components/tdi/tdiclass.pas @@ -85,6 +85,8 @@ type FMainMenu : TMainMenu ; FBackgroundCorner : TTDIBackgroundCorner ; FTDIActions : TTDIActions ; + FClosePageShortCut: TShortCut; + FClosePageMouseMiddleButtom: Boolean; procedure SetBackgroundImage(AValue : TImage) ; procedure SetBackgroundCorner(AValue : TTDIBackgroundCorner) ; @@ -124,11 +126,15 @@ type procedure Loaded; override; procedure RemovePage(Index: Integer); override; + procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; public - constructor Create(TheOwner: TComponent ); override; + constructor Create(TheOwner: TComponent); override; destructor Destroy ; override; + procedure DoCloseTabClicked(APage: TCustomPage); override; procedure CreateFormInNewPage( AFormClass: TFormClass; ImageIndex : Integer = -1 ) ; procedure ShowForInNewPage( AForm: TForm; ImageIndex : Integer = -1 ); @@ -149,6 +155,11 @@ type property TDIActions : TTDIActions read FTDIActions write FTDIActions ; + property ClosePageMouseMiddleButtom : Boolean read FClosePageMouseMiddleButtom + write FClosePageMouseMiddleButtom default True; + property ClosePageShortCut: TShortCut read FClosePageShortCut + write FClosePageShortCut default 0; + property RestoreActiveControl : Boolean read FRestoreActiveControl write FRestoreActiveControl default True; property VerifyIfCanChangePage : Boolean read FVerifyIfCanChangePage @@ -357,19 +368,21 @@ constructor TTDINoteBook.Create(TheOwner : TComponent) ; begin inherited Create(TheOwner) ; - FCloseTabButtom := tbMenu; - FBackgroundCorner := coBottomRight; - FFixedPages := 0; - FRestoreActiveControl := True; - FVerifyIfCanChangePage := True; - FIsRemovingAPage := False; - FBackgroundImage := nil; - FCloseBitBtn := nil; - FCloseMenuItem := nil; - FCloseMenuItem2 := nil; - FCloseAllTabsMenuItem := nil; - FTabsMenuItem := nil; - FTDIActions := TTDIActions.Create; + FCloseTabButtom := tbMenu; + FBackgroundCorner := coBottomRight; + FFixedPages := 0; + FRestoreActiveControl := True; + FVerifyIfCanChangePage := True; + FIsRemovingAPage := False; + FClosePageMouseMiddleButtom:= True; + FClosePageShortCut := 0; + FBackgroundImage := nil; + FCloseBitBtn := nil; + FCloseMenuItem := nil; + FCloseMenuItem2 := nil; + FCloseAllTabsMenuItem := nil; + FTabsMenuItem := nil; + FTDIActions := TTDIActions.Create; { This is ugly, I know... but I didn't found a best solution to restore Last Focused Control of TDIPage } @@ -404,6 +417,23 @@ begin inherited Destroy; end ; +procedure TTDINoteBook.DoCloseTabClicked(APage: TCustomPage); +var + LastPageCount: Integer; +begin + LastPageCount := PageCount; + + inherited DoCloseTabClicked(APage); + + if Assigned( APage ) and (LastPageCount = PageCount) then // If Page was not closed... + begin + PageIndex := APage.PageIndex; + + if PageIndex >= FixedPages then + RemovePage( APage.PageIndex ); + end; +end; + procedure TTDINoteBook.CreateCloseBitBtn ; begin if FCloseBitBtn <> nil then exit; @@ -892,6 +922,38 @@ begin end ; end ; +procedure TTDINoteBook.MouseDown(Button: TMouseButton; Shift: TShiftState; X, + Y: Integer); +var + APageIndex : Integer ; +begin + if FClosePageMouseMiddleButtom and (Button = mbMiddle) then + begin + APageIndex := TabIndexAtClientPos( Point(X,Y) ); + if (APageIndex >= 0) and (APageIndex >= FixedPages) then + begin + RemovePage( APageIndex ); + exit; + end; + end; + + inherited MouseDown(Button, Shift, X, Y); +end; + +procedure TTDINoteBook.KeyDown(var Key: Word; Shift: TShiftState); +begin + // TODO: HiJack TDIPage.Form.OnKeyDown to detect ShortCut inside the Form // + + if ShortCut(Key, Shift) = FClosePageShortCut then + if PageIndex >= FFixedPages then + begin + RemovePage( PageIndex ); + exit; + end; + + inherited KeyDown(Key, Shift); +end; + procedure TTDINoteBook.Notification(AComponent : TComponent ; Operation : TOperation) ; begin