tvplanit: New demo (navbar). Fix distance of small icons in navbar.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4989 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-07-17 20:05:36 +00:00
parent 829bff542a
commit ced32e0763
5 changed files with 1783 additions and 2 deletions

View File

@ -0,0 +1,82 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="project1"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="laz_visualplanit"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="project1"/>
</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>

View File

@ -0,0 +1,21 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1, laz_visualplanit
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,141 @@
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, VpNavBar;
type
{ TForm1 }
TForm1 = class(TForm)
Bevel1: TBevel;
BtnAddFolder: TButton;
BtnAddItem: TButton;
IconsLbl: TLabel;
IconsLink: TLabel;
RadioGroup2: TRadioGroup;
Label1: TLabel;
Images: TImageList;
Panel1: TPanel;
RadioGroup1: TRadioGroup;
VpNavBar1: TVpNavBar;
procedure BtnAddFolderClick(Sender: TObject);
procedure BtnAddItemClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure IconsLinkClick(Sender: TObject);
procedure IconsLinkMouseEnter(Sender: TObject);
procedure IconsLinkMouseLeave(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
procedure RadioGroup2Click(Sender: TObject);
procedure VpNavBar1FolderChanged(Sender: TObject; Index: Integer);
procedure VpNavBar1ItemClick(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; Index: Integer);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
uses
LCLIntf;
{ TForm1 }
procedure TForm1.BtnAddFolderClick(Sender: TObject);
var
s: String;
begin
s := InputBox('Add folder', 'Folder name:', '');
if s <> '' then
VpNavBar1.AddFolder(s);
end;
procedure TForm1.BtnAddItemClick(Sender: TObject);
var
folder: TVpNavFolder;
item: TVpNavBtnItem;
s: String;
idx: Integer;
begin
if VpNavBar1.ActiveFolder = -1 then
exit;
s := InputBox('Add item', 'Item name:', '');
if s <> '' then begin
folder := VpNavBar1.Folders[VpNavBar1.ActiveFolder];
idx := folder.ItemCount;
VpNavBar1.AddItem(s, VpNavBar1.ActiveFolder, idx);
item := folder.Items[idx];
item.IconIndex := Random(VpNavBar1.Images.Count);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
RandSeed := 1;
IconsLink.Left := IconsLbl.Left + IconsLbl.Width;
RadioGroup1.ItemIndex := ord(VpNavBar1.DrawingStyle);
end;
procedure TForm1.IconsLinkClick(Sender: TObject);
begin
OpenDocument(IconsLink.Caption);
end;
procedure TForm1.IconsLinkMouseEnter(Sender: TObject);
begin
IconsLink.Font.style := IconsLink.Font.Style + [fsUnderline];
end;
procedure TForm1.IconsLinkMouseLeave(Sender: TObject);
begin
IconsLink.Font.style := IconsLink.Font.Style - [fsUnderline];
end;
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
VpNavBar1.DrawingStyle := TVpFolderDrawingStyle(Radiogroup1.ItemIndex);
end;
procedure TForm1.RadioGroup2Click(Sender: TObject);
var
folder: TVpNavFolder;
begin
folder := VpNavBar1.Folders[VpNavBar1.ActiveFolder];
folder.IconSize := TVpIconSize(RadioGroup1.ItemIndex);
end;
procedure TForm1.VpNavBar1FolderChanged(Sender: TObject; Index: Integer);
var
folder: TVpNavFolder;
begin
RadioGroup2.OnClick := nil;
folder := VpNavBar1.Folders[Index];
RadioGroup2.ItemIndex := ord(folder.IconSize);
RadioGroup2.OnClick := @RadioGroup2Click;
end;
procedure TForm1.VpNavBar1ItemClick(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; Index: Integer);
var
folder: TVpNavFolder;
item: TVpNavBtnItem;
begin
folder := VpNavBar1.Folders[VpNavBar1.ActiveFolder];
item := folder.Items[Index];
Label1.Caption := Format('Item "%s" clicked', [item.Caption]);
end;
end.

View File

@ -329,9 +329,10 @@ begin
labelWidth := WidthOf(R);
R.Right := R.Left + labelWidth + 1;
item.LabelRect := R;
DrawText(Canvas.Handle, Buf, Length(item.DisplayName), R, DT_LEFT or DT_VCENTER);
X := DrawText(Canvas.Handle, Buf, Length(item.DisplayName), R, DT_LEFT or DT_VCENTER);
if X < H then X := H;
Inc(CurPos, FItemSpacing);
Inc(CurPos, FItemSpacing + X);
end; { Small icons }
end; { for J }
end; { if folder.FolderType = ftDefault }