diff --git a/components/tvplanit/source/vpbase.pas b/components/tvplanit/source/vpbase.pas index ab3527c70..bb5d62bac 100644 --- a/components/tvplanit/source/vpbase.pas +++ b/components/tvplanit/source/vpbase.pas @@ -590,6 +590,7 @@ begin end; {=====} + (*****************************************************************************) { TVpCollectionItem } diff --git a/components/tvplanit/source/vpnavbar.pas b/components/tvplanit/source/vpnavbar.pas index 1a902e0ed..0c01da2cc 100644 --- a/components/tvplanit/source/vpnavbar.pas +++ b/components/tvplanit/source/vpnavbar.pas @@ -34,11 +34,11 @@ interface uses {$IFDEF LCL} - LMessages,LCLProc,LCLType,LCLIntf, + LMessages, LCLProc, LCLType, LCLIntf, {$ELSE} - Windows,MMSystem, + Windows, MMSystem, {$ENDIF} - Messages,Controls, Graphics, Forms, Buttons, SysUtils, + Messages, Controls, Graphics, Forms, Buttons, SysUtils, StdCtrls, Classes, ExtCtrls, VpBase, VpConst, VpMisc, VpSR, Math; type @@ -48,14 +48,13 @@ type TVpIconSize = (isLarge, isSmall); TVpBackgroundMethod = (bmNone, bmNormal, bmStretch, bmTile); - TVpFolderDrawingStyle = (dsDefButton, dsEtchedButton, dsCoolTab, - dsStandardTab); + TVpFolderDrawingStyle = (dsDefButton, dsEtchedButton, dsCoolTab, dsStandardTab); TVpFolderType = (ftDefault, ftContainer); TVpFolderContainer = class(TPanel) protected{Private} - FNavBar : TVpCustomNavBar; - FIndex : Integer; + FNavBar: TVpCustomNavBar; + FIndex: Integer; procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; function GetChildOwner: TComponent; override; @@ -69,91 +68,79 @@ type TVpNavBtnItem = class(TVpCollectionItem) protected {private} {property variables} - FFolder : TVpNavFolder; - FCaption : string; - FDescription : String; - FIconIndex : Integer; - FIconRect : TRect; - FLabelRect : TRect; - FTag : Integer; + FFolder: TVpNavFolder; + FCaption: string; + FDescription: String; + FIconIndex: Integer; + FIconRect: TRect; + FLabelRect: TRect; + FTag: Integer; {internal variables} liDisplayName : string; {property methods} - procedure SetCaption(const Value : string); - procedure SetIconIndex(Value : Integer); + procedure SetCaption(const Value: string); + procedure SetIconIndex(Value: Integer); public constructor Create(Collection: TCollection); override; destructor Destroy; override; property Folder: TVpNavFolder read FFolder; procedure Assign(Source: TPersistent); override; - property IconRect : TRect read FIconRect; - property LabelRect : TRect read FLabelRect; + property IconRect: TRect read FIconRect; + property LabelRect: TRect read FLabelRect; published - property Caption : string - read FCaption write SetCaption; - property Description : string - read FDescription write FDescription; - property IconIndex : Integer - read FIconIndex write SetIconIndex; + property Caption: string read FCaption write SetCaption; + property Description: string read FDescription write FDescription; + property IconIndex: Integer read FIconIndex write SetIconIndex; property Name; - property Tag: Integer - read FTag write FTag; + property Tag: Integer read FTag write FTag; end; TVpNavFolder = class(TVpCollectionItem) protected {private} {property variables} - FNavBar : TVpCustomNavBar; - FCaption : string; - FEnabled : Boolean; - FIconSize : TVpIconSize; - FFolderType : TVpFolderType; - FContainerIndex : Integer; - FItems : TVpCollection; + FNavBar: TVpCustomNavBar; + FCaption: string; + FEnabled: Boolean; + FIconSize: TVpIconSize; + FFolderType: TVpFolderType; + FContainerIndex: Integer; + FItems: TVpCollection; {internal variables} - lfDisplayName : string; - lfRect : TRect; - FTag : Integer; + lfDisplayName: string; + lfRect: TRect; + FTag: Integer; {property methods} - function GetItem(Index : Integer) : TVpNavBtnItem; - function GetItemCount : Integer; - procedure SetCaption(const Value : string); - procedure SetEnabled(Value : Boolean); + function GetItem(Index: Integer): TVpNavBtnItem; + function GetItemCount: Integer; + procedure SetCaption(const Value: string); + procedure SetEnabled(Value: Boolean); procedure SetFolderType(Value: TVpFolderType); function CreateContainer: Integer; - procedure SetIconSize(Value : TVpIconSize); - procedure SetItem(Index : Integer; Value : TVpNavBtnItem); - procedure lfGetEditorCaption(var Caption : string); - procedure lfItemChange(Sender : TObject); + procedure SetIconSize(Value: TVpIconSize); + procedure SetItem(Index: Integer; Value: TVpNavBtnItem); + procedure lfGetEditorCaption(var Caption: string); + procedure lfItemChange(Sender: TObject); procedure DefineProperties(Filer: TFiler); override; procedure ReadIndex(Reader: TReader); procedure WriteIndex(Writer: TWriter); - public - constructor Create(Collection : TCollection); override; - destructor Destroy; override; + public + constructor Create(Collection: TCollection); override; + destructor Destroy; override; function GetContainer: TVpFolderContainer; - property Items[Index : Integer] : TVpNavBtnItem - read GetItem; - property ItemCount : Integer - read GetItemCount; - property ContainerIndex: Integer - read FContainerIndex write FContainerIndex; + property Items[Index: Integer]: TVpNavBtnItem read GetItem; + property ItemCount: Integer read GetItemCount; + property ContainerIndex: Integer read FContainerIndex write FContainerIndex; + published - property Caption : string - read FCaption write SetCaption; - property Enabled : Boolean - read FEnabled write SetEnabled; - property FolderType: TVpFolderType - read FFolderType write SetFolderType; - property ItemCollection : TVpCollection - read FItems write FItems; - property IconSize : TVpIconSize - read FIconSize write SetIconSize; + property Caption: string read FCaption write SetCaption; + property Enabled: Boolean read FEnabled write SetEnabled; + property FolderType: TVpFolderType read FFolderType write SetFolderType; + property ItemCollection: TVpCollection read FItems write FItems; + property IconSize: TVpIconSize read FIconSize write SetIconSize; property Name; - property Tag: Integer - read FTag write FTag; + property Tag: Integer read FTag write FTag; end; TVpRenameEdit = class(TCustomMemo) @@ -161,156 +148,146 @@ type protected procedure KeyPress(var Key: Char); override; public - FolderIndex : Integer; - ItemIndex : Integer; - constructor Create(AOwner : TComponent); override; + FolderIndex: Integer; + ItemIndex: Integer; + constructor Create(AOwner: TComponent); override; end; {NavBar Events} - TVpFolderClickEvent = - procedure(Sender : TObject; Button : TMouseButton; Shift : TShiftState; - Index : Integer) of object; - TVpItemClickEvent = - procedure(Sender : TObject; Button : TMouseButton; Shift : TShiftState; - Index : Integer) of object; - TVpFolderChangeEvent = - procedure(Sender : TObject; Index : Integer; var AllowChange : Boolean; - Dragging : Boolean) of object; - TVpFolderChangedEvent = - procedure(Sender : TObject; Index : Integer) of object; - TVpNABDragOverEvent = - procedure(Sender, Source: TObject; X, Y: Integer; State: TDragState; - var AcceptFolder, AcceptItem: Boolean) of object; - TVpNABDragDropEvent = - procedure(Sender, Source: TObject; X, Y: Integer; - FolderIndex, ItemIndex : Integer) of object; - TVpMouseOverItemEvent = - procedure(Sender : TObject; Item : TVpNavBtnItem) of object; + TVpFolderClickEvent = procedure(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; Index: Integer) of object; + TVpItemClickEvent = procedure(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; Index: Integer) of object; + + TVpFolderChangeEvent = procedure(Sender: TObject; Index: Integer; + var AllowChange: Boolean; Dragging: Boolean) of object; + + TVpFolderChangedEvent = procedure(Sender: TObject; Index: Integer) of object; + + TVpNABDragOverEvent = procedure(Sender, Source: TObject; X, Y: Integer; + State: TDragState; var AcceptFolder, AcceptItem: Boolean) of object; + + TVpNABDragDropEvent = procedure(Sender, Source: TObject; X, Y: Integer; + FolderIndex, ItemIndex: Integer) of object; + + TVpMouseOverItemEvent = procedure(Sender: TObject; Item: TVpNavBtnItem) of object; TVpCustomNavBar = class(TVpCustomControl) protected {private} {property variables} - FActiveFolder : Integer; - FActiveItem : Integer; - FAllowRearrange : Boolean; - FBackgroundColor : TColor; - FBackgroundImage : TBitmap; - FBackgroundMethod : TVpBackgroundMethod; - FBorderStyle : TBorderStyle; - FButtonHeight : Integer; - FContainers : TVpContainerList; - FDrawingStyle : TVpFolderDrawingStyle; - FFolders : TVpCollection; - FHotFolder : Integer; - FImages : TImageList; - FItemFont : TFont; - FItemSpacing : Word; - FPreviousFolder : Integer; - FPreviousItem : Integer; - FPlaySounds : Boolean; - FSelectedItem : Integer; - FSelectedItemFont : TFont; - FScrollDelta : Integer; - FShowButtons : Boolean; - FSoundAlias : string; - FLoadingFolder : Integer; + FActiveFolder: Integer; + FActiveItem: Integer; + FAllowRearrange: Boolean; + FBackgroundColor: TColor; + FBackgroundImage: TBitmap; + FBackgroundMethod: TVpBackgroundMethod; + FBorderStyle: TBorderStyle; + FButtonHeight: Integer; + FContainers: TVpContainerList; + FDrawingStyle: TVpFolderDrawingStyle; + FFolders: TVpCollection; + FHotFolder: Integer; + FImages: TImageList; + FItemFont: TFont; + FItemSpacing: Word; + FPreviousFolder: Integer; + FPreviousItem: Integer; + FPlaySounds: Boolean; + FSelectedItem: Integer; + FSelectedItemFont: TFont; + FScrollDelta: Integer; + FShowButtons: Boolean; + FSoundAlias: string; + FLoadingFolder: Integer; {event variables} - FOnArrange : TNotifyEvent; - FOnDragDrop : TVpNABDragDropEvent; - FOnDragOver : TVpNABDragOverEvent; - FOnFolderChange : TVpFolderChangeEvent; - FOnFolderChanged : TVpFolderChangedEvent; - FOnFolderClick : TVpFolderClickEvent; - FOnItemClick : TVpItemClickEvent; - FOnMouseOverItem : TVpMouseOverItemEvent; + FOnArrange: TNotifyEvent; + FOnDragDrop: TVpNABDragDropEvent; + FOnDragOver: TVpNABDragOverEvent; + FOnFolderChange: TVpFolderChangeEvent; + FOnFolderChanged: TVpFolderChangedEvent; + FOnFolderClick: TVpFolderClickEvent; + FOnItemClick: TVpItemClickEvent; + FOnMouseOverItem: TVpMouseOverItemEvent; {internal variables} - nabChanging : Boolean; - nabEdit : TVpRenameEdit; - nabTopItem : Integer; - nabExternalDrag : Boolean; - nabDragFromItem : Integer; - nabDragFromFolder : Integer; - nabDragToItem : Integer; - nabDragToFolder : Integer; - nabDropY : Integer; - nabHitTest : TPoint; {location of mouse cursor} - nabItemsRect : TRect; - nabMouseDown : Boolean; - nabOverButton : Boolean; - nabScrollDownBtn : TSpeedButton; - nabScrollUpBtn : TSpeedButton; - nabTimer : Integer; {timer-pool handle} - nabExternalDragItem : Integer; - nabFolderAccept : Boolean; - nabItemAccept : Boolean; - nabCursorOverItem : Boolean; - nabAcceptAny : Boolean; + nabChanging: Boolean; + nabEdit: TVpRenameEdit; + nabTopItem: Integer; + nabExternalDrag: Boolean; + nabDragFromItem: Integer; + nabDragFromFolder: Integer; + nabDragToItem: Integer; + nabDragToFolder: Integer; + nabDropY: Integer; + nabHitTest: TPoint; {location of mouse cursor} + nabItemsRect: TRect; + nabMouseDown: Boolean; + nabOverButton: Boolean; + nabScrollDownBtn: TSpeedButton; + nabScrollUpBtn: TSpeedButton; + nabTimer: Integer; {timer-pool handle} + nabExternalDragItem: Integer; + nabFolderAccept: Boolean; + nabItemAccept: Boolean; + nabCursorOverItem: Boolean; + nabAcceptAny: Boolean; nabLastMouseOverItem: Integer; {property methods} - function GetFolder(Index : Integer) : TVpNavFolder; - function GetFolderCount : Integer; - function GetContainer(Index: Integer):TVpFolderContainer; - procedure SetActiveFolder(Value : Integer); - procedure SetBackgroundColor(Value : TColor); - procedure SetBackgroundImage(Value : TBitmap); - procedure SetBackgroundMethod(Value : TVpBackgroundMethod); - procedure SetDrawingStyle(Value : TVpFolderDrawingStyle); - procedure SetBorderStyle(const Value : TBorderStyle); - procedure SetButtonHeight(Value : Integer); - procedure SetImages(Value : TImageList); - procedure SetItemFont(Value : TFont); - procedure SetItemSpacing(Value : Word); - procedure SetSelectedItemFont(Value : TFont); - procedure SetScrollDelta(Value : Integer); + function GetFolder(Index: Integer): TVpNavFolder; + function GetFolderCount: Integer; + function GetContainer(Index: Integer): TVpFolderContainer; + procedure SetActiveFolder(Value: Integer); + procedure SetBackgroundColor(Value: TColor); + procedure SetBackgroundImage(Value: TBitmap); + procedure SetBackgroundMethod(Value: TVpBackgroundMethod); + procedure SetDrawingStyle(Value: TVpFolderDrawingStyle); + procedure SetBorderStyle(const Value: TBorderStyle); + procedure SetButtonHeight(Value: Integer); + procedure SetImages(Value: TImageList); + procedure SetItemFont(Value: TFont); + procedure SetItemSpacing(Value: Word); + procedure SetSelectedItemFont(Value: TFont); + procedure SetScrollDelta(Value: Integer); {internal methods} - function nabButtonRect(Index : Integer) : TRect; - procedure nabCommitEdit(Sender : TObject); - procedure DragOver(Source: TObject; - X, Y: Integer; - State: TDragState; - var Accept: Boolean); override; - function nabDropHitTest(X, Y : Integer) : Boolean; - procedure nabFolderChange(Sender : TObject); - procedure nabFolderSelected(Sender : TObject; Index : Integer); - procedure nabFontChanged(Sender : TObject); - procedure nabGetEditorCaption(var Caption : string); - function nabGetFolderArea(Index : Integer) : TRect; - procedure nabGetHitTest(X, Y : Integer; - var FolderIndex : Integer; - var ItemIndex : Integer); - procedure nabImagesChanged(Sender : TObject); + function nabButtonRect(Index: Integer): TRect; + procedure nabCommitEdit(Sender: TObject); + procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override; + function nabDropHitTest(X, Y: Integer): Boolean; + procedure nabFolderChange(Sender: TObject); + procedure nabFolderSelected(Sender: TObject; Index: Integer); + procedure nabFontChanged(Sender: TObject); + procedure nabGetEditorCaption(var Caption: string); + function nabGetFolderArea(Index: Integer): TRect; + procedure nabGetHitTest(X, Y: Integer; var FolderIndex: Integer; var ItemIndex: Integer); + procedure nabImagesChanged(Sender: TObject); procedure nabRecalcDisplayNames; - procedure nabScrollDownBtnClick(Sender : TObject); - procedure nabScrollUpBtnClick(Sender : TObject); - function nabShowScrollUp : Boolean; - function nabShowScrollDown : Boolean; - procedure nabTimerEvent(Sender : TObject; - Handle : Integer; - Interval : Cardinal; - ElapsedTime : LongInt); + procedure nabScrollDownBtnClick(Sender: TObject); + procedure nabScrollUpBtnClick(Sender: TObject); + function nabShowScrollUp: Boolean; + function nabShowScrollDown: Boolean; + procedure nabTimerEvent(Sender: TObject; Handle: Integer; Interval: Cardinal; ElapsedTime: LongInt); {VCL message methods} {$IFNDEF LCL} - procedure CMCtl3DChanged(var Msg : TMessage); message CM_CTL3DCHANGED; - procedure CMDesignHitTest(var Msg : TCMDesignHitTest); message CM_DESIGNHITTEST; + procedure CMCtl3DChanged(var Msg: TMessage); message CM_CTL3DCHANGED; + procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST; procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED; {windows message response methods} - procedure WMEraseBkGnd(var Msg : TWMEraseBkGnd); message WM_ERASEBKGND; - procedure WMGetDlgCode(var Msg : TWMGetDlgCode); message WM_GETDLGCODE; - procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST; - procedure WMSetCursor(var Msg : TWMSetCursor); message WM_SETCURSOR; + procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND; + procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE; + procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST; + procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR; {$ELSE} procedure CMFontChanged(var Message: TLMessage); message CM_FONTCHANGED; procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED; {windows message response methods} - procedure WMEraseBkGnd(var Msg : TLMEraseBkGnd); message LM_ERASEBKGND; - procedure WMNCHitTest(var Msg : TLMNCHitTest); message LM_NCHITTEST; + procedure WMEraseBkGnd(var Msg: TLMEraseBkGnd); message LM_ERASEBKGND; + procedure WMNCHitTest(var Msg: TLMNCHitTest); message LM_NCHITTEST; {$ENDIF} procedure CreateParams(var Params: TCreateParams); override; procedure CreateWnd; override; @@ -322,66 +299,38 @@ type function AddContainer(Container: TVpFOlderContainer): Integer; procedure RemoveContainer(Container: TVpFolderContainer); - procedure MouseDown(Button : TMouseButton; - Shift : TShiftState; - X, Y : Integer); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; - procedure MouseUp(Button : TMouseButton; - Shift : TShiftState; - X, Y : Integer); override; - procedure Notification(AComponent : TComponent; - Operation : TOperation); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure Paint; override; procedure DoArrange; - procedure DoFolderChange(Index : Integer; var AllowChange : Boolean); - procedure DoFolderChanged(Index : Integer); - procedure DoFolderClick(Button : TMouseButton; - Shift : TShiftState; - Index : Integer); - procedure DoItemClick(Button : TMouseButton; - Shift : TShiftState; - Index : Integer); - procedure DoMouseOverItem(X, Y, ItemIndex : Integer); + procedure DoFolderChange(Index: Integer; var AllowChange: Boolean); + procedure DoFolderChanged(Index: Integer); + procedure DoFolderClick(Button: TMouseButton; Shift: TShiftState; Index: Integer); + procedure DoItemClick(Button: TMouseButton; Shift: TShiftState; Index: Integer); + procedure DoMouseOverItem(X, Y, ItemIndex: Integer); {properties} - property ActiveFolder : Integer - read FActiveFolder write SetActiveFolder; - property AllowRearrange : Boolean - read FAllowRearrange write FAllowRearrange; - property BackgroundColor : TColor - read FBackgroundColor write SetBackgroundColor; - property BackgroundImage : TBitmap - read FBackgroundImage write SetBackgroundImage; - property BackgroundMethod : TVpBackgroundMethod - read FBackgroundMethod write SetBackgroundMethod; - property BorderStyle : TBorderStyle - read FBorderStyle write SetBorderStyle; - property ButtonHeight : Integer - read FButtonHeight write SetButtonHeight; - property DrawingStyle : TVpFolderDrawingStyle - read FDrawingStyle write SetDrawingStyle; - property FolderCollection : TVpCollection - read FFolders write FFolders; - property Images : TImageList - read FImages write SetImages; - property ItemFont : TFont - read FItemFont write SetItemFont; - property ItemSpacing : Word - read FItemSpacing write SetItemSpacing; - property PlaySounds : Boolean - read FPlaySounds write FPlaySounds; - property ScrollDelta : Integer - read FScrollDelta write SetScrollDelta default 2; - property SelectedItem : Integer - read FSelectedItem write FSelectedItem; - property SelectedItemFont : TFont - read FSelectedItemFont write SetSelectedItemFont; - property ShowButtons : Boolean - read FShowButtons write FShowButtons; - property SoundAlias : string - read FSoundAlias write FSoundAlias; -{ property Storage : TOvcAbstractStore - read FStorage write SetStorage;} + property ActiveFolder: Integer read FActiveFolder write SetActiveFolder; + property AllowRearrange: Boolean read FAllowRearrange write FAllowRearrange; + property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor; + property BackgroundImage: TBitmap read FBackgroundImage write SetBackgroundImage; + property BackgroundMethod: TVpBackgroundMethod read FBackgroundMethod write SetBackgroundMethod; + property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle; + property ButtonHeight: Integer read FButtonHeight write SetButtonHeight; + property DrawingStyle: TVpFolderDrawingStyle read FDrawingStyle write SetDrawingStyle; + property FolderCollection: TVpCollection read FFolders write FFolders; + property Images: TImageList read FImages write SetImages; + property ItemFont: TFont read FItemFont write SetItemFont; + property ItemSpacing: Word read FItemSpacing write SetItemSpacing; + property PlaySounds: Boolean read FPlaySounds write FPlaySounds; + property ScrollDelta: Integer read FScrollDelta write SetScrollDelta default 2; + property SelectedItem: Integer read FSelectedItem write FSelectedItem; + property SelectedItemFont: TFont read FSelectedItemFont write SetSelectedItemFont; + property ShowButtons: Boolean read FShowButtons write FShowButtons; + property SoundAlias: string read FSoundAlias write FSoundAlias; +{ property Storage: TOvcAbstractStore read FStorage write SetStorage;} {inherited Events} property AfterEnter; @@ -389,27 +338,19 @@ type property OnMouseWheel; {events} - property OnArrange : TNotifyEvent - read FOnArrange write FOnArrange; - property OnDragDrop : TVpNABDragDropEvent - read FOnDragDrop write FOnDragDrop; - property OnDragOver : TVpNABDragOverEvent - read FOnDragOver write FOnDragOver; - property OnFolderClick : TVpFolderClickEvent - read FOnFolderClick write FOnFolderClick; - property OnItemClick : TVpItemClickEvent - read FOnItemClick write FOnItemClick; - property OnFolderChange : TVpFolderChangeEvent - read FOnFolderChange write FOnFolderChange; - property OnFolderChanged : TVpFolderChangedEvent - read FOnFolderChanged write FOnFolderChanged; - property OnMouseOverItem : TVpMouseOverItemEvent - read FOnMouseOverItem write FOnMouseOverItem; + property OnArrange: TNotifyEvent read FOnArrange write FOnArrange; + property OnDragDrop: TVpNABDragDropEvent read FOnDragDrop write FOnDragDrop; + property OnDragOver: TVpNABDragOverEvent read FOnDragOver write FOnDragOver; + property OnFolderClick: TVpFolderClickEvent read FOnFolderClick write FOnFolderClick; + property OnItemClick: TVpItemClickEvent read FOnItemClick write FOnItemClick; + property OnFolderChange: TVpFolderChangeEvent read FOnFolderChange write FOnFolderChange; + property OnFolderChanged: TVpFolderChangedEvent read FOnFolderChanged write FOnFolderChanged; + property OnMouseOverItem: TVpMouseOverItemEvent read FOnMouseOverItem write FOnMouseOverItem; public - constructor Create(AOwner : TComponent); override; + constructor Create(AOwner: TComponent); override; destructor Destroy; override; - procedure SetBounds(ALeft, ATop, AWidth, AHeight : Integer); override; + procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; { Declared public because TControl's DragDrop is public. } procedure DragDrop(Source: TObject; X, Y: Integer); override; @@ -417,35 +358,26 @@ type procedure ItemChanged(FolderIndex, ItemIndex: Integer); procedure FolderChanged(FolderIndex: Integer); procedure EndUpdate; - function GetFolderAt(X, Y : Integer) : Integer; - function GetItemAt(X, Y : Integer) : Integer; + function GetFolderAt(X, Y: Integer): Integer; + function GetItemAt(X, Y: Integer): Integer; function Container: TVpFolderContainer; - procedure InsertFolder(const ACaption : string; AFolderIndex : Integer); - procedure AddFolder(const ACaption : string); - procedure RemoveFolder(AFolderIndex : Integer); - procedure RenameFolder(AFolderIndex : Integer); - procedure InsertItem(const ACaption : string; AFolderIndex, AItemIndex, - AIconIndex : Integer); - procedure AddItem(const ACaption : string; AFolderIndex, - AIconIndex : Integer); - procedure RemoveItem(AFolderIndex, AItemIndex : Integer); - procedure InvalidateItem(FolderIndex, ItemIndex : Integer); - procedure RenameItem(AFolderIndex, AItemIndex : Integer); - property ActiveItem : Integer - read FActiveItem; - property Containers[Index: Integer]: TVpFolderContainer - read GetContainer; - property Folders[Index : Integer] : TVpNavFolder - read GetFolder; - property FolderCount : Integer - read GetFolderCount; - property PreviousFolder : Integer - read FPreviousFolder; - property PreviousItem : Integer - read FPreviousItem; + procedure InsertFolder(const ACaption: string; AFolderIndex: Integer); + procedure AddFolder(const ACaption: string); + procedure RemoveFolder(AFolderIndex: Integer); + procedure RenameFolder(AFolderIndex: Integer); + procedure InsertItem(const ACaption: string; AFolderIndex, AItemIndex, AIconIndex: Integer); + procedure AddItem(const ACaption: string; AFolderIndex, AIconIndex: Integer); + procedure RemoveItem(AFolderIndex, AItemIndex: Integer); + procedure InvalidateItem(FolderIndex, ItemIndex: Integer); + procedure RenameItem(AFolderIndex, AItemIndex: Integer); + property ActiveItem: Integer read FActiveItem; + property Containers[Index: Integer]: TVpFolderContainer read GetContainer; + property Folders[Index: Integer]: TVpNavFolder read GetFolder; + property FolderCount: Integer read GetFolderCount; + property PreviousFolder : Integer read FPreviousFolder; + property PreviousItem : Integer read FPreviousItem; end; - TVpNavBar = class(TVpCustomNavBar) published property ActiveFolder; @@ -519,19 +451,13 @@ const nabTimerInterval = 200; {DrawNavTab - returns the usable text area inside the tab rect.} -function DrawNavTab(Canvas: TCanvas; - const Client: TRect; - BevelWidth: Integer; - TabColor: TColor; - TabNumber: Integer; - CoolTab, - IsFocused, - IsMouseOver: Boolean): TRect; +function DrawNavTab(Canvas: TCanvas; const Client: TRect; BevelWidth: Integer; + TabColor: TColor; TabNumber: Integer; CoolTab, IsFocused, IsMouseOver: Boolean): TRect; var R: TRect; - {$IFNDEF VERSION4} - Points: array[1..5] of TPoint; - {$ENDIF} + {$IFNDEF VERSION4} + Points: array[1..5] of TPoint; + {$ENDIF} begin R := Client; @@ -541,15 +467,16 @@ begin Pen.Color := TabColor; {fill the tab area} - Polygon([Point(R.Left, R.Bottom), - Point(R.Left, R.Top), - Point(R.Right, R.Top), - Point(R.Right, R.Bottom)]); + Polygon([ + Point(R.Left, R.Bottom), + Point(R.Left, R.Top), + Point(R.Right, R.Top), + Point(R.Right, R.Bottom) + ]); if CoolTab then - {Draw Cool Tabs} begin - + { --- Draw Cool Tabs --- } Pen.Color := clBlack; {Draw the bottom, left line} @@ -557,65 +484,71 @@ begin LineTo(R.Left + 5, R.Bottom - 1); {Draw the bottom, left curve} - {$IFNDEF VERSION4} + {$IFNDEF VERSION4} Points[1] := Point(R.Left + 5, R.Bottom - 1); Points[2] := Point(R.Left + 11, R.Bottom - 2); Points[3] := Point(R.Left + 12, R.Bottom - 7); Points[4] := Point(R.Left + 13, R.Bottom - 9); - {$IFDEF CBuilder} - Canvas.PolyBezier(Points); - {$ELSE} - Canvas.Polyline(Points); - {$ENDIF} + {$IFDEF CBuilder} + Canvas.PolyBezier(Points); {$ELSE} - PolyBezier([Point(R.Left + 5, R.Bottom - 1), {StartPoint} - Point(R.Left + 11, R.Bottom - 2), {ControlPoint} - Point(R.Left + 12, R.Bottom - 7), {ControlPoint} - Point(R.Left + 13, R.Bottom - 9)]); {EndPoint} + Canvas.Polyline(Points); {$ENDIF} + {$ELSE} + PolyBezier([ + Point(R.Left + 5, R.Bottom - 1), {StartPoint} + Point(R.Left + 11, R.Bottom - 2), {ControlPoint} + Point(R.Left + 12, R.Bottom - 7), {ControlPoint} + Point(R.Left + 13, R.Bottom - 9) {EndPoint} + ]); + {$ENDIF} {Draw the left side of the tab} MoveTo(R.Left + 13, R.Bottom - 9); LineTo(R.Left + 13, R.Top + 9); {Draw the top, left corner of the tab} - {$IFNDEF VERSION4} - Points[1] := Point(R.Left + 13, R.Top + 9); - Points[2] := Point(R.Left + 14, R.Top + 7); - Points[3] := Point(R.Left + 15, R.Top + 2); - Points[4] := Point(R.Left + 21, R.Top + 1); - {$IFDEF CBuilder} - Canvas.PolyBezier(Points); - {$ELSE} - Canvas.Polyline(Points); - {$ENDIF} + {$IFNDEF VERSION4} + Points[1] := Point(R.Left + 13, R.Top + 9); + Points[2] := Point(R.Left + 14, R.Top + 7); + Points[3] := Point(R.Left + 15, R.Top + 2); + Points[4] := Point(R.Left + 21, R.Top + 1); + {$IFDEF CBuilder} + Canvas.PolyBezier(Points); {$ELSE} - PolyBezier([Point(R.Left + 13, R.Top + 9), {StartPoint} - Point(R.Left + 14, R.Top + 7), {ControlPoint} - Point(R.Left + 15, R.Top + 2), {ControlPoint} - Point(R.Left + 21, R.Top + 1)]); {EndPoint} + Canvas.Polyline(Points); {$ENDIF} + {$ELSE} + PolyBezier([ + Point(R.Left + 13, R.Top + 9), {StartPoint} + Point(R.Left + 14, R.Top + 7), {ControlPoint} + Point(R.Left + 15, R.Top + 2), {ControlPoint} + Point(R.Left + 21, R.Top + 1) {EndPoint} + ]); + {$ENDIF} {Draw the top of the tab} - MoveTo(R.Left + 21, R.Top + 1); - LineTo(R.Right - 16, R.Top + 1); + MoveTo(R.Left + 21, R.Top + 1); + LineTo(R.Right - 16, R.Top + 1); {Draw the Top, Right corner of the tab} - {$IFNDEF VERSION4} - Points[1] := Point(R.Right - 16, R.Top + 1); - Points[2] := Point(R.Right - 10, R.Top + 2); - Points[3] := Point(R.Right - 9, R.Top + 7); - Points[4] := Point(R.Right - 8, R.Top + 9); - {$IFDEF CBuilder} - Canvas.PolyBezier(Points); - {$ELSE} - Canvas.Polyline(Points); - {$ENDIF} + {$IFNDEF VERSION4} + Points[1] := Point(R.Right - 16, R.Top + 1); + Points[2] := Point(R.Right - 10, R.Top + 2); + Points[3] := Point(R.Right - 9, R.Top + 7); + Points[4] := Point(R.Right - 8, R.Top + 9); + {$IFDEF CBuilder} + Canvas.PolyBezier(Points); {$ELSE} - PolyBezier([Point(R.Right - 16, R.Top + 1), {StartPoint} - Point(R.Right - 10, R.Top + 2), {ControlPoint} - Point(R.Right - 9, R.Top + 7), {ControlPoint} - Point(R.Right - 8, R.Top + 9)]); {EndPoint} + Canvas.Polyline(Points); + {$ENDIF} + {$ELSE} + PolyBezier([ + Point(R.Right - 16, R.Top + 1), {StartPoint} + Point(R.Right - 10, R.Top + 2), {ControlPoint} + Point(R.Right - 9, R.Top + 7), {ControlPoint} + Point(R.Right - 8, R.Top + 9) {EndPoint} + ]); {$ENDIF} {Draw the right side of the tab} @@ -624,36 +557,40 @@ begin {Draw the bottom, Right curve of the tab which should finish against the right side.} - {$IFNDEF VERSION4} - Points[1] := Point(R.Right - 8, R.Bottom - 9); - Points[2] := Point(R.Right - 7, R.Bottom - 7); - Points[3] := Point(R.Right - 6, R.Bottom - 2); - Points[4] := Point(R.Right, R.Bottom - 1); - {$IFDEF CBuilder} - Canvas.PolyBezier(Points); - {$ELSE} - Canvas.Polyline(Points); - {$ENDIF} + {$IFNDEF VERSION4} + Points[1] := Point(R.Right - 8, R.Bottom - 9); + Points[2] := Point(R.Right - 7, R.Bottom - 7); + Points[3] := Point(R.Right - 6, R.Bottom - 2); + Points[4] := Point(R.Right, R.Bottom - 1); + {$IFDEF CBuilder} + Canvas.PolyBezier(Points); {$ELSE} - PolyBezier([Point(R.Right - 8, R.Bottom - 9), {StartPoint} - Point(R.Right - 7, R.Bottom - 7), {ControlPoint} - Point(R.Right - 6, R.Bottom - 2), {ControlPoint} - Point(R.Right, R.Bottom - 1)]); {EndPoint} + Canvas.Polyline(Points); {$ENDIF} - - end else begin - {Draw Standard Tabs} - + {$ELSE} + PolyBezier([ + Point(R.Right - 8, R.Bottom - 9), {StartPoint} + Point(R.Right - 7, R.Bottom - 7), {ControlPoint} + Point(R.Right - 6, R.Bottom - 2), {ControlPoint} + Point(R.Right, R.Bottom - 1) {EndPoint} + ]); + {$ENDIF} + end + else + begin + {Draw Standard Tabs} if TabNumber > 0 then begin Brush.Color := TabColor; Brush.Style := bsSolid; Pen.Color := TabColor; {fill the tab area} - Polygon([Point(R.Left, R.Bottom), - Point(R.Left, R.Top), - Point(R.Right, R.Top), - Point(R.Right, R.Bottom)]); + Polygon([ + Point(R.Left, R.Bottom), + Point(R.Left, R.Top), + Point(R.Right, R.Top), + Point(R.Right, R.Bottom) + ]); end; Brush.Color := TabColor; @@ -661,44 +598,50 @@ begin {Draw Tab} Pen.Color := TabColor; - Polygon([Point(R.Left + 10, R.Bottom - 1), - Point(R.Left + 10, R.Top + 3), - Point(R.Left + 12, R.Top + 1), - Point(R.Right-4, R.Top+1), - Point(R.Right-2, R.Top+3), - Point(R.Right-2, R.Bottom-1)]); + Polygon([ + Point(R.Left + 10, R.Bottom - 1), + Point(R.Left + 10, R.Top + 3), + Point(R.Left + 12, R.Top + 1), + Point(R.Right - 4, R.Top + 1), + Point(R.Right - 2, R.Top + 3), + Point(R.Right - 2, R.Bottom - 1) + ]); {highlight tab} Pen.Color := clBtnHighlight; - PolyLine([Point(R.Left, R.Bottom - 2), - Point(R.Left + 8, R.Bottom - 2), - Point(R.Left + 9, R.Bottom - 3), - Point(R.Left + 9, R.Top + 3), - Point(R.Left + 11, R.Top + 1), - Point(R.Right - 1, R.Top + 1)]); + PolyLine([ + Point(R.Left, R.Bottom - 2), + Point(R.Left + 8, R.Bottom - 2), + Point(R.Left + 9, R.Bottom - 3), + Point(R.Left + 9, R.Top + 3), + Point(R.Left + 11, R.Top + 1), + Point(R.Right - 1, R.Top + 1) + ]); {draw border} Pen.Color := clBlack; - PolyLine([Point(R.Left, R.Bottom - 1), - Point(R.Left + 9, R.Bottom - 1), - Point(R.Left + 10, R.Bottom - 2), - Point(R.Left + 10, R.Top + 4), - Point(R.Left + 11, R.Top + 3), - Point(R.Left + 12, R.Top + 2), - Point(R.Right-2, R.Top + 2), - Point(R.Right-1, R.Top + 3), - Point(R.Right-1, R.Bottom-1)]); + PolyLine([ + Point(R.Left, R.Bottom - 1), + Point(R.Left + 9, R.Bottom - 1), + Point(R.Left + 10, R.Bottom - 2), + Point(R.Left + 10, R.Top + 4), + Point(R.Left + 11, R.Top + 3), + Point(R.Left + 12, R.Top + 2), + Point(R.Right - 2, R.Top + 2), + Point(R.Right - 1, R.Top + 3), + Point(R.Right - 1, R.Bottom - 1)]); {draw shadow} end; end; - 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); end; + {===== TVpFolderContainer ===========================================} + constructor TVpFolderContainer.Create(AOwner: TComponent); begin inherited Create(AOwner); @@ -737,15 +680,16 @@ begin end; end; + {===== TRenameEdit ===================================================} -constructor TVpRenameEdit.Create(AOwner : TComponent); +constructor TVpRenameEdit.Create(AOwner: TComponent); begin inherited Create(AOwner); Visible := False; WantReturns := False; FolderIndex := -1; - ItemIndex := -1; + ItemIndex := -1; end; {=====} @@ -754,23 +698,26 @@ begin if Key = #13 then begin Key := #0; DoExit; - end else if Key = #27 then begin + end else + if Key = #27 then begin FolderIndex := -1; - ItemIndex := -1; + ItemIndex := -1; Key := #0; DoExit; end; + inherited; // wp: was missing end; + {===== Miscellaneous routines ========================================} -function RectWidth(Rect : TRect) : Integer; +function RectWidth(Rect: TRect): Integer; begin Result := Rect.Right - Rect.Left; end; {=====} -function RectHeight(Rect : TRect) : Integer; +function RectHeight(Rect: TRect): Integer; begin Result := Rect.Bottom - Rect.Top; end; @@ -778,12 +725,12 @@ end; {===== TVpNavBtnItem ===============================================} -constructor TVpNavBtnItem.Create(Collection : TCollection); +constructor TVpNavBtnItem.Create(Collection: TCollection); begin inherited Create(Collection); FFolder := TVpNavFolder((TVpCollection(Collection)).GetOwner); FIconIndex := -1; - Name := 'Item' + IntToStr(FFolder.Index) + '-' + IntToStr(Index); + Name := Format('Item%d-%d', [FFolder.Index, Index]); FFolder.FNavBar.Invalidate; end; {=====} @@ -812,7 +759,7 @@ begin end; {=====} -procedure TVpNavBtnItem.SetCaption(const Value : string); +procedure TVpNavBtnItem.SetCaption(const Value: string); begin if Value <> FCaption then begin FCaption := Value; @@ -822,7 +769,7 @@ begin end; {=====} -procedure TVpNavBtnItem.SetIconIndex(Value : Integer); +procedure TVpNavBtnItem.SetIconIndex(Value: Integer); begin if Value <> FIconIndex then begin FIconIndex := Value; @@ -831,9 +778,10 @@ begin end; end; + {===== TVpNavBtnFolder =============================================} -constructor TVpNavFolder.Create(Collection : TCollection); +constructor TVpNavFolder.Create(Collection: TCollection); begin inherited Create(Collection); RegisterClass(TVpFolderContainer); @@ -856,7 +804,6 @@ begin FNavBar.ActiveFolder := 0 else FNavBar.ActiveFolder := -1; - FNavBar.FolderChanged(Index); end; @@ -866,13 +813,13 @@ begin end; {=====} -function TVpNavFolder.GetItem(Index : Integer) : TVpNavBtnItem; +function TVpNavFolder.GetItem(Index: Integer): TVpNavBtnItem; begin Result := TVpNavBtnItem(FItems[Index]); end; {=====} -function TVpNavFolder.GetItemCount : Integer; +function TVpNavFolder.GetItemCount: Integer; begin Result := FItems.Count; end; @@ -887,13 +834,13 @@ begin end; {=====} -procedure TVpNavFolder.lfGetEditorCaption(var Caption : string); +procedure TVpNavFolder.lfGetEditorCaption(var Caption: string); begin Caption := RSEditingItems; end; {=====} -procedure TVpNavFolder.lfItemChange(Sender : TObject); +procedure TVpNavFolder.lfItemChange(Sender: TObject); begin if (TVpCollection(Collection).GetOwner is TComponent) then if not (csDestroying in @@ -924,7 +871,7 @@ begin end; {=====} -procedure TVpNavFolder.SetCaption(const Value : string); +procedure TVpNavFolder.SetCaption(const Value: string); begin if FCaption <> Value then begin FCaption := Value; @@ -934,7 +881,7 @@ begin end; {=====} -procedure TVpNavFolder.SetEnabled(Value : Boolean); +procedure TVpNavFolder.SetEnabled(Value: Boolean); begin if Value <> FEnabled then begin FEnabled := Value; @@ -956,7 +903,7 @@ begin FNavBar.FContainers.Delete(FContainerIndex); FContainerIndex := -1; end; - FNavBar.FolderChanged(Index); + FNavBar.FolderChanged(Index); end; end; end; @@ -977,7 +924,7 @@ begin end; {=====} -procedure TVpNavFolder.SetIconSize(Value : TVpIconSize); +procedure TVpNavFolder.SetIconSize(Value: TVpIconSize); begin if FIconSize <> Value then begin FIconSize := Value; @@ -987,15 +934,17 @@ begin end; {=====} -procedure TVpNavFolder.SetItem(Index : Integer; Value : TVpNavBtnItem); +procedure TVpNavFolder.SetItem(Index: Integer; Value: TVpNavBtnItem); begin SetItem(Index, Value); end; + {===== TVpNavBar ================================================} -constructor TVpCustomNavBar.Create(AOwner : TComponent); + +constructor TVpCustomNavBar.Create(AOwner: TComponent); var - HSnd : THandle; + HSnd: THandle; begin inherited Create(AOwner); @@ -1025,7 +974,7 @@ begin FSelectedItemFont.OnChange := nabFontChanged; FSelectedItemFont.Color := FItemFont.Color; FSelectedItemFont.Style := FItemFont.Style; - FSelectedItemFont.Size := FItemFont.Size; + FSelectedItemFont.Size := FItemFont.Size; {force drivers to load by playing empty wave data} { HSnd := FindResource(HInstance, 'VPEMPTYWAVE', RT_RCDATA); @@ -1042,7 +991,7 @@ begin Visible := False; Parent := Self; OnClick := nabScrollUpBtnClick; - Glyph.Handle := LoadBaseBitmap('VPUPARROW'); + Glyph.LoadFromResourceName(HINSTANCE, 'VPUPARROW'); NumGlyphs := 1; Left := -20; Height := 15; @@ -1054,7 +1003,7 @@ begin Visible := False; Parent := Self; OnClick := nabScrollDownBtnClick; - Glyph.Handle := LoadBaseBitmap('VPDOWNARROW'); + Glyph.LoadFromResourceName(HINSTANCE, 'VPDOWNARROW'); NumGlyphs := 1; Left := -20; Height := 15; @@ -1072,7 +1021,7 @@ begin Width := 120; ParentColor := False; - FAllowRearrange := True; + FAllowRearrange := True; FBackgroundColor := clInactiveCaption; FBackgroundImage := TBitmap.Create; FBackgroundMethod := bmNormal; @@ -1147,7 +1096,7 @@ end; {=====} {$IFNDEF LCL} -procedure TVpCustomNavBar.CMDesignHitTest(var Msg : TCMDesignHitTest); +procedure TVpCustomNavBar.CMDesignHitTest(var Msg: TCMDesignHitTest); begin Msg.Result := LongInt(nabOverButton); end; @@ -1163,7 +1112,6 @@ end; procedure TVpCustomNavBar.CMParentColorChanged(var Message: {$IFDEF LCL}TLMessage{$ELSE}TMessage{$ENDIF}); begin inherited; - if ParentColor then SetBackgroundColor(Color); end; @@ -1172,10 +1120,8 @@ end; procedure TVpCustomNavBar.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); - with Params do Style := LongInt(Style) or BorderStyles[FBorderStyle]; - if NewStyleControls {and Ctl3D }and (FBorderStyle = bsSingle) then begin Params.Style := Params.Style and not WS_BORDER; Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE; @@ -1187,7 +1133,6 @@ procedure TVpCustomNavBar.CreateWnd; begin if (csDestroying in ComponentState) then exit; inherited CreateWnd; - nabRecalcDisplayNames; end; {=====} @@ -1213,8 +1158,7 @@ begin end; {=====} -function TVpCustomNavBar.AddContainer( - Container: TVpFolderContainer): Integer; +function TVpCustomNavBar.AddContainer(Container: TVpFolderContainer): Integer; begin result := FContainers.Add(Container); end; @@ -1234,44 +1178,40 @@ begin end; {=====} -procedure TVpCustomNavBar.DoFolderChange(Index : Integer; - var AllowChange: Boolean); +procedure TVpCustomNavBar.DoFolderChange(Index: Integer; var AllowChange: Boolean); begin if Assigned(FOnFolderChange) then FOnFolderChange(Self, Index, AllowChange, nabDragFromItem <> -1); end; {=====} -procedure TVpCustomNavBar.DoFolderChanged(Index : Integer); +procedure TVpCustomNavBar.DoFolderChanged(Index: Integer); begin if Assigned(FOnFolderChanged) then FOnFolderChanged(Self, Index); end; {=====} -procedure TVpCustomNavBar.DoFolderClick(Button : TMouseButton; - Shift : TShiftState; - Index : Integer); +procedure TVpCustomNavBar.DoFolderClick(Button: TMouseButton; Shift: TShiftState; + Index: Integer); begin if Assigned(FOnFolderClick) then FOnFolderClick(Self, Button, Shift, Index); end; {=====} -procedure TVpCustomNavBar.DoItemClick(Button : TMouseButton; - Shift : TShiftState; - Index : Integer); +procedure TVpCustomNavBar.DoItemClick(Button: TMouseButton; Shift: TShiftState; + Index: Integer); begin if Assigned(FOnItemClick) then FOnItemClick(Self, Button, Shift, Index); end; {=====} -procedure TVpCustomNavBar.DoMouseOverItem(X, Y, ItemIndex : Integer); +procedure TVpCustomNavBar.DoMouseOverItem(X, Y, ItemIndex: Integer); begin if Assigned(FOnMouseOverItem) then - FOnMouseOverItem(Self, - Folders[ActiveFolder].Items[GetItemAt(X, Y)]); + FOnMouseOverItem(Self, Folders[ActiveFolder].Items[GetItemAt(X, Y)]); end; {=====} @@ -1282,27 +1222,27 @@ begin end; {=====} -function TVpCustomNavBar.GetFolderCount : Integer; +function TVpCustomNavBar.GetFolderCount: Integer; begin Result := FFolders.Count; end; {=====} -function TVpCustomNavBar.GetFolder(Index : Integer) : TVpNavFolder; +function TVpCustomNavBar.GetFolder(Index: Integer): TVpNavFolder; begin Result := TVpNavFolder(FFolders.GetItem(Index)); end; {=====} -function TVpCustomNavBar.GetFolderAt(X, Y : Integer) : Integer; +function TVpCustomNavBar.GetFolderAt(X, Y: Integer): Integer; var - Dummy : Integer; + Dummy: Integer; begin nabGetHitTest(X, Y, Result, Dummy); end; {=====} -function TVpCustomNavBar.GetContainer(Index: Integer):TVpFolderContainer; +function TVpCustomNavBar.GetContainer(Index: Integer): TVpFolderContainer; begin try result := FContainers[Index]; @@ -1312,9 +1252,9 @@ begin end; {=====} -function TVpCustomNavBar.GetItemAt(X, Y : Integer) : Integer; +function TVpCustomNavBar.GetItemAt(X, Y: Integer): Integer; var - Dummy : Integer; + Dummy: Integer; begin nabGetHitTest(X, Y, Dummy, Result); end; @@ -1323,17 +1263,16 @@ end; function TVpCustomNavBar.Container: TVpFolderContainer; begin if Folders[FActiveFolder].FolderType = ftContainer then - result := FContainers[Folders[FActiveFolder].ContainerIndex] + Result := FContainers[Folders[FActiveFolder].ContainerIndex] else - result := nil; + Result := nil; end; {=====} -procedure TVpCustomNavBar.InsertFolder(const ACaption : string; - AFolderIndex : Integer); +procedure TVpCustomNavBar.InsertFolder(const ACaption: string; AFolderIndex: Integer); {$IFNDEF VERSION4} var - I : Integer; + I: Integer; {$ENDIF} begin {$IFNDEF VERSION4} @@ -1355,7 +1294,7 @@ begin end; {=====} -procedure TVpCustomNavBar.AddFolder(const ACaption : string); +procedure TVpCustomNavBar.AddFolder(const ACaption: string); var NewFolder: TVpNavFolder; begin @@ -1370,7 +1309,7 @@ begin end; {=====} -procedure TVpCustomNavBar.RemoveFolder(AFolderIndex : Integer); +procedure TVpCustomNavBar.RemoveFolder(AFolderIndex: Integer); var Folder: TVpNavFolder; begin @@ -1384,7 +1323,7 @@ end; procedure TVpCustomNavBar.RenameFolder(AFolderIndex: Integer); var - Folder : TVpNavFolder; + Folder: TVpNavFolder; begin Folder := Folders[AFolderIndex]; nabEdit.FolderIndex := AFolderIndex; @@ -1402,13 +1341,12 @@ begin end; {=====} -procedure TVpCustomNavBar.InsertItem(const ACaption : string; - AFolderIndex, AItemIndex, - AIconIndex : Integer); +procedure TVpCustomNavBar.InsertItem(const ACaption: string; + AFolderIndex, AItemIndex, AIconIndex: Integer); var - AFolder : TVpNavFolder; + AFolder: TVpNavFolder; {$IFNDEF VERSION4} - I : Integer; + I: Integer; {$ENDIF} begin AFolder := Folders[AFolderIndex]; @@ -1426,9 +1364,8 @@ begin end; {=====} -procedure TVpCustomNavBar.AddItem(const ACaption : string; - AFolderIndex, - AIconIndex : Integer); +procedure TVpCustomNavBar.AddItem(const ACaption: string; + AFolderIndex, AIconIndex: Integer); var AFolder : TVpNavFolder; AItem: TVpNavBtnItem; @@ -1441,9 +1378,9 @@ begin end; {=====} -procedure TVpCustomNavBar.RemoveItem(AFolderIndex, AItemIndex : Integer); +procedure TVpCustomNavBar.RemoveItem(AFolderIndex, AItemIndex: Integer); var - Folder : TVpNavFolder; + Folder: TVpNavFolder; begin Folder := TVpNavFolder(FolderCollection.GetItem(AFolderIndex)); Folder.Items[AItemIndex].Free; @@ -1453,10 +1390,10 @@ begin end; {=====} -procedure TVpCustomNavBar.InvalidateItem(FolderIndex, ItemIndex : Integer); +procedure TVpCustomNavBar.InvalidateItem(FolderIndex, ItemIndex: Integer); var - F : TRect; - R : TRect; + F: TRect; + R: TRect; begin R := TVpNavBtnItem(Folders[FolderIndex].Items[ItemIndex]).FIconRect; {expand rect} @@ -1465,8 +1402,8 @@ begin Inc(R.Bottom, 2); Inc(R.Right, 2); { Might be a hidden folder. } - if (not ((FolderCount = 1) and (Folders[0].Caption = ''))) - or (csDesigning in ComponentState) then + if (not ((FolderCount = 1) and (Folders[0].Caption = ''))) or (csDesigning in ComponentState) + then F := nabGetFolderArea(FolderIndex) else F := R; @@ -1477,9 +1414,9 @@ begin end; {=====} -procedure TVpCustomNavBar.RenameItem(AFolderIndex, AItemIndex : Integer); +procedure TVpCustomNavBar.RenameItem(AFolderIndex, AItemIndex: Integer); var - Item : TVpNavBtnItem; + Item: TVpNavBtnItem; begin Item := Folders[AFolderIndex].Items[AItemIndex]; nabEdit.FolderIndex := AFolderIndex; @@ -1498,19 +1435,18 @@ begin end; {=====} -function GetLargeIconDisplayName(Canvas : TCanvas; - Rect : TRect; - const Name : string) : string; - {-given a string, and a rectangle, find the string that can be displayed - using two lines. Add ellipsis to the end of each line if necessary and - possible} +{ Given a string, and a rectangle, find the string that can be displayed + using two lines. Add ellipsis to the end of each line if necessary and + possible} +function GetLargeIconDisplayName(Canvas: TCanvas; Rect: TRect; + const Name: string): string; var - TestRect : TRect; - SH, DH : Integer; - Buf : array[0..255] of Char; - I : Integer; - TempName : string; - Temp2 : string; + TestRect: TRect; + SH, DH: Integer; + Buf: array[0..255] of Char; + I: Integer; + TempName: string; + Temp2: string; begin TempName := Trim(Name); {get single line height} @@ -1520,8 +1456,7 @@ begin Right := 1; Bottom := 1; end; - SH := DrawText(Canvas.Handle, 'W W', 3, TestRect, - DT_SINGLELINE or DT_CALCRECT); + SH := DrawText(Canvas.Handle, 'W W', 3, TestRect, DT_SINGLELINE or DT_CALCRECT); {get double line height} with TestRect do begin @@ -1530,64 +1465,52 @@ begin Right := 1; Bottom := 1; end; - DH := DrawText(Canvas.Handle, 'W W', 3, TestRect, - DT_WORDBREAK or DT_CALCRECT); + DH := DrawText(Canvas.Handle, 'W W', 3, TestRect, DT_WORDBREAK or DT_CALCRECT); {see if the text can fit within the existing rect without growing} TestRect := Rect; StrPLCopy(Buf, TempName, 255); - DrawText(Canvas.Handle, Buf, Length(TempName), TestRect, - DT_WORDBREAK or DT_CALCRECT); + DrawText(Canvas.Handle, Buf, Length(TempName), TestRect, DT_WORDBREAK or DT_CALCRECT); I := Pos(' ', TempName); if (RectHeight(TestRect) = SH) or (I < 2) then Result := GetDisplayString(Canvas, TempName, 1, RectWidth(Rect)) else begin {the first line only has ellipsis if there's only one word on it and that word won't fit} - Temp2 := GetDisplayString(Canvas, Copy(TempName, 1, I-1), 1, - RectWidth(Rect)); + Temp2 := GetDisplayString(Canvas, Copy(TempName, 1, I-1), 1, RectWidth(Rect)); if CompareStr(Temp2, Copy(TempName, 1, I-1)) <> 0 then begin - Result := GetDisplayString(Canvas, Copy(TempName, 1, I-1), 1, - RectWidth(Rect)) + - ' ' + - GetDisplayString(Canvas, Copy(TempName, I+1, - Length(TempName) - I), 1, RectWidth(Rect)); + Result := GetDisplayString(Canvas, Copy(TempName, 1, I-1), 1, RectWidth(Rect)) + ' ' + + GetDisplayString(Canvas, Copy(TempName, I+1, Length(TempName) - I), 1, RectWidth(Rect)); end else begin {2 or more lines, and the first line isn't getting an ellipsis} - if (RectHeight(TestRect) = DH) and - (RectWidth(TestRect) <= RectWidth(Rect)) then + if (RectHeight(TestRect) = DH) and (RectWidth(TestRect) <= RectWidth(Rect)) then {it will fit} Result := TempName else begin {it won't fit, but the first line wraps OK - 2nd line needs an ellipsis} TestRect.Right := Rect.Right + 1; - while (RectWidth(TestRect) > RectWidth(Rect)) or - (RectHeight(TestRect) > DH) do begin + while (RectWidth(TestRect) > RectWidth(Rect)) or (RectHeight(TestRect) > DH) do + begin if Length(TempName) > 1 then begin TestRect := Rect; Delete(TempName, Length(TempName), 1); TempName := Trim(TempName); StrPLCopy(Buf, TempName + '...', 255); - DrawText(Canvas.Handle, Buf, Length(TempName) + 3, TestRect, - DT_WORDBREAK or DT_CALCRECT); + DrawText(Canvas.Handle, Buf, Length(TempName) + 3, TestRect, DT_WORDBREAK or DT_CALCRECT); Result := TempName + '...'; end else begin Result := TempName + '..'; TestRect := Rect; StrPLCopy(Buf, Result, 255); - DrawText(Canvas.Handle, Buf, Length(Result), TestRect, - DT_WORDBREAK or DT_CALCRECT); - if (RectWidth(TestRect) <= RectWidth(Rect)) and - (RectHeight(TestRect) > DH) then - Break; + DrawText(Canvas.Handle, Buf, Length(Result), TestRect, DT_WORDBREAK or DT_CALCRECT); + if (RectWidth(TestRect) <= RectWidth(Rect)) and (RectHeight(TestRect) > DH) then + Break; Result := TempName + '.'; TestRect := Rect; StrPLCopy(Buf, Result, 255); - DrawText(Canvas.Handle, Buf, Length(Result), TestRect, - DT_WORDBREAK or DT_CALCRECT); - if (RectWidth(TestRect) <= RectWidth(Rect)) and - (RectHeight(TestRect) > DH) then - Break; + DrawText(Canvas.Handle, Buf, Length(Result), TestRect, DT_WORDBREAK or DT_CALCRECT); + if (RectWidth(TestRect) <= RectWidth(Rect)) and (RectHeight(TestRect) > DH) then + Break; Result := TempName; end; end; @@ -1597,16 +1520,16 @@ begin end; {=====} -function TVpCustomNavBar.nabButtonRect(Index : Integer) : TRect; +function TVpCustomNavBar.nabButtonRect(Index: Integer): TRect; begin Result := Folders[Index].lfRect; end; {=====} -procedure TVpCustomNavBar.nabCommitEdit(Sender : TObject); +procedure TVpCustomNavBar.nabCommitEdit(Sender: TObject); var - Folder : TVpNavFolder; - Item : TVpNavBtnItem; + Folder: TVpNavFolder; + Item: TVpNavBtnItem; begin if not Assigned(nabEdit) then Exit; @@ -1622,20 +1545,20 @@ begin end; end; nabEdit.FolderIndex := -1; - nabEdit.ItemIndex := -1; - nabEdit.Visible := False; + nabEdit.ItemIndex := -1; + nabEdit.Visible := False; Update; end; {=====} -function TVpCustomNavBar.nabDropHitTest(X, Y : Integer) : Boolean; +function TVpCustomNavBar.nabDropHitTest(X, Y: Integer): Boolean; {given an X, Y, is this a legal spot to drop a folder?} var - I : Integer; - SpaceTop : Integer; - SpaceBottom : Integer; - OldDrop : Integer; - Folder : TVpNavFolder; + I: Integer; + SpaceTop: Integer; + SpaceBottom: Integer; + OldDrop: Integer; + Folder: TVpNavFolder; begin Result := False; {assume that X,Y aren't on a folder or item} @@ -1688,8 +1611,7 @@ begin end; {check below the last item...} - SpaceTop := - TVpNavBtnItem(Folder.Items[Folder.ItemCount - 1]).FLabelRect.Bottom+1; + SpaceTop := TVpNavBtnItem(Folder.Items[Folder.ItemCount - 1]).FLabelRect.Bottom+1; SpaceBottom := nabItemsRect.Bottom - 1; if (Y >= SpaceTop) and (Y <= SpaceBottom) then begin nabDropY := SpaceTop + 3; @@ -1709,12 +1631,11 @@ begin end; {=====} -procedure TVpCustomNavBar.nabFolderChange(Sender : TObject); +procedure TVpCustomNavBar.nabFolderChange(Sender: TObject); var ParentForm: TCustomForm; begin if not (csDestroying in ComponentState) then begin - if FolderCount = 0 then FActiveFolder := -1 else begin @@ -1736,32 +1657,31 @@ begin end; {=====} -procedure TVpCustomNavBar.nabFolderSelected(Sender : TObject; Index : Integer); +procedure TVpCustomNavBar.nabFolderSelected(Sender: TObject; Index: Integer); begin if not (csDestroying in ComponentState) then ActiveFolder := Index; end; {=====} -procedure TVpCustomNavBar.nabFontChanged(Sender : TObject); +procedure TVpCustomNavBar.nabFontChanged(Sender: TObject); begin Perform(CM_FONTCHANGED, 0, 0); end; {=====} -procedure TVpCustomNavBar.nabGetEditorCaption(var Caption : string); +procedure TVpCustomNavBar.nabGetEditorCaption(var Caption: string); begin Caption := RSEditingFolders; end; {=====} -procedure TVpCustomNavBar.nabGetHitTest(X, Y : Integer; - var FolderIndex : Integer; - var ItemIndex : Integer); +procedure TVpCustomNavBar.nabGetHitTest(X, Y: Integer; var FolderIndex: Integer; + var ItemIndex: Integer); var - I : Integer; - Item : TVpNavBtnItem; - Folder : TVpNavFolder; + I: Integer; + Item: TVpNavBtnItem; + Folder: TVpNavFolder; begin FolderIndex := -1; ItemIndex := -1; @@ -1782,8 +1702,8 @@ begin for I := nabTopItem to Folder.ItemCount-1 do begin Item := Folder.Items[I]; if PtInRect(Item.FIconRect, Point(X,Y)) or - (PtInRect(Item.FLabelRect, Point(X,Y)) and - (Item.Caption <> '')) then begin + (PtInRect(Item.FLabelRect, Point(X,Y)) and (Item.Caption <> '')) + then begin if nabExternalDrag then begin nabCursorOverItem := True; nabExternalDragItem := I; @@ -1798,7 +1718,7 @@ begin end; {=====} -function TVpCustomNavBar.nabGetFolderArea(Index : Integer) : TRect; +function TVpCustomNavBar.nabGetFolderArea(Index: Integer): TRect; var I : Integer; begin @@ -1810,7 +1730,7 @@ begin end; {=====} -procedure TVpCustomNavBar.nabImagesChanged(Sender : TObject); +procedure TVpCustomNavBar.nabImagesChanged(Sender: TObject); begin Invalidate; end; @@ -1818,7 +1738,7 @@ end; procedure TVpCustomNavBar.nabRecalcDisplayNames; var - I : Integer; + I: Integer; begin if not HandleAllocated then exit; @@ -1831,10 +1751,10 @@ begin end; {=====} -function TVpCustomNavBar.nabShowScrollDown : Boolean; +function TVpCustomNavBar.nabShowScrollDown: Boolean; var - Folder : TVpNavFolder; - Item : TVpNavBtnItem; + Folder: TVpNavFolder; + Item: TVpNavBtnItem; begin Result := False; if (FolderCount > 0) then begin @@ -1847,7 +1767,7 @@ begin end; {=====} -procedure TVpCustomNavBar.nabScrollDownBtnClick(Sender : TObject); +procedure TVpCustomNavBar.nabScrollDownBtnClick(Sender: TObject); begin if nabShowScrollDown then begin Inc(nabTopItem); @@ -1856,13 +1776,13 @@ begin end; {=====} -function TVpCustomNavBar.nabShowScrollUp : Boolean; +function TVpCustomNavBar.nabShowScrollUp: Boolean; begin Result := nabTopItem > 0; end; {=====} -procedure TVpCustomNavBar.nabScrollUpBtnClick(Sender : TObject); +procedure TVpCustomNavBar.nabScrollUpBtnClick(Sender: TObject); begin if nabTopItem > 0 then begin Dec(nabTopItem); @@ -1871,11 +1791,11 @@ begin end; {=====} -procedure TVpCustomNavBar.nabTimerEvent(Sender : TObject; Handle : Integer; - Interval : Cardinal; ElapsedTime : LongInt); +procedure TVpCustomNavBar.nabTimerEvent(Sender: TObject; Handle: Integer; + Interval: Cardinal; ElapsedTime: LongInt); var - Pt : TPoint; - Form : TCustomForm; + Pt: TPoint; + Form: TCustomForm; begin GetCursorPos(Pt); Pt := ScreenToClient(Pt); @@ -1917,9 +1837,8 @@ begin end; {=====} -procedure TVpCustomNavBar.MouseDown(Button : TMouseButton; - Shift : TShiftState; - X, Y : Integer); +procedure TVpCustomNavBar.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); begin {complete any editing} nabCommitEdit(nil); @@ -1929,8 +1848,8 @@ begin {was it a click on a folder button?} if FPreviousFolder <> -1 then begin - if Folders[FPreviousFolder].Enabled or - (csDesigning in ComponentState) then begin + if Folders[FPreviousFolder].Enabled or (csDesigning in ComponentState) then + begin if (Button = mbLeft) then begin nabMouseDown := True; Invalidate; @@ -1940,8 +1859,8 @@ begin end; if FPreviousItem <> -1 then begin - if Folders[FActiveFolder].Enabled or - (csDesigning in ComponentState) then begin + if Folders[FActiveFolder].Enabled or (csDesigning in ComponentState) then + begin if (Button = mbLeft) then begin InvalidateItem(FActiveFolder, FPreviousItem); nabMouseDown := True; @@ -1953,10 +1872,10 @@ begin end; {=====} -procedure TVpCustomNavBar.MouseMove(Shift : TShiftState; X, Y : Integer); +procedure TVpCustomNavBar.MouseMove(Shift: TShiftState; X, Y: Integer); var - ItemIndex : Integer; - FolderIndex : Integer; + ItemIndex: Integer; + FolderIndex: Integer; begin nabGetHitTest(X, Y, FolderIndex, ItemIndex); @@ -1971,14 +1890,16 @@ begin end; end; if nabScrollUpBtn.Visible then begin - if Y < (nabScrollUpBtn.Top + nabScrollUpBtn.Height)then begin + if Y < (nabScrollUpBtn.Top + nabScrollUpBtn.Height) then + begin Dec(nabTopItem); InvalidateRect(Handle, @nabItemsRect, False); inherited MouseMove(Shift, X, Y); Exit; end; end; - if (FActiveItem <> -1) and (ItemIndex = -1) and FAllowRearrange then begin + if (FActiveItem <> -1) and (ItemIndex = -1) and FAllowRearrange then + begin nabDragFromFolder := FActiveFolder; nabDragFromItem := FActiveItem; if (FolderIndex = -1) then begin @@ -1991,13 +1912,15 @@ begin end; end; end; - if (FolderIndex <> -1) and FAllowRearrange then begin + if (FolderIndex <> -1) and FAllowRearrange then + begin ActiveFolder := FolderIndex; nabDropY := -1; FActiveItem := -1; Repaint; end; - end else begin + end else + begin if ItemIndex <> -1 then begin if (ItemIndex <> FActiveItem) then begin if FActiveItem <> -1 then @@ -2041,17 +1964,16 @@ begin end; {=====} -procedure TVpCustomNavBar.MouseUp(Button : TMouseButton; Shift : TShiftState; - X, Y : Integer); +procedure TVpCustomNavBar.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); var - FolderIndex : Integer; - ItemIndex : Integer; - Folder : TVpNavFolder; - Item : TVpNavBtnItem; - FromItem : TVpNavBtnItem; - SourceName : string; + FolderIndex: Integer; + ItemIndex: Integer; + Folder: TVpNavFolder; + Item: TVpNavBtnItem; + FromItem: TVpNavBtnItem; + SourceName: string; begin - if nabMouseDown then begin try nabGetHitTest(X, Y, FolderIndex, ItemIndex); @@ -2070,8 +1992,6 @@ begin FromItem := TVpNavBtnItem(Folder.Items[nabDragFromItem]); {create the new item} Folder := Folders[nabDragToFolder]; - - Item := TVpNavBtnItem(Folder.FItems.Insert(nabDragToItem)); Item.Assign(FromItem); SourceName := FromItem.Name; @@ -2099,8 +2019,8 @@ begin end; {=====} -procedure TVpCustomNavBar.Notification(AComponent : TComponent; - Operation : TOperation); +procedure TVpCustomNavBar.Notification(AComponent: TComponent; + Operation: TOperation); begin inherited Notification(AComponent, Operation); @@ -2113,40 +2033,37 @@ end; procedure TVpCustomNavBar.Paint; var - I : Integer; - J : Integer; - X : Integer; - W : Integer; - H : Integer; - CurPos : Integer; - lOffset : Integer; - BkMode : Integer; - LabelWidth : Integer; - Flags : Integer; - MyRect : TRect; - TR : TRect; - ContainerRect : TRect; - FolderType : TVpFolderType; - BkColor : TColor; - Folder : TVpNavFolder; - Item : TVpNavBtnItem; - DrawBmp : TBitmap; - Text : string; - Buf : array[0..255] of Char; - DrawFolder : Boolean; - BM : TBitmap; - RowStart : Integer; - ILeft : Integer; - IHeight : Integer; - IWidth : integer; - + I, J: Integer; + X: Integer; + W, H: Integer; + CurPos: Integer; + lOffset: Integer; + BkMode: Integer; + LabelWidth: Integer; + Flags: Integer; + MyRect: TRect; + TR: TRect; + ContainerRect: TRect; + FolderType: TVpFolderType; + BkColor: TColor; + Folder: TVpNavFolder; + Item: TVpNavBtnItem; + DrawBmp: TBitmap; + Text: string; + Buf: array[0..255] of Char; + DrawFolder: Boolean; + BM: TBitmap; + RowStart: Integer; + ILeft: Integer; + IHeight: Integer; + IWidth: integer; begin if nabChanging then Exit; DrawBmp := TBitMap.Create; try - DrawBmp.Width := ClientWidth; + DrawBmp.Width := ClientWidth; DrawBmp.Height := ClientHeight; DrawBmp.Canvas.Font := Self.Font; @@ -2157,7 +2074,6 @@ begin MyRect := ClientRect; DrawFolder := (FolderCount > 0); - if DrawFolder then TR := nabGetFolderArea(FActiveFolder) else @@ -2165,22 +2081,19 @@ begin if FBackgroundImage.Empty or (FBackgroundMethod = bmNone) then Rectangle(TR.Left, TR.Top, TR.Right, TR.Bottom) - else begin case FBackgroundMethod of - bmNormal : - Draw(TR.Left, TR.Top, FBackgroundImage); - - bmStretch : - StretchDraw(TR, FBackgroundImage); - - bmTile : + bmNormal: + Draw(TR.Left, TR.Top, FBackgroundImage); + bmStretch: + StretchDraw(TR, FBackgroundImage); + bmTile: begin {Tile the background in the default folder} RowStart := 0; IHeight := FBackgroundImage.Height; - IWidth := FBackgroundImage.Width; - ILeft := 0; + IWidth := FBackgroundImage.Width; + ILeft := 0; while (RowStart < ClientRect.Bottom) do begin while (ILeft < ClientRect.Right) do begin Draw(TR.Left + ILeft, RowStart, FBackgroundImage); @@ -2209,58 +2122,64 @@ begin {Draw the top tabs based on the selected style...} case FDrawingStyle of - - dsDefButton : begin + dsDefButton: + begin {Draw regular buttons} //TODO: TR := DrawButtonFace(DrawBmp.Canvas, MyRect, 1, bsNew, False, // (I = FHotFolder) and nabMouseDown, False); - end; + end; - dsEtchedButton : begin - {Draw regular etched (Win98 style) buttons} - Brush.Color := clBtnFace; - FillRect(MyRect); - Pen.Color := clBtnShadow; - Brush.Style := bsClear; - Rectangle(MyRect.Left, MyRect.Top, MyRect.Right - 1, - MyRect.Bottom); - Pen.Color := clBtnHighlight; - MoveTo(MyRect.Left + 1, MyRect.Bottom - 2); - LineTo(MyRect.Left + 1, MyRect.Top + 1); - LineTo(MyRect.Right - 2, MyRect.Top + 1); - { Draw border around control. } - MoveTo(Width - 1, Top); - LineTo(Width - 1, Height - 1); - LineTo(0, Height - 1); - Pen.Color := clWindowFrame; - MoveTo(Width - 1, MyRect.Bottom); - LineTo(1, MyRect.Bottom); - LineTo(1, Height - 1); - TR := MyRect; - end; + dsEtchedButton: + begin + {Draw regular etched (Win98 style) buttons} + Brush.Color := clBtnFace; + FillRect(MyRect); + Pen.Color := clBtnShadow; + Brush.Style := bsClear; + Rectangle(MyRect.Left, MyRect.Top, MyRect.Right - 1, MyRect.Bottom); + Pen.Color := clBtnHighlight; + MoveTo(MyRect.Left + 1, MyRect.Bottom - 2); + LineTo(MyRect.Left + 1, MyRect.Top + 1); + LineTo(MyRect.Right - 2, MyRect.Top + 1); + { Draw border around control. } + MoveTo(Width - 1, Top); + LineTo(Width - 1, Height - 1); + LineTo(0, Height - 1); + Pen.Color := clWindowFrame; + MoveTo(Width - 1, MyRect.Bottom); + LineTo(1, MyRect.Bottom); + LineTo(1, Height - 1); + TR := MyRect; + end; - dsCoolTab: begin - {Draw cool (Netscape Sidebar style) tabs} - TR := DrawNavTab(DrawBmp.Canvas, {Canvas} - MyRect, {Client Rect} - 1, {Bevel Width} - FBackgroundColor, {Tab Color} - I, {Tab Number} - true, {Cool Tabs?} - (I = FHotFolder), {Is Focused} - (I = nabLastMouseOverItem)); {MouseOverItem} - end; + dsCoolTab: + begin + {Draw cool (Netscape Sidebar style) tabs} + TR := DrawNavTab( + DrawBmp.Canvas, {Canvas} + MyRect, {Client Rect} + 1, {Bevel Width} + FBackgroundColor, {Tab Color} + I, {Tab Number} + true, {Cool Tabs?} + (I = FHotFolder), {Is Focused} + (I = nabLastMouseOverItem) {MouseOverItem} + ); + end; - dsStandardTab: begin - {Draw regular old tabs} - TR := DrawNavTab(DrawBmp.Canvas, {Canvas} - MyRect, {Client Rect} - 1, {Bevel Width} - FBackgroundColor, {Tab Color} - I, {Tab Number} - false, {Cool Tabs?} - (I = FHotFolder), {Is Focused} - (I = nabLastMouseOverItem)); {MouseOverItem} + dsStandardTab: + begin + {Draw regular old tabs} + TR := DrawNavTab( + DrawBmp.Canvas, {Canvas} + MyRect, {Client Rect} + 1, {Bevel Width} + FBackgroundColor, {Tab Color} + I, {Tab Number} + false, {Cool Tabs?} + (I = FHotFolder), {Is Focused} + (I = nabLastMouseOverItem) {MouseOverItem} + ); end; end; @@ -2270,36 +2189,37 @@ begin if Folders[I].Enabled then begin DrawText(DrawBmp.Canvas.Handle, Buf, StrLen(Buf), TR, Flags); if (I = FHotFolder) and not nabMouseDown then begin - case FDrawingStyle of - - dsDefButton : begin - { Regular button style. } + dsDefButton: + begin + { Regular button style. } InflateRect(TR,1,1); inc(TR.Left); DrawBmp.Canvas.Frame3D(TR, 1,bvRaised); end; - dsEtchedButton : begin - { Etched style (Outlook98). } - Pen.Color := clWindowFrame; - MoveTo(TR.Right - 2, TR.Top); - LineTo(TR.Right - 2, TR.Bottom - 1); - LineTo(0, TR.Bottom - 1); - Pen.Color := clBtnShadow; - if I = ActiveFolder then - lOffset := 1 - else - lOffset := 2; - MoveTo(TR.Right - 3, TR.Top - 2); - LineTo(TR.Right - 3, TR.Bottom - lOffset); - LineTo(1, TR.Bottom - lOffset); - if I = ActiveFolder then - Pixels[1, TR.Bottom - lOffset] := clBtnHighlight; - end; - end; + dsEtchedButton: + begin + { Etched style (Outlook98). } + Pen.Color := clWindowFrame; + MoveTo(TR.Right - 2, TR.Top); + LineTo(TR.Right - 2, TR.Bottom - 1); + LineTo(0, TR.Bottom - 1); + Pen.Color := clBtnShadow; + if I = ActiveFolder then + lOffset := 1 + else + lOffset := 2; + MoveTo(TR.Right - 3, TR.Top - 2); + LineTo(TR.Right - 3, TR.Bottom - lOffset); + LineTo(1, TR.Bottom - lOffset); + if I = ActiveFolder then + Pixels[1, TR.Bottom - lOffset] := clBtnHighlight; + end; + end; // case end; - end else begin + end else + begin {use shadow text for inactive folder text} DrawBmp.Canvas.Font.Color := clHighlightText; SetBkMode(Canvas.Handle, OPAQUE); @@ -2312,7 +2232,8 @@ begin end; Inc(CurPos, FButtonHeight); end; - end else begin + end else + begin if FDrawingStyle = dsEtchedButton then begin { Draw border around control. } Pen.Color := clBtnHighlight; @@ -2343,13 +2264,11 @@ begin Top := CurPos; Left := 0; Right := ClientWidth; - Bottom := ClientHeight - - (FolderCount - FActiveFolder - 1) * FButtonHeight + 1; + Bottom := ClientHeight - (FolderCount - FActiveFolder - 1) * FButtonHeight + 1; end; for J := 0 to Folder.ItemCount-1 do - TVpNavBtnItem(Folder.Items[J]).FLabelRect.Bottom := - nabItemsRect.Bottom + 1; + TVpNavBtnItem(Folder.Items[J]).FLabelRect.Bottom := nabItemsRect.Bottom + 1; for J := nabTopItem to Folder.ItemCount-1 do begin if (FSelectedItem = J) then @@ -2419,11 +2338,9 @@ begin with Item.FLabelRect do begin Top := CurPos; Bottom := CurPos + (FButtonHeight shl 1) - 7; - Left := 0; Right := ClientWidth - 1; - Item.liDisplayName := GetLargeIconDisplayName(DrawBmp.Canvas, - Item.FLabelRect, Text); + Item.liDisplayName := GetLargeIconDisplayName(DrawBmp.Canvas, Item.FLabelRect, Text); X := DrawBmp.Canvas.TextWidth(Item.liDisplayName); Left := (ClientWidth - X) div 2; if Left < 5 then @@ -2436,19 +2353,18 @@ begin end; StrPLCopy(Buf, Item.liDisplayName, 255); - DrawText(DrawBmp.Canvas.Handle, Buf, Length(Item.liDisplayName), - Item.FLabelRect, DT_CENTER or DT_VCENTER or - DT_WORDBREAK or DT_CALCRECT); + DrawText(DrawBmp.Canvas.Handle, Buf, Length(Item.liDisplayName), Item.FLabelRect, + DT_CENTER or DT_VCENTER or DT_WORDBREAK or DT_CALCRECT); LabelWidth := RectWidth(Item.FLabelRect); with Item.FLabelRect do begin Left := (ClientWidth - LabelWidth) div 2; Right := Left + LabelWidth + 1; end; BkMode := SetBkMode(DrawBmp.Canvas.Handle, TRANSPARENT); - Inc(CurPos, DrawText(DrawBmp.Canvas.Handle, Buf, - Length(Item.liDisplayName), - Item.FLabelRect, - DT_CENTER or DT_VCENTER or DT_WORDBREAK)); + Inc(CurPos, DrawText( + DrawBmp.Canvas.Handle, Buf, Length(Item.liDisplayName), + Item.FLabelRect, DT_CENTER or DT_VCENTER or DT_WORDBREAK) + ); SetBkMode(DrawBmp.Canvas.Handle, BkMode); Inc(CurPos, FItemSpacing); @@ -2456,7 +2372,7 @@ begin {glyph is at the left} with Item.FIconRect do begin Top := CurPos; - lOffset := (Abs(DrawBmp.Canvas.Font.Height)) div 2; + lOffset := Abs(DrawBmp.Canvas.Font.Height) div 2; if lOffset > 8 then Top := Top + lOffset - 8; Bottom := Top + 16; @@ -2484,10 +2400,12 @@ begin end else begin Pen.Color := FBackgroundColor; Brush.Color := FBackgroundColor; - Rectangle(Item.FIconRect.Left - 1, - Item.FIconRect.Top - 1, - Item.FIconRect.Right + 1, - Item.FIconRect.Bottom + 1); + Rectangle( + Item.FIconRect.Left - 1, + Item.FIconRect.Top - 1, + Item.FIconRect.Right + 1, + Item.FIconRect.Bottom + 1 + ); end; if Assigned(FImages) then begin BM := TBitmap.Create; @@ -2518,23 +2436,21 @@ begin Break; end; Item.liDisplayName := - GetDisplayString(DrawBmp.Canvas, Text, 1, - RectWidth(Item.FLabelRect)); + GetDisplayString(DrawBmp.Canvas, Text, 1, RectWidth(Item.FLabelRect)); StrPLCopy(Buf, Item.liDisplayName, 255); DrawText(DrawBmp.Canvas.Handle, Buf, Length(Item.liDisplayName), - Item.FLabelRect, DT_LEFT or DT_VCENTER or DT_CALCRECT); + Item.FLabelRect, DT_LEFT or DT_VCENTER or DT_CALCRECT); LabelWidth := RectWidth(Item.FLabelRect); with Item.FLabelRect do Right := Left + LabelWidth + 1; DrawText(DrawBmp.Canvas.Handle, Buf, Length(Item.liDisplayName), - Item.FLabelRect, DT_LEFT or DT_VCENTER); + Item.FLabelRect, DT_LEFT or DT_VCENTER); Inc(CurPos, FItemSpacing); end; end; end; - {now, draw the folder buttons at the bottom} DrawBmp.Canvas.Font := Self.Font; SetBkMode(Handle, BkMode); @@ -2560,53 +2476,58 @@ begin MyRect.Bottom := CurPos + FButtonHeight; Folders[I].lfRect := MyRect; case FDrawingStyle of - dsDefButton : begin {Regular Old Buttons} //TODO: TR := DrawButtonFace(DrawBmp.Canvas, MyRect, 1, bsNew, False, // (I = FHotFolder) and nabMouseDown, False); end; - dsEtchedButton : begin - {Etched (Outlook98 style) buttons} - Brush.Color := clBtnFace; - FillRect(MyRect); - Pen.Color := clBtnShadow; - Brush.Style := bsClear; - Rectangle(MyRect.Left, MyRect.Top, MyRect.Right - 1, - MyRect.Bottom); - Pen.Color := clBtnHighlight; - MoveTo(MyRect.Left + 1, MyRect.Bottom - 2); - LineTo(MyRect.Left + 1, MyRect.Top + 1); - LineTo(MyRect.Right - 2, MyRect.Top + 1); - Pen.Color := clBtnHighlight; - MoveTo(Width - 1, 0); - LineTo(Width - 1, Height); - TR := MyRect; + dsEtchedButton : + begin + {Etched (Outlook98 style) buttons} + Brush.Color := clBtnFace; + FillRect(MyRect); + Pen.Color := clBtnShadow; + Brush.Style := bsClear; + Rectangle(MyRect.Left, MyRect.Top, MyRect.Right - 1, MyRect.Bottom); + Pen.Color := clBtnHighlight; + MoveTo(MyRect.Left + 1, MyRect.Bottom - 2); + LineTo(MyRect.Left + 1, MyRect.Top + 1); + LineTo(MyRect.Right - 2, MyRect.Top + 1); + Pen.Color := clBtnHighlight; + MoveTo(Width - 1, 0); + LineTo(Width - 1, Height); + TR := MyRect; + end; + + dsCoolTab: + begin + {Draw cool (Netscape Sidebar style) tabs} + TR := DrawNavTab( + DrawBmp.Canvas, {Canvas} + MyRect, {Client Rect} + 1, {Bevel Width} + FBackgroundColor, {Tab Color} + I, {Tab Number} + true, {Cool Tabs?} + (I = FHotFolder), {Is Focused} + (I = nabLastMouseOverItem) {MouseOverItem} + ); end; - dsCoolTab: begin - {Draw cool (Netscape Sidebar style) tabs} - TR := DrawNavTab(DrawBmp.Canvas, {Canvas} - MyRect, {Client Rect} - 1, {Bevel Width} - FBackgroundColor, {Tab Color} - I, {Tab Number} - true, {Cool Tabs?} - (I = FHotFolder), {Is Focused} - (I = nabLastMouseOverItem)); {MouseOverItem} - end; - - dsStandardTab: begin - {Draw regular old tabs} - TR := DrawNavTab(DrawBmp.Canvas, {Canvas} - MyRect, {Client Rect} - 1, {Bevel Width} - FBackgroundColor, {Tab Color} - I, {Tab Number} - false, {Cool Tabs?} - (I = FHotFolder), {Is Focused} - (I = nabLastMouseOverItem)); {MouseOverItem} + dsStandardTab: + begin + {Draw regular old tabs} + TR := DrawNavTab( + DrawBmp.Canvas, {Canvas} + MyRect, {Client Rect} + 1, {Bevel Width} + FBackgroundColor, {Tab Color} + I, {Tab Number} + false, {Cool Tabs?} + (I = FHotFolder), {Is Focused} + (I = nabLastMouseOverItem) {MouseOverItem} + ); end; end; @@ -2617,25 +2538,26 @@ begin DrawText(DrawBmp.Canvas.Handle, Buf, StrLen(Buf), TR, Flags); if (I = FHotFolder) and not nabMouseDown then begin case FDrawingStyle of + dsDefButton: + begin + { Regular button style. } + InflateRect(TR,1,1); + inc(TR.Left); + DrawBmp.Canvas.Frame3D(TR,1,bvRaised); + end; - dsDefButton : begin - { Regular button style. } - InflateRect(TR,1,1); - inc(TR.Left); - DrawBmp.Canvas.Frame3D(TR,1,bvRaised); - end; - - dsEtchedButton : begin - { Etched (Outlook98 style). } - Pen.Color := clWindowFrame; - MoveTo(TR.Right - 2, TR.Top); - LineTo(TR.Right - 2, TR.Bottom - 1); - LineTo(0, TR.Bottom - 1); - Pen.Color := clBtnShadow; - MoveTo(TR.Right - 3, TR.Top - 2); - LineTo(TR.Right - 3, TR.Bottom - 2); - LineTo(1, TR.Bottom - 2); - end; + dsEtchedButton : + begin + { Etched (Outlook98 style). } + Pen.Color := clWindowFrame; + MoveTo(TR.Right - 2, TR.Top); + LineTo(TR.Right - 2, TR.Bottom - 1); + LineTo(0, TR.Bottom - 1); + Pen.Color := clBtnShadow; + MoveTo(TR.Right - 3, TR.Top - 2); + LineTo(TR.Right - 3, TR.Bottom - 2); + LineTo(1, TR.Bottom - 2); + end; end; end; end else begin @@ -2673,6 +2595,7 @@ begin end else nabScrollDownBtn.Visible := False; end; + {if we're dragging, show the drag marker} if (nabDragFromItem <> -1) or nabExternalDrag then begin if (nabDropY <> -1) then begin @@ -2685,13 +2608,17 @@ begin Brush.Color := clBlack; MoveTo(5, nabDropY); LineTo(ClientWidth - 5, nabDropY); - DrawBmp.Canvas.Polygon([ Point(3,nabDropY+4), - Point(7,nabDropY), - Point(3, nabDropY-4)]); + DrawBmp.Canvas.Polygon([ + Point(3, nabDropY+4), + Point(7, nabDropY), + Point(3, nabDropY-4) + ]); DrawBmp.Canvas.FloodFill(5, nabDropY, clBlack, fsBorder); - DrawBmp.Canvas.Polygon([ Point(ClientWidth-3,nabDropY+4), - Point(ClientWidth-7,nabDropY), - Point(ClientWidth-3,nabDropY-4)]); + DrawBmp.Canvas.Polygon([ + Point(ClientWidth-3,nabDropY+4), + Point(ClientWidth-7,nabDropY), + Point(ClientWidth-3,nabDropY-4) + ]); DrawBmp.Canvas.FloodFill(ClientWidth-5, nabDropY, clBlack, fsBorder); end; end; @@ -2735,31 +2662,31 @@ begin end; {=====} -procedure TVpCustomNavBar.SetActiveFolder(Value : Integer); +procedure TVpCustomNavBar.SetActiveFolder(Value: Integer); var - Y : Integer; - YDelta : Integer; - R : TRect; - R2 : TRect; - Buf : array[0..1023] of Char; - AllowChange : Boolean; + Y: Integer; + YDelta: Integer; + R: TRect; + R2: TRect; + Buf: array[0..1023] of Char; + AllowChange: Boolean; begin if Value <> FActiveFolder then begin if FolderCount = 0 then FActiveFolder := -1 - else if (Value > -1) and (Value < FolderCount) then begin - - { Fire DoFolderChange only if not dragging. } - if nabDragFromItem = -1 then begin - { Default for AllowChange is True. } - AllowChange := True; - { Fire the OnFolderChange event. } - DoFolderChange(Value, AllowChange); - { If AllowChange is False then bail out. } - if not AllowChange then - Exit; - end; + else + if (Value > -1) and (Value < FolderCount) then begin + { Fire DoFolderChange only if not dragging. } + if nabDragFromItem = -1 then begin + { Default for AllowChange is True. } + AllowChange := True; + { Fire the OnFolderChange event. } + DoFolderChange(Value, AllowChange); + { If AllowChange is False then bail out. } + if not AllowChange then + Exit; + end; {animated scroll} if FActiveFolder > -1 then begin {play sound} @@ -2815,7 +2742,7 @@ begin end; {=====} -procedure TVpCustomNavBar.SetBackgroundColor(Value : TColor); +procedure TVpCustomNavBar.SetBackgroundColor(Value: TColor); begin if Value <> FBackgroundColor then begin FBackgroundColor := Value; @@ -2824,7 +2751,7 @@ begin end; {=====} -procedure TVpCustomNavBar.SetBackgroundImage(Value : TBitmap); +procedure TVpCustomNavBar.SetBackgroundImage(Value: TBitmap); begin if Assigned(Value) then FBackgroundImage.Assign(Value) @@ -2836,7 +2763,7 @@ begin end; {=====} -procedure TVpCustomNavBar.SetBackgroundMethod(Value : TVpBackgroundMethod); +procedure TVpCustomNavBar.SetBackgroundMethod(Value: TVpBackgroundMethod); begin if Value <> FBackgroundMethod then begin FBackgroundMethod := Value; @@ -2845,7 +2772,7 @@ begin end; {=====} -procedure TVpCustomNavBar.SetBorderStyle(const Value : TBorderStyle); +procedure TVpCustomNavBar.SetBorderStyle(const Value: TBorderStyle); begin if Value <> FBorderStyle then begin FBorderStyle := Value; @@ -2854,13 +2781,14 @@ begin end; {=====} -procedure TVpCustomNavBar.SetButtonHeight(Value : Integer); +procedure TVpCustomNavBar.SetButtonHeight(Value: Integer); begin if Value <> FButtonHeight then begin {Minimum ButtonHeight for CoolTabs is 17} if FDrawingStyle = dsCoolTab then begin - if Value < 17 then FButtonHeight := 17 - else FButtonHeight := Value; + if Value < 17 + then FButtonHeight := 17 + else FButtonHeight := Value; end else FButtonHeight := Value; Invalidate; @@ -2886,14 +2814,14 @@ begin end; {=====} -procedure TVpCustomNavBar.SetBounds(ALeft, ATop, AWidth, AHeight : Integer); +procedure TVpCustomNavBar.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); begin inherited SetBounds(ALeft, ATop, AWidth, AHeight); nabRecalcDisplayNames; end; {=====} -procedure TVpCustomNavBar.SetImages(Value : TImageList); +procedure TVpCustomNavBar.SetImages(Value: TImageList); begin if FImages <> nil then FImages.OnChange := nil; @@ -2905,14 +2833,14 @@ begin end; {=====} -procedure TVpCustomNavBar.SetItemFont(Value : TFont); +procedure TVpCustomNavBar.SetItemFont(Value: TFont); begin if Assigned(Value) then FItemFont.Assign(Value); end; {=====} -procedure TVpCustomNavBar.SetItemSpacing(Value : Word); +procedure TVpCustomNavBar.SetItemSpacing(Value: Word); begin if (Value > 0) then begin FItemSpacing := Value; @@ -2921,7 +2849,7 @@ begin end; {=====} -procedure TVpCustomNavBar.SetSelectedItemFont(Value : TFont); +procedure TVpCustomNavBar.SetSelectedItemFont(Value: TFont); begin if Assigned(Value) then FSelectedItemFont.Assign(Value); @@ -2938,9 +2866,9 @@ end; {=====} {$IFDEF LCL} -procedure TVpCustomNavBar.WMEraseBkGnd(var Msg : TLMEraseBkGnd); +procedure TVpCustomNavBar.WMEraseBkGnd(var Msg: TLMEraseBkGnd); {$ELSE} -procedure TVpCustomNavBar.WMEraseBkGnd(var Msg : TWMEraseBkGnd); +procedure TVpCustomNavBar.WMEraseBkGnd(var Msg: TWMEraseBkGnd); {$ENDIF} begin Msg.Result := 1; {don't erase background} @@ -2948,7 +2876,7 @@ end; {=====} {$IFNDEF LCL} -procedure TVpCustomNavBar.WMGetDlgCode(var Msg : TWMGetDlgCode); +procedure TVpCustomNavBar.WMGetDlgCode(var Msg: TWMGetDlgCode); begin {tell windows we are a static control to avoid receiving the focus} Msg.Result := DLGC_STATIC; @@ -2957,9 +2885,9 @@ end; {=====} {$IFDEF LCL} -procedure TVpCustomNavBar.WMNCHitTest(var Msg : TLMNCHitTest); +procedure TVpCustomNavBar.WMNCHitTest(var Msg: TLMNCHitTest); {$ELSE} -procedure TVpCustomNavBar.WMNCHitTest(var Msg : TWMNCHitTest); +procedure TVpCustomNavBar.WMNCHitTest(var Msg: TWMNCHitTest); {$ENDIF} begin inherited; @@ -2969,7 +2897,7 @@ end; {=====} {$IFNDEF LCL} -procedure TVpCustomNavBar.WMSetCursor(var Msg : TWMSetCursor); +procedure TVpCustomNavBar.WMSetCursor(var Msg: TWMSetCursor); var I : Integer; R : TRect; @@ -2994,13 +2922,11 @@ end; {=====} { Overridden DragOver method. } -procedure TVpCustomNavBar.DragOver(Source: TObject; - X, Y: Integer; - State: TDragState; - var Accept: Boolean); +procedure TVpCustomNavBar.DragOver(Source: TObject; X, Y: Integer; + State: TDragState; var Accept: Boolean); var - ItemIndex : Integer; - FolderIndex : Integer; + ItemIndex: Integer; + FolderIndex: Integer; begin { If State is dsDragLeave then the user has dragged } { outside us. Invalidate the component to get rid } @@ -3024,8 +2950,7 @@ begin nabItemAccept := True; { Call the user's OnDragOver. } if Assigned(FOnDragOver) then - FOnDragOver(Self, Source, - X, Y, State, nabFolderAccept, nabItemAccept); + FOnDragOver(Self, Source, X, Y, State, nabFolderAccept, nabItemAccept); { Might have to scroll the items in the folder. } if nabScrollDownBtn.Visible then begin @@ -3056,7 +2981,7 @@ begin end; {=====} -procedure TVpCustomNavBar.DragDrop(Source: TObject; X, Y : Integer); +procedure TVpCustomNavBar.DragDrop(Source: TObject; X, Y: Integer); begin if Assigned(FOnDragDrop) then FOnDragDrop(Self, Source, X, Y, FActiveFolder, nabExternalDragItem);