tvplanit: Fix crash due to non-registered navbar container class. (Container still does not accept controls). Some cleanup.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4999 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-07-18 20:40:50 +00:00
parent 0aaccd7fee
commit 98d39ec706
3 changed files with 75 additions and 11 deletions

View File

@ -13,7 +13,7 @@ object Form1: TForm1
Height = 370 Height = 370
Top = 0 Top = 0
Width = 128 Width = 128
ActiveFolder = 0 ActiveFolder = 3
AllowInplaceEdit = True AllowInplaceEdit = True
AllowRearrange = True AllowRearrange = True
BackgroundColor = clInactiveCaption BackgroundColor = clInactiveCaption
@ -113,6 +113,17 @@ object Form1: TForm1
IconSize = isLarge IconSize = isLarge
Name = 'NavFolder2' Name = 'NavFolder2'
Tag = 0 Tag = 0
end
item
Version = 'v1.04'
Caption = 'Container'
Enabled = True
FolderType = ftContainer
ItemCollection = <>
IconSize = isLarge
Name = 'NavFolder3'
Tag = 0
ContainerIndex = 0
end> end>
Images = Images Images = Images
ItemFont.Color = clWhite ItemFont.Color = clWhite
@ -127,6 +138,16 @@ object Form1: TForm1
OnFolderChanged = VpNavBar1FolderChanged OnFolderChanged = VpNavBar1FolderChanged
Align = alLeft Align = alLeft
ParentColor = False ParentColor = False
object Container0: TVpFolderContainer
Left = 0
Height = 290
Top = 80
Width = 128
BevelOuter = bvNone
Color = clInactiveCaption
ParentColor = False
TabOrder = 0
end
end end
object RgDrawingStyle: TRadioGroup object RgDrawingStyle: TRadioGroup
Left = 141 Left = 141

View File

