diff --git a/components/jvcllaz/design/JvCustomControls/images/images.txt b/components/jvcllaz/design/JvCustomControls/images/images.txt index f3f0683af..2c09e016e 100644 --- a/components/jvcllaz/design/JvCustomControls/images/images.txt +++ b/components/jvcllaz/design/JvCustomControls/images/images.txt @@ -1,3 +1,6 @@ +tjvtabbar.bmp +tjvmoderntabbarpainter.bmp +Tjvtabbarxppainter.bmp tjvoutlookbar.bmp tjvtimeline.bmp tjvtmtimeline.bmp diff --git a/components/jvcllaz/design/JvCustomControls/images/tjvmoderntabbarpainter.bmp b/components/jvcllaz/design/JvCustomControls/images/tjvmoderntabbarpainter.bmp new file mode 100644 index 000000000..05bdd9dc9 Binary files /dev/null and b/components/jvcllaz/design/JvCustomControls/images/tjvmoderntabbarpainter.bmp differ diff --git a/components/jvcllaz/design/JvCustomControls/images/tjvtabbar.bmp b/components/jvcllaz/design/JvCustomControls/images/tjvtabbar.bmp new file mode 100644 index 000000000..98c10b87b Binary files /dev/null and b/components/jvcllaz/design/JvCustomControls/images/tjvtabbar.bmp differ diff --git a/components/jvcllaz/design/JvCustomControls/images/tjvtabbarxppainter.bmp b/components/jvcllaz/design/JvCustomControls/images/tjvtabbarxppainter.bmp new file mode 100644 index 000000000..654b8fc1f Binary files /dev/null and b/components/jvcllaz/design/JvCustomControls/images/tjvtabbarxppainter.bmp differ diff --git a/components/jvcllaz/design/JvCustomControls/jvcustomreg.pas b/components/jvcllaz/design/JvCustomControls/jvcustomreg.pas index 9477e3694..f63001392 100644 --- a/components/jvcllaz/design/JvCustomControls/jvcustomreg.pas +++ b/components/jvcllaz/design/JvCustomControls/jvcustomreg.pas @@ -15,12 +15,15 @@ implementation uses Classes, ImgList, Controls, PropEdits, GraphPropEdits, ComponentEditors, - JvDsgnConsts, JvOutlookBar, JvOutlookBarEditors, + JvDsgnConsts, + JvOutlookBar, JvOutlookBarEditors, + JvTabBar, JvTabBarXPPainter, JvTimeLine, JvTMTimeline, JvTimeLineEditor; procedure Register; begin RegisterComponents(RsPaletteJvcl, [ + TJvTabBar, TJvModernTabBarPainter, TJvTabBarXPPainter, TJvOutlookBar, TJvTimeLine, TJvTMTimeLine diff --git a/components/jvcllaz/examples/JvTabBar/JvTabBarDemo.lpi b/components/jvcllaz/examples/JvTabBar/JvTabBarDemo.lpi new file mode 100644 index 000000000..ced99fe6b --- /dev/null +++ b/components/jvcllaz/examples/JvTabBar/JvTabBarDemo.lpi @@ -0,0 +1,84 @@ + + + + + + + + + + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0"/> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="JvCustomLazR"/> + </Item1> + <Item2> + <PackageName Value="LCL"/> + </Item2> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="JvTabBarDemo.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="main.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="Main"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\..\bin\JvTabBarDemo"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Debugging> + <UseExternalDbgSyms Value="True"/> + </Debugging> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/jvcllaz/examples/JvTabBar/JvTabBarDemo.lpr b/components/jvcllaz/examples/JvTabBar/JvTabBarDemo.lpr new file mode 100644 index 000000000..665b893af --- /dev/null +++ b/components/jvcllaz/examples/JvTabBar/JvTabBarDemo.lpr @@ -0,0 +1,22 @@ +program JvTabBarDemo; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, Main + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource := True; + Application.Scaled := True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/components/jvcllaz/examples/JvTabBar/main.lfm b/components/jvcllaz/examples/JvTabBar/main.lfm new file mode 100644 index 000000000..59080c9e6 --- /dev/null +++ b/components/jvcllaz/examples/JvTabBar/main.lfm @@ -0,0 +1,303 @@ +object Form1: TForm1 + Left = 310 + Height = 335 + Top = 127 + Width = 614 + Caption = 'Form1' + ClientHeight = 315 + ClientWidth = 614 + Menu = MainMenu1 + OnCreate = FormCreate + OnDestroy = FormDestroy + LCLVersion = '1.9.0.0' + object JvTabBar1: TJvTabBar + Left = 0 + Top = 40 + Width = 614 + Visible = False + HotTracking = True + Painter = JvModernTabBarPainter1 + Images = ImageList1 + Tabs = <> + OnTabClosing = JvTabBar1TabClosing + OnTabClosed = JvTabBar1TabClosed + OnTabSelected = JvTabBar1TabSelected + end + object ToolBar: TToolBar + Left = 0 + Height = 40 + Top = 0 + Width = 614 + AutoSize = True + ButtonHeight = 40 + ButtonWidth = 40 + Caption = 'ToolBar' + Images = ImageList1 + ShowCaptions = True + TabOrder = 1 + object TbOpen: TToolButton + Left = 1 + Top = 0 + Action = AcFileOpen + end + object TbQuit: TToolButton + Left = 102 + Top = 0 + Action = AcFileQuit + end + object TbStyle: TToolButton + Left = 47 + Top = 0 + Caption = 'Style' + DropdownMenu = PopupMenu1 + ImageIndex = 3 + Style = tbsButtonDrop + end + object ToolButton2: TToolButton + Left = 97 + Height = 40 + Top = 0 + Caption = 'ToolButton2' + Style = tbsDivider + end + end + object Memo1: TMemo + Left = 4 + Height = 244 + Top = 67 + Width = 606 + Align = alClient + BorderSpacing.Around = 4 + Font.CharSet = ANSI_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + Font.Pitch = fpFixed + Font.Quality = fqDraft + ParentFont = False + TabOrder = 2 + end + object JvModernTabBarPainter1: TJvModernTabBarPainter + Font.Color = clWindowText + DisabledFont.Color = clGrayText + SelectedFont.Color = clWindowText + left = 360 + top = 192 + end + object JvTabBarXPPainter1: TJvTabBarXPPainter + Font.Color = clWindowText + DisabledFont.Color = clGrayText + SelectedFont.Color = clWindowText + FixedTabSize = 0 + left = 360 + top = 120 + end + object ImageList1: TImageList + left = 208 + top = 120 + Bitmap = { + 4C69040000001000000010000000FFFFFF00FFFFFF00459AD3EF4498D2FF4197 + D1FF3F95D1FF3D94D0FF3B93D0FF3B92CFFF3B92CFFF3B92CFFF3D94D0FF4398 + D2EF00000000FFFFFF00FFFFFF00FFFFFF00FFFFFF004297D2FF3B93D0FF62AD + DCFF93CDEDFFBBE7FAFFD9FCFFFFD9FAFFFFD7F9FFFFD7F9FFFFD9FBFFFF3D94 + D0FF00000000FFFFFF00FFFFFF00FFFFFF00FFFFFF003C93D0FFE9FFFFFFA8DA + F3FF7BBDE4FF4398D1FF3493D1FF46AAE0FF53BDEBFF61D3FBFFCEF8FFFF3B92 + CFFF00000000FFFFFF00FFFFFF00FFFFFF00FFFFFF003991CFFFE9FFFFFFAFF0 + FFFFCEF7FFFFDAFAFFFFC5EBFBFF90C8EAFF66ADDBFF47A8DDFFCBF8FFFF3C92 + CFFF00000000FFFFFF00FFFFFF00FFFFFF00FFFFFF003A91CEFFD2FCFFFF7AE2 + FCFF77DDFCFF7FDFFBFF9BE6FCFFB4EDFFFFD8FAFFFF318ACBFFC6F8FFFF3D93 + CFFF00000000FFFFFF00FFFFFF00FFFFFF00FFFFFF003B91CEFFC9F9FFFF7EE2 + FCFF7CDEFCFF78DCFBFF72D9FAFF6AD6FAFFD4F7FFFF318ACBFFC1F8FFFF3D93 + CFFF00000000FFFFFF00FFFFFF00FFFFFF00FFFFFF003C91CEFFC0F8FFFF7FE2 + FCFF7DDFFCFF7ADDFBFF75DAFAFF6DD7FAFFC7F3FFFF338BCBFFBCF7FFFF3D92 + CFFF00000000FFFFFF00FFFFFF00FFFFFF00FFFFFF003C92CEFFB6F6FFFF80E3 + FCFF7DDFFCFF7ADDFBFF76DAFAFF6ED7FAFFBAEFFFFF338BCBFFB5F7FFFF3A8F + CDFF4397D1E7FFFFFF00FFFFFF00FFFFFF00FFFFFF003D92CEFFADF3FFFF81E3 + FCFF7EDFFCFF7ADDFBFF76DAFAFF6FD8FAFFADEBFFFF358ACBFFB0F4FFFFABF4 + FFFF3F94D0FFFFFFFF00FFFFFF00FFFFFF00FFFFFF003E92CEFFA3F1FFFF82E3 + FCFF7EDFFCFF7ADDFBFF76DAFAFF71D9FBFFA0E8FFFF368ACAFF87EBFFFFA3F2 + FFFF3E92CEFFFFFFFF00FFFFFF00FFFFFF00FFFFFF003E92CEFF9AF0FFFF83E4 + FDFF7EDFFCFF7ADDFBFF76DAFAFF8AE2FEFF4EA9DDFF54ABDCFF8DEDFFFF9FF3 + FFFF3E92CFFFFFFFFF00FFFFFF00FFFFFF00FFFFFF004094CFFF92F1FFFF85E7 + FFFF80E1FDFF7ADEFBFF77DBFBFF85E2FFFF3B8DCBFF93F1FFFF96F3FFFF9FF9 + FFFF4094D0FFFFFFFF00FFFFFF00FFFFFF00FFFFFF004295CEEF58B0DFFF6DC9 + EFFF7FE2FDFF7EE3FEFF7ADEFCFF80E2FFFF3F92CEFF4094CFFF4093CFFF4094 + D0FF4396CFF1FFFFFF00FFFFFF00FFFFFF00FFFFFF000000002F326F997C3D8A + C1C74092CEFF54ADDEFF66C4EDFF7AE0FEFF4295D0FF1F455F502653725A2859 + 7A5F0000002FFFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000120000 + 002500000033326E987A3E8BC1C84396D1FF4496CFF1000000070000000A0000 + 000B00000000FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 0000000000000000001200000025000000330000002F00000000000000000000 + 000000000000FFFFFF00FFFFFF004A7CA5004A7CA5004A7CA5004A7CA5004A7E + A7004A7EA8004A7EA8004A7EA8004A7EA800497DA7004579A400709BBE00B5D2 + EA00C3DAEF58CDE3F5FB3F75A1FF4B7CA7004B7CA7004B7CA7004B7EA8B04B81 + AEFF4B83B0FF4A83B0FF4A83B0FF4A83B0FF4A82AFFF447DA9FF709CBFFFB9D5 + EBFFB3D1EAFFC1DBF2FF4279A5FF5179AD005079AD004F7AAC004C7EAFFF4438 + 32FF433B37FF433D38FF433D38FF433D38FF423B36FF3C332CFFB9DAF5FF7FB0 + DAFF5495CCFFC0DAEFFF467CA8FF0091460000914600009243004C7AAEFF4742 + 3FFF4A4443FF484644FF484644FF484644FF474542FF433C36FF5FA1D8FF5C9A + CCFF5896C9FFB8D3EBFF4980ACFF008F4D00008F4C00008E4900009046FF0387 + 4AFF524449FF4E484AFF4D494AFF4C4A4AFF4C4848FF4A423DFF60A0D5FF5D98 + C9FF5894C6FFAFCCE6FF4B83B0FF008F4E00008C4A00008843FFA2E6DAFF0090 + 47FF5B414BFF57474DFF544A4EFF514C4EFF4F4D4CFF4D4641FF5E9CD2FF5C95 + C5FF5990C1FFA6C4DFFF4E86B5FF008D4B00008743FF9BE0D1FF00C1A0FF0086 + 3FFF008D44FF009247FF177A4CFF584E51FF54504FFF524B45FF5B9ACDFF5C91 + C1FF20B7F5FF9EBCD7FF5189B8FF008A48FF86DEC8FF00C59CFF00C49BFF63DC + C8FF5FDECAFF5EE4CFFF009247FF5E4F55FF585353FF574F4AFF5A96CAFF5B8F + BEFF22B9F7FF95B5D3FF548DBCFF008A48FF74DABDFF00CD9CFF00CC9CFF00D2 + 9EFF00D5A0FF5FF0D0FF009146FF635358FF5D5756FF5B534DFF5794C5FF588E + BCFF47749BFF88AFCFFF5790C0FF00000033008744FF65D7B4FF00DAA2FF0086 + 41FF008B44FF008F46FF1C7D50FF645A5CFF605C5AFF605852FF5490C2FF558C + BAFF4E81ADFF7EA6C8FF5A94C4FF00924D0000000033008945FF52DCB0FF008E + 47FF725760FF6B5B60FF675E60FF646060FF62605FFF645D57FF518DBEFF528A + B7FF5187B4FF739FC2FF5D97C9FF6A545E0000964C0000000033009147FF068A + 4EFF6E6064FF696364FF676463FF676463FF676462FF68615BFF4F8ABBFF5086 + B4FF4F84B1FF6895B9FF5F9BCDFF605A5C0064585D0066565B003A6BA1FF6B69 + 66FF6F6869FF6C6A69FF6C6A69FF6C6A69FF6C6A68FF6E6762FF4C89BAFF4E85 + B2FF4D83AEFF5D8CB2FF629ED1FF5C5C5CFF5D5B5CFF5E5B5BFF5E5A5AFF5D5A + 5AFF5B5A5BFF5A5B5BFF5A5B5BFF5A5B5BFF5B5A5AFF5C5956FF576876FF4E7E + A4FF4C80ACFF5082ABFF65A2D5FF000000330000003300000033000000330000 + 0033000000330000003300000033000000330000003300000033000000330000 + 0033365D7B79497BA2FC68A4D9FF000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000120000003200000033FFFFFF00008C4AEF008743FF00843FFF0084 + 3FFF00843FFF00843FFF00843FFF00843FFF008641FF008946EA000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00008743FFF8FFFFFFF1FFFFFFF2FF + FFFFF2FFFFFFF2FFFFFFEFFFFFFFEEFFFFFFF4FFFFFF91DBC0FF008540A60000 + 000000000000FFFFFF00FFFFFF00FFFFFF0000843FFFF0FFFFFF3CD9B5FF41DA + B6FF43DAB7FF41DAB6FF3BD9B4FFE9FFFFFF00772CFFF1FFFFFF8ED9BEFF0085 + 41A700000000FFFFFF00FFFFFF00FFFFFF0000843FFFF0FFFFFF4EDCBBFF55DD + BCFF57DDBDFF55DDBCFF4EDCBAFFEBFFFFFF00792FFFADF5E2FFF1FFFFFF91DB + C1FF008945ACFFFFFF00FFFFFF00FFFFFF0000843FFFF0FFFFFF5CE0BFFF62E1 + C0FF64E1C1FF62E1C0FF5CDFBEFFEAFFFFFF40AF7EFF00792FFF00772CFFF4FF + FFFF008641FFFFFFFF00FFFFFF00FFFFFF0000843FFFEFFFFFFF68E2C3FF6DE3 + C4FF6FE3C5FF6EE3C5FF6AE2C3FF97EFD8FFE7FFFFFFE8FFFFFFE6FFFFFFEDFF + FFFF00843FFFFFFFFF00FFFFFF00FFFFFF0000843FFFEEFFFFFF74E4C7FF78E5 + C8FF7AE5C9FF7AE5C9FF78E5C8FF75E4C7FF73E4C7FF72E3C6FF6FE3C6FFECFF + FFFF00843FFFFFFFFF00FFFFFF00FFFFFF0000843FFFEDFFFFFF80E8CCFF84E8 + CCFF85E8CDFF85E8CDFF85E8CDFF84E8CDFF84E8CCFF82E7CCFF7FE8CBFFECFF + FFFF00843FFFFFFFFF00FFFFFF00FFFFFF0000843FFFEBFFFFFF8DEAD0FF8FEA + D1FF90EAD1FF90EAD1FF90EAD1FF90EAD1FF90EAD1FF8FEAD1FF8DEAD0FFEBFF + FFFF00843FFFFFFFFF00FFFFFF00FFFFFF0000843FFFEAFFFFFF9AECD5FF9BEC + D5FF9CECD5FF9CECD5FF9CECD5FF9CECD5FF9CECD5FF9BECD5FF9AECD5FFEAFF + FFFF00843FFFFFFFFF00FFFFFF00FFFFFF0000843EFFE9FFFFFFA6EFD8FFA6EF + D8FFA7EFD8FFA7EFD8FFA7EFD8FFA7EFD8FFA7EFD8FFA6EFD8FFA6EFD8FFE9FF + FFFF00843EFFFFFFFF00FFFFFF00FFFFFF0000843EFFE8FFFFFFB2F2DCFFB2F1 + DCFFB2F1DCFFB2F1DCFFB2F1DCFFB2F1DCFFB2F1DCFFB2F1DCFFB2F2DCFFE8FF + FFFF00843EFFFFFFFF00FFFFFF00FFFFFF0000843FFFE9FFFFFFC1F5E3FFBFF5 + E2FFBFF5E3FFBFF5E3FFBFF5E3FFBFF5E3FFBFF5E3FFBFF5E2FFC1F5E3FFE9FF + FFFF00843FFFFFFFFF00FFFFFF00FFFFFF00008743FFF5FFFFFFE0FFF5FFDEFF + F4FFDEFFF4FFDEFFF4FFDEFFF4FFDEFFF4FFDEFFF4FFDEFFF4FFE0FFF5FFF5FF + FFFF008743FFFFFFFF00FFFFFF00FFFFFF00008044C0008743FF008440FF0084 + 3FFF00843FFF00843FFF00843FFF00843FFF00843FFF00843FFF008440FF0087 + 43FF008044C0FFFFFF00FFFFFF00FFFFFF000000002300000033000000330000 + 0033000000330000003300000033000000330000003300000033000000330000 + 003300000023FFFFFF00FFFFFF00000000000000000000000000000000000000 + 0000CF9043EACD8D3FFFCE8E40FFD19247AF0000000000000000000000000000 + 00000000000000000000FFFFFF0000000000000000000000000000000000CF90 + 4482E1B681FFFFFEF3FFFFFFF5FFD08F41FF0000000000000000000000000000 + 00000000000000000000FFFFFF0000000000000000000000000000000000CD8C + 3FFFFBE6C6FFFBD291FFFFF6E1FFCF8D3EFFB27C3596B37B34FFB37A32FFB47C + 34FFB6803AEF00000000FFFFFF00000000000000000000000000CF904480E1B4 + 7CFFF5D29EF2E0A85DF0FFF1D2FFBF8135FFC19255FFFAE6CCFFFAE4C9FFFDE7 + CCFFB47C35FF00000000FFFFFF00000000000000000000000000CD8D40FFFCE4 + BEFFE2AE68DFC8873AF0FCE3BAFFB1762DFFE4C49BFFEBB575FFE3A55AFFF9E2 + C5FFB37A33FF00000000FFFFFF000000000000000000CF90447FE0B275FFFFE2 + ADFFDBA256FFCD8B3DFFCFA261FFC7995FFFE8C297FFC18437FFE29942FFF5D3 + AAFFB27B34FF00000000FFFFFF0000000000D0924709CD8D41FFFDE3B6FFFFE2 + A4FFFFF2CBFFF2D7A9FFB17A34FFF2CFA4FFC08B46F7AA7734E4E6A049FFF6CF + A2FFB37C35FF00000000FFFFFF0000000000CC8E43A2E3B374FFFADA9FFFD89D + 54FFD08E41FFB67B33FFD2A56DFFE7B373FF00000031A57434C3EAA34EFFF4CA + 97FFB37C36FF00000000FFFFFF00CF9146FFD49A52FFFFE7B5FFD6994FFF0000 + 0033704E2366B7823FFFF4C78EFFC68B41FFB88138FFAE7935F3EBA650FFF4C6 + 8DFFB37C37FF00000000FFFFFF00CF9045FFFFFACAFFF4D196FFCA8C43E50000 + 0000B37D38FFDDAF73FFF2B568FFF6C68AFFF9C98FFFF8C98FFFECA753FFF3C2 + 83FFB27C37FF00000000FFFFFF00D09248FFCF9044FFD09145FF0000002CB37E + 3988BF8B4AFFF8C07CFFC0873EFFB17B36FFB17B36FFAF7935FFF0AC57FFF4BE + 79FFB27C38FF00000000FFFFFF00000000330000003300000033B37D3A32B27C + 38FFE9B471FFE3A658E9855E2B7F0000003300000033AF7B37FFF2AF5BFFF4BA + 6FFFB17C38FF00000000FFFFFF000000000000000000B47F3AFFC08A44FFCC97 + 51FFF8BB6CFFBA843DFF0000001300000000B9823EFFD09952FFF4B25FFFF4B5 + 65FFD0984FFFB57F3BFFFFFFFF000000000000000000B57F3BFFFFC06EFFFBBC + 69FFFCBB69FFB37E3AFF0000000000000000B9833EFFFDBF6EFFF9B763FFF9B8 + 64FFFDBF6EFFB57F3BFFFFFFFF000000000000000000B6813CFFB47F3AFFB37D + 3AFFB47F3AFFB6803CFF0000000000000000B6803CFFB47F3AFFB27D3AFFB27D + 3AFFB47F3AFFB6803CFFFFFFFF00000000000000000000000033000000330000 + 0033000000330000003300000000000000000000003300000033000000330000 + 00330000003300000033FFFFFF00 + } + end + object OpenDialog1: TOpenDialog + Options = [ofAllowMultiSelect, ofEnableSizing, ofViewDetail] + left = 209 + top = 191 + end + object PopupMenu1: TPopupMenu + left = 77 + top = 109 + object MenuItem1: TMenuItem + Action = AcModernPainter + AutoCheck = True + GroupIndex = 1 + end + object MenuItem2: TMenuItem + Action = AcXPPainter + AutoCheck = True + GroupIndex = 1 + end + end + object ActionList1: TActionList + Images = ImageList1 + left = 78 + top = 184 + object AcFileOpen: TAction + Category = 'File' + Caption = 'Open...' + ImageIndex = 0 + OnExecute = AcFileOpenExecute + end + object AcFileQuit: TAction + Category = 'File' + Caption = 'Quit' + ImageIndex = 1 + OnExecute = AcFileQuitExecute + end + object AcModernPainter: TAction + AutoCheck = True + Caption = 'Modern painter' + Checked = True + GroupIndex = 1 + OnExecute = AcModernPainterExecute + end + object AcXPPainter: TAction + AutoCheck = True + Caption = 'XP painter' + GroupIndex = 1 + OnExecute = AcXPPainterExecute + end + end + object MainMenu1: TMainMenu + left = 77 + top = 253 + object MenuItem3: TMenuItem + Caption = 'File' + object MenuItem4: TMenuItem + Action = AcFileOpen + end + object MenuItem5: TMenuItem + Action = AcFileQuit + end + end + object MenuItem6: TMenuItem + Caption = 'Style' + object MenuItem7: TMenuItem + Action = AcModernPainter + AutoCheck = True + end + object MenuItem8: TMenuItem + Action = AcXPPainter + AutoCheck = True + end + end + end +end diff --git a/components/jvcllaz/examples/JvTabBar/main.pas b/components/jvcllaz/examples/JvTabBar/main.pas new file mode 100644 index 000000000..4142c4321 --- /dev/null +++ b/components/jvcllaz/examples/JvTabBar/main.pas @@ -0,0 +1,171 @@ +unit Main; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls, + Menus, ActnList, JvTabBar, JvTabBarXPPainter; + +type + + { TForm1 } + + TForm1 = class(TForm) + AcFileOpen: TAction; + AcFileQuit: TAction; + AcModernPainter: TAction; + AcXPPainter: TAction; + ActionList1: TActionList; + ImageList1: TImageList; + JvModernTabBarPainter1: TJvModernTabBarPainter; + JvTabBar1: TJvTabBar; + JvTabBarXPPainter1: TJvTabBarXPPainter; + MainMenu1: TMainMenu; + Memo1: TMemo; + MenuItem1: TMenuItem; + MenuItem2: TMenuItem; + MenuItem3: TMenuItem; + MenuItem4: TMenuItem; + MenuItem5: TMenuItem; + MenuItem6: TMenuItem; + MenuItem7: TMenuItem; + MenuItem8: TMenuItem; + OpenDialog1: TOpenDialog; + PopupMenu1: TPopupMenu; + ToolBar: TToolBar; + TbOpen: TToolButton; + TbQuit: TToolButton; + TbStyle: TToolButton; + ToolButton2: TToolButton; + procedure AcFileOpenExecute(Sender: TObject); + procedure AcFileQuitExecute(Sender: TObject); + procedure AcModernPainterExecute(Sender: TObject); + procedure AcXPPainterExecute(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure JvTabBar1TabClosed(Sender: TObject; Item: TJvTabBarItem); + procedure JvTabBar1TabClosing(Sender: TObject; Item: TJvTabBarItem; + var AllowClose: Boolean); + procedure JvTabBar1TabSelected(Sender: TObject; Item: TJvTabBarItem); + private + FLoading: integer; + procedure LoadFile(AFileName: String); + + public + + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +type + TTabInfo = class + Filename: string; + end; + +{ TForm1 } + +procedure TForm1.AcFileOpenExecute(Sender: TObject); +var + fn: String; +begin + if OpenDialog1.Execute then + for fn in OpenDialog1.Files do LoadFile(fn); +end; + +procedure TForm1.AcFileQuitExecute(Sender: TObject); +begin + Close; +end; + +procedure TForm1.AcModernPainterExecute(Sender: TObject); +begin + JvTabBar1.Painter := JvModernTabBarPainter1; +end; + +procedure TForm1.AcXPPainterExecute(Sender: TObject); +begin + JvTabBar1.Painter := JvTabBarXPPainter1; +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + OpenDialog1.InitialDir := '..\examples\JvTabBar'; + LoadFile('..\examples\JvTabBar\main.pas'); + LoadFile('..\examples\JvTabBar\main.lfm'); +end; + +procedure TForm1.FormDestroy(Sender: TObject); +var + i: Integer; + info: TTabInfo; +begin + for i := JvTabBar1.Tabs.Count-1 downto 0 do begin + info := TTabInfo((JvTabBar1.Tabs[i]).Tag); + FreeAndNil(info); + end; +end; + +procedure TForm1.JvTabBar1TabClosed(Sender: TObject; Item: TJvTabBarItem); +begin + if JvTabBar1.Tabs.Count = 1 then begin + JvTabBar1.Visible := false; + Memo1.Clear; + end; +end; + +procedure TForm1.JvTabBar1TabClosing(Sender: TObject; Item: TJvTabBarItem; + var AllowClose: Boolean); +var + info: TTabInfo; +begin + info := TTabInfo(Item.Tag); + FreeAndNil(info); + AllowClose := true; +end; + +procedure TForm1.JvTabBar1TabSelected(Sender: TObject; Item: TJvTabBarItem); +var + tab: TJvTabBarItem; + info: TTabInfo; + fn: String; +begin + if FLoading <> 0 then + exit; + tab := JvTabBar1.SelectedTab; + if tab = nil then exit; + info := TTabInfo(tab.Tag); + Memo1.Lines.LoadfromFile(info.FileName); +end; + +procedure TForm1.Loadfile(AFileName: String); +var + tab: TJvTabBarItem; + info: TTabInfo; +begin + if not FileExists(ExpandFileName(AFileName)) then begin + ShowMessage('File "' + AFileName + '" does not exist.'); + exit; + end; + + Memo1.Lines.LoadfromFile(AFileName); + inc(FLoading); + tab := TJvTabBarItem(JvTabBar1.Tabs.Add); + tab.Caption := ExtractFileName(AFileName); + info := TTabInfo.Create; + info.FileName := AFileName; + tab.Tag := PtrInt(info); + tab.ImageIndex := 2; + JvTabBar1.Visible := JvTabBar1.Tabs.Count > 0; + tab.Selected := true; + dec(FLoading); +end; + +end. + diff --git a/components/jvcllaz/packages/jvcustomlazr.lpk b/components/jvcllaz/packages/jvcustomlazr.lpk new file mode 100644 index 000000000..553fe09ac --- /dev/null +++ b/components/jvcllaz/packages/jvcustomlazr.lpk @@ -0,0 +1,58 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <Package Version="4"> + <PathDelim Value="\"/> + <Name Value="JvCustomLazR"/> + <Author Value="Various authors - see header of each unit for original author."/> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <SearchPaths> + <OtherUnitFiles Value="..\run\JvCustomControls"/> + <UnitOutputDirectory Value="..\lib\$(TargetCPU)-$(TargetOS)\run\JvCustom"/> + </SearchPaths> + </CompilerOptions> + <Description Value="Custom controls of the JVCL library (https://sourceforge.net/projects/jvcl/) (runtime code): +- TimeLine components +- OutlookBar component +"/> + <License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/> + <Version Major="1" Release="4"/> + <Files Count="5"> + <Item1> + <Filename Value="..\run\JvCustomControls\jvtimeline.pas"/> + <UnitName Value="JvTimeLine"/> + </Item1> + <Item2> + <Filename Value="..\run\JvCustomControls\jvtmtimeline.pas"/> + <UnitName Value="JvTMTimeLine"/> + </Item2> + <Item3> + <Filename Value="..\run\JvCustomControls\jvoutlookbar.pas"/> + <UnitName Value="JvOutlookBar"/> + </Item3> + <Item4> + <Filename Value="..\run\JvCustomControls\JvTabBar.pas"/> + <UnitName Value="JvTabBar"/> + </Item4> + <Item5> + <Filename Value="..\run\JvCustomControls\JvTabBarXPPainter.pas"/> + <UnitName Value="JvTabBarXPPainter"/> + </Item5> + </Files> + <RequiredPkgs Count="2"> + <Item1> + <PackageName Value="JvCoreLazR"/> + </Item1> + <Item2> + <PackageName Value="FCL"/> + </Item2> + </RequiredPkgs> + <UsageOptions> + <UnitPath Value="$(PkgOutDir)"/> + </UsageOptions> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + </Package> +</CONFIG> diff --git a/components/jvcllaz/resource/jvcustomreg.res b/components/jvcllaz/resource/jvcustomreg.res index b8378e1b7..7b8f170c6 100644 Binary files a/components/jvcllaz/resource/jvcustomreg.res and b/components/jvcllaz/resource/jvcustomreg.res differ diff --git a/components/jvcllaz/run/JvCustomControls/JvTabBar.pas b/components/jvcllaz/run/JvCustomControls/JvTabBar.pas new file mode 100644 index 000000000..a67727592 --- /dev/null +++ b/components/jvcllaz/run/JvCustomControls/JvTabBar.pas @@ -0,0 +1,2548 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvTabBar.pas, released on 2004-12-23. + +The Initial Developer of the Original Code is Andreas Hausladen <Andreas dott Hausladen att gmx dott de> +Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen. +All Rights Reserved. + +Contributor(s): + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvTabBar; + +{$MODE objfpc}{$H+} +{$DEFINE JVCLThemesEnabled} + +interface + +uses + LCLIntf, LCLType, LMessages, Types, +// Windows, Messages, + Graphics, Controls, Forms, ImgList, Menus, Buttons, + ExtCtrls, SysUtils, Classes, Contnrs, Themes; + +type + TJvCustomTabBar = class; + TJvTabBarItem = class; + + TJvTabBarOrientation = (toTop, toBottom); + TJvTabBarScrollButtonKind = (sbScrollLeft, sbScrollRight); + TJvTabBarScrollButtonState = (sbsHidden, sbsNormal, sbsHot, sbsPressed, sbsDisabled); + + TJvGetModifiedEvent = procedure(Sender: TJvTabBarItem; var Modified: Boolean) of object; + TJvGetEnabledEvent = procedure(Sender: TJvTabBarItem; var Enabled: Boolean) of object; + + IPageList = interface + ['{6BB90183-CFB1-4431-9CFD-E9A032E0C94C}'] + function CanChange(AIndex: Integer): Boolean; + procedure SetActivePageIndex(AIndex: Integer); + function GetPageCount: Integer; + function GetPageCaption(AIndex: Integer): string; + procedure AddPage(const ACaption: string); + procedure DeletePage(Index: Integer); + procedure MovePage(CurIndex, NewIndex: Integer); + procedure PageCaptionChanged(Index: Integer; const NewCaption: string); + end; + + TJvTabBarItem = class(TCollectionItem) + private + FLeft: Integer; // used for calculating DisplayRect + + FImageIndex: TImageIndex; + FEnabled: Boolean; + FVisible: Boolean; + FTag: Integer; + FData: TObject; + FHint: TCaption; + FName: string; + FCaption: TCaption; + FImages: TCustomImageList; + FModified: Boolean; + FPopupMenu: TPopupMenu; + FOnGetEnabled: TJvGetEnabledEvent; + FOnGetModified: TJvGetModifiedEvent; + FShowHint: Boolean; + FAutoDeleteDatas: TObjectList; + function GetEnabled: Boolean; + function GetModified: Boolean; + + procedure SetPopupMenu(const Value: TPopupMenu); + function GetClosing: Boolean; + procedure SetModified(const Value: Boolean); + procedure SetCaption(const Value: TCaption); + procedure SetSelected(const Value: Boolean); + procedure SetEnabled(const Value: Boolean); + procedure SetImageIndex(const Value: TImageIndex); + procedure SetName(const Value: string); + procedure SetVisible(const Value: Boolean); + function GetTabBar: TJvCustomTabBar; + function GetSelected: Boolean; + function GetDisplayRect: TRect; + function GetHot: Boolean; + protected + procedure Changed; virtual; + + procedure SetIndex(Value: Integer); override; + procedure Notification(Component: TComponent; Operation: TOperation); virtual; + property Name: string read FName write SetName; + public + constructor Create(ACollection: Classes.TCollection); override; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + function GetImages: TCustomImageList; + function CanSelect: Boolean; + function GetNextVisible: TJvTabBarItem; + function GetPreviousVisible: TJvTabBarItem; + procedure MakeVisible; + function AutoDeleteData: TObjectList; + + property Data: TObject read FData write FData; + property TabBar: TJvCustomTabBar read GetTabBar; + property DisplayRect: TRect read GetDisplayRect; + property Hot: Boolean read GetHot; + property Closing: Boolean read GetClosing; + published + property Caption: TCaption read FCaption write SetCaption; + property Selected: Boolean read GetSelected write SetSelected default False; + property Enabled: Boolean read GetEnabled write SetEnabled default True; + property Modified: Boolean read GetModified write SetModified default False; + property Hint: TCaption read FHint write FHint; + property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; + property Tag: Integer read FTag write FTag default 0; + property Visible: Boolean read FVisible write SetVisible default True; + property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu; + property ShowHint: Boolean read FShowHint write FShowHint default True; + + property OnGetModified: TJvGetModifiedEvent read FOnGetModified write FOnGetModified; + property OnGetEnabled: TJvGetEnabledEvent read FOnGetEnabled write FOnGetEnabled; + end; + + TJvTabBarItems = class(TOwnedCollection) + private + function GetTabBar: TJvCustomTabBar; + function GetItem(Index: Integer): TJvTabBarItem; + procedure SetItem(Index: Integer; const Value: TJvTabBarItem); + protected + function Find(const AName: string): TJvTabBarItem; + procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override; + public + function IndexOf(Item: TJvTabBarItem): Integer; + procedure EndUpdate; override; + property Items[Index: Integer]: TJvTabBarItem read GetItem write SetItem; default; + + property TabBar: TJvCustomTabBar read GetTabBar; + end; + + TJvTabBarPainterOptionType = (poPaintsHotTab, poBottomScrollButtons); + TJvTabBarPainterOptions = set of TJvTabBarPainterOptionType; + + TJvTabBarPainter = class(TComponent) + private + FOnChangeList: TList; + protected + procedure Changed; virtual; + + procedure DrawBackground(Canvas: TCanvas; TabBar: TJvCustomTabBar; R: TRect); virtual; abstract; + procedure DrawTab(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect); virtual; abstract; + procedure DrawDivider(Canvas: TCanvas; LeftTab: TJvTabBarItem; R: TRect); virtual; abstract; + procedure DrawMoveDivider(Canvas: TCanvas; Tab: TJvTabBarItem; MoveLeft: Boolean); virtual; abstract; + function GetDividerWidth(Canvas: TCanvas; LeftTab: TJvTabBarItem): Integer; virtual; abstract; + function GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize; virtual; abstract; + function GetCloseRect(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect): TRect; virtual; abstract; + function Options: TJvTabBarPainterOptions; virtual; abstract; + + procedure DrawScrollButton(Canvas: TCanvas; TabBar: TJvCustomTabBar; Button: TJvTabBarScrollButtonKind; + State: TJvTabBarScrollButtonState; R: TRect); virtual; + procedure GetScrollButtons(TabBar: TJvCustomTabBar; var LeftButton, RightButton: TRect); {virtual; reserved for future use } + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + end; + + TJvModernTabBarPainter = class(TJvTabBarPainter) + private + FFont: TFont; + FDisabledFont: TFont; + FSelectedFont: TFont; + FColor: TColor; + FTabColor: TColor; + FControlDivideColor: TColor; + FBorderColor: TColor; + FModifiedCrossColor: TColor; + FCloseRectColor: TColor; + FCloseRectColorDisabled: TColor; + FCloseCrossColorDisabled: TColor; + FCloseCrossColorSelected: TColor; + FCloseCrossColor: TColor; + FCloseColor: TColor; + FCloseColorSelected: TColor; + FDividerColor: TColor; + FMoveDividerColor: TColor; + FTabWidth: Integer; + + procedure SetCloseRectColorDisabled(const Value: TColor); + procedure SetCloseColor(const Value: TColor); + procedure SetCloseColorSelected(const Value: TColor); + procedure SetCloseCrossColor(const Value: TColor); + procedure SetCloseCrossColorDisabled(const Value: TColor); + procedure SetCloseRectColor(const Value: TColor); + procedure SetFont(const Value: TFont); + procedure SetDisabledFont(const Value: TFont); + procedure SetSelectedFont(const Value: TFont); + + procedure SetModifiedCrossColor(const Value: TColor); + procedure SetBorderColor(const Value: TColor); + procedure SetControlDivideColor(const Value: TColor); + + procedure SetTabColor(const Value: TColor); + procedure SetColor(const Value: TColor); + procedure FontChanged(Sender: TObject); + procedure SetDividerColor(const Value: TColor); + procedure SetCloseCrossColorSelected(const Value: TColor); + procedure SetTabWidth(Value: Integer); + protected + procedure DrawBackground(Canvas: TCanvas; TabBar: TJvCustomTabBar; R: TRect); override; + procedure DrawTab(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect); override; + procedure DrawDivider(Canvas: TCanvas; LeftTab: TJvTabBarItem; R: TRect); override; + procedure DrawMoveDivider(Canvas: TCanvas; Tab: TJvTabBarItem; MoveLeft: Boolean); override; + function GetDividerWidth(Canvas: TCanvas; LeftTab: TJvTabBarItem): Integer; override; + function GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize; override; + function GetCloseRect(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect): TRect; override; + function Options: TJvTabBarPainterOptions; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property TabColor: TColor read FTabColor write SetTabColor default clBtnFace; + property Color: TColor read FColor write SetColor default clWindow; + property BorderColor: TColor read FBorderColor write SetBorderColor default clSilver; + property ControlDivideColor: TColor read FControlDivideColor write SetControlDivideColor default clBlack; + property ModifiedCrossColor: TColor read FModifiedCrossColor write SetModifiedCrossColor default clRed; + property CloseColorSelected: TColor read FCloseColorSelected write SetCloseColorSelected default $F4F4F4; + property CloseColor: TColor read FCloseColor write SetCloseColor default clWhite; + property CloseCrossColorSelected: TColor read FCloseCrossColorSelected write SetCloseCrossColorSelected default clBlack; + property CloseCrossColor: TColor read FCloseCrossColor write SetCloseCrossColor default $5D5D5D; + property CloseCrossColorDisabled: TColor read FCloseCrossColorDisabled write SetCloseCrossColorDisabled default $ADADAD; + property CloseRectColor: TColor read FCloseRectColor write SetCloseRectColor default $868686; + property CloseRectColorDisabled: TColor read FCloseRectColorDisabled write SetCloseRectColorDisabled default $D6D6D6; + property DividerColor: TColor read FDividerColor write SetDividerColor default $99A8AC; + property MoveDividerColor: TColor read FMoveDividerColor write FMoveDividerColor default clBlack; + property TabWidth: Integer read FTabWidth write SetTabWidth default 0; + + property Font: TFont read FFont write SetFont; + property DisabledFont: TFont read FDisabledFont write SetDisabledFont; + property SelectedFont: TFont read FSelectedFont write SetSelectedFont; + end; + TJvTabBarModernPainter = TJvModernTabBarPainter; // TJvModernTabBarPainter should have been named TJvTabBarModernPainter + + TJvTabBarItemEvent = procedure(Sender: TObject; Item: TJvTabBarItem) of object; + TJvTabBarSelectingEvent = procedure(Sender: TObject; Item: TJvTabBarItem; var AllowSelect: Boolean) of object; + TJvTabBarClosingEvent = procedure(Sender: TObject; Item: TJvTabBarItem; var AllowClose: Boolean) of object; + TJvTabBarCloseQueryEvent = procedure(Sender: TObject; Item: TJvTabBarItem; var CanClose: Boolean) of object; + TJvTabBarScrollButtonClickEvent = procedure(Sender: TObject; Button: TJvTabBarScrollButtonKind) of object; + + TJvTabBarScrollButtonInfo = record + State: TJvTabBarScrollButtonState; + Rect: TRect; + ExState: Boolean; + end; + + TJvCustomTabBar = class(TCustomControl) + private + FTabs: TJvTabBarItems; + FPainter: TJvTabBarPainter; + FDefaultPainter: TJvTabBarPainter; + FChangeLink: TChangeLink; + FCloseButton: Boolean; + FRightClickSelect: Boolean; + FImages: TCustomImageList; + FHotTracking: Boolean; + FHotTab: TJvTabBarItem; + FSelectedTab: TJvTabBarItem; + FClosingTab: TJvTabBarItem; + FLastInsertTab: TJvTabBarItem; + FMouseDownClosingTab: TJvTabBarItem; + FMargin: Integer; + FAutoFreeClosed: Boolean; + FAllowUnselected: Boolean; + FSelectBeforeClose: Boolean; + FPageList: TCustomControl; + + FOnTabClosing: TJvTabBarClosingEvent; + FOnTabSelected: TJvTabBarItemEvent; + FOnTabSelecting: TJvTabBarSelectingEvent; + FOnTabCloseQuery: TJvTabBarCloseQueryEvent; + FOnTabClosed: TJvTabBarItemEvent; + FOnTabMoved: TJvTabBarItemEvent; + FOnChange: TNotifyEvent; + + // scrolling + FLeftIndex: Integer; + FLastTabRight: Integer; + FRequiredWidth: Integer; + FBarWidth: Integer; + FBtnLeftScroll: TJvTabBarScrollButtonInfo; + FBtnRightScroll: TJvTabBarScrollButtonInfo; + FScrollButtonBackground: TBitmap; + FHint: TCaption; + FFlatScrollButtons: Boolean; + FAllowTabMoving: Boolean; + FOrientation: TJvTabBarOrientation; + FOnScrollButtonClick: TJvTabBarScrollButtonClickEvent; + FPageListTabLink: Boolean; + + FRepeatTimer: TTimer; + FScrollRepeatedClicked: Boolean; + FOnLeftTabChange: TNotifyEvent; + + function GetLeftTab: TJvTabBarItem; + procedure SetLeftTab(Value: TJvTabBarItem); + procedure SetSelectedTab(Value: TJvTabBarItem); + procedure SetTabs(Value: TJvTabBarItems); + procedure SetPainter(Value: TJvTabBarPainter); + procedure SetImages(Value: TCustomImageList); + procedure SetCloseButton(Value: Boolean); + procedure SetMargin(Value: Integer); + + procedure SetHotTab(Tab: TJvTabBarItem); + procedure SetClosingTab(Tab: TJvTabBarItem); + procedure UpdateScrollButtons; + function FindSelectableTab(Tab: TJvTabBarItem): TJvTabBarItem; + procedure SetHint(const Value: TCaption); + procedure SetFlatScrollButtons(const Value: Boolean); + procedure SetPageList(const Value: TCustomControl); + procedure SetOrientation(const Value: TJvTabBarOrientation); + procedure TimerExpired(Sender: TObject); + protected + procedure DrawScrollBarGlyph(ACanvas: TCanvas; X, Y: Integer; ALeft, Disabled: Boolean); + procedure Resize; override; + procedure CalcTabsRects; + procedure Paint; override; + procedure PaintTab(ACanvas: TCanvas; Tab: TJvTabBarItem); virtual; + procedure PaintScrollButtons; + + function GetTabWidth(Tab: TJvTabBarItem): Integer; + function GetTabHeight(Tab: TJvTabBarItem): Integer; + + function CurrentPainter: TJvTabBarPainter; + procedure Notification(Component: TComponent; Operation: TOperation); override; + + function TabClosing(Tab: TJvTabBarItem): Boolean; virtual; + function TabCloseQuery(Tab: TJvTabBarItem): Boolean; virtual; + procedure TabClosed(Tab: TJvTabBarItem); virtual; + function TabSelecting(Tab: TJvTabBarItem): Boolean; virtual; + procedure TabSelected(Tab: TJvTabBarItem); virtual; + procedure TabMoved(Tab: TJvTabBarItem); virtual; + procedure Changed; virtual; + procedure ImagesChanged(Sender: TObject); virtual; + procedure ScrollButtonClick(Button: TJvTabBarScrollButtonKind); virtual; + procedure LeftTabChanged; virtual; + + procedure DragOver(Source: TObject; X: Integer; Y: Integer; + State: TDragState; var Accept: Boolean); override; + procedure DragCanceled; override; + + function ScrollButtonsMouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer): Boolean; virtual; + function ScrollButtonsMouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer): Boolean; virtual; + function ScrollButtonsMouseMove(Shift: TShiftState; X: Integer; Y: Integer): Boolean; virtual; + + function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override; + procedure CMMouseLeave(var Msg: TLMessage); message CM_MOUSELEAVE; + procedure WMEraseBkgnd(var Msg: TLMEraseBkgnd); message LM_ERASEBKGND; + procedure Loaded; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function AddTab(const ACaption: string): TJvTabBarItem; + function FindTab(const ACaption: string): TJvTabBarItem; // returns the first tab with the given Caption + function TabAt(X, Y: Integer): TJvTabBarItem; + function MakeVisible(Tab: TJvTabBarItem): Boolean; + function FindData(Data: TObject): TJvTabBarItem; + function CloseTab(ATab: TJvTabBarItem): Boolean; + + procedure DragDrop(Source: TObject; X: Integer; Y: Integer); override; + + property PageListTabLink: Boolean read FPageListTabLink write FPageListTabLink default False; // if true the PageList's Pages[] are kept in sync with the Tabs + property PageList: TCustomControl read FPageList write SetPageList; + property Painter: TJvTabBarPainter read FPainter write SetPainter; + property Images: TCustomImageList read FImages write SetImages; + property Tabs: TJvTabBarItems read FTabs write SetTabs; + + // Status + property SelectedTab: TJvTabBarItem read FSelectedTab write SetSelectedTab; + property LeftTab: TJvTabBarItem read GetLeftTab write SetLeftTab; + property HotTab: TJvTabBarItem read FHotTab; + property ClosingTab: TJvTabBarItem read FClosingTab; + + // Options + property Orientation: TJvTabBarOrientation read FOrientation write SetOrientation default toTop; + property CloseButton: Boolean read FCloseButton write SetCloseButton default True; + property RightClickSelect: Boolean read FRightClickSelect write FRightClickSelect default True; + property HotTracking: Boolean read FHotTracking write FHotTracking default False; + property AutoFreeClosed: Boolean read FAutoFreeClosed write FAutoFreeClosed default True; + property AllowUnselected: Boolean read FAllowUnselected write FAllowUnselected default False; + property SelectBeforeClose: Boolean read FSelectBeforeClose write FSelectBeforeClose default False; + property Margin: Integer read FMargin write SetMargin default 6; + property FlatScrollButtons: Boolean read FFlatScrollButtons write SetFlatScrollButtons default True; + property Hint: TCaption read FHint write SetHint; + property AllowTabMoving: Boolean read FAllowTabMoving write FAllowTabMoving default False; + + // Events + + { With OnTabClosing you can prevent the close button [X] in the tab from shrinking. + If you want to ask the user you should use OnTabCloseQuery } + property OnTabClosing: TJvTabBarClosingEvent read FOnTabClosing write FOnTabClosing; + property OnTabCloseQuery: TJvTabBarCloseQueryEvent read FOnTabCloseQuery write FOnTabCloseQuery; + property OnTabClosed: TJvTabBarItemEvent read FOnTabClosed write FOnTabClosed; + property OnTabSelecting: TJvTabBarSelectingEvent read FOnTabSelecting write FOnTabSelecting; + property OnTabSelected: TJvTabBarItemEvent read FOnTabSelected write FOnTabSelected; + property OnTabMoved: TJvTabBarItemEvent read FOnTabMoved write FOnTabMoved; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnScrollButtonClick: TJvTabBarScrollButtonClickEvent read FOnScrollButtonClick write FOnScrollButtonClick; + property OnLeftTabChange: TNotifyEvent read FOnLeftTabChange write FOnLeftTabChange; + end; + + TJvTabBar = class(TJvCustomTabBar) + published + property Align default alTop; + property Cursor; + property PopupMenu; + property ShowHint default False; + property Height default 23; + property Hint; + property Visible; + property Enabled; + + property Orientation; + property CloseButton; + property RightClickSelect; + property HotTracking; + property AutoFreeClosed; + property AllowUnselected; + property SelectBeforeClose; + property Margin; + property FlatScrollButtons; + property AllowTabMoving; + + property PageListTabLink; + property PageList; + property Painter; + property Images; + property Tabs; + + property OnTabClosing; + property OnTabCloseQuery; + property OnTabClosed; + property OnTabSelecting; + property OnTabSelected; + property OnTabMoved; + property OnChange; + property OnLeftTabChange; + + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnContextPopup; + + property OnClick; + property OnDblClick; + + property OnDragDrop; + property OnDragOver; + property OnStartDrag; + property OnEndDrag; + + property OnStartDock; + property OnEndDock; + end; + + +implementation + +uses + JvJVCLUtils; + +const + WHEEL_DELTA = 120; + +function DrawButtonFace(ACanvas: TCanvas; const ARect: TRect; AFlat: Boolean; +// BevelWidth: Integer; Style: TButtonStyle; IsRounded, + IsDown, IsFocused: Boolean): TRect; +var + R: TRect; +begin + R := ARect; + + ACanvas.Pen.Style := psSolid; + if AFlat then begin + ACanvas.Brush.Color := clBtnFace; + ACanvas.Brush.Style := bsSolid; + ACanvas.FillRect(R); + if IsDown then begin + ACanvas.Pen.Color := clBlack; + ACanvas.Line(R.Left, R.Top, R.Left, R.Bottom); // left + ACanvas.Line(R.Left, R.Top, R.Right, R.Top); // top + ACanvas.Pen.Color := clBtnHighlight; + ACanvas.Line(R.Right, R.Top, R.Right, R.Bottom); // right + ACanvas.Line(R.Left, R.Bottom, R.Right, R.Bottom); // bottom + InflateRect(R, -1, -1); + ACanvas.Pen.Color := clBtnShadow; + ACanvas.Line(R.Left, R.Top, R.Left, R.Bottom); // left + ACanvas.Line(R.Left, R.Top, R.Right, R.Top); // top + end else begin + ACanvas.Pen.Color := clBlack; + ACanvas.Line(R.Right, R.Top, R.Right, R.Bottom); // right + ACanvas.Line(R.Left, R.Bottom, R.Right, R.Bottom); // bottom + dec(R.Right); + dec(R.Bottom); + ACanvas.Pen.Color := clBtnHighlight; + ACanvas.Line(R.Left, R.Top, R.Left, R.Bottom); // left + ACanvas.Line(R.Left, R.Top, R.Right, R.Top); // top + Inc(R.Top); + Inc(R.Left); + ACanvas.Line(R.Right, R.Top, R.Right, R.Bottom); // right + ACanvas.Line(R.Left, R.Bottom, R.Right, R.Bottom); // bottom + end; + end else begin + ACanvas.Pen.Color := clWindowFrame; + ACanvas.Brush.Color := clBtnFace; + ACanvas.Brush.Style := bsSolid; + ACanvas.Rectangle(R); + if IsFocused then begin + InflateRect(R, 1, 1); + ACanvas.Brush.Style := bsClear; + ACanvas.Pen.Color := clBlack; + ACanvas.Rectangle(R); + end; + InflateRect(R, -1, -1); + if not IsDown then begin + ACanvas.Pen.Color := clBtnHighlight; + ACanvas.Line(R.Left, R.Top, R.Left, R.Bottom); // left + ACanvas.Line(R.Left, R.Top, R.Right, R.Top); // top + ACanvas.Pen.Color := clBtnShadow; + ACanvas.Line(R.Right, R.Top, R.Right, R.Bottom); // right + ACanvas.Line(R.Left, R.Bottom, R.Right, R.Bottom); // bottom + end else begin + ACanvas.Pen.Color := clBtnShadow; + ACanvas.MoveTo(R.Left, R.Bottom-1); + ACanvas.LineTo(R.Left, R.Top); + ACanvas.LineTo(R.Right, R.Top); + end; + end; + + Result := Rect(ARect.Left + 1, ARect.Top + 1, ARect.Right - 2, ARect.Bottom - 2); + if IsDown then OffsetRect(Result, 1, 1); +end; + + + +//=== { TJvCustomTabBar } ==================================================== + +constructor TJvCustomTabBar.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + ControlStyle := ControlStyle - [csAcceptsControls, csOpaque] {+ [csDesignInteractive]}; + + FTabs := TJvTabBarItems.Create(Self, TJvTabBarItem); + FChangeLink := TChangeLink.Create; + FChangeLink.OnChange := @ImagesChanged; + + FOrientation := toTop; + FRightClickSelect := True; + FCloseButton := True; + FAutoFreeClosed := True; + FFlatScrollButtons := True; + + FMargin := 6; + + Align := alTop; + Height := 23; +end; + +destructor TJvCustomTabBar.Destroy; +begin + // these events are too dangerous during object destruction + FOnTabSelected := nil; + FOnTabSelecting := nil; + FOnChange := nil; + + Painter := nil; + Images := nil; + FChangeLink.Free; + FTabs.Free; + FTabs := nil; + FScrollButtonBackground.Free; + FScrollButtonBackground := nil; + + inherited Destroy; +end; + +procedure TJvCustomTabBar.LeftTabChanged; +begin + if Assigned(FOnLeftTabChange) then + FOnLeftTabChange(Self); +end; + +procedure TJvCustomTabBar.Loaded; +begin + inherited Loaded; + SelectedTab := FindSelectableTab(nil); + UpdateScrollButtons; +end; + +procedure TJvCustomTabBar.Notification(Component: TComponent; Operation: TOperation); +var + I: Integer; +begin + inherited Notification(Component, Operation); + if Operation = opRemove then + begin + if Component = FPainter then + Painter := nil + else + if Component = FImages then + Images := nil + else + if Component = FPageList then + PageList := nil; + end; + if FTabs <> nil then + for I := Tabs.Count - 1 downto 0 do + Tabs[I].Notification(Component, Operation); +end; + +procedure TJvCustomTabBar.DrawScrollBarGlyph(ACanvas: TCanvas; X, Y: Integer; ALeft, Disabled: Boolean); + + procedure OffsetPt(var Pt: TPoint; X, Y: Integer); + begin + Pt := Point(Pt.X + X, Pt.Y + Y); + end; + +const + W = 4; + H = 7; +var + Pts: array [0..2] of TPoint; + savedBrush: TBrush; + savedPen: TPen; +begin + savedBrush := TBrush.Create; + savedPen := TPen.Create; + try + savedBrush.Assign(ACanvas.Brush); + savedPen.Assign(ACanvas.Pen); + + if ALeft then + begin + Pts[0] := Point(X + W - 1, Y + 0); + Pts[1] := Point(X + W - 1, Y + H - 1); + Pts[2] := Point(X + 0, Y + (H - 1) div 2); + end + else + begin + Pts[0] := Point(X + 0, Y + 0); + Pts[1] := Point(X + 0, Y + H - 1); + Pts[2] := Point(X + W - 1, Y + (H - 1) div 2); + end; + ACanvas.Brush.Style := bsSolid; + if Disabled then + begin + ACanvas.Brush.Color := clWhite; + OffsetPt(Pts[0], 1, 1); + OffsetPt(Pts[1], 1, 1); + OffsetPt(Pts[2], 1, 1); + end + else + ACanvas.Brush.Color := clBlack; + + ACanvas.Pen.Color := ACanvas.Brush.Color; + ACanvas.Polygon(Pts); + if Disabled then + begin + ACanvas.Brush.Color := clGray; + OffsetPt(Pts[0], -1, -1); + OffsetPt(Pts[1], -1, -1); + OffsetPt(Pts[2], -1, -1); + ACanvas.Pen.Color := ACanvas.Brush.Color; + ACanvas.Polygon(Pts); + end; + finally + ACanvas.Pen.Assign(savedPen); + ACanvas.Brush.Assign(savedBrush); + savedPen.Free; + savedBrush.Free; + end; +end; + +procedure TJvCustomTabBar.SetTabs(Value: TJvTabBarItems); +begin + if Value <> FTabs then + FTabs.Assign(Value); +end; + +procedure TJvCustomTabBar.SetPainter(Value: TJvTabBarPainter); +begin + if Value <> FPainter then + begin + if FPainter <> nil then + FPainter.FOnChangeList.Extract(Self); + ReplaceComponentReference(Self, Value, tComponent(FPainter)); + if FPainter <> nil then + begin + FreeAndNil(FDefaultPainter); + FPainter.FOnChangeList.Add(Self); + if Parent <> nil then + UpdateScrollButtons; + end; + + if not (csDestroying in ComponentState) then + Invalidate; + end; +end; + +procedure TJvCustomTabBar.SetImages(Value: TCustomImageList); +begin + if ReplaceImageListReference(Self, Value, FImages, FChangeLink) then + if not (csDestroying in ComponentState) then + Invalidate; +end; + +procedure TJvCustomTabBar.SetCloseButton(Value: Boolean); +begin + if Value <> FCloseButton then + begin + FCloseButton := Value; + Invalidate; + end; +end; + +procedure TJvCustomTabBar.SetMargin(Value: Integer); +begin + if Value <> FMargin then + begin + FMargin := Value; + Invalidate; + end; +end; + +procedure TJvCustomTabBar.SetSelectedTab(Value: TJvTabBarItem); +begin + if Value <> FSelectedTab then + begin + if (Value <> nil) and not Value.CanSelect then + Exit; + + if TabSelecting(Value) then + begin + FSelectedTab := Value; + if not (csDestroying in ComponentState) then + Invalidate; + MakeVisible(FSelectedTab); + TabSelected(FSelectedTab); + end; + end; +end; + +function TJvCustomTabBar.CurrentPainter: TJvTabBarPainter; +begin + Result := FPainter; + if Result = nil then + begin + if FDefaultPainter = nil then + FDefaultPainter := TJvModernTabBarPainter.Create(Self); + Result := FDefaultPainter; + end; +end; + +function TJvCustomTabBar.TabClosing(Tab: TJvTabBarItem): Boolean; +begin + Result := True; + if Assigned(FOnTabClosing) then + FOnTabClosing(Self, Tab, Result); +end; + +function TJvCustomTabBar.TabCloseQuery(Tab: TJvTabBarItem): Boolean; +begin + Result := True; + if Assigned(FOnTabCloseQuery) then + FOnTabCloseQuery(Self, Tab, Result); +end; + +procedure TJvCustomTabBar.TabClosed(Tab: TJvTabBarItem); +begin + if AutoFreeClosed and not (csDesigning in ComponentState) then + Tab.Visible := False; + try + if Assigned(FOnTabClosed) then + FOnTabClosed(Self, Tab); + finally + // Do not double release if somebody "accidentally" released the Tab in TabClosed even if AutoFreeClosed is true + if AutoFreeClosed and not (csDesigning in ComponentState) and (FTabs.IndexOf(Tab) <> -1) then + Tab.Free; + end; +end; + +function TJvCustomTabBar.TabSelecting(Tab: TJvTabBarItem): Boolean; +begin + Result := True; + if Assigned(FOnTabSelecting) then + FOnTabSelecting(Self, Tab, Result); +end; + +procedure TJvCustomTabBar.TabSelected(Tab: TJvTabBarItem); +var + PageListIntf: IPageList; +begin + if (PageList <> nil) and Supports(PageList, IPageList, PageListIntf) then + begin + if Tab <> nil then + PageListIntf.SetActivePageIndex(Tab.Index) + else + PageListIntf.SetActivePageIndex(-1); + PageListIntf := nil; // who knows what OnTabSelected does with the PageList + end; + if Assigned(FOnTabSelected) then + FOnTabSelected(Self, Tab); +end; + +function TJvCustomTabBar.FindSelectableTab(Tab: TJvTabBarItem): TJvTabBarItem; +var + Index: Integer; +begin + Result := Tab; + if (Result <> nil) and not Result.CanSelect then + begin + if AllowUnselected then + Result := nil + else + begin + Index := Result.Index + 1; + while Index < Tabs.Count do + begin + if Tabs[Index].CanSelect then + Break; + Inc(Index); + end; + if Index >= Tabs.Count then + begin + Index := Result.Index - 1; + while Index >= 0 do + begin + if Tabs[Index].CanSelect then + Break; + Dec(Index); + end; + end; + if Index >= 0 then + Result := Tabs[Index] + else + Result := nil; + end; + end; + if not AllowUnselected and not (Result <> nil) then + begin + // try to find a selectable tab + for Index := 0 to Tabs.Count - 1 do + if Tabs[Index].CanSelect then + begin + Result := Tabs[Index]; + Break; + end; + end; +end; + +procedure TJvCustomTabBar.Changed; +begin + if not (csDestroying in ComponentState) then + begin + // The TabSelected tab is now no more selectable + SelectedTab := FindSelectableTab(SelectedTab); + if Tabs.UpdateCount = 0 then + begin + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + UpdateScrollButtons; + end; + end; +end; + +procedure TJvCustomTabBar.ImagesChanged(Sender: TObject); +begin + if not (csDestroying in ComponentState) then + Invalidate; +end; + +procedure TJvCustomTabBar.TabMoved(Tab: TJvTabBarItem); +begin + if Assigned(FOnTabMoved) then + FOnTabMoved(Self, Tab); +end; + +procedure TJvCustomTabBar.DragOver(Source: TObject; X: Integer; Y: Integer; + State: TDragState; var Accept: Boolean); +var + InsertTab: TJvTabBarItem; +begin + if AllowTabMoving then + begin + InsertTab := TabAt(X, Y); + if InsertTab = nil then + if (LeftTab <> nil) and (X < LeftTab.FLeft) then + InsertTab := LeftTab + else + if Tabs.Count > 0 then + InsertTab := Tabs[Tabs.Count - 1]; + + Accept := (Source = Self) and (SelectedTab <> nil) and (InsertTab <> SelectedTab) and (InsertTab <> nil); + if Accept then + begin + if InsertTab <> FLastInsertTab then + begin + if FLastInsertTab <> nil then + Repaint; + { Paint MoveDivider } + FLastInsertTab := InsertTab; + CurrentPainter.DrawMoveDivider(Canvas, InsertTab, InsertTab.Index < SelectedTab.Index); + end; + { inherited DrawOver sets Accept to False if no event handler is assigned. } + if Assigned(OnDragOver) then + OnDragOver(Self, Source, X, Y, State, Accept); + Exit; + end + else + if FLastInsertTab <> nil then + begin + Repaint; + FLastInsertTab := nil; + end; + end; + inherited DragOver(Source, X, Y, State, Accept); +end; + +procedure TJvCustomTabBar.DragCanceled; +begin + if FLastInsertTab <> nil then + Repaint; + FLastInsertTab := nil; + inherited DragCanceled; +end; + +procedure TJvCustomTabBar.DragDrop(Source: TObject; X: Integer; Y: Integer); +var + InsertTab: TJvTabBarItem; +begin + if AllowTabMoving and (Source = Self) and (SelectedTab <> nil) then + begin + InsertTab := TabAt(X, Y); + if InsertTab = nil then + if (LeftTab <> nil) and (X < LeftTab.FLeft) then + InsertTab := LeftTab + else + InsertTab := Tabs[Tabs.Count - 1]; + if InsertTab <> nil then + begin + SelectedTab.Index := InsertTab.Index; + TabMoved(SelectedTab); + SelectedTab.MakeVisible; + UpdateScrollButtons; + end; + end + else + if FLastInsertTab <> nil then + Repaint; + FLastInsertTab := nil; + inherited DragDrop(Source, X, Y); +end; + +procedure TJvCustomTabBar.CMMouseLeave(var Msg: TLMessage); +begin + SetHotTab(nil); + inherited; +end; + +procedure TJvCustomTabBar.WMEraseBkgnd(var Msg: TLMEraseBkgnd); +begin + Msg.Result := 1; +end; + +function TJvCustomTabBar.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; +begin + Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos); + if not Result then + begin + Result := True; + + if SelectedTab = nil then + SelectedTab := LeftTab; + if SelectedTab = nil then + Exit; // nothing to do + + WheelDelta := WheelDelta div WHEEL_DELTA; + while WheelDelta <> 0 do + begin + if WheelDelta < 0 then + begin + if SelectedTab.GetNextVisible <> nil then + SelectedTab := SelectedTab.GetNextVisible + else + Break; + end + else + begin + if SelectedTab.GetPreviousVisible <> nil then + SelectedTab := SelectedTab.GetPreviousVisible + else + Break; + end; + + if WheelDelta < 0 then + Inc(WheelDelta) + else + Dec(WheelDelta); + end; + end; +end; + +procedure TJvCustomTabBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, + Y: Integer); +var + Tab: TJvTabBarItem; + LastSelected: TJvTabBarItem; +begin + if ScrollButtonsMouseDown(Button, Shift, X, Y) then + Exit; + + if Button = mbLeft then + begin + FMouseDownClosingTab := nil; + SetClosingTab(nil); // no tab should be closed + + LastSelected := SelectedTab; + Tab := TabAt(X, Y); + if Tab <> nil then + SelectedTab := Tab; + + if (Tab <> nil) and (Tab = SelectedTab) then + if CloseButton and (not SelectBeforeClose or (SelectedTab = LastSelected)) then + begin + if PtInRect(CurrentPainter.GetCloseRect(Canvas, Tab, Tab.DisplayRect), Point(X, Y)) then + begin + if TabClosing(Tab) then + begin + if FTabs.IndexOf(Tab) = -1 then + Tab := nil; // We should not keep a reference if somebody "accidentally" released the Tab in TabClosing + FMouseDownClosingTab := Tab; + SetClosingTab(Tab); + end; + inherited MouseDown(Button, Shift, X, Y); + Exit; + end; + end; + if (FClosingTab = nil) and AllowTabMoving and + ([ssLeft, ssMiddle, ssRight] * Shift = [ssLeft]) then + BeginDrag(False); + end; + inherited MouseDown(Button, Shift, X, Y); +end; + +procedure TJvCustomTabBar.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + Pt: TPoint; + Tab: TJvTabBarItem; +begin + if ScrollButtonsMouseUp(Button, Shift, X, Y) then + Exit; + + try + if RightClickSelect and not (PopupMenu <> nil) and (Button = mbRight) then + begin + Tab := TabAt(X, Y); + if Tab <> nil then + SelectedTab := Tab; + if (Tab <> nil) and (Tab.PopupMenu <> nil) then + begin + Pt := ClientToScreen(Point(X, Y)); + Tab.PopupMenu.Popup(Pt.X, Pt.Y); + end; + end + else + if Button = mbLeft then + begin + if (FClosingTab <> nil) and CloseButton then + begin + CalcTabsRects; + if PtInRect(CurrentPainter.GetCloseRect(Canvas, FClosingTab, FClosingTab.DisplayRect), Point(X, Y)) then + begin + if TabCloseQuery(FClosingTab) then + TabClosed(FClosingTab) + end; + end; + end; + finally + FMouseDownClosingTab := nil; + SetClosingTab(nil); + end; + inherited MouseUp(Button, Shift, X, Y); +end; + +procedure TJvCustomTabBar.MouseMove(Shift: TShiftState; X, Y: Integer); +var + Tab: TJvTabBarItem; + NewHint: TCaption; +begin + CalcTabsRects; // maybe inefficent + if ScrollButtonsMouseMove(Shift, X, Y) then + Exit; + + Tab := TabAt(X, Y); + if HotTracking and ([ssLeft, ssMiddle, ssRight] * Shift = []) then + SetHotTab(Tab); + + if CloseButton and (FMouseDownClosingTab <> nil) and (ssLeft in Shift) then + begin + if PtInRect(CurrentPainter.GetCloseRect(Canvas, FMouseDownClosingTab, + FMouseDownClosingTab.DisplayRect), Point(X, Y)) then + SetClosingTab(FMouseDownClosingTab) + else + SetClosingTab(nil) + end; + + if (Tab <> nil) and Tab.ShowHint then + NewHint := Tab.Hint + else + NewHint := FHint; + + if NewHint <> inherited Hint then + begin + Application.CancelHint; + ShowHint := False; + ShowHint := True; + inherited Hint := NewHint; + end; + + inherited MouseMove(Shift, X, Y); +end; + +function TJvCustomTabBar.ScrollButtonsMouseDown(Button: TMouseButton; + Shift: TShiftState; X, Y: Integer): Boolean; + + function HandleButton(Kind: TJvTabBarScrollButtonKind; var State: TJvTabBarScrollButtonState; + X, Y: Integer; const R: TRect): Boolean; + begin + Result := PtInRect(R, Point(X, Y)); + case State of + sbsNormal, sbsHot: + begin + if Result then + begin + State := sbsPressed; + PaintScrollButtons; + + if FRepeatTimer = nil then + FRepeatTimer := TTimer.Create(Self); + FRepeatTimer.OnTimer := @TimerExpired; + FRepeatTimer.Interval := 400; + FRepeatTimer.Enabled := True; + FRepeatTimer.Tag := Integer(Kind); + FScrollRepeatedClicked := False; + end; + end; + end; + end; + +begin + Result := False; + if (FBtnLeftScroll.State <> sbsHidden) then + Result := HandleButton(sbScrollLeft, FBtnLeftScroll.State, X, Y, FBtnLeftScroll.Rect); + if not Result and (FBtnRightScroll.State <> sbsHidden) then + Result := HandleButton(sbScrollRight, FBtnRightScroll.State, X, Y, FBtnRightScroll.Rect); +end; + +function TJvCustomTabBar.ScrollButtonsMouseMove(Shift: TShiftState; X, Y: Integer): Boolean; + + function HandleButton(var ExState: Boolean; var State: TJvTabBarScrollButtonState; + X, Y: Integer; const R: TRect): Boolean; + begin + Result := PtInRect(R, Point(X, Y)); + case State of + sbsNormal: + begin + if Result then + begin + State := sbsHot; + PaintScrollButtons; + Result := True; + end; + end; + sbsPressed: + begin + if not Result then + begin + ExState := True; + State := sbsNormal; + PaintScrollButtons; + State := sbsPressed; + end + else + begin + if ExState then + begin + ExState := False; + PaintScrollButtons; + end; + end; + end; + sbsHot: + begin + if not Result then + begin + State := sbsNormal; + PaintScrollButtons; + end; + end; + end; + end; + +begin + Result := False; + if (FBtnLeftScroll.State <> sbsHidden) then + Result := HandleButton(FBtnLeftScroll.ExState, FBtnLeftScroll.State, X, Y, FBtnLeftScroll.Rect); + if not Result and (FBtnRightScroll.State <> sbsHidden) then + Result := HandleButton(FBtnRightScroll.ExState, FBtnRightScroll.State, X, Y, FBtnRightScroll.Rect); +end; + +function TJvCustomTabBar.ScrollButtonsMouseUp(Button: TMouseButton; + Shift: TShiftState; X, Y: Integer): Boolean; + + function HandleButton(Kind: TJvTabBarScrollButtonKind; var State: TJvTabBarScrollButtonState; + X, Y: Integer; const R: TRect): Boolean; + begin + Result := PtInRect(R, Point(X, Y)); + case State of + sbsPressed: + begin + FreeAndNil(FRepeatTimer); + State := sbsNormal; + PaintScrollButtons; + if Result and not FScrollRepeatedClicked then + ScrollButtonClick(Kind); + FScrollRepeatedClicked := False; + end; + end; + end; + +begin + Result := False; + if (FBtnLeftScroll.State <> sbsHidden) then + Result := HandleButton(sbScrollLeft, FBtnLeftScroll.State, X, Y, FBtnLeftScroll.Rect); + if not Result and (FBtnRightScroll.State <> sbsHidden) then + Result := HandleButton(sbScrollRight, FBtnRightScroll.State, X, Y, FBtnRightScroll.Rect); +end; + +procedure TJvCustomTabBar.TimerExpired(Sender: TObject); +var + Kind: TJvTabBarScrollButtonKind; + State: TJvTabBarScrollButtonState; +begin + FRepeatTimer.Interval := 100; + Kind := TJvTabBarScrollButtonKind(FRepeatTimer.Tag); + case Kind of + sbScrollLeft: + State := FBtnLeftScroll.State; + sbScrollRight: + State := FBtnRightScroll.State; + else + Exit; + end; + + if (State = sbsPressed) and Enabled {and MouseCapture} then + begin + try + FScrollRepeatedClicked := True; + ScrollButtonClick(Kind); + case Kind of + sbScrollLeft: + if not (FBtnLeftScroll.State in [sbsHidden, sbsDisabled]) then + FBtnLeftScroll.State := sbsPressed; + sbScrollRight: + if not (FBtnRightScroll.State in [sbsHidden, sbsDisabled]) then + FBtnRightScroll.State := sbsPressed; + end; + except + FRepeatTimer.Enabled := False; + raise; + end; + end + else + FreeAndNil(FRepeatTimer); +end; + +procedure TJvCustomTabBar.SetHotTab(Tab: TJvTabBarItem); +begin + if (csDestroying in ComponentState) or not HotTracking then + FHotTab := nil + else + if Tab <> FHotTab then + begin + FHotTab := Tab; + if poPaintsHotTab in CurrentPainter.Options then + Paint; + end; +end; + +function TJvCustomTabBar.CloseTab(ATab: TJvTabBarItem): Boolean; +begin + Result := False; + if ATab <> nil then + begin + FClosingTab := ATab; + try + Result := TabCloseQuery(FClosingTab); + if Result then + TabClosed(FClosingTab); + finally + FClosingTab := nil; + end; + end; +end; + +function TJvCustomTabBar.AddTab(const ACaption: string): TJvTabBarItem; +begin + Result := TJvTabBarItem(Tabs.Add); + Result.Caption := ACaption; +end; + +function TJvCustomTabBar.FindTab(const ACaption: string): TJvTabBarItem; +var + i: Integer; +begin + for i := 0 to Tabs.Count - 1 do + if ACaption = Tabs[i].Caption then + begin + Result := Tabs[i]; + Exit; + end; + Result := nil; +end; + +procedure TJvCustomTabBar.CalcTabsRects; +var + I, X: Integer; + Tab: TJvTabBarItem; + Offset: Integer; + Index: Integer; +begin + if csDestroying in ComponentState then + Exit; + + Offset := 0; + X := Margin; // adjust for scrolled area + Index := 0; + for I := 0 to Tabs.Count - 1 do + begin + Tab := Tabs[I]; + if Tab.Visible then + begin + Tab.FLeft := X; + Inc(X, GetTabWidth(Tab)); + Inc(X, CurrentPainter.GetDividerWidth(Canvas, Tab)); + if Index < FLeftIndex then + begin + Inc(Offset, X); // this tab is placed too left. + X := 0; + Tab.FLeft := -Offset - 10; + end; + Inc(Index); + end + else + Tab.FLeft := -1; + end; + + FRequiredWidth := X + Offset; + FLastTabRight := X; +end; + +procedure TJvCustomTabBar.Paint; +var + I: Integer; + Bmp: TBitmap; + R: TRect; +begin + CalcTabsRects; + Bmp := TBitmap.Create; + try + Bmp.Width := ClientWidth; + Bmp.Height := ClientHeight; + CurrentPainter.DrawBackground(Bmp.Canvas, Self, ClientRect); + if (FBtnLeftScroll.State <> sbsHidden) and (FBtnRightScroll.State <> sbsHidden) then + begin + if FScrollButtonBackground = nil then + FScrollButtonBackground := TBitmap.Create; + FScrollButtonBackground.Width := Bmp.Width - FBarWidth; + FScrollButtonBackground.Height := Bmp.Height; + R := Rect(FBarWidth, 0, Bmp.Width, Bmp.Height); + FScrollButtonBackground.Canvas.CopyRect(Rect(0, 0, FScrollButtonBackground.Width, R.Bottom), Bmp.Canvas, R); + PaintScrollButtons; + if FBarWidth > 0 then + Bmp.Width := FBarWidth; + end; + + if FBarWidth > 0 then + for I := 0 to Tabs.Count - 1 do + if Tabs[I].Visible then + PaintTab(Bmp.Canvas, Tabs[I]); + Canvas.Draw(0, 0, Bmp); + finally + Bmp.Free; + end; +end; + +procedure TJvCustomTabBar.PaintTab(ACanvas: TCanvas; Tab: TJvTabBarItem); +var + R: TRect; +begin + if csDestroying in ComponentState then + Exit; + + if Tab.Visible then + begin + R := Tab.DisplayRect; + if (R.Right >= 0) and (R.Left < FBarWidth) then + begin + CurrentPainter.DrawTab(ACanvas, Tab, R); + R.Left := R.Right; + R.Right := R.Left + CurrentPainter.GetDividerWidth(ACanvas, Tab) - 1; + CurrentPainter.DrawDivider(ACanvas, Tab, R); + end; + end; +end; + +procedure TJvCustomTabBar.PaintScrollButtons; +begin + if not HandleAllocated then + exit; + + if (FScrollButtonBackground = nil) and Visible then + Paint + else // paint scroll button's background and the buttons + Canvas.Draw(FBarWidth, 0, FScrollButtonBackground); + + CurrentPainter.DrawScrollButton(Canvas, Self, sbScrollLeft, FBtnLeftScroll.State, FBtnLeftScroll.Rect); + CurrentPainter.DrawScrollButton(Canvas, Self, sbScrollRight, FBtnRightScroll.State, FBtnRightScroll.Rect); +end; + +function TJvCustomTabBar.GetTabHeight(Tab: TJvTabBarItem): Integer; +begin + Result := Abs(CurrentPainter.GetTabSize(Canvas, Tab).cy); + if Result > High(Word) then + Result := High(Word); +end; + +function TJvCustomTabBar.GetTabWidth(Tab: TJvTabBarItem): Integer; +begin + Result := Abs(CurrentPainter.GetTabSize(Canvas, Tab).cx); + if Result > High(Word) then + Result := High(Word); +end; + +function TJvCustomTabBar.TabAt(X, Y: Integer): TJvTabBarItem; +var + I: Integer; + Pt: TPoint; +begin + if (FBtnLeftScroll.State = sbsHidden) or (X < FBarWidth) then + begin + CalcTabsRects; + Pt := Point(X, Y); + for I := 0 to Tabs.Count - 1 do + if PtInRect(Tabs[I].DisplayRect, Pt) then + begin + Result := Tabs[I]; + Exit; + end; + end; + Result := nil; +end; + +procedure TJvCustomTabBar.SetClosingTab(Tab: TJvTabBarItem); +begin + if Tab <> FClosingTab then + begin + FClosingTab := Tab; // this tab should be TabClosed + Paint; + end; +end; + +function TJvCustomTabBar.GetLeftTab: TJvTabBarItem; +begin + if (Tabs <> nil) and (FLeftIndex < Tabs.Count) then + begin + Result := Tabs[FLeftIndex]; + if not Result.Visible then + Result := Result.GetNextVisible; + end + else + Result := nil; +end; + +procedure TJvCustomTabBar.SetLeftTab(Value: TJvTabBarItem); +var + Index: Integer; + Tab: TJvTabBarItem; +begin + Index := 0; + if Value <> nil then + begin + // find first visible before or at Value.Index + if (Tabs <> nil) and (Tabs.Count > 0) and (Value <> Tabs[0]) then + begin + while Index < Tabs.Count do + begin + Tab := Tabs[Index].GetNextVisible; + if Tab = nil then + begin + Index := FLeftIndex; // do not change + Break; + end + else + begin + Index := Tab.Index; + if Tab.Index >= Value.Index then + Break; + end; + end; + if Index >= Tabs.Count then + Index := FLeftIndex; // do not change + end; + end; + if Index <> FLeftIndex then + begin + FLeftIndex := Index; + Invalidate; + UpdateScrollButtons; + LeftTabChanged; + end; +end; + +procedure TJvCustomTabBar.UpdateScrollButtons; +const + State: array[Boolean] of TJvTabBarScrollButtonState = (sbsDisabled, sbsNormal); + BtnSize = 12; +begin + CalcTabsRects; + if (FRequiredWidth < ClientWidth) or ((FLeftIndex = 0) and + (FLastTabRight <= ClientWidth)) then + begin + FBtnLeftScroll.State := sbsHidden; + FBtnRightScroll.State := sbsHidden; + FLeftIndex := 0; + FBarWidth := ClientWidth; + Invalidate; + end + else + begin + FBtnLeftScroll.State := sbsNormal; + FBtnRightScroll.State := sbsNormal; + + if poBottomScrollButtons in CurrentPainter.Options then + begin + FBtnLeftScroll.Rect := Bounds(ClientWidth - BtnSize * 2 - 1 - 1, + ClientHeight - BtnSize - 2, BtnSize, BtnSize); + FBtnRightScroll.Rect := Bounds(FBtnLeftScroll.Rect.Right, + ClientHeight - BtnSize - 2, BtnSize, BtnSize); + end + else + begin + FBtnLeftScroll.Rect := Bounds(ClientWidth - BtnSize * 2 - 1 - 1, 2, BtnSize, BtnSize); + FBtnRightScroll.Rect := Bounds(FBtnLeftScroll.Rect.Right, 2, BtnSize, BtnSize); + end; + if not FlatScrollButtons then + OffsetRect(FBtnRightScroll.Rect, -1, 0); + + //CurrentPainter.GetScrollButtons(Self, FBtnLeftScroll.Rect, FBtnRightScroll.Rect); + + FBarWidth := FBtnLeftScroll.Rect.Left - 2; + + FBtnLeftScroll.State := State[FLeftIndex > 0]; + FBtnRightScroll.State := State[FLastTabRight >= ClientWidth]; + + PaintScrollButtons; + end; +end; + +procedure TJvCustomTabBar.Resize; +begin + UpdateScrollButtons; + inherited Resize; +end; + +procedure TJvCustomTabBar.ScrollButtonClick(Button: TJvTabBarScrollButtonKind); +begin + if Button = sbScrollLeft then + begin + if FBtnLeftScroll.State in [sbsHidden, sbsDisabled] then + Exit; + Dec(FLeftIndex); + end + else + if Button = sbScrollRight then + begin + if FBtnRightScroll.State in [sbsHidden, sbsDisabled] then + Exit; + Inc(FLeftIndex); + end; + UpdateScrollButtons; + Invalidate; + if Assigned(FOnScrollButtonClick) then + FOnScrollButtonClick(Self, Button); + LeftTabChanged; +end; + +function TJvCustomTabBar.MakeVisible(Tab: TJvTabBarItem): Boolean; +var + R: TRect; + LastLeftIndex: Integer; + AtLeft: Boolean; +begin + Result := False; + if (Tab = nil) or not Tab.Visible then + Exit; + + LastLeftIndex := FLeftIndex; + if FBarWidth > 0 then + begin + AtLeft := False; + repeat + CalcTabsRects; + R := Tab.DisplayRect; + if (R.Right > FBarWidth) and not AtLeft then + Inc(FLeftIndex) + else + if R.Left < 0 then + begin + Dec(FLeftIndex); + AtLeft := True; // prevent an endless loop + end + else + Break; + until FLeftIndex = Tabs.Count - 1; + end + else + FLeftIndex := 0; + if (R.Left < 0) and (FLeftIndex > 0) then + Dec(FLeftIndex); // bar is too small + if FLeftIndex <> LastLeftIndex then + begin + UpdateScrollButtons; + Invalidate; + LeftTabChanged; + end; +end; + +function TJvCustomTabBar.FindData(Data: TObject): TJvTabBarItem; +var + I: Integer; +begin + for I := 0 to Tabs.Count - 1 do + if Tabs[I].Data = Data then + begin + Result := Tabs[I]; + Exit; + end; + Result := nil; +end; + +procedure TJvCustomTabBar.SetHint(const Value: TCaption); +begin + if Value <> FHint then + FHint := Value; +end; + +procedure TJvCustomTabBar.SetFlatScrollButtons(const Value: Boolean); +begin + if Value <> FFlatScrollButtons then + begin + FFlatScrollButtons := Value; + FBtnLeftScroll.State := sbsHidden; + FBtnRightScroll.State := sbsHidden; + UpdateScrollButtons; + end; +end; + +procedure TJvCustomTabBar.SetPageList(const Value: TCustomControl); +var + PageListIntf: IPageList; +begin + if Value <> FPageList then + begin + if Value <> nil then + begin + if not Supports(Value, IPageList, PageListIntf) then + Exit; + if SelectedTab <> nil then + PageListIntf.SetActivePageIndex(SelectedTab.Index) + else + PageListIntf.SetActivePageIndex(0); + PageListIntf := nil; + end; + if FPageList <> nil then + FPageList.RemoveFreeNotification(Self); + FPageList := Value; + if FPageList <> nil then + FPageList.FreeNotification(Self); + end; +end; + +procedure TJvCustomTabBar.SetOrientation(const Value: TJvTabBarOrientation); +begin + if Value <> FOrientation then + begin + FOrientation := Value; + CalcTabsRects; + Repaint; + end; +end; + +//=== { TJvTabBarItem } ====================================================== + +constructor TJvTabBarItem.Create(ACollection: Classes.TCollection); +begin + inherited Create(ACollection); + FImageIndex := -1; + FEnabled := True; + FVisible := True; + FShowHint := True; +end; + +destructor TJvTabBarItem.Destroy; +begin + PopupMenu := nil; + Visible := False; // CanSelect returns false + FAutoDeleteDatas.Free; + inherited Destroy; +end; + +procedure TJvTabBarItem.Assign(Source: TPersistent); +begin + if Source is TJvTabBarItem then + begin + with TJvTabBarItem(Source) do + begin + Self.FImageIndex := FImageIndex; + Self.FEnabled := FEnabled; + Self.FVisible := FVisible; + Self.FTag := FTag; + Self.FData := FData; + Self.FHint := FHint; + Self.FShowHint := FShowHint; + Self.FName := FName; + Self.FCaption := FCaption; + Self.FModified := FModified; + Self.FImages := FImages; + Changed; + end; + end + else + inherited Assign(Source); +end; + +procedure TJvTabBarItem.Notification(Component: TComponent; + Operation: TOperation); +begin + if Operation = opRemove then + if Component = PopupMenu then + PopupMenu := nil; +end; + +procedure TJvTabBarItem.Changed; +begin + TabBar.Changed; +end; + +function TJvTabBarItem.GetDisplayRect: TRect; +begin + if not Visible then + Result := Rect(-1, -1, -1, -1) + else + begin + if FLeft = -1 then + TabBar.CalcTabsRects; // not initialized + + case TabBar.Orientation of + toBottom: + Result := Rect(FLeft, 0, + FLeft + TabBar.GetTabWidth(Self), 0 + TabBar.GetTabHeight(Self)); + else + // toTop + Result := Rect(FLeft, TabBar.ClientHeight - TabBar.GetTabHeight(Self), + FLeft + TabBar.GetTabWidth(Self), TabBar.ClientHeight); + end; + end; +end; + +function TJvTabBarItem.GetHot: Boolean; +begin + Result := TabBar.HotTab = Self; +end; + +function TJvTabBarItem.GetImages: TCustomImageList; +begin + Result := TabBar.Images; +end; + +function TJvTabBarItem.GetSelected: Boolean; +begin + Result := TabBar.SelectedTab = Self; +end; + +function TJvTabBarItem.GetTabBar: TJvCustomTabBar; +begin + Result := (GetOwner as TJvTabBarItems).TabBar; +end; + +procedure TJvTabBarItem.SetCaption(const Value: TCaption); +var + PageListIntf: IPageList; +begin + if Value <> FCaption then + begin + FCaption := Value; + if TabBar.PageListTabLink and (TabBar.PageList <> nil) and + not (csLoading in TabBar.ComponentState) and + Supports(TabBar.PageList, IPageList, PageListIntf) then + PageListIntf.PageCaptionChanged(Index, FCaption); + Changed; + end; +end; + +procedure TJvTabBarItem.SetEnabled(const Value: Boolean); +begin + if Value <> FEnabled then + begin + FEnabled := Value; + Changed; + end; +end; + +procedure TJvTabBarItem.SetImageIndex(const Value: TImageIndex); +begin + if Value <> FImageIndex then + begin + FImageIndex := Value; + Changed; + end; +end; + +procedure TJvTabBarItem.SetName(const Value: string); +begin + if (Value <> FName) and (TJvTabBarItems(Collection).Find(Value) = nil) then + FName := Value; +end; + +procedure TJvTabBarItem.SetSelected(const Value: Boolean); +begin + if Value then + TabBar.SelectedTab := Self; +end; + +procedure TJvTabBarItem.SetVisible(const Value: Boolean); +begin + if Value <> FVisible then + begin + FVisible := Value; + FLeft := -1; // discard + Changed; + end; +end; + +function TJvTabBarItem.CanSelect: Boolean; +begin + Result := Visible and Enabled; +end; + +function TJvTabBarItem.GetNextVisible: TJvTabBarItem; +var + I: Integer; +begin + for I := Index + 1 to TabBar.Tabs.Count - 1 do + if TabBar.Tabs[I].Visible then + begin + Result := TabBar.Tabs[I]; + Exit; + end; + Result := nil; +end; + +function TJvTabBarItem.GetPreviousVisible: TJvTabBarItem; +var + I: Integer; +begin + for I := Index - 1 downto 0 do + if TabBar.Tabs[I].Visible then + begin + Result := TabBar.Tabs[I]; + Exit; + end; + Result := nil; +end; + +function TJvTabBarItem.AutoDeleteData: TObjectList; +begin + if FAutoDeleteDatas = nil then + FAutoDeleteDatas := TObjectList.Create; + Result := FAutoDeleteDatas; +end; + +function TJvTabBarItem.GetClosing: Boolean; +begin + Result := TabBar.ClosingTab = Self; +end; + +procedure TJvTabBarItem.SetModified(const Value: Boolean); +begin + if Value <> FModified then + begin + FModified := Value; + Changed; + end; +end; + +procedure TJvTabBarItem.SetPopupMenu(const Value: TPopupMenu); +begin + if Value <> FPopupMenu then + begin + if FPopupMenu <> nil then + FPopupMenu.RemoveFreeNotification(TabBar); + FPopupMenu := Value; + if FPopupMenu <> nil then + FPopupMenu.FreeNotification(TabBar); + end; +end; + +procedure TJvTabBarItem.MakeVisible; +begin + TabBar.MakeVisible(Self); +end; + +function TJvTabBarItem.GetEnabled: Boolean; +begin + Result := FEnabled; + if Assigned(FOnGetEnabled) then + FOnGetEnabled(Self, Result); +end; + +function TJvTabBarItem.GetModified: Boolean; +begin + Result := FModified; + if Assigned(FOnGetModified) then + FOnGetModified(Self, Result); +end; + +procedure TJvTabBarItem.SetIndex(Value: Integer); +var + PageListIntf: IPageList; + LastIndex: Integer; +begin + LastIndex := Index; + inherited SetIndex(Value); + if TabBar.PageListTabLink and (LastIndex <> Index) and (TabBar.PageList <> nil) and + not (csLoading in TabBar.ComponentState) and + Supports(TabBar.PageList, IPageList, PageListIntf) then + PageListIntf.MovePage(LastIndex, Index); + Changed; +end; + +//=== { TJvTabBarItems } ===================================================== + +procedure TJvTabBarItems.EndUpdate; +begin + inherited EndUpdate; + if UpdateCount = 0 then + TabBar.Changed; +end; + +function TJvTabBarItems.Find(const AName: string): TJvTabBarItem; +var + I: Integer; +begin + Result := nil; + for I := 0 to Count - 1 do + if Items[I].Name = AName then + begin + Result := Items[I]; + Break; + end; +end; + +function TJvTabBarItems.GetTabBar: TJvCustomTabBar; +begin + Result := GetOwner as TJvCustomTabBar; +end; + +function TJvTabBarItems.GetItem(Index: Integer): TJvTabBarItem; +begin + Result := TJvTabBarItem(inherited Items[Index]); +end; + +procedure TJvTabBarItems.SetItem(Index: Integer; const Value: TJvTabBarItem); +begin + if Value <> GetItem(Index) then + GetItem(Index).Assign(Value); +end; + +procedure TJvTabBarItems.Notify(Item: TCollectionItem; Action: TCollectionNotification); +var + PageListIntf: IPageList; +begin + inherited Notify(Item, Action); + if Action in [cnExtracting, cnDeleting] then + begin + // unselect the item to delete + if TabBar.SelectedTab = Item then + TabBar.SelectedTab := nil; + if TabBar.HotTab = Item then + TabBar.SetHotTab(nil); + if TabBar.FMouseDownClosingTab = Item then + TabBar.FMouseDownClosingTab := nil; + if TabBar.ClosingTab = Item then + TabBar.FClosingTab := nil; + if TabBar.FLastInsertTab = Item then + TabBar.FLastInsertTab := nil; + if not (csDestroying in TabBar.ComponentState) and (TabBar.LeftTab = Item) then + TabBar.LeftTab := TabBar.LeftTab.GetPreviousVisible; + end; + if TabBar.PageListTabLink and (TabBar.PageList <> nil) and + not (csLoading in TabBar.ComponentState) and + Supports(TabBar.PageList, IPageList, PageListIntf) then + begin + case Action of + cnAdded: + PageListIntf.AddPage(TJvTabBarItem(Item).Caption); + cnExtracting, cnDeleting: + PageListIntf.DeletePage(TJvTabBarItem(Item).Index); + end; + end; + TabBar.Changed; +end; + +function TJvTabBarItems.IndexOf(Item: TJvTabBarItem): Integer; +begin + for Result := 0 to Count - 1 do + if Items[Result] = Item then + Exit; + Result := -1; +end; + +//=== { TJvTabBarPainter } =================================================== + +constructor TJvTabBarPainter.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FOnChangeList := TList.Create; +end; + +destructor TJvTabBarPainter.Destroy; +begin + inherited Destroy; // invokes TJvTabBar.Notification that accesses FOnChangeList + FOnChangeList.Free; +end; + +procedure TJvTabBarPainter.Changed; +var + i: Integer; +begin + for i := 0 to FOnChangeList.Count - 1 do + TJvCustomTabBar(FOnChangeList[i]).ImagesChanged(Self); +end; + +procedure TJvTabBarPainter.GetScrollButtons(TabBar: TJvCustomTabBar; var LeftButton, RightButton: TRect); +begin + { reserved for future use } +end; + +procedure TJvTabBarPainter.DrawScrollButton(Canvas: TCanvas; TabBar: TJvCustomTabBar; Button: TJvTabBarScrollButtonKind; + State: TJvTabBarScrollButtonState; R: TRect); +{$IFDEF JVCLThemesEnabled} +const + SCROLL: array[TJvTabBarScrollButtonKind, TJvTabBarScrollButtonState] of TThemedScrollbar = ( + // sbsHidden sbsNormal sbsHot sbsPressed sbsDisabled + (tsArrowBtnLeftNormal, tsArrowBtnLeftNormal, tsArrowBtnLeftHot, tsArrowBtnLeftPressed, tsArrowBtnLeftDisabled), + (tsArrowBtnRightNormal, tsArrowBtnRightNormal, tsArrowBtnRightHot, tsArrowBtnRightPressed, tsArrowBtnRightDisabled) + ); +var + details: TThemedElementDetails; +{$ENDIF JVCLThemesEnabled} +begin + {$IFDEF JVCLThemesEnabled} + if ThemeServices.ThemesEnabled then begin + details := ThemeServices.GetElementDetails(SCROLL[Button, State]); + ThemeServices.DrawElement(Canvas.Handle, details, R, nil); + end else + {$ENDIF JVCLThemesEnabled} + begin + DrawButtonFace(Canvas, R, TabBar.FlatScrollButtons, State = sbsPressed, false); + if State = sbsPressed then + OffsetRect(R, 1, 1); + TabBar.DrawScrollBarGlyph(Canvas, + R.Left + (R.Right - R.Left - 4) div 2, + R.Top + (R.Bottom - R.Top - 7) div 2, + Button = sbScrollLeft, State = sbsDisabled); + end; +end; + +//=== { TJvModernTabBarPainter } ============================================= + +constructor TJvModernTabBarPainter.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FFont := TFont.Create; + FDisabledFont := TFont.Create; + FSelectedFont := TFont.Create; + + FFont.Color := clWindowText; + FDisabledFont.Color := clGrayText; + FSelectedFont.Assign(FFont); + + FFont.OnChange := @FontChanged; + FDisabledFont.OnChange := @FontChanged; + FSelectedFont.OnChange := @FontChanged; + + FTabColor := clBtnFace; + FColor := clWindow; + FBorderColor := clSilver; + FControlDivideColor := clBlack; + + FModifiedCrossColor := clRed; + FCloseColorSelected := $F4F4F4; + FCloseColor := clWhite; + FCloseCrossColorSelected := clBlack; + FCloseCrossColor := $5D5D5D; + FCloseCrossColorDisabled := $ADADAD; + FCloseRectColor := $868686; + FCloseRectColorDisabled := $D6D6D6; + FDividerColor := $99A8AC; + FMoveDividerColor := clBlack; +end; + +destructor TJvModernTabBarPainter.Destroy; +begin + FFont.Free; + FDisabledFont.Free; + FSelectedFont.Free; + inherited Destroy; +end; + +procedure TJvModernTabBarPainter.DrawBackground(Canvas: TCanvas; TabBar: TJvCustomTabBar; R: TRect); +begin + with Canvas do + begin + Brush.Style := bsSolid; + Brush.Color := Color; + FillRect(R); + + Brush.Style := bsClear; + Pen.Color := BorderColor; + Pen.Width := 1; + if TabBar.Orientation = toBottom then + begin + MoveTo(0, R.Bottom - 1); + LineTo(0, 0); + Pen.Color := ControlDivideColor; + LineTo(R.Right - 1, 0); + Pen.Color := BorderColor; + LineTo(R.Right - 1, R.Bottom - 1); + LineTo(0, R.Bottom - 1); + end + else // toTop + begin + MoveTo(0, R.Bottom - 1); + LineTo(0, 0); + LineTo(R.Right - 1, 0); + LineTo(R.Right - 1, R.Bottom - 1); + Pen.Color := ControlDivideColor; + LineTo(0, R.Bottom - 1); + end; + end; +end; + +procedure TJvModernTabBarPainter.DrawDivider(Canvas: TCanvas; LeftTab: TJvTabBarItem; R: TRect); +begin + if not LeftTab.Selected then + begin + if (LeftTab.TabBar.SelectedTab = nil) or + (LeftTab.GetNextVisible <> LeftTab.TabBar.SelectedTab) then + begin + with Canvas do + begin + Pen.Color := DividerColor; + Pen.Width := 1; + MoveTo(R.Right - 1, R.Top + 3); + LineTo(R.Right - 1, R.Bottom - 3); + end; + end; + end; +end; + +procedure TJvModernTabBarPainter.DrawMoveDivider(Canvas: TCanvas; Tab: TJvTabBarItem; MoveLeft: Boolean); +var + R: TRect; +begin + with Canvas do + begin + R := Tab.DisplayRect; + Inc(R.Top, 4); + Dec(R.Bottom, 2); + if MoveLeft then + begin + Dec(R.Left); + R.Right := R.Left + 4 + end + else + begin + Dec(R.Right, 1); + R.Left := R.Right - 4; + end; + Brush.Color := MoveDividerColor; + FillRect(R); + end; +end; + +procedure TJvModernTabBarPainter.DrawTab(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect); +var + CloseR: TRect; +begin + with Canvas do + begin + Brush.Style := bsSolid; + Brush.Color := Color; + Pen.Mode := pmCopy; + Pen.Style := psSolid; + Pen.Width := 1; + + if Tab.Selected then + begin + Brush.Style := bsSolid; + Brush.Color := TabColor; + FillRect(R); + + Pen.Color := ControlDivideColor; + if Tab.TabBar.Orientation = toBottom then + begin + MoveTo(R.Left, R.Top); + LineTo(R.Left, R.Bottom - 1); + LineTo(R.Right - 1, R.Bottom - 1); + LineTo(R.Right - 1, R.Top - 1{end}); + end + else // toTop + begin + MoveTo(R.Left, R.Bottom - 1); + LineTo(R.Left, R.Top); + LineTo(R.Right - 1, R.Top); + LineTo(R.Right - 1, R.Bottom - 1 + 1{end}); + end; + end; + + if Tab.Enabled and not Tab.Selected and Tab.Hot then + begin + // hot + Pen.Color := DividerColor; + MoveTo(R.Left, R.Top); + LineTo(R.Right - 1 - 1, R.Top); + end; + + if Tab.TabBar.CloseButton then + begin + // close button color + if Tab.Selected then + Brush.Color := CloseColorSelected + else + Brush.Color := CloseColor; + + CloseR := GetCloseRect(Canvas, Tab, R); + Pen.Color := CloseRectColor; + if not Tab.Enabled then + Pen.Color := CloseRectColorDisabled; + + if Tab.Closing then + // shrink + Rectangle(CloseR.Left + 1, CloseR.Top + 1, CloseR.Right - 1, CloseR.Bottom - 1) + else + Rectangle(CloseR); + + if Tab.Modified then + Pen.Color := ModifiedCrossColor + else + if Tab.Selected and not Tab.Closing then + Pen.Color := CloseCrossColorSelected + else + if Tab.Enabled then + Pen.Color := CloseCrossColor + else + Pen.Color := CloseCrossColorDisabled; + + // close cross + MoveTo(CloseR.Left + 3, CloseR.Top + 3); + LineTo(CloseR.Right - 3, CloseR.Bottom - 3); + MoveTo(CloseR.Left + 4, CloseR.Top + 3); + LineTo(CloseR.Right - 4, CloseR.Bottom - 3); + + MoveTo(CloseR.Right - 4, CloseR.Top + 3); + LineTo(CloseR.Left + 2, CloseR.Bottom - 3); + MoveTo(CloseR.Right - 5, CloseR.Top + 3); + LineTo(CloseR.Left + 3, CloseR.Bottom - 3); + + // remove intersection + if Tab.Modified then + FillRect(Rect(CloseR.Left + 5, CloseR.Top + 4, CloseR.Right - 5, CloseR.Bottom - 4)); + + R.Left := CloseR.Right; + end; + + InflateRect(R, -1, -1); + + if not Tab.TabBar.CloseButton then + Inc(R.Left, 2); + + if (Tab.ImageIndex <> -1) and (Tab.GetImages <> nil) then + begin + Tab.GetImages.Draw(Canvas, R.Left, R.Top + (R.Bottom - R.Top - Tab.GetImages.Height) div 2, + Tab.ImageIndex, Tab.Enabled); + Inc(R.Left, Tab.GetImages.Width + 2); + end; + + if Tab.Enabled then + begin + if Tab.Selected then + Font.Assign(Self.SelectedFont) + else + Font.Assign(Self.Font); + end + else + Font.Assign(Self.DisabledFont); + + Brush.Style := bsClear; + TextRect(R, R.Left + 3, R.Top + 3, Tab.Caption); + end; +end; + +function TJvModernTabBarPainter.GetCloseRect(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect): TRect; +begin + (* + Result.Right := R.Right - 5; + Result.Top := R.Top + ((R.Bottom div 2) - 8); + Result.Left := Result.Right - 15; + Result.Bottom := Result.Top + 15; + *) + Result.Left := R.Left + 5; + Result.Top := R.Top + 5; + Result.Right := Result.Left + 12; + Result.Bottom := Result.Top + 11; +end; + +function TJvModernTabBarPainter.GetDividerWidth(Canvas: TCanvas; LeftTab: TJvTabBarItem): Integer; +begin + Result := 1; +end; + +function TJvModernTabBarPainter.GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize; +begin + if Tab.Enabled then + begin + if Tab.Selected then + Canvas.Font.Assign(SelectedFont) + else + Canvas.Font.Assign(Font) + end + else + Canvas.Font.Assign(DisabledFont); + + Result.cx := Canvas.TextWidth(Tab.Caption) + 11; + Result.cy := Canvas.TextHeight(Tab.Caption + 'Ag') + 7; + if Tab.TabBar.CloseButton then + Result.cx := Result.cx + 15; + if (Tab.ImageIndex <> -1) and (Tab.GetImages <> nil) then + Result.cx := Result.cx + Tab.GetImages.Width + 2; + + if TabWidth > 0 then + Result.cx := TabWidth; +end; + +function TJvModernTabBarPainter.Options: TJvTabBarPainterOptions; +begin + Result := [poPaintsHotTab]; +end; + +procedure TJvModernTabBarPainter.FontChanged(Sender: TObject); +begin + Changed; +end; + +procedure TJvModernTabBarPainter.SetBorderColor(const Value: TColor); +begin + if Value <> FBorderColor then + begin + FBorderColor := Value; + Changed; + end; +end; + +procedure TJvModernTabBarPainter.SetColor(const Value: TColor); +begin + if Value <> FColor then + begin + FColor := Value; + Changed; + end; +end; + +procedure TJvModernTabBarPainter.SetControlDivideColor(const Value: TColor); +begin + if Value <> FControlDivideColor then + begin + FControlDivideColor := Value; + Changed; + end; +end; + +procedure TJvModernTabBarPainter.SetModifiedCrossColor(const Value: TColor); +begin + if Value <> FModifiedCrossColor then + begin + FModifiedCrossColor := Value; + Changed; + end; +end; + +procedure TJvModernTabBarPainter.SetTabColor(const Value: TColor); +begin + if Value <> FTabColor then + begin + FTabColor := Value; + Changed; + end; +end; + +procedure TJvModernTabBarPainter.SetCloseColor(const Value: TColor); +begin + if Value <> FCloseColor then + begin + FCloseColor := Value; + Changed; + end; +end; + +procedure TJvModernTabBarPainter.SetCloseColorSelected(const Value: TColor); +begin + if Value <> FCloseColorSelected then + begin + FCloseColorSelected := Value; + Changed; + end; +end; + +procedure TJvModernTabBarPainter.SetCloseCrossColor(const Value: TColor); +begin + if Value <> FCloseCrossColor then + begin + FCloseCrossColor := Value; + Changed; + end; +end; + +procedure TJvModernTabBarPainter.SetCloseCrossColorDisabled(const Value: TColor); +begin + if Value <> FCloseCrossColorDisabled then + begin + FCloseCrossColorDisabled := Value; + Changed; + end; +end; + +procedure TJvModernTabBarPainter.SetCloseCrossColorSelected(const Value: TColor); +begin + if Value <> FCloseCrossColorSelected then + begin + FCloseCrossColorSelected := Value; + Changed; + end; +end; + +procedure TJvModernTabBarPainter.SetCloseRectColor(const Value: TColor); +begin + if Value <> FCloseRectColor then + begin + FCloseRectColor := Value; + Changed; + end; +end; + +procedure TJvModernTabBarPainter.SetCloseRectColorDisabled(const Value: TColor); +begin + if Value <> FCloseRectColorDisabled then + begin + FCloseRectColorDisabled := Value; + Changed; + end; +end; + +procedure TJvModernTabBarPainter.SetDividerColor(const Value: TColor); +begin + if Value <> FDividerColor then + begin + FDividerColor := Value; + Changed; + end; +end; + +procedure TJvModernTabBarPainter.SetTabWidth(Value: Integer); +begin + if Value < 0 then + Value := 0; + if Value <> FTabWidth then + begin + FTabWidth := Value; + Changed; + end; +end; + +procedure TJvModernTabBarPainter.SetFont(const Value: TFont); +begin + if Value <> FFont then + FFont.Assign(Value); +end; + +procedure TJvModernTabBarPainter.SetDisabledFont(const Value: TFont); +begin + if Value <> FDisabledFont then + FDisabledFont.Assign(Value); +end; + +procedure TJvModernTabBarPainter.SetSelectedFont(const Value: TFont); +begin + if Value <> FSelectedFont then + FSelectedFont.Assign(Value); +end; + + +end. diff --git a/components/jvcllaz/run/JvCustomControls/JvTabBarXPPainter.pas b/components/jvcllaz/run/JvCustomControls/JvTabBarXPPainter.pas new file mode 100644 index 000000000..8650353cc --- /dev/null +++ b/components/jvcllaz/run/JvCustomControls/JvTabBarXPPainter.pas @@ -0,0 +1,194 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvTabBarXPPainter.pas, released on 2007-05-07. + +The Initial Developer of the Original Code is Valdir Stiebe Junior <valdir att dype dott com dott br> +All Rights Reserved. + +Contributor(s): + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvTabBarXPPainter; + + +interface + +uses + LCLType, Types, SysUtils, Classes, Graphics, JvTabBar; + +type + TJvTabBarXPPainter = class(TJvTabBarModernPainter) + private + FFixedTabSize: Integer; + procedure SetFixedTabSize(const Value: Integer); + protected + procedure DrawBackground(Canvas: TCanvas; TabBar: TJvCustomTabBar; R: TRect); override; + procedure DrawTab(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect); override; + procedure DrawDivider(Canvas: TCanvas; LeftTab: TJvTabBarItem; R: TRect); override; + procedure DrawMoveDivider(Canvas: TCanvas; Tab: TJvTabBarItem; MoveLeft: Boolean); override; + function GetDividerWidth(Canvas: TCanvas; LeftTab: TJvTabBarItem): Integer; override; + function GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize; override; + function GetCloseRect(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect): TRect; override; + published + property FixedTabSize: Integer read FFixedTabSize write SetFixedTabSize; + end; + + +implementation + +uses + Math, Themes; + +{ TJvTabBarXPPainter } + +procedure TJvTabBarXPPainter.DrawBackground(Canvas: TCanvas; + TabBar: TJvCustomTabBar; R: TRect); +var + Details: TThemedElementDetails; +begin + if ThemeServices.ThemesEnabled then + begin + Details := ThemeServices.GetElementDetails(ttTabRoot); + ThemeServices.DrawElement(Canvas.Handle, Details, R); + end + else + inherited DrawBackground(Canvas, TabBar, R); +end; + +procedure TJvTabBarXPPainter.DrawDivider(Canvas: TCanvas; LeftTab: TJvTabBarItem; R: TRect); +begin + if not ThemeServices.ThemesEnabled then + inherited DrawDivider(Canvas, LeftTab, R); +end; + +procedure TJvTabBarXPPainter.DrawMoveDivider(Canvas: TCanvas; Tab: TJvTabBarItem; + MoveLeft: Boolean); +begin + if not ThemeServices.ThemesEnabled then + inherited DrawMoveDivider(Canvas, Tab, MoveLeft); +end; + +procedure TJvTabBarXPPainter.DrawTab(Canvas: TCanvas; Tab: TJvTabBarItem; + R: TRect); +var + TabDetails, ButtonDetails: TThemedElementDetails; + CloseRect, TextRect: TRect; +begin + if ThemeServices.ThemesEnabled then + begin + if Tab.Selected then + begin + ButtonDetails := ThemeServices.GetElementDetails(twSmallCloseButtonNormal); + TabDetails := ThemeServices.GetElementDetails(ttTabItemSelected); + end + else if Tab.Hot then + begin + ButtonDetails := ThemeServices.GetElementDetails(twSmallCloseButtonHot); + TabDetails := ThemeServices.GetElementDetails(ttTabItemHot); + end + else + begin + ButtonDetails := ThemeServices.GetElementDetails(twSmallCloseButtonNormal); + TabDetails := ThemeServices.GetElementDetails(ttTabItemNormal); + end; + + if Tab.Closing then + ButtonDetails := ThemeServices.GetElementDetails(twSmallCloseButtonPushed); + ThemeServices.DrawElement(Canvas.Handle, TabDetails, R); + + if (Tab.ImageIndex <> -1) and (Tab.GetImages <> nil) then + begin + Tab.GetImages.Draw(Canvas, R.Left + 4, R.Top + (R.Bottom - R.Top - Tab.GetImages.Height) div 2, + Tab.ImageIndex, Tab.Enabled); + Inc(R.Left, Tab.GetImages.Width + 2); + end; + + TextRect := R; + TextRect.Left := TextRect.Left + Tab.TabBar.Margin; + if Tab.TabBar.CloseButton then + begin + CloseRect := GetCloseRect(Canvas, Tab, R); + TextRect.Right := CloseRect.Left - 3; + end + else + Dec(TextRect.Right, 3); + ThemeServices.DrawText(Canvas.Handle, TabDetails, Tab.Caption, TextRect, DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS, 0); + + if Tab.TabBar.CloseButton then + ThemeServices.DrawElement(Canvas.Handle, ButtonDetails, CloseRect); + end + else + inherited DrawTab(Canvas, Tab, R); +end; + +function TJvTabBarXPPainter.GetCloseRect(Canvas: TCanvas; Tab: TJvTabBarItem; + R: TRect): TRect; +begin + if ThemeServices.ThemesEnabled then + begin + Result.Right := R.Right - 5; + Result.Top := R.Top + ((R.Bottom div 2) - 8); + Result.Left := Result.Right - 15; + Result.Bottom := Result.Top + 15; + end + else + Result := inherited GetCloseRect(Canvas, Tab, R); +end; + +function TJvTabBarXPPainter.GetDividerWidth(Canvas: TCanvas; LeftTab: TJvTabBarItem): Integer; +begin + if ThemeServices.ThemesEnabled then + Result := 1 + else + Result := inherited GetDividerWidth(Canvas, LeftTab); +end; + +function TJvTabBarXPPainter.GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize; +begin + if FixedTabSize > 0 then + begin + if ThemeServices.ThemesEnabled then + Result.cx := FixedTabSize + else + Result.cx := Min(FixedTabSize + 40, Canvas.TextWidth(Tab.Caption) + 26); + end + else + begin + if ThemeServices.ThemesEnabled then + begin + Result.cx := Canvas.TextWidth(Tab.Caption) + 16; + if (Tab.ImageIndex <> -1) and (Tab.GetImages <> nil) then + Inc(Result.cx, Tab.GetImages.Width + 2); + if Tab.TabBar.CloseButton then + Inc(Result.cx, 18); + end + else + Result := inherited GetTabSize(Canvas, Tab); + end; + Result.cy := Tab.TabBar.Height - 3; +end; + +procedure TJvTabBarXPPainter.SetFixedTabSize(const Value: Integer); +begin + if Value <> FixedTabSize then + begin + FFixedTabSize := Value; + Changed; + end; +end; + +end.