paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

jvcllaz: Add JvRollOut (expandable panel)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6660 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2018-09-27 22:12:41 +00:00
parent da4f53f1bd
commit f103e78625
13 changed files with 3739 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/jvcllaz/design/JvCtrls/images/images.txt
View File

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

BIN
components/jvcllaz/design/JvCtrls/images/tjvrollout.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.6 KiB

13
components/jvcllaz/design/JvCtrls/jvctrlsreg.pas
View File

@ -14,24 +14,19 @@ implementation
{$R ../../resource/jvctrlsreg.res}
uses
Classes, JvDsgnConsts,
JvMovableBevel, JvRuler, JvGroupHeader,
Classes, ActnList, JvDsgnConsts,
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.

79
components/jvcllaz/examples/JvRollOut/JvRollOutDemo.lpi Normal file
View File

@ -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>

14
components/jvcllaz/examples/JvRollOut/JvRollOutDemo.lpr Normal file
View File

@ -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.

1594
components/jvcllaz/examples/JvRollOut/MainFrm.lfm Normal file
View File

File diff suppressed because it is too large Load Diff

206
components/jvcllaz/examples/JvRollOut/MainFrm.pas Normal file
View File

@ -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.

11
components/jvcllaz/packages/jvctrlslazd.lpk
View File

@ -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
- Ruler
- Hypertext components
- Movable bevel and panel, ruler, expandable panel (RollOut), group header, 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)"/>

12
components/jvcllaz/packages/jvctrlslazr.lpk
View File

@ -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
- Ruler
- Hypertext components
- Movable bevel and panel, ruler, exandable panel (RollOut), group header, 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>

59
components/jvcllaz/packages/jvdtrlslazr.lpk
View File

@ -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>

BIN
components/jvcllaz/resource/jvctrlsreg.res
View File

Binary file not shown.

1707
components/jvcllaz/run/JvCtrls/jvrollout.pas Normal file
View File

File diff suppressed because it is too large Load Diff

124
components/jvcllaz/run/JvPageComps/jvnotebookpagelist.pas Normal file
View File

@ -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.