You've already forked lazarus-ccr
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:
82
components/tvplanit/examples/navbar/project1.lpi
Normal file
82
components/tvplanit/examples/navbar/project1.lpi
Normal 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>
|
21
components/tvplanit/examples/navbar/project1.lpr
Normal file
21
components/tvplanit/examples/navbar/project1.lpr
Normal 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.
|
||||
|
1536
components/tvplanit/examples/navbar/unit1.lfm
Normal file
1536
components/tvplanit/examples/navbar/unit1.lfm
Normal file
File diff suppressed because it is too large
Load Diff
141
components/tvplanit/examples/navbar/unit1.pas
Normal file
141
components/tvplanit/examples/navbar/unit1.pas
Normal 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.
|
||||
|
@ -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 }
|
||||
|
Reference in New Issue
Block a user