@ -278,6 +278,7 @@ type
function nabShowScrollUp: Boolean; function nabShowScrollUp: Boolean;
function nabShowScrollDown: Boolean; function nabShowScrollDown: Boolean;
procedure nabTimerEvent(Sender: TObject; Handle: Integer; Interval: Cardinal; ElapsedTime: LongInt); procedure nabTimerEvent(Sender: TObject; Handle: Integer; Interval: Cardinal; ElapsedTime: LongInt);
procedure nabProcessContainers;
{VCL message methods} {VCL message methods}
{$IFNDEF LCL} {$IFNDEF LCL}
@ -462,6 +463,7 @@ uses
Themes, Themes,
VpNavBarPainter; VpNavBarPainter;
{$IFNDEF PAINTER}
{DrawNavTab - returns the usable text area inside the tab rect.} {DrawNavTab - returns the usable text area inside the tab rect.}
function DrawNavTab(Canvas: TCanvas; const Client: TRect; BevelWidth: Integer; function DrawNavTab(Canvas: TCanvas; const Client: TRect; BevelWidth: Integer;
TabColor: TColor; TabNumber: Integer; CoolTab, IsFocused, IsMouseOver: Boolean): TRect; TabColor: TColor; TabNumber: Integer; CoolTab, IsFocused, IsMouseOver: Boolean): TRect;
@ -650,7 +652,7 @@ begin
Result := Rect(Client.Left + 1, Client.Top + 1, Client.Right - 2, Client.Bottom - 2); Result := Rect(Client.Left + 1, Client.Top + 1, Client.Right - 2, Client.Bottom - 2);
if IsFocused then OffsetRect(Result, 1, 1); if IsFocused then OffsetRect(Result, 1, 1);
end; end;
{$ENDIF}
{===== TVpFolderContainer ===========================================} {===== TVpFolderContainer ===========================================}
@ -798,7 +800,7 @@ end;
constructor TVpNavFolder.Create(Collection: TCollection); constructor TVpNavFolder.Create(Collection: TCollection);
begin begin
inherited Create(Collection); inherited Create(Collection);
RegisterClass(TVpFolderContainer); // RegisterClass(TVpFolderContainer);
FNavBar := TVpCustomNavBar(TVpCollection(Collection).GetOwner); FNavBar := TVpCustomNavBar(TVpCollection(Collection).GetOwner);
FNavBar.ActiveFolder := Index; FNavBar.ActiveFolder := Index;
FItems := TVpCollection.Create(Self, TVpNavBtnItem); FItems := TVpCollection.Create(Self, TVpNavBtnItem);
@ -1111,8 +1113,7 @@ end;
procedure TVpCustomNavBar.ItemChanged(FolderIndex, ItemIndex: Integer); procedure TVpCustomNavBar.ItemChanged(FolderIndex, ItemIndex: Integer);
begin begin
Invalidate; InvalidateItem(FolderIndex, ItemIndex);
// InvalidateItem(FolderIndex, ItemIndex);
if not (csDestroying in ComponentState) then if not (csDestroying in ComponentState) then
RecreateWnd{$IFDEF LCL}(self){$ENDIF}; RecreateWnd{$IFDEF LCL}(self){$ENDIF};
end; end;
@ -2024,6 +2025,8 @@ begin
finally finally
painter.Free; painter.Free;
end; end;
nabProcessContainers;
end; end;
{$ELSE} {$ELSE}
@ -3033,4 +3036,47 @@ begin
Result := Self; Result := Self;
end; end;
procedure TVpCustomNavBar.nabProcessContainers;
var
I: Integer;
folder: TVpNavFolder;
TR: TRect;
begin
{For container style folders...}
{Hide the containers for all inactive folders}
for I := 0 to FFolders.Count - 1 do begin
if I <> FActiveFolder then begin
if Folders[i].FolderType = ftContainer then
with Containers[Folders[i].ContainerIndex] do begin
Width := 0;
Height := 0;
Visible := false;
end;
end;
end;
Folder := Folders[FActiveFolder];
TR := nabGetFolderArea(FActiveFolder);
if Folder.FolderType = ftContainer then
with Containers[Folder.ContainerIndex] do begin
{Position and show the folder's container}
Height := TR.Bottom - TR.Top;
Top := TR.Top;
Left := TR.Left;
Width := TR.Right - TR.Left;
Visible := true;
BringToFront;
for I := 0 to ControlCount - 1 do
Controls[i].Invalidate;
end;
end;
initialization
RegisterClass(TVpFolderContainer);
end. end.

View File

@ -6,7 +6,7 @@ interface
uses uses
{$IFDEF LCL} {$IFDEF LCL}
LMessages, LCLProc, LCLType, LCLIntf, LCLProc, LCLType, LCLIntf,
{$ELSE} {$ELSE}
Windows, Messages, MMSystem, Windows, Messages, MMSystem,
{$ENDIF} {$ENDIF}
@ -136,7 +136,7 @@ var
item: TVpNavBtnItem; item: TVpNavBtnItem;
J: Integer; J: Integer;
text: String; text: String;
H, X: Integer; X: Integer;
R: TRect; R: TRect;
begin begin
folder := FNavBar.Folders[FActiveFolder]; folder := FNavBar.Folders[FActiveFolder];
@ -569,7 +569,6 @@ function TVpNavBarPainter.DrawLargeIcon(Canvas: TCanvas; AItem: TVpNavBtnItem;
CurPos: Integer): Boolean; CurPos: Integer): Boolean;
var var
W, H: Integer; W, H: Integer;
lOffset: Integer;
R: TRect; R: TRect;
begin begin
Result := false; Result := false;
@ -715,7 +714,6 @@ var
displayTxt: String; displayTxt: String;
TR: TRect; TR: TRect;
Flags: Integer; Flags: Integer;
lOffset: Integer;
folder: TVpNavFolder; folder: TVpNavFolder;
savedFontstyle: TFontStyles; savedFontstyle: TFontStyles;
begin begin
@ -854,8 +852,7 @@ var
DrawBmp: TBitmap; DrawBmp: TBitmap;
DrawFolder: Boolean; DrawFolder: Boolean;
TR: TRect; TR: TRect;
CurPos: Integer; CurPos: Integer = 0;
I: Integer;
MyRect: TRect; MyRect: TRect;
begin begin
MyRect := FNavBar.ClientRect; MyRect := FNavBar.ClientRect;