jvcllaz: Add JvRollOut (expandable panel)

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

components/jvcllaz/design/JvCtrls/images/images.txt

@@ -20,3 +20,4 @@ tjvruler.png
 tjvruler_150.png
 tjvruler_200.png
 tjvgroupheader.bmp
+tjvrollout.bmp

components/jvcllaz/design/JvCtrls/jvctrlsreg.pas

@@ -14,24 +14,19 @@ implementation
 {$R ../../resource/jvctrlsreg.res}
 
 uses
-  Classes, JvDsgnConsts,
+  Classes, ActnList, JvDsgnConsts,
-  JvMovableBevel, JvRuler, JvGroupHeader,
+  JvMovableBevel, JvRuler, JvGroupHeader, JvRollOut,
   JvHtControls, {JvDBHTLabel,} JvHint, JvHTHintForm,
   PropEdits, Controls;
 
 procedure Register;
 begin
   RegisterComponents(RsPaletteJvcl, [
-    TJvMovableBevel, TJvMovablePanel, TJvRuler, TJvGroupHeader,
+    TJvMovableBevel, TJvMovablePanel, TJvRuler, TJvGroupHeader, TJvRollOut,
     TJvHint, TJvHTLabel, TJvHTListbox, TJvHTCombobox
   ]);
-  {
-  RegisterComponents(RsPaletteBarPanel, [TJvMovableBevel]);
-  RegisterComponents(RsPaletteLabel, [TJvHTLabel]);
-  RegisterComponents(RsPaletteListComboTree, [TJvHTListBox, TJvHTComboBox]);
-  RegisterComponents(RsPaletteNonVisual, [TJvHint]);
-  }
   RegisterPropertyEditor(TypeInfo(TCaption), TJvHTLabel, 'Caption', TJvHintProperty);
+  RegisterActions(RsJVCLActionsCategory, [TJvRollOutAction], nil);
 end;
 
 end.

components/jvcllaz/examples/JvRollOut/JvRollOutDemo.lpi

@@ -0,0 +1,79 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="JvRollOutDemo"/>
+      <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"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="JvCtrlsLazR"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="JvRollOutDemo.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="MainFrm.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="..\..\bin\JvRollOutDemo"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <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>

components/jvcllaz/examples/JvRollOut/JvRollOutDemo.lpr

@@ -0,0 +1,14 @@
+program JvRollOutDemo;
+
+uses
+  Interfaces, Forms,
+  MainFrm in 'MainFrm.pas' {Form1};
+
+{$R *.res}
+
+begin
+  Application.Scaled:=True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.

components/jvcllaz/examples/JvRollOut/MainFrm.pas

