From 170b2a730f3fcef849d4d7c4813d208811c1bc7b Mon Sep 17 00:00:00 2001 From: eugene1 Date: Wed, 8 Oct 2008 20:15:45 +0000 Subject: [PATCH] fixed issues, added events git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@589 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../gradcontrols/examples/Forms/unit1.lfm | 130 +++- .../gradcontrols/examples/Forms/unit1.lrs | 126 ++-- .../gradcontrols/examples/Forms/unit1.pas | 223 +++++- .../gradcontrols/examples/gradcontroltest.lpi | 3 +- .../gradcontrols/examples/gradcontroltest.lpr | 2 + components/gradcontrols/src/ugradbtn.pas | 18 +- .../gradcontrols/src/ugradtabcontrol.lrs | 6 + .../gradcontrols/src/ugradtabcontrol.pas | 645 ++++++++++++++---- 8 files changed, 932 insertions(+), 221 deletions(-) create mode 100644 components/gradcontrols/src/ugradtabcontrol.lrs diff --git a/components/gradcontrols/examples/Forms/unit1.lfm b/components/gradcontrols/examples/Forms/unit1.lfm index f090dbcfe..921851c1c 100644 --- a/components/gradcontrols/examples/Forms/unit1.lfm +++ b/components/gradcontrols/examples/Forms/unit1.lfm @@ -1,13 +1,16 @@ object Form1: TForm1 - Left = 270 + Left = 254 Height = 506 - Top = 98 + Top = 116 Width = 898 Caption = 'Form1' ClientHeight = 506 ClientWidth = 898 OnCreate = FormCreate OnDestroy = FormDestroy + OnMouseWheel = FormMouseWheel + OnMouseWheelDown = FormMouseWheelDown + OnMouseWheelUp = FormMouseWheelUp ParentFont = False LCLVersion = '0.9.27' object Panel1: TPanel @@ -27,10 +30,88 @@ object Form1: TForm1 Width = 749 Align = alClient ControlStyle = [csAcceptsControls] - PageIndex = -1 - TabHeight = 30 - TabPosition = tpLeft + ActivePage = GradTabPage1 + OnTabButtonClick = GradTabControl1TabButtonClick + OnTabButtonMouseDown = GradTabControl1TabButtonMouseDown + OnTabButtonMouseUp = GradTabControl1TabButtonMouseUp + OnTabButtonMouseMove = GradTabControl1TabButtonMouseMove + OnDragDrop = GradTabControl1DragDrop + OnDragOver = GradTabControl1DragOver + OnMouseDown = GradTabControl1MouseDown + OnMouseWheelUp = GradTabControl1MouseWheelUp + OnMouseWheelDown = GradTabControl1MouseWheelDown + OnPagesBarDragOver = GradTabControl1PagesBarDragOver + TabHeight = 20 MoveIncrement = 1 + OnPageChanged = GradTabControl1PageChanged + object GradTabPage2: TGradTabPage + Left = 2 + Height = 480 + Top = 22 + Width = 745 + PageIndex = 1 + Caption = 'GradTabPage2' + object PageControl1: TPageControl + Left = 173 + Height = 200 + Top = 57 + Width = 200 + ActivePage = TabSheet3 + TabIndex = 2 + TabOrder = 0 + OnDragDrop = PageControl1DragDrop + OnDragOver = PageControl1DragOver + OnMouseDown = PageControl1MouseDown + object TabSheet1: TTabSheet + Caption = 'TabSheet1' + end + object TabSheet2: TTabSheet + Caption = 'TabSheet2' + end + object TabSheet3: TTabSheet + Caption = 'TabSheet3' + end + end + object Button2: TButton + Left = 47 + Height = 25 + Top = 28 + Width = 75 + Caption = 'Button2' + TabOrder = 1 + end + object Panel3: TPanel + Left = 429 + Height = 50 + Top = 89 + Width = 170 + Caption = 'Panel3' + TabOrder = 2 + end + end + object GradTabPage1: TGradTabPage + Left = 2 + Height = 480 + Top = 22 + Width = 745 + Caption = 'GradTabPage1' + object Button1: TButton + Left = 94 + Height = 25 + Top = 50 + Width = 75 + Caption = 'Button1' + TabOrder = 0 + end + object ToggleBox2: TToggleBox + Left = 357 + Height = 23 + Top = 155 + Width = 90 + Caption = 'ToggleBox2' + TabOrder = 1 + end + end end end object Panel2: TPanel @@ -63,9 +144,9 @@ object Form1: TForm1 TabOrder = 0 end object RadioGroup1: TRadioGroup - Left = 17 + Left = 21 Height = 113 - Top = 80 + Top = 144 Width = 100 AutoFill = True Caption = 'Tab Position' @@ -95,7 +176,6 @@ object Form1: TForm1 Top = 276 Width = 75 Caption = 'Long Tabs' - Enabled = False OnClick = CheckBox1Click TabOrder = 3 end @@ -110,12 +190,13 @@ object Form1: TForm1 TabOrder = 1 Value = 50 end - object GradButton1: TGradButton + object NewPageBtn: TGradButton Left = 16 Height = 25 Top = 48 - Width = 104 + Width = 100 Caption = 'New Page' + Font.Color = clWhite OnClick = BewegeBtn TabOrder = 4 TabStop = True @@ -141,6 +222,29 @@ object Form1: TForm1 OnChange = SpinEdit2Change TabOrder = 5 end + object DeleteBtn: TGradButton + Left = 16 + Height = 25 + Top = 80 + Width = 100 + Caption = 'Delete' + Font.Color = clWhite + OnClick = DeleteBtnClick + TabOrder = 6 + TabStop = True + NormalBlend = 0.5 + OverBlend = 0.653 + BaseColor = clBlue + Color = clBlue + NormalBlendColor = clWhite + OverBlendColor = clSilver + BackgroundColor = clBtnFace + BorderSides = [bsTopLine, bsBottomLine, bsLeftLine, bsRightLine] + ShowFocusBorder = True + GlyphBackgroundColor = clWhite + ClickColor = clBlue + AutoWidthBorderSpacing = 15 + end end object Splitter1: TSplitter Left = 751 @@ -154,10 +258,4 @@ object Form1: TForm1 Caption = 'New Item1' end end - object SynPHPSyn1: TSynPHPSyn - DefaultFilter = 'PHP-Dateien (*.php,*.php3,*.phtml,*.inc)|*.php;*.php3;*.phtml;*.inc' - Enabled = False - left = 115 - top = 255 - end end diff --git a/components/gradcontrols/examples/Forms/unit1.lrs b/components/gradcontrols/examples/Forms/unit1.lrs index f9c1bcac7..b4f1a6fe1 100644 --- a/components/gradcontrols/examples/Forms/unit1.lrs +++ b/components/gradcontrols/examples/Forms/unit1.lrs @@ -1,51 +1,83 @@ { Das ist eine automatisch erzeugte Lazarus-Ressourcendatei } LazarusResources.Add('TForm1','FORMDATA',[ - 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#14#1#6'Height'#3#250#1#3'Top'#2'b'#5'Widt' - +'h'#3#130#3#7'Caption'#6#5'Form1'#12'ClientHeight'#3#250#1#11'ClientWidth'#3 - +#130#3#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy'#10'Parent' - +'Font'#8#10'LCLVersion'#6#6'0.9.27'#0#6'TPanel'#6'Panel1'#6'Height'#3#250#1#5 - +'Width'#3#239#2#5'Align'#7#6'alLeft'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRi' - +'ght'#8'akBottom'#0#7'Caption'#6#6'Panel1'#12'ClientHeight'#3#250#1#11'Clien' - +'tWidth'#3#239#2#8'TabOrder'#2#0#7'OnClick'#7#9'BewegeBtn'#0#15'TGradTabCont' - +'rol'#15'GradTabControl1'#4'Left'#2#1#6'Height'#3#248#1#3'Top'#2#1#5'Width'#3 - +#237#2#5'Align'#7#8'alClient'#12'ControlStyle'#11#17'csAcceptsControls'#0#9 - +'PageIndex'#2#255#9'TabHeight'#2#30#11'TabPosition'#7#6'tpLeft'#13'MoveIncre' - +'ment'#2#1#0#0#0#6'TPanel'#6'Panel2'#4'Left'#3#244#2#6'Height'#3#250#1#5'Wid' - +'th'#3#142#0#5'Align'#7#8'alClient'#7'Caption'#6#6'Panel2'#12'ClientHeight'#3 - +#250#1#11'ClientWidth'#3#142#0#8'TabOrder'#2#2#7'OnClick'#7#11'Panel2Click'#0 - +#6'TLabel'#6'Label1'#4'Left'#2#15#6'Height'#2#14#3'Top'#3'0'#1#5'Width'#2'O' - +#7'Caption'#6#14'Move Increment'#11'ParentColor'#8#0#0#9'TComboBox'#9'ComboB' - +'ox1'#4'Left'#2#16#6'Height'#2#21#3'Top'#2#16#5'Width'#2'd'#10'ItemHeight'#2 - +#13#9'MaxLength'#2#255#8'OnChange'#7#15'ComboBox1Change'#5'Style'#7#14'csDro' - +'pDownList'#8'TabOrder'#2#0#0#0#11'TRadioGroup'#11'RadioGroup1'#4'Left'#2#17 - +#6'Height'#2'q'#3'Top'#2'P'#5'Width'#2'd'#8'AutoFill'#9#7'Caption'#6#12'Tab ' - +'Position'#28'ChildSizing.LeftRightSpacing'#2#6#28'ChildSizing.TopBottomSpac' - +'ing'#2#6#29'ChildSizing.EnlargeHorizontal'#7#24'crsHomogenousChildResize'#27 - +'ChildSizing.EnlargeVertical'#7#24'crsHomogenousChildResize'#28'ChildSizing.' - +'ShrinkHorizontal'#7#14'crsScaleChilds'#26'ChildSizing.ShrinkVertical'#7#14 - +'crsScaleChilds'#18'ChildSizing.Layout'#7#29'cclLeftToRightThenTopToBottom' - +#27'ChildSizing.ControlsPerLine'#2#1#12'ClientHeight'#2'_'#11'ClientWidth'#2 - +'`'#9'ItemIndex'#2#0#13'Items.Strings'#1#6#5'tpTop'#6#8'tpBottom'#6#6'tpLeft' - +#6#7'tpRight'#0#7'OnClick'#7#16'RadioGroup1Click'#8'TabOrder'#2#2#0#0#9'TChe' - +'ckBox'#9'CheckBox1'#4'Left'#2#15#6'Height'#2#19#3'Top'#3#20#1#5'Width'#2'K' - +#7'Caption'#6#9'Long Tabs'#7'Enabled'#8#7'OnClick'#7#14'CheckBox1Click'#8'Ta' - +'bOrder'#2#3#0#0#9'TSpinEdit'#9'SpinEdit1'#4'Left'#2'_'#6'Height'#2#19#3'Top' - +#3#20#1#5'Width'#2'"'#7'Enabled'#8#8'MaxValue'#2'2'#13'OnEditingDone'#7#20'S' - +'pinEdit1EditingDone'#8'TabOrder'#2#1#5'Value'#2'2'#0#0#11'TGradButton'#11'G' - +'radButton1'#4'Left'#2#16#6'Height'#2#25#3'Top'#2'0'#5'Width'#2'h'#7'Caption' - +#6#8'New Page'#7'OnClick'#7#9'BewegeBtn'#8'TabOrder'#2#4#7'TabStop'#9#11'Nor' - +'malBlend'#5#0#0#0#0#0#0#0#128#254'?'#9'OverBlend'#5'5^'#186'I'#12#2'+'#167 - +#254'?'#9'BaseColor'#7#6'clBlue'#5'Color'#7#6'clBlue'#16'NormalBlendColor'#7 - +#7'clWhite'#14'OverBlendColor'#7#8'clSilver'#15'BackgroundColor'#7#9'clBtnFa' - +'ce'#11'BorderSides'#11#9'bsTopLine'#12'bsBottomLine'#10'bsLeftLine'#11'bsRi' - +'ghtLine'#0#15'ShowFocusBorder'#9#20'GlyphBackgroundColor'#7#7'clWhite'#10'C' - +'lickColor'#7#6'clBlue'#22'AutoWidthBorderSpacing'#2#15#0#0#9'TSpinEdit'#9'S' - +'pinEdit2'#4'Left'#2#15#6'Height'#2#23#3'Top'#3'@'#1#5'Width'#2'O'#8'MinValu' - +'e'#2#156#8'OnChange'#7#15'SpinEdit2Change'#8'TabOrder'#2#5#0#0#0#9'TSplitte' - +'r'#9'Splitter1'#4'Left'#3#239#2#6'Height'#3#250#1#5'Width'#2#5#0#0#10'TPopu' - +'pMenu'#10'PopupMenu1'#4'left'#3#222#2#3'top'#3#141#1#0#9'TMenuItem'#9'MenuI' - +'tem1'#7'Caption'#6#9'New Item1'#0#0#0#10'TSynPHPSyn'#10'SynPHPSyn1'#13'Defa' - +'ultFilter'#6'CPHP-Dateien (*.php,*.php3,*.phtml,*.inc)|*.php;*.php3;*.phtml' - +';*.inc'#7'Enabled'#8#4'left'#2's'#3'top'#3#255#0#0#0#0 + 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#254#0#6'Height'#3#250#1#3'Top'#2't'#5'Wid' + +'th'#3#130#3#7'Caption'#6#5'Form1'#12'ClientHeight'#3#250#1#11'ClientWidth'#3 + +#130#3#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy'#12'OnMous' + +'eWheel'#7#14'FormMouseWheel'#16'OnMouseWheelDown'#7#18'FormMouseWheelDown' + +#14'OnMouseWheelUp'#7#16'FormMouseWheelUp'#10'ParentFont'#8#10'LCLVersion'#6 + +#6'0.9.27'#0#6'TPanel'#6'Panel1'#6'Height'#3#250#1#5'Width'#3#239#2#5'Align' + +#7#6'alLeft'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#7'Cap' + +'tion'#6#6'Panel1'#12'ClientHeight'#3#250#1#11'ClientWidth'#3#239#2#8'TabOrd' + +'er'#2#0#7'OnClick'#7#9'BewegeBtn'#0#15'TGradTabControl'#15'GradTabControl1' + +#4'Left'#2#1#6'Height'#3#248#1#3'Top'#2#1#5'Width'#3#237#2#5'Align'#7#8'alCl' + +'ient'#12'ControlStyle'#11#17'csAcceptsControls'#0#10'ActivePage'#7#12'GradT' + +'abPage1'#16'OnTabButtonClick'#7#29'GradTabControl1TabButtonClick'#20'OnTabB' + +'uttonMouseDown'#7'!GradTabControl1TabButtonMouseDown'#18'OnTabButtonMouseUp' + +#7#31'GradTabControl1TabButtonMouseUp'#20'OnTabButtonMouseMove'#7'!GradTabCo' + +'ntrol1TabButtonMouseMove'#10'OnDragDrop'#7#23'GradTabControl1DragDrop'#10'O' + +'nDragOver'#7#23'GradTabControl1DragOver'#11'OnMouseDown'#7#24'GradTabContro' + +'l1MouseDown'#14'OnMouseWheelUp'#7#27'GradTabControl1MouseWheelUp'#16'OnMous' + +'eWheelDown'#7#29'GradTabControl1MouseWheelDown'#18'OnPagesBarDragOver'#7#31 + +'GradTabControl1PagesBarDragOver'#9'TabHeight'#2#20#13'MoveIncrement'#2#1#13 + +'OnPageChanged'#7#26'GradTabControl1PageChanged'#0#12'TGradTabPage'#12'GradT' + +'abPage2'#4'Left'#2#2#6'Height'#3#224#1#3'Top'#2#22#5'Width'#3#233#2#9'PageI' + +'ndex'#2#1#7'Caption'#6#12'GradTabPage2'#0#12'TPageControl'#12'PageControl1' + +#4'Left'#3#173#0#6'Height'#3#200#0#3'Top'#2'9'#5'Width'#3#200#0#10'ActivePag' + +'e'#7#9'TabSheet3'#8'TabIndex'#2#2#8'TabOrder'#2#0#10'OnDragDrop'#7#20'PageC' + +'ontrol1DragDrop'#10'OnDragOver'#7#20'PageControl1DragOver'#11'OnMouseDown'#7 + +#21'PageControl1MouseDown'#0#9'TTabSheet'#9'TabSheet1'#7'Caption'#6#9'TabShe' + +'et1'#0#0#9'TTabSheet'#9'TabSheet2'#7'Caption'#6#9'TabSheet2'#0#0#9'TTabShee' + +'t'#9'TabSheet3'#7'Caption'#6#9'TabSheet3'#0#0#0#7'TButton'#7'Button2'#4'Lef' + +'t'#2'/'#6'Height'#2#25#3'Top'#2#28#5'Width'#2'K'#7'Caption'#6#7'Button2'#8 + +'TabOrder'#2#1#0#0#6'TPanel'#6'Panel3'#4'Left'#3#173#1#6'Height'#2'2'#3'Top' + +#2'Y'#5'Width'#3#170#0#7'Caption'#6#6'Panel3'#8'TabOrder'#2#2#0#0#0#12'TGrad' + +'TabPage'#12'GradTabPage1'#4'Left'#2#2#6'Height'#3#224#1#3'Top'#2#22#5'Width' + +#3#233#2#7'Caption'#6#12'GradTabPage1'#0#7'TButton'#7'Button1'#4'Left'#2'^'#6 + +'Height'#2#25#3'Top'#2'2'#5'Width'#2'K'#7'Caption'#6#7'Button1'#8'TabOrder'#2 + +#0#0#0#10'TToggleBox'#10'ToggleBox2'#4'Left'#3'e'#1#6'Height'#2#23#3'Top'#3 + +#155#0#5'Width'#2'Z'#7'Caption'#6#10'ToggleBox2'#8'TabOrder'#2#1#0#0#0#0#0#6 + +'TPanel'#6'Panel2'#4'Left'#3#244#2#6'Height'#3#250#1#5'Width'#3#142#0#5'Alig' + +'n'#7#8'alClient'#7'Caption'#6#6'Panel2'#12'ClientHeight'#3#250#1#11'ClientW' + +'idth'#3#142#0#8'TabOrder'#2#2#7'OnClick'#7#11'Panel2Click'#0#6'TLabel'#6'La' + +'bel1'#4'Left'#2#15#6'Height'#2#14#3'Top'#3'0'#1#5'Width'#2'O'#7'Caption'#6 + +#14'Move Increment'#11'ParentColor'#8#0#0#9'TComboBox'#9'ComboBox1'#4'Left'#2 + +#16#6'Height'#2#21#3'Top'#2#16#5'Width'#2'd'#10'ItemHeight'#2#13#9'MaxLength' + +#2#255#8'OnChange'#7#15'ComboBox1Change'#5'Style'#7#14'csDropDownList'#8'Tab' + +'Order'#2#0#0#0#11'TRadioGroup'#11'RadioGroup1'#4'Left'#2#21#6'Height'#2'q'#3 + +'Top'#3#144#0#5'Width'#2'd'#8'AutoFill'#9#7'Caption'#6#12'Tab Position'#28'C' + +'hildSizing.LeftRightSpacing'#2#6#28'ChildSizing.TopBottomSpacing'#2#6#29'Ch' + +'ildSizing.EnlargeHorizontal'#7#24'crsHomogenousChildResize'#27'ChildSizing.' + +'EnlargeVertical'#7#24'crsHomogenousChildResize'#28'ChildSizing.ShrinkHorizo' + +'ntal'#7#14'crsScaleChilds'#26'ChildSizing.ShrinkVertical'#7#14'crsScaleChil' + +'ds'#18'ChildSizing.Layout'#7#29'cclLeftToRightThenTopToBottom'#27'ChildSizi' + +'ng.ControlsPerLine'#2#1#12'ClientHeight'#2'_'#11'ClientWidth'#2'`'#9'ItemIn' + +'dex'#2#0#13'Items.Strings'#1#6#5'tpTop'#6#8'tpBottom'#6#6'tpLeft'#6#7'tpRig' + +'ht'#0#7'OnClick'#7#16'RadioGroup1Click'#8'TabOrder'#2#2#0#0#9'TCheckBox'#9 + +'CheckBox1'#4'Left'#2#15#6'Height'#2#19#3'Top'#3#20#1#5'Width'#2'K'#7'Captio' + +'n'#6#9'Long Tabs'#7'OnClick'#7#14'CheckBox1Click'#8'TabOrder'#2#3#0#0#9'TSp' + +'inEdit'#9'SpinEdit1'#4'Left'#2'_'#6'Height'#2#19#3'Top'#3#20#1#5'Width'#2'"' + +#7'Enabled'#8#8'MaxValue'#2'2'#13'OnEditingDone'#7#20'SpinEdit1EditingDone'#8 + +'TabOrder'#2#1#5'Value'#2'2'#0#0#11'TGradButton'#10'NewPageBtn'#4'Left'#2#16 + +#6'Height'#2#25#3'Top'#2'0'#5'Width'#2'd'#7'Caption'#6#8'New Page'#10'Font.C' + +'olor'#7#7'clWhite'#7'OnClick'#7#9'BewegeBtn'#8'TabOrder'#2#4#7'TabStop'#9#11 + +'NormalBlend'#5#0#0#0#0#0#0#0#128#254'?'#9'OverBlend'#5'5^'#186'I'#12#2'+' + +#167#254'?'#9'BaseColor'#7#6'clBlue'#5'Color'#7#6'clBlue'#16'NormalBlendColo' + +'r'#7#7'clWhite'#14'OverBlendColor'#7#8'clSilver'#15'BackgroundColor'#7#9'cl' + +'BtnFace'#11'BorderSides'#11#9'bsTopLine'#12'bsBottomLine'#10'bsLeftLine'#11 + ,'bsRightLine'#0#15'ShowFocusBorder'#9#20'GlyphBackgroundColor'#7#7'clWhite' + +#10'ClickColor'#7#6'clBlue'#22'AutoWidthBorderSpacing'#2#15#0#0#9'TSpinEdit' + +#9'SpinEdit2'#4'Left'#2#15#6'Height'#2#23#3'Top'#3'@'#1#5'Width'#2'O'#8'MinV' + +'alue'#2#156#8'OnChange'#7#15'SpinEdit2Change'#8'TabOrder'#2#5#0#0#11'TGradB' + +'utton'#9'DeleteBtn'#4'Left'#2#16#6'Height'#2#25#3'Top'#2'P'#5'Width'#2'd'#7 + +'Caption'#6#6'Delete'#10'Font.Color'#7#7'clWhite'#7'OnClick'#7#14'DeleteBtnC' + +'lick'#8'TabOrder'#2#6#7'TabStop'#9#11'NormalBlend'#5#0#0#0#0#0#0#0#128#254 + +'?'#9'OverBlend'#5'5^'#186'I'#12#2'+'#167#254'?'#9'BaseColor'#7#6'clBlue'#5 + +'Color'#7#6'clBlue'#16'NormalBlendColor'#7#7'clWhite'#14'OverBlendColor'#7#8 + +'clSilver'#15'BackgroundColor'#7#9'clBtnFace'#11'BorderSides'#11#9'bsTopLine' + +#12'bsBottomLine'#10'bsLeftLine'#11'bsRightLine'#0#15'ShowFocusBorder'#9#20 + +'GlyphBackgroundColor'#7#7'clWhite'#10'ClickColor'#7#6'clBlue'#22'AutoWidthB' + +'orderSpacing'#2#15#0#0#0#9'TSplitter'#9'Splitter1'#4'Left'#3#239#2#6'Height' + +#3#250#1#5'Width'#2#5#0#0#10'TPopupMenu'#10'PopupMenu1'#4'left'#3#222#2#3'to' + +'p'#3#141#1#0#9'TMenuItem'#9'MenuItem1'#7'Caption'#6#9'New Item1'#0#0#0#0 ]); diff --git a/components/gradcontrols/examples/Forms/unit1.pas b/components/gradcontrols/examples/Forms/unit1.pas index 5cabef75f..544d2f2e9 100644 --- a/components/gradcontrols/examples/Forms/unit1.pas +++ b/components/gradcontrols/examples/Forms/unit1.pas @@ -9,13 +9,10 @@ unit Unit1; gelöscht werden ^^ ToDo: - - TGradTabBar & TGradTabPagesBar mit sortieren von Tabs "ausstatten" - - TabPosition einbauen, sowie das zeichnen und anordnen der Tabs/Pages ändern - CurrentPage-Button ohne Abstand - IDE Testen hoffe es geht *g* Danach: - - Eigene Page Classen zu ordnen ( bräuchte ich zumindest ^^ ) - Feddich - Tabs disable-n - noch welche Wünsche? xD - Testen testen testen und voila wir haben eine neue komponente :D @@ -26,11 +23,11 @@ unit Unit1; interface uses - Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls, - ugradbtn, StdCtrls, ComCtrls, LCLType, LCLProc, Buttons, ugradtabcontrol, + windows, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls, + ugradbtn, StdCtrls, ComCtrls, LCLType, LCLProc, LCLIntf, Buttons, ugradtabcontrol, Menus, Spin, ButtonPanel, MaskEdit, DBGrids, DbCtrls, EditBtn, Arrow, - SynHighlighterPHP, Grids, SynEdit; + SynHighlighterPHP, Grids, SynEdit, SynMemo; type @@ -41,15 +38,20 @@ type { TForm1 } TForm1 = class(TForm) + Button1: TButton; + Button2: TButton; CheckBox1: TCheckBox; ComboBox1: TComboBox; Edit1: TEdit; - GradButton1: TGradButton; + GradTabPage1: TGradTabPage; + GradTabPage2: TGradTabPage; + NewPageBtn: TGradButton; + DeleteBtn: TGradButton; GradTabControl1: TGradTabControl; Label1: TLabel; - Memo1: TMemo; Memo2: TMemo; MenuItem1: TMenuItem; + PageControl1: TPageControl; Panel1: TPanel; Panel2: TPanel; Panel3: TPanel; @@ -59,14 +61,22 @@ type SpinEdit2: TSpinEdit; Splitter1: TSplitter; StringGrid1: TStringGrid; - SynEdit1: TSynEdit; - SynPHPSyn1: TSynPHPSyn; + TabSheet1: TTabSheet; + TabSheet2: TTabSheet; + TabSheet3: TTabSheet; + ToggleBox2: TToggleBox; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure CheckBox1Click(Sender: TObject); procedure ComboBox1Change(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); + procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); + procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState; + MousePos: TPoint; var Handled: Boolean); + procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState; + MousePos: TPoint; var Handled: Boolean); procedure GradButton1Click(Sender: TObject); procedure GradButton1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); @@ -76,16 +86,41 @@ type Y: Integer); procedure GradButton1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - procedure GradButton2Click(Sender: TObject); + procedure DeleteBtnClick(Sender: TObject); procedure BewegeBtn(Sender: TObject); procedure GradButton3Click(Sender: TObject); procedure GradButton4Click(Sender: TObject); + procedure GradTabControl1DragDrop(Sender, Source: TObject; X, Y: Integer); + procedure GradTabControl1DragOver(Sender, Source: TObject; X, Y: Integer; + State: TDragState; var Accept: Boolean); + procedure GradTabControl1MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure GradTabControl1MouseMove(Sender: TObject; Shift: TShiftState; X, + Y: Integer); + procedure GradTabControl1MouseWheelDown(Sender: TObject; + Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); + procedure GradTabControl1MouseWheelUp(Sender: TObject; Shift: TShiftState; + MousePos: TPoint; var Handled: Boolean); + procedure GradTabControl1PageChanged(Sender: TObject); + procedure GradTabControl1PagesBarDragOver(Sender, Source: TObject; X, + Y: Integer; State: TDragState; var Accept: Boolean); procedure GradTabControl1TabButtonClick(GradTabControl: TGradTabControl; AIndex: Integer); + procedure GradTabControl1TabButtonMouseDown( + GradTabControl: TGradTabControl; Button: TMouseButton; + Shift: TShiftState; X, Y, AIndex: Integer); + procedure GradTabControl1TabButtonMouseMove( + GradTabControl: TGradTabControl; Shift: TShiftState; X, Y, AIndex: Integer + ); procedure GradTabControl1TabButtonMouseUp(GradTabControl: TGradTabControl; Button: TMouseButton; Shift: TShiftState; X, Y, AIndex: Integer); procedure GradTabControl2TabButtonClick(GradTabControl: TGradTabControl; AIndex: Integer); + procedure PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer); + procedure PageControl1DragOver(Sender, Source: TObject; X, Y: Integer; + State: TDragState; var Accept: Boolean); + procedure PageControl1MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); procedure Panel2Click(Sender: TObject); procedure RadioGroup1Click(Sender: TObject); procedure SpinEdit1EditingDone(Sender: TObject); @@ -105,7 +140,6 @@ var implementation - { TForm1 } procedure TForm1.FormCreate(Sender: TObject); @@ -194,7 +228,7 @@ begin WriteLn(BoolToStr(GradTabControl1.Pages[0] <> nil,true)); - GradButton1.Parent := GradTabControl1.Pages[0]; + NewPageBtn.Parent := GradTabControl1.Pages[0]; BitBtn1.Parent := GradTabControl1.Pages[0]; } //GradButton3Click(GradButton3); @@ -247,6 +281,24 @@ begin GradTabControl1.Free; end; +procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); +begin + +end; + +procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState; + MousePos: TPoint; var Handled: Boolean); +begin + +end; + +procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState; + MousePos: TPoint; var Handled: Boolean); +begin + +end; + procedure TForm1.GradButton1Click(Sender: TObject); begin @@ -280,19 +332,36 @@ begin end; -procedure TForm1.GradButton2Click(Sender: TObject); +procedure TForm1.DeleteBtnClick(Sender: TObject); var C : Integer; + T : String; begin - GradTabControl1.PagesBar.MoveTo(SpinEdit2.Value); + T := ComboBox1.Text; + C := GradTabControl1.Tabs.IndexOf(T); + + DebugLn('Text=%s Index=%d',[T,ComboBox1.Items.IndexOf(T)]); + + if (C < GradTabControl1.PageList.Count) AND (GradTabControl1.PageList.Count<>0) then + begin + ComboBox1.Items.Delete(ComboBox1.Items.IndexOf(T)); + GradTabControl1.Tabs.Delete(C); + + end; end; procedure TForm1.BewegeBtn(Sender: TObject); var C,R,G,B : Integer; + newName : String; begin - C := GradTabControl1.Tabs.Count; - GradTabControl1.Tabs.Add('tab_'+IntToStr(C)); + C := -1; + + repeat + Inc(C); + newName := 'tab_'+IntToStr(C); + until(GradTabControl1.Tabs.IndexOf(newName)=-1); + GradTabControl1.Tabs.Add(newName); Randomize; @@ -301,10 +370,10 @@ begin B := Random(255)+1; //WriteLn(R, ' ', G, ' ', B, ColorToString(RGBToColor(R,G,B))); - GradTabControl1.CurrentPage.Caption:='tab_'+IntToStr(C); + GradTabControl1.ActivePage.Caption:='tab_'+IntToStr(C); //GradTabControl1.CurrentPage.Color:=RGBToColor(R, G, B); - GradTabControl1.CurrentPage.TabPopupMenu := PopupMenu1; - GradTabControl1.CurrentPage.PopupMenu:= PopupMenu1; + GradTabControl1.ActivePage.TabPopupMenu := PopupMenu1; + GradTabControl1.ActivePage.PopupMenu:= PopupMenu1; ComboBox1.ItemIndex:=ComboBox1.Items.Add('tab_'+IntToStr(C)); end; @@ -327,17 +396,92 @@ begin GradTabControl1.PagesBar.MoveToNorm; end; +procedure TForm1.GradTabControl1DragDrop(Sender, Source: TObject; X, Y: Integer + ); +begin + DebugLn('DragDrop X=%d Y=%d',[X,Y]); +end; + +procedure TForm1.GradTabControl1DragOver(Sender, Source: TObject; X, + Y: Integer; State: TDragState; var Accept: Boolean); +begin + DebugLn('Name=%s',[Sender.ClassName]); + if (Sender is TGradTabControl) then Accept := True; +end; + +procedure TForm1.GradTabControl1MouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + ShowMessage('Jep'); +end; + +procedure TForm1.GradTabControl1MouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); +begin + DebugLn('X=%d Y=%d',[X,Y]); +end; + +procedure TForm1.GradTabControl1MouseWheelDown(Sender: TObject; + Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); +var + NewNum : Integer; +begin + NewNum:= GradTabControl1.CurrentPageNum; + Inc(NewNum); + GradTabControl1.CurrentPageNum:=NewNum; +end; + +procedure TForm1.GradTabControl1MouseWheelUp(Sender: TObject; + Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); +var + NewNum : Integer; +begin + NewNum:= GradTabControl1.CurrentPageNum; + Dec(NewNum); + GradTabControl1.CurrentPageNum:=NewNum; +end; + +procedure TForm1.GradTabControl1PageChanged(Sender: TObject); +begin + with GradTabControl1 do + ComboBox1.Text:=Tabs[CurrentPageNum]; +end; + +procedure TForm1.GradTabControl1PagesBarDragOver(Sender, Source: TObject; X, + Y: Integer; State: TDragState; var Accept: Boolean); +begin + DebugLn('Name=%s',[Sender.ClassName]); + if (Sender is TGradTabPagesBar) then Accept := True; +end; + procedure TForm1.GradTabControl1TabButtonClick(GradTabControl: TGradTabControl; AIndex: Integer); begin - ShowMessage('TabClicked: Index: '+IntToStr(AIndex)+' Caption: '+GradTabControl.Page[AIndex].Caption); + //ShowMessage('TabClicked: Index: '+IntToStr(AIndex)+' Caption: '+GradTabControl.Page[AIndex].Caption); +end; + +procedure TForm1.GradTabControl1TabButtonMouseDown( + GradTabControl: TGradTabControl; Button: TMouseButton; Shift: TShiftState; X, + Y, AIndex: Integer); +begin + if ssCtrl in Shift then + GradTabControl1.BeginDrag(False); +end; + +procedure TForm1.GradTabControl1TabButtonMouseMove( + GradTabControl: TGradTabControl; Shift: TShiftState; X, Y, AIndex: Integer); +var + TabRect : TRect; +begin + //TabRect := GradTabControl.GetTabRect(Aindex); + //DebugLn('X=%d Y=%d AIndex=%d',[X+TabRect.Left,Y+TabRect.Top,AIndex]); end; procedure TForm1.GradTabControl1TabButtonMouseUp( GradTabControl: TGradTabControl; Button: TMouseButton; Shift: TShiftState; X, Y, AIndex: Integer); begin - ShowMessage('TabMouseUp: Index: '+IntToStr(AIndex)+' Caption: '+GradTabControl.Page[AIndex].Caption); + //ShowMessage('TabMouseUp: Index: '+IntToStr(AIndex)+' Caption: '+GradTabControl.Page[AIndex].Caption); if Button=mbMiddle then begin @@ -362,6 +506,41 @@ begin end; end; +procedure TForm1.PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer); +const + TCM_GETITEMRECT = $130A; +var + TabRect: TRect; + j: Integer; +begin + if (Sender is TGradTabControl) then + for j := 0 to GradTabControl1.PageCount - 1 do + begin + //GradTabControl1.Perform(TCM_GETITEMRECT, j, LParam(@TabRect)) ; + TabRect := GradTabControl1.GetTabRect(j); + DebugLn('X=%d Y=%d T.L=%d T.T=%d T.R=%d T.B=%d',[X,Y,TabRect.Left, TabRect.Top, TabRect.Right, TabRect.Bottom]); + if PtInRect(TabRect, Point(X, Y)) then + begin + if GradTabControl1.ActivePage.PageIndex <> j then + GradTabControl1.ActivePage.PageIndex := j; + Exit; + end; + end; +end; + +procedure TForm1.PageControl1DragOver(Sender, Source: TObject; X, Y: Integer; + State: TDragState; var Accept: Boolean); +begin + DebugLn('Name=%s',[Sender.ClassName]); + if (Sender is TGradTabControl) then Accept := True; +end; + +procedure TForm1.PageControl1MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + PageControl1.BeginDrag(False) ; +end; + procedure TForm1.Panel2Click(Sender: TObject); begin diff --git a/components/gradcontrols/examples/gradcontroltest.lpi b/components/gradcontrols/examples/gradcontroltest.lpi index 2c6347e70..519483876 100644 --- a/components/gradcontrols/examples/gradcontroltest.lpi +++ b/components/gradcontrols/examples/gradcontroltest.lpi @@ -6,7 +6,6 @@ - <UseAppBundle Value="False"/> @@ -15,7 +14,7 @@ <VersionInfo> <UseVersionInfo Value="True"/> <AutoIncrementBuild Value="True"/> - <CurrentBuildNr Value="607"/> + <CurrentBuildNr Value="805"/> <ProjectVersion Value="0.0.0.0"/> </VersionInfo> <PublishOptions> diff --git a/components/gradcontrols/examples/gradcontroltest.lpr b/components/gradcontrols/examples/gradcontroltest.lpr index 8b26ffe1e..a0c8c3ab6 100644 --- a/components/gradcontrols/examples/gradcontroltest.lpr +++ b/components/gradcontrols/examples/gradcontroltest.lpr @@ -14,6 +14,8 @@ uses {$IFDEF WINDOWS}{$R manifest.rc}{$ENDIF} +{$IFDEF WINDOWS}{$R gradcontroltest.rc}{$ENDIF} + begin Application.Initialize; Application.CreateForm(TForm1,Form1); diff --git a/components/gradcontrols/src/ugradbtn.pas b/components/gradcontrols/src/ugradbtn.pas index da5f2331d..21dbc6ab4 100644 --- a/components/gradcontrols/src/ugradbtn.pas +++ b/components/gradcontrols/src/ugradbtn.pas @@ -33,7 +33,8 @@ type TGradButton = class(TCustomControl) private - FAutoWidthBorderSpacing: Integer; + FAutoWidthBorderSpacing: Integer; + FOnMouseMove: TMouseMoveEvent; FRotateDirection : TRotateDirection; FTextAlignment : TTextAlignment; FButtonLayout: TButtonLayout; @@ -125,7 +126,7 @@ type property OnMouseDown; property OnMouseEnter; property OnMouseLeave; - property OnMouseMove; + property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove; property OnMouseUp; property OnPaint; property OnResize; @@ -1081,16 +1082,23 @@ procedure TGradButton.MouseMove(Shift: TShiftState; X, Y: Integer); begin //WriteLn('MouseMove'); - if PtInRect(Rect(0,0,Width,Height),Point(X,Y)) then + //if PtInRect(Rect(0,0,Width,Height),Point(X,Y)) then begin - inherited; - + // + if ssLeft in Shift then FState := bsDown else FState := bsHot; InvPaint(true); + + if Assigned(FOnMouseMove) then begin + //DebugLn('X=%d Y=%d',[X,Y]); + FOnMouseMove(Self, Shift, X,Y); + end; + + //inherited; end; end; diff --git a/components/gradcontrols/src/ugradtabcontrol.lrs b/components/gradcontrols/src/ugradtabcontrol.lrs new file mode 100644 index 000000000..f4de868db --- /dev/null +++ b/components/gradcontrols/src/ugradtabcontrol.lrs @@ -0,0 +1,6 @@ +LazarusResources.Add('close_btn','PNG',[ + #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#10#0#0#0#10#8#6#0#0#0#141'2'#207 + +#189#0#0#0'0IDATx'#218'c````d '#1#252#135'b'#130#226#255#177#8#254#199'e'#192 + +''#28#24#175#19#240'*b '#215'4'#130#238#195#235#25#162#131#135' '#0#0#177'5' + +''''#218'{1'#230#136#0#0#0#0'IEND'#174'B`'#130 +]); diff --git a/components/gradcontrols/src/ugradtabcontrol.pas b/components/gradcontrols/src/ugradtabcontrol.pas index 9910f6a33..99b6bccf2 100644 --- a/components/gradcontrols/src/ugradtabcontrol.pas +++ b/components/gradcontrols/src/ugradtabcontrol.pas @@ -3,12 +3,19 @@ unit ugradtabcontrol; {------------------------------------------------------------------------------- @name GradTabControl @author Eugen Bolz - @lastchange 28.07.2008 + @lastchange 07.10.2008 @version 0.1 - @comments TGradTabControl is based on TNotebook/TPageControl + @comments TGradTabControl is based on TNotebook/TPageControl/TTabControl @license http://creativecommons.org/licenses/LGPL/2.1/ @todo: - + - If a Button isnt visible but focused the bar should move to the button - working + - LongTabs at Left/Right - Side needed + - Close Button at Tabs + - Drawer needed or first style wishes + - Button Events accessable from Page-Events + - TabBar Events accessable from TGradTabControl + - Maybe rename TGradTabControl to TCustomPageControl and of these + TGradTabControl and TGradPageControl ------------------------------------------------------------------------------} {$mode objfpc}{$H+} @@ -19,7 +26,7 @@ interface uses Classes,LResources, SysUtils, Menus, LCLType, - LCLProc, ExtCtrls, Graphics, ugradbtn,Controls, urotatebitmap; + LCLProc, ExtCtrls, Graphics, ugradbtn, Controls, uRotateBitmap; type TGradTabControl = class; @@ -40,13 +47,30 @@ type destructor Destroy; override; procedure Resize; override; property ShowCloseButton : Boolean read FShowCloseButton write SetShowCloseButton default false; + published + property OnStartDock; + property OnStartDrag; + property OnDockDrop; + property OnDockOver; + property OnDragDrop; + property OnDragOver; + property OnEndDock; + property OnEndDrag; + property OnMouseDown; + property OnMouseUp; + property OnMouseMove; + property OnMouseWheel; + property OnMouseWheelUp; + property OnMouseWheelDown; end; TGradTabPageButtonClickEvent = procedure(GradTabControl : TGradTabControl;AIndex : Integer) of object; TGradTabPageButtonMouseDownUpEvent = procedure(GradTabControl : TGradTabControl;Button: TMouseButton; Shift: TShiftState; X, Y, AIndex: Integer) of object; - - //Eigenschaft des Tabs hier miteinbauen + TGradTabPageButtonMouseMoveEvent = procedure(GradTabControl : TGradTabControl; Shift: TShiftState; + X, Y, AIndex: Integer) of object; + + //Properties of the Tab should be accessable from here TGradTabPage = class(TCustomControl) private FButton : TGradTabPageButton; @@ -61,7 +85,7 @@ type protected function GetPageIndex: integer; procedure SetPageIndex(AValue: Integer); - procedure SetButton(Value : TGradTabPageButton); //Spaeter nicht mehr nötig + procedure SetButton(Value : TGradTabPageButton); //Later dont needed procedure SetParent(NewParent: TWinControl); override; procedure SetShowCloseButton(Value: Boolean); procedure SetTabVisible(Value: Boolean); @@ -80,19 +104,34 @@ type property Caption : TCaption read GetText write SetText; property ShowCloseButton : Boolean read FShowCloseButton write SetShowCloseButton default false; property TabPopupMenu : TPopupMenu read GetTabPopupMenu write SetTabPopupMenu; + property OnStartDock; + property OnStartDrag; + property OnDockDrop; + property OnDockOver; + property OnDragDrop; + property OnDragOver; + property OnEndDock; + property OnEndDrag; + property OnMouseDown; + property OnMouseUp; + property OnMouseMove; + property OnMouseWheel; + property OnMouseWheelUp; + property OnMouseWheelDown; end; - //Zeigt die Tabs an - //Dafür extra eine Komponente damit die Tabs auch "abgehackt" - //angezeigt werden können - //ohne ihre größe zu ändern^^ - //Die Tab wechsel Effekte werden nur auf diesem Control ausgeführt - { TGradTabPagesBar } + TTabs = Array of Integer; + + { + @name TGradTabPagesBar + @comments Shows and Order the TabButtons + } TGradTabPagesBar = class(TCustomControl) private FPageList : TListWithEvent; + FTabControl : TGradTabControl; FShowFromButton, FMovedTo : Integer; FTabPosition : TTabPosition; FTabHeight,FLongWidth : Integer; @@ -102,22 +141,44 @@ type procedure OrderButtons; procedure UnFocusButton(Index: Integer); procedure FocusButton(Index: Integer); - procedure SetTabPosition(Value: - TTabPosition); + procedure SetTabPosition(Value: TTabPosition); function IsVisible(Index: Integer) : Boolean; procedure ChangeLeftTop(LastTabPosition : TTabPosition); + function GetViewedTabs : TTabs; public - constructor Create(AOwner: TComponent; var thePageList: TListWithEvent); + constructor Create(AOwner: TComponent; var thePageList: TListWithEvent; + TheTabControl : TGradTabControl); procedure Paint; override; + procedure MoveToNext; + procedure MoveToPrior; procedure MoveTo(Num: Integer); procedure MoveToNorm; property TabPosition : TTabPosition read FTabPosition write SetTabPosition; + published + property OnStartDock; + property OnStartDrag; + property OnDockDrop; + property OnDockOver; + property OnDragDrop; + property OnDragOver; + property OnEndDock; + property OnEndDrag; + property OnMouseDown; + property OnMouseUp; + property OnMouseMove; + property OnMouseWheel; + property OnMouseWheelUp; + property OnMouseWheelDown; //destructor Destroy; override; end; //Verwaltet die extra Buttons ( wie weiter/zurück ) //Verschiebt die ansicht von TGradTabPagesBar //irgendwann mit effekt + { + @name TGradTabBar + @description + } TGradTabBar = class(TCustomControl) public constructor Create(AOwner: TComponent); override; @@ -153,24 +214,29 @@ type private FMoveIncrement: Integer; FLeftButton, FRightButton : TGradButton; + FOnPageChanged: TNotifyEvent; FTabStrings : TStrings; //TGradTabPages FPageList: TList; //Is Managed by TGradTabPages FTabList : TList; //Also ^^ FOnTabButtonClick : TGradTabPageButtonClickEvent; FOnTabButtonMouseDown, FOnTabButtonMouseUp : TGradTabPageButtonMouseDownUpEvent; + FOnTabButtonMouseMove : TGradTabPageButtonMouseMoveEvent; FPageIndex, fPageIndexOnLastChange, fPageIndexOnLastShow, FTabHeight, FLongWidth : Integer; FBar : TGradTabBar; FPagesBar: TGradTabPagesBar; FTabPosition : TTabPosition; FLongTabs : Boolean; + procedure AssignEvents(TheControl : TCustomControl); procedure AlignPage(APage : TGradTabPage; ARect : TRect); + procedure AlignPages; //procedure AddRemovePageHandle(APage: TGradTabPage); //procedure DoSendPageIndex; function GetCurrentPage : TGradTabPage; function GetPage(AIndex: Integer) : TGradTabPage; function GetCount : Integer; + function GetPagesBarDragOver: TDragOverEvent; procedure MoveTab(Sender: TObject; NewIndex: Integer); function FindVisiblePage(Index: Integer): Integer; procedure PageButtonMouseDown(Sender: TObject; Button: TMouseButton; @@ -178,11 +244,30 @@ type procedure PageButtonMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure PageButtonMouseClick(Sender: TObject); + procedure PageButtonMouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); + + //SubControl Events + procedure SubMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); + procedure SubMouseWheelUp(Sender: TObject; + Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); + procedure SubMouseWheelDown(Sender: TObject; + Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); + procedure SubMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure SubMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure SubMouseClick(Sender: TObject); + procedure SubMouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); + //End procedure MoveLeftTopClick(Sender: TObject); procedure MoveRightBottomClick(Sender: TObject); procedure PageRemoved(Index: Integer); procedure SetCurrentPage(Value : TGradTabPage); procedure SetCurrentPageNum(Value: Integer); + procedure SetPagesBarDragOver(const AValue: TDragOverEvent); procedure ShowPage(Index: Integer); procedure ShowCurrentPage; procedure UnShowPage(Index: Integer); @@ -200,8 +285,11 @@ type public constructor Create(AOwner: TComponent); override; destructor Destroy; override; + function GetTabRect(AIndex : Integer) : TRect; + //function GetTabAtPoint(TabPoint : TPoint) : T function AddPage(AName: String) : Integer; function AddPage(APage: TGradTabPage) : Integer; + function GetTabBarSize(TabPos : TTabPosition) : Integer; function GetClientRect: TRect; override; procedure Paint; override; procedure Resize; override; @@ -210,7 +298,6 @@ type //Old - will be erased soon ^^ property CurrentPageNum : Integer read FPageIndex write SetCurrentPageNum; - property CurrentPage : TGradTabPage read GetCurrentPage write SetCurrentPage; property Pages[Index: Integer] : TGradTabPage read GetPage; property Page[Index: Integer] : TGradTabPage read GetPage; property Bar : TGradTabBar read FBar; @@ -225,6 +312,25 @@ type property OnTabButtonClick : TGradTabPageButtonClickEvent read FOnTabButtonClick write FOnTabButtonClick; property OnTabButtonMouseDown : TGradTabPageButtonMouseDownUpEvent read FOnTabButtonMouseDown write FOnTabButtonMouseDown; property OnTabButtonMouseUp : TGradTabPageButtonMouseDownUpEvent read FOnTabButtonMouseUp write FOnTabButtonMouseUp; + property OnTabButtonMouseMove : TGradTabPageButtonMouseMoveEvent read FOnTabButtonMouseMove write FOnTabButtonMouseMove; + property OnStartDock; + property OnStartDrag; + property OnDockDrop; + property OnDockOver; + property OnDragDrop; + property OnDragOver; + property OnEndDock; + property OnEndDrag; + property OnMouseDown; + property OnMouseUp; + property OnMouseMove; + property OnMouseWheel; + property OnMouseWheelUp; + property OnMouseWheelDown; + //On*- PagesBar Events + property OnPagesBarDragOver : TDragOverEvent read GetPagesBarDragOver write SetPagesBarDragOver; + //End + property PageIndex : Integer read FPageIndex write SetCurrentPageNum; property TabHeight : Integer read FTabHeight write SetTabHeight; property TabPosition : TTabPosition read FTabPosition write SetTabPosition default tpTop; @@ -232,11 +338,13 @@ type property LongTabs : Boolean read FLongTabs write SetLongTabs; property LongWidth: Integer read FLongWidth write FLongWidth; property MoveIncrement : Integer read FMoveIncrement write FMoveIncrement; + property OnPageChanged: TNotifyEvent read FOnPageChanged write FOnPageChanged; //property ShowTabs : Boolean; { TODO } end; procedure Register; function IsAssigned(var Obj : TObject) : String; + function BoolStr(BV : Boolean) : String; implementation @@ -262,6 +370,25 @@ begin Result := 'Assigned: '+BoolToStr(Assigned(Obj),true); end; +function BoolStr(BV: Boolean): String; +begin + Result := BoolToStr(BV,true); +end; + +function ValueInArray(Needle : Integer; Stack : TTabs) : Boolean; +var + i : Integer; +begin + Result := false; + DebugLn('ValueInArray: Needle=%d Low=%d High=%d',[Needle, Low(Stack), High(Stack)]); + for i := Low(Stack) to High(Stack) do + if Needle =Stack[i] then + begin + Result := true; + Exit; + end; +end; + {------------------------------------------------------------------------------- TGradTabPageButton Create(AOwner: TComponent ------------------------------------------------------------------------------} @@ -665,17 +792,24 @@ begin end; {------------------------------------------------------------------------------- - TGradTabPagesBar Create(AOwner: TComponent; var theTabList: TListWithEvent) + TGradTabPagesBar Create(AOwner: TComponent; var theTabList: TListWithEvent; + TheTabControl : TGradTabControl) ------------------------------------------------------------------------------} -constructor TGradTabPagesBar.Create(AOwner: TComponent; var thePageList: TListWithEvent); +constructor TGradTabPagesBar.Create(AOwner: TComponent; var thePageList: TListWithEvent; + TheTabControl : TGradTabControl); begin inherited Create(AOwner); FPageList := thePageList; - FShowFromButton:=0; + FShowFromButton:=-1; ControlStyle := ControlStyle+[csNoDesignSelectable]; FTabPosition:=tpTop; FMovedTo:=1; + FTabControl := TheTabControl; + SetSubComponent(true); + + FTabControl.FLeftButton.Visible:=false; + FTabControl.FRightButton.Visible:=false; {Enabled:=false; NotEnabledColor:=Color; @@ -697,6 +831,43 @@ begin inherited; end; +procedure TGradTabPagesBar.MoveToNext; +var + TheTabs : TTabs; + VIA, L : Boolean; +begin + DebugLn('MoveToNext Begin'); + //DebugLn(GetStackTrace(true)); + TheTabs:= GetViewedTabs; + + VIA := ValueInArray(FPageList.Count-1,TheTabs); + L := (Length(TheTabs)>1); + + DebugLn('ValueInArray=%s Length=%s',[BoolToStr(VIA,true),BoolToStr(L,true)]); + + if VIA AND L then + FShowFromButton := TheTabs[0] else + Inc(FShowFromButton); + + if FShowFromButton>=FPageList.Count then + FShowFromButton:= FPageList.Count-1; + + + DebugLn('New FShowFromButton: %d',[FShowFromButton]); + OrderButtons; + + DebugLn('MoveToNext End'); +end; + +procedure TGradTabPagesBar.MoveToPrior; +begin + Dec(FShowFromButton); + if FShowFromButton<0 then FShowFromButton := 0; + + DebugLn('New FShowFromButton: %d',[FShowFromButton]); + OrderButtons; +end; + {------------------------------------------------------------------------------- TGradTabPagesBar InsertButton(AButton: TGradTabPageButton; Index: Integer) ------------------------------------------------------------------------------} @@ -709,17 +880,28 @@ begin if (Index >= 1) AND (FPageList.Count>=1) then LastLeft := TGradTabPage(FPageList.Items[Index-1]).TabButton.Left; + FTabControl.AssignEvents(AButton); + with AButton do begin - Left := LastLeft; + Left:=-123; Parent := Self; ShowFocusBorder:=false; - AutoWidth:=true; TextAlignment:=taCenter; BorderSides:=[bsTopLine,bsRightLine,bsLeftLine]; - OnMouseDown:=@((Self.Owner as TGradTabControl).PageButtonMouseDown); - OnMouseUp:=@((Self.Owner as TGradTabControl).PageButtonMouseUp); - OnClick:=@((Self.Owner as TGradTabControl).PageButtonMouseClick); + OnMouseDown:=@FTabControl.PageButtonMouseDown; + OnMouseUp:=@FTabControl.PageButtonMouseUp; + OnClick:=@FTabControl.PageButtonMouseClick; + OnMouseMove:=@FTabControl.PageButtonMouseMove; + + if TabPosition in [tpTop, tpBottom] then + AutoWidth := true + else if FTabControl.LongTabs then + AutoWidth := false + else + AutoWidth := true; + + end; //FTabList.Insert(Index,AButton); @@ -731,7 +913,7 @@ begin FocusButton(Index); - //OrderButtons; + OrderButtons; //WriteLn('TGradTabPagesBar.InsertButton'); end; @@ -752,7 +934,7 @@ procedure TGradTabPagesBar.MoveTo(Num: Integer); begin Btn := TGradTabPage(FPageList.Items[i]).TabButton; - L := L +1; + L := L + 1; if TabPosition in [tpTop, tpBottom] then begin L := L + Btn.Width; @@ -785,12 +967,12 @@ begin DebugLn('Max: %d, Current: %d',[GetLast+1,FMovedTo]); - FMovedTo:=FMovedTo + Num; + //FMovedTo:=FMovedTo + Num; if FMovedTo > 1 then FMovedTo := 1; if FMovedTo < -GetLast then FMovedTo := -GetLast+2; - OrderButtons; + //OrderButtons; end; procedure TGradTabPagesBar.MoveToNorm; @@ -813,6 +995,23 @@ var begin DebugLn('OrderButton Start'); + FMovedTo:=0; + + if FPageList.Count=0 then Exit; + + for i := FShowFromButton-1 downto 0 do + begin + if i >= FPageList.Count then Continue; + B := TGradTabPage(FPageList.Items[i]).TabButton; + if FTabPosition in [tpRight, tpLeft] then + Dec(FMovedTo,B.Height+1); + + if FTabPosition in [tpTop, tpBottom] then + Dec(FMovedTo,B.Width+1); + end; + + Inc(FMovedTo); + LastLeft:= FMovedTo; LastTop := FMovedTo; @@ -851,6 +1050,11 @@ begin end; end; + + //DebugLn('ActivePage: %d',[FActiveIndex]); + FActiveIndex:=FTabControl.CurrentPageNum; + //DebugLn('ActivePage: %d',[FActiveIndex]); + for i := 0 to FPageList.Count - 1 do begin B := TGradTabPage(FPageList.Items[i]).TabButton; @@ -861,7 +1065,7 @@ begin B.BorderSides := NewBorderSides; B.GradientType := NewGradientType; - DebugLn('Begin I: %d W: %d H: %d L: %d T: %d, BW: %d, BH: %d',[i,B.Width,B.Height,B.Left,B.Top,BarWidth,BarHeight]); + //DebugLn('Begin I: %d W: %d H: %d L: %d T: %d, BW: %d, BH: %d',[i,B.Width,B.Height,B.Left,B.Top,BarWidth,BarHeight]); case FTabPosition of tpTop: @@ -916,43 +1120,26 @@ begin end; end; - - - - - {if FActiveIndex = i then - FocusButton(i) - else - UnFocusButton(i); - } - - - {if FTabPosition in [tpTop, tpBottom] then - begin - B.Left := LastLeft; - LastLeft := LastLeft + B.Width + 1; - - if FTabPosition = tpBottom then begin - - - - - end else begin - - end; - end - else - begin - - if FTabPosition = tpRight then begin - - - end else - end; } - - DebugLn('End I: %d W: %d H: %d L: %d T: %d, BW: %d, BH: %d',[i,B.Width,B.Height,B.Left,B.Top,BarWidth,BarHeight]) + //DebugLn('End I: %d W: %d H: %d L: %d T: %d, BW: %d, BH: %d',[i,B.Width,B.Height,B.Left,B.Top,BarWidth,BarHeight]) end; end; + + DebugLn('BarWidth=%d LastLeft=%d FMovedTo=%d BarHeight=%d LastTop=%d',[BarWidth, + LastLeft, FMovedTo, BarHeight, LastTop]); + + DebugLn('BarWidth < LastLeft-FMovedTo = %s BarHeight < LastTop-FMovedTo=%s',[ + BoolStr(BarWidth < (LastLeft-FMovedTo)), BoolStr(BarHeight < (LastTop-FMovedTo))]); + + if ((BarWidth < (LastLeft-FMovedTo)) OR (BarHeight < (LastTop-FMovedTo))) AND ((BarHeight<>0) AND (BarWidth<>0)) then begin + FTabControl.FLeftButton.Visible:=true; + FTabControl.FRightButton.Visible:=true; + end else begin + FTabControl.FLeftButton.Visible:=false; + FTabControl.FRightButton.Visible:=false; + end; + + DebugLn('FR=%s FL=%s',[BoolStr(FTabControl.FRightButton.Visible),BoolStr(FTabControl.FLeftButton.Visible)]); + DebugLn('OrderButton End'); end; @@ -998,11 +1185,15 @@ end; TGradTabPagesBar FocusButton(Index: Integer) ------------------------------------------------------------------------------} procedure TGradTabPagesBar.FocusButton(Index: Integer); +var + CurTabs : TTabs; + DoNext : Boolean; + c : Integer; begin //FShowFromButton:=Index; if (Index < 0) or (Index >= FPageList.Count) then Exit; - FActiveIndex:=Index; - FShowFromButton:=Index; + //FActiveIndex:=Index; + //FShowFromButton:=Index; {$IFDEF DEBUGTAB} DebugLn('TGradTabPagesBar.FocusButton Index: %d Assigned %s', [Index,BoolToStr(Assigned(TGradTabPage(FPageList.Items[Index]).TabButton),true)]); {$ENDIF} @@ -1013,14 +1204,43 @@ begin tpTop, tpBottom : begin Top:=0; Height:=Self.Height; + + DoNext := ((Left+Width)>= Self.Width); end; tpRight, tpLeft: begin Left := 0; Width:= Self.Width; + + DoNext := ((Top+Height)>= Self.Height); end; end; Color := clGreen; end; + + DebugLn('FR=%s FL=%s',[BoolStr(FTabControl.FRightButton.Visible),BoolStr(FTabControl.FLeftButton.Visible)]); + if not (FTabControl.FRightButton.Visible AND FTabControl.FLeftButton.Visible) then Exit; + C := 0; + + DebugLn('Left=%d Width=%d Width=%d',[TGradTabPage(FPageList.Items[Index]).TabButton.Left, + TGradTabPage(FPageList.Items[Index]).TabButton.Width, Width]); + + repeat + CurTabs := GetViewedTabs; + SetLength(CurTabs, Length(CurTabs)-1); + + with TGradTabPage(FPageList.Items[Index]).TabButton do + case FTabPosition of + tpTop, tpBottom : DoNext := ((Left+Width)>= Self.Width); + tpRight, tpLeft: DoNext := ((Top+Height)>= Self.Height); + end; + + if not DoNext then MoveToNext else MoveToPrior; + + Inc(C); + + until(ValueInArray(Index,CurTabs) OR (C=10)); + + if DoNext then MoveToNext else MoveToPrior; end; {------------------------------------------------------------------------------- @@ -1065,6 +1285,32 @@ begin end; +function TGradTabPagesBar.GetViewedTabs: TTabs; + + function IncAr(var Ar : TTabs) : Integer; + begin + SetLength(Ar, Length(Ar)+1); + Result := Length(Ar)-1; + end; + +var + i,l : Integer; +begin + for i := 0 to FPageList.Count-1 do + begin + with TGradTabPage(FPageList.Items[i]).TabButton do + begin + if ((TabPosition in [tpTop, tpBottom]) AND (Left >= 0) {AND (Left <=(Self.Width-10))} AND (Left+Width < Self.Width)) OR + ((TabPosition in [tpLeft, tpRight]) AND (Top >= 0) {AND (Top <=(Self.Height-10))} AND (Top+Height < Self.Height)) then + begin + l := IncAr(Result); + DebugLn('GetViewedTabs: Length: %d Value: %d',[l,i]); + Result[l] := i; + end; + end; + end; +end; + {------------------------------------------------------------------------------- TGradTabPagesBar Create(AOwner: TComponent) ------------------------------------------------------------------------------} @@ -1072,6 +1318,7 @@ constructor TGradTabBar.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := ControlStyle+[csNoDesignSelectable]; + SetSubComponent(true); end; {------------------------------------------------------------------------------- @@ -1087,9 +1334,9 @@ end; ------------------------------------------------------------------------------} procedure TGradTabBar.Paint; begin - Canvas.Brush.Color:=clFuchsia; + {Canvas.Brush.Color:=clFuchsia; Canvas.FillRect(0,0,Width,Height); - + } {$IFDEF DEBUGTAB} //WriteLn(Left, ' ' ,Top, ' ' ,Width, ' ' ,Height); {$ENDIF} @@ -1338,7 +1585,7 @@ begin FTabPosition:=tpTop; fCompStyle := csNoteBook; - ControlStyle := [csAcceptsControls]; + ControlStyle := [{csAcceptsControls, }csDesignInteractive]; TabStop:=true; FPageList := TListWithEvent.Create; @@ -1347,7 +1594,7 @@ begin TListWithEvent(FTabList) ,Self); FPageIndex:=-1; - FTabHeight:=30; + FTabHeight:=20; FBar := TGradTabBar.Create(Self); FBar.Height:=FTabHeight; @@ -1359,7 +1606,23 @@ begin FMoveIncrement:=1; - FPagesBar := TGradTabPagesBar.Create(Self,TListWithEvent(FPageList)); + FLeftButton := TGradButton.Create(Self); + FLeftButton.Parent := FBar; + FLeftButton.Align:= alLeft; + FLeftButton.Caption:='<'; + FLeftButton.AutoWidth:=true; + FLeftButton.Visible := false; + FLeftButton.SetSubComponent(true); + + FRightButton := TGradButton.Create(Self); + FRightButton.Parent := FBar; + FRightButton.Align:= alRight; + FRightButton.Caption:='>'; + FRightButton.AutoWidth:=true; + FRightButton.Visible:= false; + FRightButton.SetSubComponent(true); + + FPagesBar := TGradTabPagesBar.Create(Self,TListWithEvent(FPageList), Self); FPagesBar.Parent:=FBar; FPagesBar.Align:=alClient; FPagesBar.Left:=0; @@ -1367,20 +1630,20 @@ begin FPagesBar.Width:=FBar.Width; FPagesBar.Height:=FBar.Height; - FLeftButton := TGradButton.Create(Self); - FLeftButton.Parent := FBar; - FLeftButton.Align:= alLeft; - FLeftButton.Caption:='<'; - FLeftButton.AutoWidth:=true; - FLeftButton.OnClick:=@MoveLeftTopClick; + AssignEvents(FBar); + AssignEvents(FPagesBar); + //AssignEvents(FRightButton); + //AssignEvents(FLeftButton); - FRightButton := TGradButton.Create(Self); - FRightButton.Parent := FBar; - FRightButton.Align:= alRight; - FRightButton.Caption:='>'; - FRightButton.AutoWidth:=true; + FLeftButton.OnClick:=@MoveLeftTopClick; FRightButton.OnClick:=@MoveRightBottomClick; + with FRightButton, FLeftButton do + begin + OnMouseUp:=nil; + OnMouseDown:=nil; + end; + Height:=200; Width:=200; end; @@ -1425,6 +1688,33 @@ begin inherited; end; +function TGradTabControl.GetTabRect(AIndex: Integer): TRect; +begin + if (AIndex >= FPageList.Count) or (AIndex < 0) then Exit; + with TGradTabPage(FPageList[AIndex]).TabButton do + begin + Result.Left:=Left; + Result.Top:=Top; + Result.Bottom:=Top+Height; + Result.Right:=Left+Width; + end; +end; + +procedure TGradTabControl.AssignEvents(TheControl: TCustomControl); +begin + if TheControl = nil then Exit; + with TheControl do + begin + OnMouseWheel:=@SubMouseWheel; + OnMouseWheelUp:=@SubMouseWheelUp; + OnMouseWheelDown:=@SubMouseWheelDown; + OnClick:=@SubMouseClick; + OnMouseMove:=@SubMouseMove; + OnMouseDown:=@SubMouseDown; + OnMouseUp:=@SubMouseUp; + end; +end; + {------------------------------------------------------------------------------ TGradTabControl AlignPage(APage : TGradTabPage; ARect : TRect) ------------------------------------------------------------------------------} @@ -1440,6 +1730,16 @@ begin end; end; +procedure TGradTabControl.AlignPages; +var + i : Integer; +begin + for i := 0 to FPageList.Count-1 do + AlignPage(TGradTabPage(FPageList.Items[i]),GetClientRect); + + UpdateAllDesignerFlags; +end; + {------------------------------------------------------------------------------ TGradTabControl GetCurrentPage : TGradTabPage ------------------------------------------------------------------------------} @@ -1478,6 +1778,11 @@ begin Result := FPageList.Count; end; +function TGradTabControl.GetPagesBarDragOver: TDragOverEvent; +begin + Result := FPagesBar.OnDragOver; +end; + {------------------------------------------------------------------------------ TGradTabControl MoveTab(Sender: TObject; NewIndex: Integer) ------------------------------------------------------------------------------} @@ -1553,14 +1858,78 @@ begin FOnTabButtonClick(Self, FPageList.IndexOf(AButton.Owner)); end; +procedure TGradTabControl.PageButtonMouseMove(Sender: TObject; + Shift: TShiftState; X, Y: Integer); +var + AButton : TGradTabPageButton; +begin + AButton := TGradTabPageButton(Sender); + + //DebugLn('PageButtonMouseMove X=%d Y=%d',[X,Y]); + + if Assigned(FOnTabButtonMouseMove) then + FOnTabButtonMouseMove(Self, Shift, X,Y, FPageList.IndexOf(AButton.Owner)); +end; + +procedure TGradTabControl.SubMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); +begin + if Assigned(OnMouseWheel) then + OnMouseWheel(Sender, Shift, WheelDelta, MousePos, Handled); +end; + +procedure TGradTabControl.SubMouseWheelUp(Sender: TObject; + Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); +begin + if Assigned(OnMouseWheelUp) then + OnMouseWheelUp(Sender, Shift, MousePos, Handled); +end; + +procedure TGradTabControl.SubMouseWheelDown(Sender: TObject; + Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); +begin + if Assigned(OnMouseWheelDown) then + OnMouseWheelDown(Sender, Shift, MousePos, Handled); +end; + +procedure TGradTabControl.SubMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + if Assigned(OnMouseDown) then + OnMouseDown(Sender, Button, Shift, X, Y); +end; + +procedure TGradTabControl.SubMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + if Assigned(OnMouseUp) then + OnMouseUp(Sender, Button, Shift, X, Y); +end; + +procedure TGradTabControl.SubMouseClick(Sender: TObject); +begin + if Assigned(OnClick) then + OnClick(Sender); +end; + +procedure TGradTabControl.SubMouseMove(Sender: TObject; Shift: TShiftState; X, + Y: Integer); +begin + if Assigned(OnMouseMove) then + OnMouseMove(Sender, Shift, X, Y); +end; + procedure TGradTabControl.MoveLeftTopClick(Sender: TObject); begin - PagesBar.MoveTo(FMoveIncrement); + //PagesBar.MoveTo(FMoveIncrement); + + PagesBar.MoveToPrior; end; procedure TGradTabControl.MoveRightBottomClick(Sender: TObject); begin - PagesBar.MoveTo(-FMoveIncrement); + //PagesBar.MoveTo(-FMoveIncrement); + PagesBar.MoveToNext; end; {------------------------------------------------------------------------------ @@ -1582,6 +1951,8 @@ begin else FPageIndex := NewPageIndex; end; + + FPagesBar.OrderButtons; end; end; @@ -1613,6 +1984,14 @@ begin UpdateAllDesignerFlags; FPagesBar.OrderButtons; //SetCurrentPage(TGradTabPage(FPageList.Items[Value])); + if ([csDesigning, csLoading, csDestroying] * ComponentState = []) + and Assigned(OnPageChanged) then + OnPageChanged(Self); +end; + +procedure TGradTabControl.SetPagesBarDragOver(const AValue: TDragOverEvent); +begin + FPagesBar.OnDragOver:=AValue; end; {------------------------------------------------------------------------------ @@ -1630,8 +2009,7 @@ begin BringToFront; end; - - //UpdateDesignerFlags(Index); + UpdateDesignerFlags(Index); AlignPage(TGradTabPage(FPageList.Items[Index]), GetClientRect); end; @@ -1641,16 +2019,18 @@ end; ------------------------------------------------------------------------------} procedure TGradTabControl.UnShowPage(Index: Integer); begin - //Tab kleiner machen //Page disablen if (Index<0) or (Index>=fPageList.Count) then Exit; + //Tab kleiner machen FPagesBar.UnFocusButton(Index); + UpdateDesignerFlags(Index); with TGradTabPage(FPageList.Items[Index]) do Visible:=false; + end; {------------------------------------------------------------------------------ @@ -1660,12 +2040,16 @@ function TGradTabControl.ChildClassAllowed(ChildClass: TClass): boolean; begin DebugLn('TGradTabControl.ChildClassAllowed ',ChildClass.ClassName); Result := (ChildClass<>nil); - if ChildClass.InheritsFrom(TGradTabPage) then Result := true; + Result := ChildClass.InheritsFrom(TGradTabPage) AND Result; + if Result then Exit; + if GetCurrentPage=nil then begin - if ChildClass.InheritsFrom(TGradTabBar) then Result := true; + Result := ChildClass.InheritsFrom(TGradTabBar); end else begin - if (ChildClass.InheritsFrom(TControl)) AND (NOT ChildClass.InheritsFrom(TGradTabPage)) then + if (ChildClass.InheritsFrom(TControl)) AND (NOT ChildClass.InheritsFrom(TGradTabPage)) then begin TControl(ChildClass.ClassParent).Parent := GetCurrentPage; + Result := true; + end; end; end; @@ -1694,18 +2078,9 @@ begin Exclude(APage.FFlags,pfInserting); APage.Parent := Self; - with APage.TabButton do - begin - OnClick:=@PageButtonMouseClick; - OnMouseDown:=@PageButtonMouseDown; - OnMouseUp:=@PageButtonMouseUp; - Left:=-123; - ShowFocusBorder:=false; - AutoWidth:=true; - BorderSides:=[bsTopLine,bsRightLine,bsLeftLine]; - Parent := PagesBar; - Caption:=APage.Name; - end; + FPagesBar.InsertButton(APage.TabButton, Index); + if APage.Caption = '' then + APage.Caption:=APage.Name; //FPageList.Insert(Index,APage); //APage.Parent := Self; @@ -1739,13 +2114,17 @@ begin AlignPage(APage, GetClientRect); SetCurrentPageNum(Index); - FPagesBar.OrderButtons; + //FPagesBar.OrderButtons; //cRect := TGradTabControl(APage.Parent).GetClientRect; //APage.Color:=clBlue; //APage.ChangeBounds(cRect.Left,cRect.Top,cRect.Right,cRect.Bottom); end; - FPagesBar.OrderButtons; + {FPagesBar.FocusButton(Index); + FPagesBar.OrderButtons; } + + //if Index = FPageList.Count-1 then FPagesBar.MoveToNext; + //DebugLn(DbgSName(APage.Parent),' a'); {$IFDEF DEBUGTAB} DebugLn(['TGradTabControl.InsertPage END ',dbgsName(Self),' Index=', @@ -1803,6 +2182,8 @@ begin //FTabStrings.Delete(Index); if FPageIndex >= Index then Dec(FPageIndex); + + FPagesBar.OrderButtons; end; end; @@ -1831,6 +2212,8 @@ begin InvPaint; + FPagesBar.OrderButtons; + if ActivePage <> nil then AlignPage(ActivePage,GetClientRect); end; @@ -1853,9 +2236,6 @@ begin tempSize:=FTabHeight; - if FLongTabs then - tempSize := FLongWidth; - {$IFDEF DEBUGTAB} DebugLn('Before'); DebugLn('FBar Left %d Top %d Height %d Width %d',[ FBar.Left, Fbar.Top, FBar.Height, FBar.Width]); @@ -1875,7 +2255,7 @@ begin FBar.Height:=Height; FBar.Top:=0; FBar.Left:=0; - FBar.Width:=FTabHeight; + FBar.Width:=GetTabBarSize(tpLeft); //FBar.Align:=alLeft; end; tpBottom:begin @@ -1886,10 +2266,10 @@ begin //FBar.Align := alBottom; end; tpRight:begin - FBar.Left:=Width-tempSize; + FBar.Left:=Width-GetTabBarSize(tpRight); FBar.Top:=0; FBar.Height:=Height; - FBar.Width:=tempSize; + FBar.Width:=GetTabBarSize(tpRight); //FBar.Align:=alRight; end; end; @@ -1935,8 +2315,9 @@ begin DebugLn('FPagesBar Left %d Top %d Height %d Width %d',[ FPagesBar.Left, FPagesbar.Top, FPagesBar.Height, FPagesBar.Width]); DebugLn('Control Left %d Top %d Height %d Width %d',[ Left, Top, Height, Width]); {$ENDIF} - - AlignPage(CurrentPage,GetClientRect); + + AlignPages; + //AlignPage(CurrentPage,GetClientRect); InvPaint; end; @@ -1981,6 +2362,16 @@ begin //Result := FTabStrings.Count; end; +function TGradTabControl.GetTabBarSize(TabPos: TTabPosition): Integer; +begin + if TabPos in [tpTop,tpBottom] then + Result := TabHeight + else if LongTabs then + Result := LongWidth + else + Result := TabHeight; +end; + {------------------------------------------------------------------------------ TGradTabControl GetClientRect: TRect ------------------------------------------------------------------------------} @@ -2006,12 +2397,12 @@ begin tpRight: begin tempR.Top:=2; tempR.Left:=2; - tempR.Right:=Width-FTabHeight-2; + tempR.Right:=Width-GetTabBarSize(tpRight)-2; tempR.Bottom:=Height-2; end; tpLeft: begin tempR.Top:=2; - tempR.Left:=FTabHeight+2; + tempR.Left:=GetTabBarSize(tpLeft)+2; tempR.Right:=Width-2; tempR.Bottom:=Height-2; end; @@ -2047,19 +2438,15 @@ begin end; tpRight: begin Canvas.Line(0,0,0,Height); //Left - Canvas.Line(0,0,Width-FTabHeight,0); //Top - Canvas.Line(Width-1-FTabHeight,0,Width-1-FTabHeight,Height); //Right - Canvas.Line(0,Height-1,Width-FTabHeight,Height-1);//Bottom + Canvas.Line(0,0,Width-GetTabBarSize(tpRight),0); //Top + Canvas.Line(Width-1-GetTabBarSize(tpRight),0,Width-1-GetTabBarSize(tpRight),Height); //Right + Canvas.Line(0,Height-1,Width-GetTabBarSize(tpRight),Height-1);//Bottom end; tpLeft: begin - Canvas.Line(FTabHeight,0,FTabHeight,Height); //Left - Canvas.Line(FTabHeight,0,Width,0); //Top + Canvas.Line(GetTabBarSize(tpLeft),0,GetTabBarSize(tpLeft),Height); //Left + Canvas.Line(GetTabBarSize(tpLeft),0,Width,0); //Top Canvas.Line(Width-1,0,Width-1,Height); //Right - Canvas.Line(FTabHeight,Height-1,Width,Height-1);//Bottom - {tempR.Top:=0; - tempR.Left:=0; - tempR.Right:=FTabHeight; - tempR.Bottom:=Height;} + Canvas.Line(GetTabBarSize(tpLeft),Height-1,Width,Height-1);//Bottom end; end; @@ -2099,7 +2486,7 @@ begin end; tpRight: begin FBar.Height:=Height; - FBar.Left:=Width-FTabHeight; + FBar.Left:=Width-GetTabBarSize(tpRight); FBar.Top:=0; end; end; @@ -2121,14 +2508,14 @@ end; ------------------------------------------------------------------------------} procedure TGradTabControl.UpdateDesignerFlags(APageIndex: integer); begin - DebugLn('UpdateDesignerFlags: Index: %d Assigned: %s',[APageIndex,BoolToStr(Assigned(Page[APageIndex]),true)]); + DebugLn('UpdateDesignerFlags: Index: %d Current: %d Assigned: %s',[APageIndex, FPageIndex,BoolToStr(Assigned(Page[APageIndex]),true)]); if APageIndex<>FPageIndex then Page[APageIndex].ControlStyle:= - Page[APageIndex].ControlStyle+[csNoDesignVisible,csNoDesignSelectable] + Page[APageIndex].ControlStyle+[csNoDesignVisible{,csNoDesignSelectable}] else Page[APageIndex].ControlStyle:= - Page[APageIndex].ControlStyle-[csNoDesignVisible,csNoDesignSelectable]; + Page[APageIndex].ControlStyle-[csNoDesignVisible{,csNoDesignSelectable}]; DebugLn('UpdateDesignerFlags End');