pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit: A combined commit due to outage of sourceforge

Browse Source 
- Increase version to 1.0.11 for new development version
- Fix misalignment of listboxes in VpNavBar component editor form (issue #33698)
- More flexible aligment of the listboxes in VpNavBar component editor (alLeft/alClient)
- Add themed highlighting of VpNavBar items.
- Extended VpNavBar demo with selection of item theme and text color.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6391 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-05-05 23:21:08 +00:00
parent bfd11b30a9
commit 6f01c05126
10 changed files with 399 additions and 239 deletions
Download Patch File Download Diff File Expand all files Collapse all files

266
components/tvplanit/examples/navbar/unit1.lfm
View File

@ -1,17 +1,17 @@
object Form1: TForm1 object Form1: TForm1
Left = 274 Left = 274
Height = 422 Height = 532
Top = 168 Top = 168
Width = 567 Width = 611
AutoSize = True AutoSize = True
Caption = 'Form1' Caption = 'Form1'
ClientHeight = 422 ClientHeight = 532
ClientWidth = 567 ClientWidth = 611
OnCreate = FormCreate OnCreate = FormCreate
LCLVersion = '1.9.0.0' LCLVersion = '1.9.0.0'
object VpNavBar1: TVpNavBar object VpNavBar1: TVpNavBar
Left = 0 Left = 0
Height = 397 Height = 507
Top = 0 Top = 0
Width = 128 Width = 128
BorderSpacing.Right = 24 BorderSpacing.Right = 24
@ -131,7 +131,6 @@ object Form1: TForm1
ImagesWidth = 0 ImagesWidth = 0
ItemFont.Color = clWhite ItemFont.Color = clWhite
ItemSpacing = 5 ItemSpacing = 5
PlaySounds = False
SelectedItem = -1 SelectedItem = -1
SelectedItemFont.Color = clYellow SelectedItemFont.Color = clYellow
SelectedItemFont.Style = [fsBold] SelectedItemFont.Style = [fsBold]
@ -158,22 +157,23 @@ object Form1: TForm1
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label1 AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideBottom.Side = asrBottom
Left = 152 Left = 152
Height = 96 Height = 116
Top = 39 Top = 31
Width = 120 Width = 120
AutoFill = True AutoFill = False
AutoSize = True AutoSize = True
BorderSpacing.Top = 16 BorderSpacing.Top = 8
Caption = 'DrawingStyle' Caption = 'DrawingStyle'
ChildSizing.LeftRightSpacing = 6 ChildSizing.LeftRightSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize ChildSizing.TopBottomSpacing = 4
ChildSizing.EnlargeVertical = crsHomogenousChildResize ChildSizing.VerticalSpacing = 4
ChildSizing.ShrinkHorizontal = crsScaleChilds ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1 ChildSizing.ControlsPerLine = 1
ClientHeight = 76 ClientHeight = 96
ClientWidth = 116 ClientWidth = 116
ItemIndex = 0 ItemIndex = 0
Items.Strings = ( Items.Strings = (
@ -200,18 +200,18 @@ object Form1: TForm1
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 25 Height = 25
Top = 397 Top = 507
Width = 567 Width = 611
Align = alBottom Align = alBottom
AutoSize = True AutoSize = True
ClientHeight = 25 ClientHeight = 25
ClientWidth = 567 ClientWidth = 611
TabOrder = 2 TabOrder = 2
object Bevel1: TBevel object Bevel1: TBevel
Left = 1 Left = 1
Height = 3 Height = 3
Top = 1 Top = 1
Width = 565 Width = 609
Align = alTop Align = alTop
Shape = bsTopLine Shape = bsTopLine
end end
@ -248,15 +248,17 @@ object Form1: TForm1
end end
end end
object BtnAddFolder: TButton object BtnAddFolder: TButton
AnchorSideLeft.Control = RgIconSize AnchorSideLeft.Control = GbIcon
AnchorSideBottom.Control = RgDrawingStyle AnchorSideTop.Control = GbIcon
AnchorSideTop.Side = asrBottom
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 296 Left = 307
Height = 25 Height = 25
Top = 110 Top = 125
Width = 91 Width = 91
Anchors = [akLeft, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Left = 11
BorderSpacing.Top = 8
Caption = 'Add folder...' Caption = 'Add folder...'
OnClick = BtnAddFolderClick OnClick = BtnAddFolderClick
TabOrder = 3 TabOrder = 3
@ -265,9 +267,9 @@ object Form1: TForm1
AnchorSideLeft.Control = BtnAddFolder AnchorSideLeft.Control = BtnAddFolder
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = BtnAddFolder AnchorSideTop.Control = BtnAddFolder
Left = 395 Left = 406
Height = 25 Height = 25
Top = 110 Top = 125
Width = 84 Width = 84
AutoSize = True AutoSize = True
BorderSpacing.Left = 8 BorderSpacing.Left = 8
@ -276,45 +278,15 @@ object Form1: TForm1
OnClick = BtnAddItemClick OnClick = BtnAddItemClick
TabOrder = 4 TabOrder = 4
end end
object RgIconSize: TRadioGroup
AnchorSideLeft.Control = RgDrawingStyle
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = RgDrawingStyle
Left = 296
Height = 39
Top = 39
Width = 110
AutoFill = True
AutoSize = True
BorderSpacing.Left = 24
Caption = 'Icons'
ChildSizing.LeftRightSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 2
ClientHeight = 19
ClientWidth = 106
Columns = 2
ItemIndex = 0
Items.Strings = (
'large'
'small'
)
OnClick = RgIconSizeClick
TabOrder = 5
end
object GbBackgroud: TGroupBox object GbBackgroud: TGroupBox
AnchorSideLeft.Control = VpNavBar1 AnchorSideLeft.Control = VpNavBar1
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = RgDrawingStyle AnchorSideTop.Control = BtnAddFolder
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 152 Left = 152
Height = 114 Height = 114
Top = 151 Top = 166
Width = 367 Width = 367
AutoSize = True AutoSize = True
BorderSpacing.Top = 16 BorderSpacing.Top = 16
@ -322,7 +294,7 @@ object Form1: TForm1
Caption = 'Background' Caption = 'Background'
ClientHeight = 94 ClientHeight = 94
ClientWidth = 363 ClientWidth = 363
TabOrder = 6 TabOrder = 5
object BkColor: TColorBox object BkColor: TColorBox
AnchorSideLeft.Control = RbBkColor AnchorSideLeft.Control = RbBkColor
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
@ -470,15 +442,15 @@ object Form1: TForm1
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 152 Left = 152
Height = 78 Height = 78
Top = 281 Top = 394
Width = 81 Width = 81
Anchors = [akTop, akLeft, akBottom] Anchors = [akTop, akLeft, akBottom]
AutoFill = True AutoFill = False
AutoSize = True AutoSize = True
Caption = 'Border style' Caption = 'Border style'
ChildSizing.LeftRightSpacing = 6 ChildSizing.LeftRightSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize ChildSizing.TopBottomSpacing = 4
ChildSizing.EnlargeVertical = crsHomogenousChildResize ChildSizing.VerticalSpacing = 4
ChildSizing.ShrinkHorizontal = crsScaleChilds ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.Layout = cclLeftToRightThenTopToBottom
@ -491,18 +463,18 @@ object Form1: TForm1
'bsSingle' 'bsSingle'
) )
OnClick = RgBorderStyleClick OnClick = RgBorderStyleClick
TabOrder = 7 TabOrder = 6
end end
object GbSounds: TGroupBox object GbSounds: TGroupBox
AnchorSideLeft.Control = RgBorderStyle AnchorSideLeft.Control = RgBorderStyle
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = GbBackgroud AnchorSideTop.Control = GbItemTextColor
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GbBackgroud AnchorSideRight.Control = GbBackgroud
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 249 Left = 249
Height = 78 Height = 78
Top = 281 Top = 394
Width = 270 Width = 270
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = True AutoSize = True
@ -512,15 +484,16 @@ object Form1: TForm1
Caption = 'Sounds' Caption = 'Sounds'
ClientHeight = 58 ClientHeight = 58
ClientWidth = 266 ClientWidth = 266
TabOrder = 8 TabOrder = 7
object CbPlaySounds: TCheckBox object CbPlaySounds: TCheckBox
AnchorSideLeft.Control = GbSounds AnchorSideLeft.Control = GbSounds
AnchorSideTop.Control = GbSounds AnchorSideTop.Control = GbSounds
Left = 12 Left = 12
Height = 19 Height = 19
Top = 0 Top = 4
Width = 83 Width = 83
BorderSpacing.Left = 12 BorderSpacing.Left = 12
BorderSpacing.Top = 4
Caption = 'Play sounds' Caption = 'Play sounds'
OnChange = CbPlaySoundsChange OnChange = CbPlaySoundsChange
TabOrder = 0 TabOrder = 0
@ -533,7 +506,7 @@ object Form1: TForm1
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 12 Left = 12
Height = 23 Height = 23
Top = 23 Top = 27
Width = 246 Width = 246
OnAcceptFileName = EdSoundFileAcceptFileName OnAcceptFileName = EdSoundFileAcceptFileName
FilterIndex = 0 FilterIndex = 0
@ -543,17 +516,170 @@ object Form1: TForm1
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 4 BorderSpacing.Top = 4
BorderSpacing.Right = 8 BorderSpacing.Right = 8
BorderSpacing.Bottom = 12 BorderSpacing.Bottom = 8
MaxLength = 0 MaxLength = 0
TabOrder = 1 TabOrder = 1
OnEditingDone = EdSoundFileEditingDone OnEditingDone = EdSoundFileEditingDone
end end
end end
object GbIcon: TGroupBox
AnchorSideLeft.Control = RgDrawingStyle
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = RgDrawingStyle
AnchorSideRight.Control = GbBackgroud
AnchorSideRight.Side = asrBottom
Left = 296
Height = 86
Top = 31
Width = 223
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Left = 24
BorderSpacing.InnerBorder = 2
Caption = 'Icons'
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 4
ChildSizing.HorizontalSpacing = 8
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.ControlsPerLine = 2
ClientHeight = 66
ClientWidth = 219
TabOrder = 8
OnClick = GbIconClick
object cmbIconSize: TComboBox
AnchorSideLeft.Control = GbIcon
AnchorSideTop.Control = GbIcon
AnchorSideRight.Control = GbIcon
AnchorSideRight.Side = asrBottom
Left = 8
Height = 23
Top = 4
Width = 203
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8
BorderSpacing.Right = 8
ItemHeight = 15
ItemIndex = 0
Items.Strings = (
'large'
'small'
)
OnSelect = cmbIconSizeSelect
Style = csDropDownList
TabOrder = 0
Text = 'large'
end
object cmbItemTheme: TComboBox
AnchorSideLeft.Control = cmbIconSize
AnchorSideTop.Control = cmbIconSize
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = cmbIconSize
AnchorSideRight.Side = asrBottom
Left = 8
Height = 23
Top = 35
Width = 203
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 8
BorderSpacing.Bottom = 4
ItemHeight = 15
ItemIndex = 0
Items.Strings = (
'no theme'
'like push button'
'like toolbar'
)
OnSelect = cmbItemThemeSelect
Style = csDropDownList
TabOrder = 1
Text = 'no theme'
end
end
object GbItemTextColor: TGroupBox
AnchorSideLeft.Control = GbBackgroud
AnchorSideTop.Control = GbBackgroud
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GbBackgroud
AnchorSideRight.Side = asrBottom
Left = 152
Height = 82
Top = 296
Width = 367
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 16
Caption = 'Item text color'
ClientHeight = 62
ClientWidth = 363
TabOrder = 9
object cbItemTextColorNormal: TColorBox
AnchorSideLeft.Control = lblItemTextColorNormal
AnchorSideRight.Control = Bevel2
Left = 16
Height = 22
Top = 24
Width = 158
Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbPrettyNames]
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Bottom = 8
ItemHeight = 16
OnChange = cbItemTextColorNormalChange
TabOrder = 0
end
object lblItemTextColorNormal: TLabel
AnchorSideLeft.Control = GbItemTextColor
AnchorSideTop.Control = GbItemTextColor
Left = 16
Height = 15
Top = 4
Width = 40
BorderSpacing.Left = 16
BorderSpacing.Top = 4
Caption = 'Normal'
ParentColor = False
end
object Bevel2: TBevel
AnchorSideLeft.Control = GbItemTextColor
AnchorSideLeft.Side = asrCenter
Left = 174
Height = 50
Top = 12
Width = 14
Shape = bsSpacer
end
object cbItemTextColorSelected: TColorBox
AnchorSideLeft.Control = Bevel2
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = cbItemTextColorNormal
AnchorSideRight.Control = GbItemTextColor
AnchorSideRight.Side = asrBottom
Left = 188
Height = 22
Top = 24
Width = 167
Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbPrettyNames]
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Right = 8
ItemHeight = 16
OnChange = cbItemTextColorSelectedChange
TabOrder = 1
end
object lblItemTextColorSelected: TLabel
AnchorSideLeft.Control = cbItemTextColorSelected
AnchorSideTop.Control = lblItemTextColorNormal
Left = 188
Height = 15
Top = 4
Width = 44
Caption = 'Selected'
ParentColor = False
end
end
object Images: TImageList object Images: TImageList
Height = 32 Height = 32
Width = 32 Width = 32
left = 480 left = 400
top = 16 top = 32
Bitmap = { Bitmap = {
4C690A0000002000000020000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 4C690A0000002000000020000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF

63
components/tvplanit/examples/navbar/unit1.pas
View File

@ -14,17 +14,26 @@ type
TForm1 = class(TForm) TForm1 = class(TForm)
Bevel1: TBevel; Bevel1: TBevel;
Bevel2: TBevel;
BtnAddFolder: TButton; BtnAddFolder: TButton;
BtnAddItem: TButton; BtnAddItem: TButton;
BkColor: TColorBox; BkColor: TColorBox;
BtnLoadBkImage: TButton; BtnLoadBkImage: TButton;
cbItemTextColorSelected: TColorBox;
CbPlaySounds: TCheckBox; CbPlaySounds: TCheckBox;
cmbItemTheme: TComboBox;
cmbIconSize: TComboBox;
cbItemTextColorNormal: TColorBox;
EdBkImage: TFileNameEdit; EdBkImage: TFileNameEdit;
EdSoundFile: TFileNameEdit; EdSoundFile: TFileNameEdit;
GbBackgroud: TGroupBox; GbBackgroud: TGroupBox;
GbIcon: TGroupBox;
GbSounds: TGroupBox; GbSounds: TGroupBox;
GbItemTextColor: TGroupBox;
IconsLbl: TLabel; IconsLbl: TLabel;
IconsLink: TLabel; IconsLink: TLabel;
lblItemTextColorNormal: TLabel;
lblItemTextColorSelected: TLabel;
Panel2: TPanel; Panel2: TPanel;
RgBorderStyle: TRadioGroup; RgBorderStyle: TRadioGroup;
RbBkColor: TRadioButton; RbBkColor: TRadioButton;
@ -32,7 +41,6 @@ type
RbBkImageTile: TRadioButton; RbBkImageTile: TRadioButton;
RbBkImageStretch: TRadioButton; RbBkImageStretch: TRadioButton;
RbBkImageNormal: TRadioButton; RbBkImageNormal: TRadioButton;
RgIconSize: TRadioGroup;
Label1: TLabel; Label1: TLabel;
Images: TImageList; Images: TImageList;
Panel1: TPanel; Panel1: TPanel;
@ -42,7 +50,12 @@ type
procedure BtnAddFolderClick(Sender: TObject); procedure BtnAddFolderClick(Sender: TObject);
procedure BtnAddItemClick(Sender: TObject); procedure BtnAddItemClick(Sender: TObject);
procedure BtnLoadBkImageClick(Sender: TObject); procedure BtnLoadBkImageClick(Sender: TObject);
procedure cbItemTextColorNormalChange(Sender: TObject);
procedure cbItemTextColorSelectedChange(Sender: TObject);
procedure CbPlaySoundsChange(Sender: TObject); procedure CbPlaySoundsChange(Sender: TObject);
procedure cbThemedItemsChange(Sender: TObject);
procedure cmbIconSizeSelect(Sender: TObject);
procedure cmbItemThemeSelect(Sender: TObject);
procedure EdSoundFileAcceptFileName(Sender: TObject; var Value: String); procedure EdSoundFileAcceptFileName(Sender: TObject; var Value: String);
procedure EdSoundFileEditingDone(Sender: TObject); procedure EdSoundFileEditingDone(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
@ -51,7 +64,7 @@ type
procedure IconsLinkMouseLeave(Sender: TObject); procedure IconsLinkMouseLeave(Sender: TObject);
procedure RgBorderStyleClick(Sender: TObject); procedure RgBorderStyleClick(Sender: TObject);
procedure RgDrawingStyleClick(Sender: TObject); procedure RgDrawingStyleClick(Sender: TObject);
procedure RgIconSizeClick(Sender: TObject); procedure GbIconClick(Sender: TObject);
procedure RbBkColorChange(Sender: TObject); procedure RbBkColorChange(Sender: TObject);
procedure VpNavBar1FolderChanged(Sender: TObject; Index: Integer); procedure VpNavBar1FolderChanged(Sender: TObject; Index: Integer);
procedure VpNavBar1ItemClick(Sender: TObject; Button: TMouseButton; procedure VpNavBar1ItemClick(Sender: TObject; Button: TMouseButton;
@ -157,11 +170,41 @@ begin
} }
end; end;
procedure TForm1.cbItemTextColorNormalChange(Sender: TObject);
begin
VpNavBar1.ItemFont.Color := CbItemTextColorNormal.Selected;
end;
procedure TForm1.cbItemTextColorSelectedChange(Sender: TObject);
begin
VpNavBar1.SelectedItemFont.Color := CbItemTextColorSelected.Selected;
end;
procedure TForm1.CbPlaySoundsChange(Sender: TObject); procedure TForm1.CbPlaySoundsChange(Sender: TObject);
begin begin
VpNavBar1.PlaySounds := CbPlaySounds.Checked; VpNavBar1.PlaySounds := CbPlaySounds.Checked;
end; end;
procedure TForm1.cbThemedItemsChange(Sender: TObject);
begin
VpNavBar1.ItemTheme := TVpItemTheme(cmbItemTheme.ItemIndex);
end;
procedure TForm1.cmbIconSizeSelect(Sender: TObject);
var
folder: TVpNavFolder;
begin
// GbIcon.OnClick := nil;
folder := VpNavBar1.Folders[VpNavBar1.ActiveFolder];
folder.IconSize := TVpIconSize(cmbIconSize.ItemIndex);
// GbIcon.OnClick := @RgIconSizeClick;
end;
procedure TForm1.cmbItemThemeSelect(Sender: TObject);
begin
VpNavBar1.ItemTheme := TVpItemTheme(cmbItemTheme.ItemIndex);
end;
procedure TForm1.EdSoundFileAcceptFileName(Sender: TObject; var Value: String); procedure TForm1.EdSoundFileAcceptFileName(Sender: TObject; var Value: String);
begin begin
VpNavBar1.SoundAlias := ExpandFilename(Value); VpNavBar1.SoundAlias := ExpandFilename(Value);
@ -179,6 +222,8 @@ begin
RgDrawingStyle.ItemIndex := ord(VpNavBar1.DrawingStyle); RgDrawingStyle.ItemIndex := ord(VpNavBar1.DrawingStyle);
RgBorderStyle.ItemIndex := ord(VpNavBar1.BorderStyle); RgBorderStyle.ItemIndex := ord(VpNavBar1.BorderStyle);
BkColor.Selected := VpNavBar1.BackgroundColor; BkColor.Selected := VpNavBar1.BackgroundColor;
cbItemTextColorNormal.Selected := VpNavBar1.ItemFont.Color;
cbItemTextColorSelected.Selected := VpNavBar1.SelectedItemFont.Color;
case VpNavBar1.BackgroundMethod of case VpNavBar1.BackgroundMethod of
bmNone: bmNone:
RbBkColor.Checked := true; RbBkColor.Checked := true;
@ -228,14 +273,14 @@ begin
VpNavBar1.DrawingStyle := TVpFolderDrawingStyle(RgDrawingStyle.ItemIndex); VpNavBar1.DrawingStyle := TVpFolderDrawingStyle(RgDrawingStyle.ItemIndex);
end; end;
procedure TForm1.RgIconSizeClick(Sender: TObject); procedure TForm1.GbIconClick(Sender: TObject);
var var
folder: TVpNavFolder; folder: TVpNavFolder;
begin begin
RgIconSize.OnClick := nil; // GbIcon.OnClick := nil;
folder := VpNavBar1.Folders[VpNavBar1.ActiveFolder]; folder := VpNavBar1.Folders[VpNavBar1.ActiveFolder];
folder.IconSize := TVpIconSize(RgIconSize.ItemIndex); folder.IconSize := TVpIconSize(cmbIconSize.ItemIndex);
RgIconSize.OnClick := @RgIconSizeClick; // GbIcon.OnClick := @RgIconSizeClick;
end; end;
procedure TForm1.RbBkColorChange(Sender: TObject); procedure TForm1.RbBkColorChange(Sender: TObject);
@ -265,10 +310,10 @@ procedure TForm1.VpNavBar1FolderChanged(Sender: TObject; Index: Integer);
var var
folder: TVpNavFolder; folder: TVpNavFolder;
begin begin
RgIconSize.OnClick := nil; // GbIcon.OnClick := nil;
folder := VpNavBar1.Folders[Index]; folder := VpNavBar1.Folders[Index];
RgIconSize.ItemIndex := ord(folder.IconSize); cmbIconSize.ItemIndex := ord(folder.IconSize);
RgIconSize.OnClick := @RgIconSizeClick; // GbIcon.OnClick := @RgIconSizeClick;
end; end;
procedure TForm1.VpNavBar1ItemClick(Sender: TObject; Button: TMouseButton; procedure TForm1.VpNavBar1ItemClick(Sender: TObject; Button: TMouseButton;

2
components/tvplanit/laz_visualplanit.lpk
View File

@ -31,7 +31,7 @@ The Initial Developer of the Original Code is TurboPower Software.
Portions created by TurboPower Software Inc. are Copyright (C) 2002 TurboPower Software Inc. All Rights Reserved. Portions created by TurboPower Software Inc. are Copyright (C) 2002 TurboPower Software Inc. All Rights Reserved.
Contributor(s): "/> Contributor(s): "/>
<Version Major="1" Release="10"/> <Version Major="1" Release="11"/>
<Files Count="71"> <Files Count="71">
<Item1> <Item1>
<Filename Value="source\vpbase.pas"/> <Filename Value="source\vpbase.pas"/>

2
components/tvplanit/laz_visualplanit_design.lpk
View File

@ -27,7 +27,7 @@ The Initial Developer of the Original Code is TurboPower Software.
Portions created by TurboPower Software Inc. are Copyright (C) 2002 TurboPower Software Inc. All Rights Reserved. Portions created by TurboPower Software Inc. are Copyright (C) 2002 TurboPower Software Inc. All Rights Reserved.
Contributor(s): "/> Contributor(s): "/>
<Version Major="1" Release="10"/> <Version Major="1" Release="11"/>
<Files Count="6"> <Files Count="6">
<Item1> <Item1>
<Filename Value="source\design\vpreg.pas"/> <Filename Value="source\design\vpreg.pas"/>

2
components/tvplanit/laz_visualplanit_zeos.lpk
View File

@ -18,7 +18,7 @@
Software distributed under the License is distributed on an &quot;AS IS&quot; basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. Software distributed under the License is distributed on an &quot;AS IS&quot; basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License.
"/> "/>
<Version Major="1" Release="10"/> <Version Major="1" Release="11"/>
<Files Count="1"> <Files Count="1">
<Item1> <Item1>
<Filename Value="source\addons\zeos\vpzeosds.pas"/> <Filename Value="source\addons\zeos\vpzeosds.pas"/>

2
components/tvplanit/laz_visualplanit_zeos_design.lpk
View File

@ -14,7 +14,7 @@
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\zeos_design"/> <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\zeos_design"/>
</SearchPaths> </SearchPaths>
</CompilerOptions> </CompilerOptions>
<Version Major="1" Release="10"/> <Version Major="1" Release="11"/>
<Files Count="1"> <Files Count="1">
<Item1> <Item1>
<Filename Value="source\addons\zeos\vpregzeos.pas"/> <Filename Value="source\addons\zeos\vpregzeos.pas"/>

229
components/tvplanit/source/design/vpnabed.lfm
View File

@ -1,13 +1,13 @@
object frmNavBarEd: TfrmNavBarEd object frmNavBarEd: TfrmNavBarEd
Left = 374 Left = 374
Height = 364 Height = 370
Top = 236 Top = 236
Width = 543 Width = 548
HorzScrollBar.Page = 425 HorzScrollBar.Page = 425
VertScrollBar.Page = 322 VertScrollBar.Page = 322
Caption = 'Nav Bar Layout Tool' Caption = 'NavBar Layout Tool'
ClientHeight = 364 ClientHeight = 370
ClientWidth = 543 ClientWidth = 548
FormStyle = fsStayOnTop FormStyle = fsStayOnTop
OnClose = FormClose OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
@ -18,72 +18,48 @@ object frmNavBarEd: TfrmNavBarEd
LCLVersion = '1.9.0.0' LCLVersion = '1.9.0.0'
object pnlFoldersAndItems: TPanel object pnlFoldersAndItems: TPanel
Left = 0 Left = 0
Height = 364 Height = 370
Top = 0 Top = 0
Width = 543 Width = 548
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 364 ClientHeight = 370
ClientWidth = 543 ClientWidth = 548
TabOrder = 0 TabOrder = 0
object pnlFolders: TPanel object pnlFolders: TPanel
AnchorSideLeft.Control = pnlFoldersAndItems
AnchorSideTop.Control = pnlFoldersAndItems
AnchorSideRight.Control = Bevel1
AnchorSideBottom.Control = pnlFoldersAndItems
AnchorSideBottom.Side = asrBottom
Left = 0 Left = 0
Height = 364 Height = 370
Top = 0 Top = 0
Width = 235 Width = 232
Align = alLeft
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Right = 4
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 364 ClientHeight = 370
ClientWidth = 235 ClientWidth = 232
TabOrder = 0 TabOrder = 0
object lbFolders: TListBox object lbFolders: TListBox
AnchorSideLeft.Control = pnlFolders AnchorSideLeft.Control = pnlFolders
AnchorSideTop.Control = Panel6 AnchorSideTop.Control = lblFolders
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = pnlFolders AnchorSideRight.Control = pnlFolders
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Panel5 AnchorSideBottom.Control = pnlFolderBtns
Left = 4 Left = 4
Height = 308 Height = 314
Top = 23 Top = 23
Width = 231 Width = 228
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Top = 4
ItemHeight = 0 ItemHeight = 0
OnClick = lbFoldersClick OnClick = lbFoldersClick
TabOrder = 1
end
object Panel6: TPanel
Left = 0
Height = 23
Top = 0
Width = 235
Align = alTop
BevelOuter = bvNone
ClientHeight = 23
ClientWidth = 235
TabOrder = 0 TabOrder = 0
object Label1: TLabel
Left = 4
Height = 15
Top = 4
Width = 38
Caption = '&Folders'
FocusControl = lbFolders
ParentColor = False
end
end end
object Panel5: TPanel object pnlFolderBtns: TPanel
Left = 4 Left = 4
Height = 25 Height = 25
Top = 335 Top = 341
Width = 231 Width = 228
Align = alBottom Align = alBottom
AutoSize = True AutoSize = True
BorderSpacing.Left = 4 BorderSpacing.Left = 4
@ -91,11 +67,11 @@ object frmNavBarEd: TfrmNavBarEd
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 25 ClientHeight = 25
ClientWidth = 231 ClientWidth = 228
TabOrder = 2 TabOrder = 1
object btnFolderAdd: TSpeedButton object btnFolderAdd: TSpeedButton
AnchorSideLeft.Control = Panel5 AnchorSideLeft.Control = pnlFolderBtns
AnchorSideTop.Control = Panel5 AnchorSideTop.Control = pnlFolderBtns
Left = 0 Left = 0
Height = 25 Height = 25
Hint = 'Add folder' Hint = 'Add folder'
@ -120,7 +96,7 @@ object frmNavBarEd: TfrmNavBarEd
object btnFolderDelete: TSpeedButton object btnFolderDelete: TSpeedButton
AnchorSideLeft.Control = btnFolderAdd AnchorSideLeft.Control = btnFolderAdd
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel5 AnchorSideTop.Control = pnlFolderBtns
Left = 29 Left = 29
Height = 25 Height = 25
Hint = 'Remove folder' Hint = 'Remove folder'
@ -146,7 +122,7 @@ object frmNavBarEd: TfrmNavBarEd
object btnFolderUp: TSpeedButton object btnFolderUp: TSpeedButton
AnchorSideLeft.Control = btnFolderDelete AnchorSideLeft.Control = btnFolderDelete
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel5 AnchorSideTop.Control = pnlFolderBtns
Left = 58 Left = 58
Height = 25 Height = 25
Hint = 'Move folder up' Hint = 'Move folder up'
@ -172,7 +148,7 @@ object frmNavBarEd: TfrmNavBarEd
object btnFolderDown: TSpeedButton object btnFolderDown: TSpeedButton
AnchorSideLeft.Control = btnFolderUp AnchorSideLeft.Control = btnFolderUp
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel5 AnchorSideTop.Control = pnlFolderBtns
Left = 83 Left = 83
Height = 25 Height = 25
Hint = 'Move folder down' Hint = 'Move folder down'
@ -195,49 +171,55 @@ object frmNavBarEd: TfrmNavBarEd
ParentShowHint = False ParentShowHint = False
end end
end end
object lblFolders: TLabel
AnchorSideLeft.Control = pnlFolders
AnchorSideTop.Control = pnlFolders
Left = 4
Height = 15
Top = 4
Width = 38
BorderSpacing.Left = 4
BorderSpacing.Top = 4
Caption = 'Folders'
FocusControl = lbFolders
ParentColor = False
end
end end
object pnlItems: TPanel object pnlItems: TPanel
AnchorSideLeft.Control = pnlFolders Left = 237
AnchorSideLeft.Side = asrBottom Height = 370
AnchorSideTop.Control = pnlFoldersAndItems
AnchorSideRight.Control = pnlFoldersAndItems
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = pnlFoldersAndItems
AnchorSideBottom.Side = asrBottom
Left = 239
Height = 364
Top = 0 Top = 0
Width = 300 Width = 311
Anchors = [akTop, akLeft, akRight, akBottom] Align = alClient
BorderSpacing.Right = 4
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 364 ClientHeight = 370
ClientWidth = 300 ClientWidth = 311
TabOrder = 1 TabOrder = 1
object lbItems: TListBox object lbItems: TListBox
AnchorSideLeft.Control = pnlItems AnchorSideLeft.Control = pnlItems
AnchorSideTop.Control = Panel4 AnchorSideTop.Control = lblImages
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = btnUseImage AnchorSideRight.Control = btnUseImage
AnchorSideBottom.Control = Panel1 AnchorSideBottom.Control = pnlItemBtns
Left = 0 Left = 0
Height = 307 Height = 314
Top = 24 Top = 23
Width = 221 Width = 228
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Top = 4
BorderSpacing.Right = 4 BorderSpacing.Right = 4
ItemHeight = 13 ItemHeight = 13
OnClick = lbItemsClick OnClick = lbItemsClick
OnDrawItem = lbItemsDrawItem OnDrawItem = lbItemsDrawItem
OnMeasureItem = lbItemsMeasureItem OnMeasureItem = lbItemsMeasureItem
Style = lbOwnerDrawVariable Style = lbOwnerDrawVariable
TabOrder = 1 TabOrder = 0
end end
object Panel1: TPanel object pnlItemBtns: TPanel
Left = 0 Left = 0
Height = 25 Height = 25
Top = 335 Top = 341
Width = 296 Width = 307
Align = alBottom Align = alBottom
AutoSize = True AutoSize = True
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -245,11 +227,11 @@ object frmNavBarEd: TfrmNavBarEd
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 25 ClientHeight = 25
ClientWidth = 296 ClientWidth = 307
TabOrder = 2 TabOrder = 1
object btnItemAdd: TSpeedButton object btnItemAdd: TSpeedButton
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = pnlItemBtns
AnchorSideTop.Control = Panel1 AnchorSideTop.Control = pnlItemBtns
Left = 0 Left = 0
Height = 25 Height = 25
Hint = 'Add Item' Hint = 'Add Item'
@ -274,7 +256,7 @@ object frmNavBarEd: TfrmNavBarEd
object btnItemDelete: TSpeedButton object btnItemDelete: TSpeedButton
AnchorSideLeft.Control = btnItemAdd AnchorSideLeft.Control = btnItemAdd
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1 AnchorSideTop.Control = pnlItemBtns
Left = 29 Left = 29
Height = 25 Height = 25
Hint = 'Remove item' Hint = 'Remove item'
@ -300,7 +282,7 @@ object frmNavBarEd: TfrmNavBarEd
object btnItemUp: TSpeedButton object btnItemUp: TSpeedButton
AnchorSideLeft.Control = btnItemDelete AnchorSideLeft.Control = btnItemDelete
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1 AnchorSideTop.Control = pnlItemBtns
Left = 58 Left = 58
Height = 25 Height = 25
Hint = 'Move item up' Hint = 'Move item up'
@ -326,7 +308,7 @@ object frmNavBarEd: TfrmNavBarEd
object btnItemDown: TSpeedButton object btnItemDown: TSpeedButton
AnchorSideLeft.Control = btnItemUp AnchorSideLeft.Control = btnItemUp
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1 AnchorSideTop.Control = pnlItemBtns
Left = 87 Left = 87
Height = 25 Height = 25
Hint = 'Move item down' Hint = 'Move item down'
@ -350,76 +332,67 @@ object frmNavBarEd: TfrmNavBarEd
ParentShowHint = False ParentShowHint = False
end end
end end
object Panel4: TPanel
Left = 0
Height = 24
Top = 0
Width = 300
Align = alTop
BevelOuter = bvNone
ClientHeight = 24
ClientWidth = 300
TabOrder = 0
object Label2: TLabel
Left = 0
Height = 15
Top = 4
Width = 62
Caption = '&Items/Icons'
FocusControl = lbItems
ParentColor = False
end
object Label4: TLabel
AnchorSideTop.Control = Label2
AnchorSideRight.Control = Panel4
AnchorSideRight.Side = asrBottom
Left = 211
Height = 15
Top = 4
Width = 89
Anchors = [akTop, akRight]
Caption = 'Available i&mages'
ParentColor = False
end
end
object lbImages: TListBox object lbImages: TListBox
AnchorSideTop.Control = lbItems AnchorSideTop.Control = lbItems
AnchorSideRight.Control = pnlItems AnchorSideRight.Control = pnlItems
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = lbItems AnchorSideBottom.Control = lbItems
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 252 Left = 259
Height = 307 Height = 314
Top = 24 Top = 23
Width = 48 Width = 48
Anchors = [akTop, akRight, akBottom] Anchors = [akTop, akRight, akBottom]
BorderSpacing.Right = 4
ItemHeight = 0 ItemHeight = 0
OnDrawItem = lbImagesDrawItem OnDrawItem = lbImagesDrawItem
Style = lbOwnerDrawFixed Style = lbOwnerDrawFixed
TabOrder = 3 TabOrder = 2
end end
object btnUseImage: TSpeedButton object btnUseImage: TSpeedButton
AnchorSideTop.Control = lbImages AnchorSideTop.Control = lbImages
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = lbImages AnchorSideRight.Control = lbImages
Left = 225 Left = 232
Height = 22 Height = 22
Hint = 'Use image in navigation bar' Hint = 'Use image in navigation bar'
Top = 166 Top = 169
Width = 23 Width = 23
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Right = 4 BorderSpacing.Right = 4
OnClick = btnUseImageClick OnClick = btnUseImageClick
end end
object lblItems: TLabel
AnchorSideLeft.Control = pnlItems
AnchorSideTop.Control = pnlItems
Left = 0
Height = 15
Top = 4
Width = 62
BorderSpacing.Top = 4
Caption = 'Items/Icons'
FocusControl = lbItems
ParentColor = False
end
object lblImages: TLabel
AnchorSideTop.Control = lblItems
AnchorSideRight.Control = pnlItems
AnchorSideRight.Side = asrBottom
Left = 218
Height = 15
Top = 4
Width = 89
Anchors = [akTop, akRight]
BorderSpacing.Right = 4
Caption = 'Available images'
ParentColor = False
end
end end
object Bevel1: TBevel object Splitter1: TSplitter
AnchorSideLeft.Control = pnlFoldersAndItems Left = 232
AnchorSideLeft.Side = asrCenter Height = 370
Left = 239
Height = 50
Top = 0 Top = 0
Width = 64 Width = 5
Shape = bsSpacer
end end
end end
end end

14
components/tvplanit/source/design/vpnabed.pas
View File

@ -53,29 +53,27 @@ type
{ TfrmNavBarEd } { TfrmNavBarEd }
TfrmNavBarEd = class(TForm) TfrmNavBarEd = class(TForm)
Bevel1: TBevel; lblImages: TLabel;
Label4: TLabel;
lbImages: TListBox; lbImages: TListBox;
pnlFoldersAndItems: TPanel; pnlFoldersAndItems: TPanel;
pnlItems: TPanel; pnlItems: TPanel;
pnlFolders: TPanel; pnlFolders: TPanel;
lbItems: TListBox; lbItems: TListBox;
lbFolders: TListBox; lbFolders: TListBox;
Panel1: TPanel; pnlItemBtns: TPanel;
btnItemAdd: TSpeedButton; btnItemAdd: TSpeedButton;
btnItemDelete: TSpeedButton; btnItemDelete: TSpeedButton;
btnItemUp: TSpeedButton; btnItemUp: TSpeedButton;
btnItemDown: TSpeedButton; btnItemDown: TSpeedButton;
Panel4: TPanel; lblItems: TLabel;
Label2: TLabel; pnlFolderBtns: TPanel;
Panel5: TPanel;
btnFolderAdd: TSpeedButton; btnFolderAdd: TSpeedButton;
btnFolderDelete: TSpeedButton; btnFolderDelete: TSpeedButton;
btnFolderUp: TSpeedButton; btnFolderUp: TSpeedButton;
btnFolderDown: TSpeedButton; btnFolderDown: TSpeedButton;
Panel6: TPanel; lblFolders: TLabel;
Label1: TLabel;
btnUseImage: TSpeedButton; btnUseImage: TSpeedButton;
Splitter1: TSplitter;
procedure btnFolderAddClick(Sender: TObject); procedure btnFolderAddClick(Sender: TObject);
procedure btnFolderDeleteClick(Sender: TObject); procedure btnFolderDeleteClick(Sender: TObject);

4
components/tvplanit/source/vpnavbar.pas
View File

@ -52,6 +52,7 @@ type
TVpBackgroundMethod = (bmNone, bmNormal, bmStretch, bmTile); TVpBackgroundMethod = (bmNone, bmNormal, bmStretch, bmTile);
TVpFolderDrawingStyle = (dsDefButton, dsEtchedButton, dsCoolTab, dsStandardTab); TVpFolderDrawingStyle = (dsDefButton, dsEtchedButton, dsCoolTab, dsStandardTab);
TVpFolderType = (ftDefault, ftContainer); TVpFolderType = (ftDefault, ftContainer);
TVpItemTheme = (itNoTheme, itPushButton, itToolbar);
TVpFolderContainer = class(TPanel) TVpFolderContainer = class(TPanel)
protected{Private} protected{Private}
@ -210,6 +211,7 @@ type
FLoadingFolder: Integer; FLoadingFolder: Integer;
FMouseDownPt: TPoint; FMouseDownPt: TPoint;
FAllowInplaceEdit: Boolean; FAllowInplaceEdit: Boolean;
FItemTheme: TVpItemTheme;
{event variables} {event variables}
FOnArrange: TNotifyEvent; FOnArrange: TNotifyEvent;
@ -351,6 +353,7 @@ type
property ImagesWidth: Integer read FImagesWidth write SetImagesWidth; property ImagesWidth: Integer read FImagesWidth write SetImagesWidth;
property ItemFont: TFont read FItemFont write SetItemFont; property ItemFont: TFont read FItemFont write SetItemFont;
property ItemSpacing: Integer read FItemSpacing write SetItemSpacing stored IsStoredItemSpacing; property ItemSpacing: Integer read FItemSpacing write SetItemSpacing stored IsStoredItemSpacing;
property ItemTheme: TVpItemTheme read FItemTheme write FItemTheme default itNoTheme;
property PlaySounds: Boolean read FPlaySounds write FPlaySounds default false; property PlaySounds: Boolean read FPlaySounds write FPlaySounds default false;
property ScrollDelta: Integer read FScrollDelta write SetScrollDelta default 2; property ScrollDelta: Integer read FScrollDelta write SetScrollDelta default 2;
property SelectedItem: Integer read FSelectedItem write FSelectedItem; property SelectedItem: Integer read FSelectedItem write FSelectedItem;
@ -429,6 +432,7 @@ type
{$ENDIF}{$ENDIF} {$ENDIF}{$ENDIF}
property ItemFont; property ItemFont;
property ItemSpacing; property ItemSpacing;
property ItemTheme;
property PlaySounds; property PlaySounds;
property ScrollDelta; property ScrollDelta;
property SelectedItem; property SelectedItem;

54
components/tvplanit/source/vpnavbarpainter.pas
View File

@ -515,28 +515,42 @@ end;
procedure TVpNavBarPainter.DrawItemHighlight(Canvas: TCanvas; R: TRect; procedure TVpNavBarPainter.DrawItemHighlight(Canvas: TCanvas; R: TRect;
Enable: Boolean); Enable: Boolean);
const
PUSHBUTTON_DETAILS: array[boolean] of TThemedButton = (tbPushButtonHot, tbPushButtonPressed);
TOOLBAR_DETAILS: array[boolean] of TThemedToolbar = (ttbButtonHot, ttbButtonPressed);
var
details: TThemedElementDetails;
margin: integer;
begin begin
if Enable then begin if Enable then begin
if nabMouseDown then if ThemeServices.ThemesEnabled and (TVpNavBarOpener(FNavBar).ItemTheme <> itNoTheme) then
Canvas.Pen.Color := clBlack begin
else margin := ScaleX(2, DesigntimeDPI);
Canvas.Pen.Color := clWhite; InflateRect(R, margin, margin);
Canvas.MoveTo(R.Left-1, R.Bottom+1); case TVpNavBarOpener(FNavBar).ItemTheme of
Canvas.LineTo(R.Left-1, R.Top-1); itPushButton:
Canvas.LineTo(R.Right+1, R.Top-1); details := ThemeServices.GetElementDetails(PUSHBUTTON_DETAILS[nabMousedown]);
if nabMouseDown then itToolbar:
Canvas.Pen.Color := clWhite details := ThemeServices.GetElementDetails(TOOLBAR_DETAILS[nabMouseDown]);
else end;
Canvas.Pen.Color := clBlack; ThemeServices.DrawElement(Canvas.Handle, details, R);
Canvas.LineTo(R.Right+1, R.Bottom+1); end else
Canvas.LineTo(R.Left-1, R.Bottom+1); begin
Canvas.Brush.Color := FBackgroundColor; if nabMouseDown then
(* Canvas.Pen.Color := clBlack
end else begin else
Canvas.Pen.Color := FBackgroundColor; Canvas.Pen.Color := clWhite;
Canvas.Brush.Color := FBackgroundColor; Canvas.MoveTo(R.Left-1, R.Bottom+1);
Canvas.Rectangle(R.Left - 1, R.Top - 1, R.Right + 1, R.Bottom + 1); Canvas.LineTo(R.Left-1, R.Top-1);
*) Canvas.LineTo(R.Right+1, R.Top-1);
if nabMouseDown then
Canvas.Pen.Color := clWhite
else
Canvas.Pen.Color := clBlack;
Canvas.LineTo(R.Right+1, R.Bottom+1);
Canvas.LineTo(R.Left-1, R.Bottom+1);
Canvas.Brush.Color := FBackgroundColor;
end;
end; end;
end; end;