@@ -0,0 +1,206 @@
+unit MainFrm;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  SysUtils, Classes, Graphics, Controls, Forms,
+  Dialogs, ExtCtrls, JvRollOut, ImgList,
+  StdCtrls, ActnList, Menus; //, JvExtComponent;
+
+type
+  TForm1 = class(TForm)
+    Splitter1: TSplitter;
+    ImageList1: TImageList;
+    Panel4: TPanel;
+    chkShowFocus: TCheckBox;
+    chkTabStop: TCheckBox;
+    chkToggleAnywhere: TCheckBox;
+    Panel3: TPanel;
+    pnlRightAlign: TPanel;
+    RO40: TJvRollOut;
+    RO39: TJvRollOut;
+    RO38: TJvRollOut;
+    RO37: TJvRollOut;
+    RO36: TJvRollOut;
+    RO35: TJvRollOut;
+    RO34: TJvRollOut;
+    RO33: TJvRollOut;
+    RO32: TJvRollOut;
+    RO31: TJvRollOut;
+    pnlLeftAlign: TPanel;
+    RO30: TJvRollOut;
+    RO29: TJvRollOut;
+    RO28: TJvRollOut;
+    RO27: TJvRollOut;
+    RO26: TJvRollOut;
+    RO25: TJvRollOut;
+    RO24: TJvRollOut;
+    RO23: TJvRollOut;
+    RO22: TJvRollOut;
+    RO21: TJvRollOut;
+    Panel1: TPanel;
+    pnlTopAlign: TPanel;
+    RO1: TJvRollOut;
+    RO2: TJvRollOut;
+    RO3: TJvRollOut;
+    RO4: TJvRollOut;
+    RO5: TJvRollOut;
+    RO6: TJvRollOut;
+    RO7: TJvRollOut;
+    RO8: TJvRollOut;
+    RO9: TJvRollOut;
+    RO10: TJvRollOut;
+    pnlBottomAlign: TPanel;
+    RO20: TJvRollOut;
+    RO19: TJvRollOut;
+    RO18: TJvRollOut;
+    RO17: TJvRollOut;
+    RO16: TJvRollOut;
+    RO15: TJvRollOut;
+    RO14: TJvRollOut;
+    RO13: TJvRollOut;
+    RO12: TJvRollOut;
+    RO11: TJvRollOut;
+    Splitter2: TSplitter;
+    Splitter3: TSplitter;
+    Label1: TLabel;
+    Label2: TLabel;
+    Label3: TLabel;
+    Label4: TLabel;
+    chkGroupIndex: TCheckBox;
+    chkHideButton: TCheckBox;
+    chkHideFrame: TCheckBox;
+    Edit1: TEdit;
+    Edit2: TEdit;
+    Edit3: TEdit;
+    Edit4: TEdit;
+    Edit5: TEdit;
+    Edit6: TEdit;
+    Edit7: TEdit;
+    Edit8: TEdit;
+    Edit9: TEdit;
+    Edit10: TEdit;
+    Edit11: TEdit;
+    Edit12: TEdit;
+    chkImages: TCheckBox;
+    ActionList1: TActionList;
+    JvRollOutAction1: TJvRollOutAction;
+    JvRollOutAction2: TJvRollOutAction;
+    MainMenu1: TMainMenu;
+    Actions1: TMenuItem;
+    Action1Ctrl11: TMenuItem;
+    Action2Ctrl21: TMenuItem;
+    procedure chkShowFocusClick(Sender: TObject);
+    procedure chkTabStopClick(Sender: TObject);
+    procedure chkToggleAnywhereClick(Sender: TObject);
+    procedure chkGroupIndexClick(Sender: TObject);
+    procedure chkHideButtonClick(Sender: TObject);
+    procedure chkHideFrameClick(Sender: TObject);
+    procedure chkImagesClick(Sender: TObject);
+    procedure JvRollOutAction1Execute(Sender: TObject);
+    procedure JvRollOutAction2Execute(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+procedure TForm1.chkShowFocusClick(Sender: TObject);
+var i:integer;
+begin
+  for i := 0 to ComponentCount - 1 do
+    if Components[i] is TJvRollOut then
+      TJvRollOut(Components[i]).ShowFocus := chkShowFocus.Checked;
+end;
+
+procedure TForm1.chkTabStopClick(Sender: TObject);
+var i:integer;
+begin
+  for i := 0 to ComponentCount - 1 do
+    if Components[i] is TJvRollOut then
+      TJvRollOut(Components[i]).TabStop   := chkTabStop.Checked;
+end;
+
+procedure TForm1.chkToggleAnywhereClick(Sender: TObject);
+var i:integer;
+begin
+  for i := 0 to ComponentCount - 1 do
+    if Components[i] is TJvRollOut then
+      TJvRollOut(Components[i]).ToggleAnywhere := chkToggleAnywhere.Checked;
+end;
+
+procedure TForm1.chkGroupIndexClick(Sender: TObject);
+var i:integer;
+begin
+  for i := 0 to ComponentCount - 1 do
+    if Components[i] is TJvRollOut then
+      TJvRollOut(Components[i]).GroupIndex := Ord(chkGroupIndex.Checked);
+end;
+
+procedure TForm1.chkHideButtonClick(Sender: TObject);
+const
+  cTopColor:array[boolean] of TColor = (clBtnHighlight, clNone);
+  cBtmColor:array[boolean] of TColor = (clBtnShadow, clNone);
+var i:integer;
+begin
+  for i := 0 to ComponentCount - 1 do
+    if Components[i] is TJvRollOut then
+    begin
+      TJvRollOut(Components[i]).Colors.ButtonTop := cTopColor[chkHideButton.Checked];
+      TJvRollOut(Components[i]).Colors.ButtonBottom := cBtmColor[chkHideButton.Checked];
+    end;
+end;
+
+procedure TForm1.chkHideFrameClick(Sender: TObject);
+const
+  cTopColor:array[boolean] of TColor = (clBtnShadow, clNone);
+  cBtmColor:array[boolean] of TColor = (clBtnHighlight, clNone);
+var i:integer;
+begin
+  for i := 0 to ComponentCount - 1 do
+    if Components[i] is TJvRollOut then
+    begin
+      TJvRollOut(Components[i]).Colors.FrameTop := cTopColor[chkHideFrame.Checked];
+      TJvRollOut(Components[i]).Colors.FrameBottom := cBtmColor[chkHideFrame.Checked];
+    end;
+end;
+
+procedure TForm1.chkImagesClick(Sender: TObject);
+var i:integer;
+begin
+  for i := 0 to ComponentCount - 1 do
+    if Components[i] is TJvRollOut then
+    begin
+      if chkImages.Checked then
+        TJvRollOut(Components[i]).ImageOptions.Images := ImageList1
+      else
+        TJvRollOut(Components[i]).ImageOptions.Images := nil;
+    end;
+end;
+
+procedure TForm1.JvRollOutAction1Execute(Sender: TObject);
+begin
+  Caption := 'Action 1 executed!';
+end;
+
+procedure TForm1.JvRollOutAction2Execute(Sender: TObject);
+begin
+  Caption := 'Action 2 executed!';
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  JvRollOutAction2.AutoCheck := true;
+end;
+
+end.

components/jvcllaz/packages/jvctrlslazd.lpk

@@ -4,7 +4,7 @@
     <PathDelim Value="\"/>
     <Name Value="JvCtrlsLazD"/>
     <Type Value="RunAndDesignTime"/>
-    <Author Value="Lazarus port by: Michał Gawrycki, Werner Pamler"/>
+    <Author Value="Several original authors - see header of each unit for details. Lazarus port by: Michał Gawrycki, Werner Pamler"/>
     <CompilerOptions>
       <Version Value="11"/>
       <PathDelim Value="\"/>
@@ -15,9 +15,7 @@
       </SearchPaths>
     </CompilerOptions>
     <Description Value="Controls of the JVCL library (https://sourceforge.net/projects/jvcl/) (designtime code):
-- Movable bevel and panel
+- Movable bevel and panel, ruler, expandable panel (RollOut), group header, hypertext components 
-- Ruler
-- Hypertext components 
 "/>
     <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"/>
@@ -36,7 +34,7 @@
         <UnitName Value="JvHTHintForm"/>
       </Item3>
     </Files>
-    <RequiredPkgs Count="4">
+    <RequiredPkgs Count="3">
       <Item1>
         <PackageName Value="IDEIntf"/>
       </Item1>
@@ -46,9 +44,6 @@
       <Item3>
         <PackageName Value="JvCtrlsLazR"/>
       </Item3>
-      <Item4>
-        <PackageName Value="FCL"/>
-      </Item4>
     </RequiredPkgs>
     <UsageOptions>
       <UnitPath Value="$(PkgOutDir)"/>

components/jvcllaz/packages/jvctrlslazr.lpk

@@ -3,7 +3,7 @@
   <Package Version="4">
     <PathDelim Value="\"/>
     <Name Value="JvCtrlsLazR"/>
-    <Author Value="Lazarus port by: Michał Gawrycki, Werner Pamler"/>
+    <Author Value="Several original authors - see header of each unit for details. Lazarus port by: Michał Gawrycki, Werner Pamler"/>
     <CompilerOptions>
       <Version Value="11"/>
       <PathDelim Value="\"/>
@@ -13,13 +13,11 @@
       </SearchPaths>
     </CompilerOptions>
     <Description Value="Controls of the JVCL library (https://sourceforge.net/projects/jvcl/) (runtime code):
-- Movable bevel and panel
+- Movable bevel and panel, ruler, exandable panel (RollOut), group header, hypertext components 
-- Ruler
-- Hypertext components 
 "/>
     <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">
+    <Files Count="6">
       <Item1>
         <Filename Value="..\run\JvCtrls\jvhint.pas"/>
         <UnitName Value="JvHint"/>
@@ -40,6 +38,10 @@
         <Filename Value="..\run\JvCtrls\jvgroupheader.pas"/>
         <UnitName Value="JvGroupHeader"/>
       </Item5>
+      <Item6>
+        <Filename Value="..\run\JvCtrls\jvrollout.pas"/>
+        <UnitName Value="JvRollOut"/>
+      </Item6>
     </Files>
     <RequiredPkgs Count="2">
       <Item1>

components/jvcllaz/packages/jvdtrlslazr.lpk

@@ -1,59 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<CONFIG>
-  <Package Version="4">
-    <PathDelim Value="\"/>
-    <Name Value="JvCtrlsLazR"/>
-    <Author Value="Lazarus port by: Michał Gawrycki, Werner Pamler"/>
-    <CompilerOptions>
-      <Version Value="11"/>
-      <PathDelim Value="\"/>
-      <SearchPaths>
-        <OtherUnitFiles Value="..\run\JvCtrls"/>
-        <UnitOutputDirectory Value="..\lib\$(TargetCPU)-$(TargetOS)\run\JvCtrls"/>
-      </SearchPaths>
-    </CompilerOptions>
-    <Description Value="Controls of the JVCL library (https://sourceforge.net/projects/jvcl/) (runtime code):
-- Movable bevel and panel
-- Ruler
-- Hypertext components 
-"/>
-    <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\JvCtrls\jvhint.pas"/>
-        <UnitName Value="JvHint"/>
-      </Item1>
-      <Item2>
-        <Filename Value="..\run\JvCtrls\jvhtcontrols.pas"/>
-        <UnitName Value="JvHtControls"/>
-      </Item2>
-      <Item3>
-        <Filename Value="..\run\JvCtrls\jvmovablebevel.pas"/>
-        <UnitName Value="JvMovableBevel"/>
-      </Item3>
-      <Item4>
-        <Filename Value="..\run\JvCtrls\jvruler.pas"/>
-        <UnitName Value="JvRuler"/>
-      </Item4>
-      <Item5>
-        <Filename Value="..\run\JvCtrls\jvgroupheader.pas"/>
-        <UnitName Value="jvgroupheader"/>
-      </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>

components/jvcllaz/run/JvPageComps/jvnotebookpagelist.pas

@@ -0,0 +1,124 @@
+{-----------------------------------------------------------------------------
+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: JvNotebookTabBar.pas, released on 2018-05-01.
+
+This unit was created as a workaround for the Lazarus issues with TJvCustomPage
+and TJvCustomPageList and their descendants.
+-----------------------------------------------------------------------------}
+
+unit JvNotebookPageList;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, ExtCtrls,
+  JvPageList;
+
+type
+  TJvNotebookPageList = class(TNotebook, IUnknown, IPageList)
+  private
+    FOnChanging: TJvPageChangingEvent;
+
+  protected
+    procedure AddPage(const ACaption: string);
+    function CanChange(AIndex: Integer): Boolean;
+    procedure DeletePage(AIndex: Integer);
+    function GetPageCaption(AIndex: Integer): string;
+    function GetPageCount: Integer;
+    procedure MovePage(CurIndex, NewIndex: Integer);
+    procedure PageCaptionChanged(AIndex: Integer; const NewCaption: string);
+    procedure SetActivePageIndex(AIndex: Integer);
+
+  public
+
+  published
+    property OnChanging: TJvPageChangingEvent read FOnChanging write FOnChanging;
+  end;
+
+implementation
+
+function GetUniqueName(AOwner: TComponent; const AClassName: string): string;
+var
+  i: Integer;
+begin
+  i := 0;
+  if AOwner = nil then
+  begin
+    repeat
+      Inc(i);
+      Result := AClassName + IntToStr(i);
+    until FindGlobalComponent(Result) = nil;
+  end
+  else
+    repeat
+      Inc(i);
+      Result := AClassName + IntToStr(i);
+    until AOwner.FindComponent(Result) = nil;
+end;
+
+
+{-------------------------------------------------------------------------------
+                           TJvNotebookPageList
+-------------------------------------------------------------------------------}
+
+procedure TJvNotebookPageList.AddPage(const ACaption: String);
+var
+  idx: Integer;
+  lPage: TPage;
+begin
+  idx := Pages.Add(ACaption);
+  lPage := Page[idx];
+  lPage.Name := GetUniqueName(Self, 'TPage');
+end;
+
+function TJvNotebookPageList.CanChange(AIndex: Integer): Boolean;
+begin
+  Result := (AIndex >= 0) and (AIndex < GetPageCount);
+  if Result and Assigned(FOnChanging) then
+    FOnChanging(Self, AIndex, Result);
+end;
+
+procedure TJvNotebookPageList.DeletePage(AIndex: Integer);
+begin
+  Pages.Delete(AIndex);
+end;
+
+function TJvNotebookPageList.GetPageCaption(AIndex: Integer): string;
+begin
+  Result := Pages[AIndex];
+end;
+
+function TJvNotebookPageList.GetPageCount: Integer;
+begin
+  Result := inherited PageCount;
+end;
+
+procedure TJvNotebookPageList.MovePage(CurIndex, NewIndex: Integer);
+begin
+  Pages.Exchange(CurIndex, NewIndex);
+end;
+
+procedure TJvNotebookPagelist.PageCaptionChanged(AIndex: Integer;
+  const NewCaption: string);
+begin
+  Pages[AIndex] := NewCaption;
+end;
+
+procedure TJvNotebookPageList.SetActivePageIndex(AIndex: Integer);
+begin
+  PageIndex := AIndex;
+end;
+
+
+end.
+