You've already forked lazarus-ccr
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:
@ -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
|
||||||
|
@ -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.
|
||||||
|
|
||||||
|
|
||||||
|
@ -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;
|
||||||
|
Reference in New Issue
Block a user