pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
f8cb554d29904b8bef64a0ead1455a37ce1361fc
lazarus-ccr/components/jvcllaz/run/JvNavigationPane.pas

5193 lines
154 KiB
ObjectPascal
Raw Normal View History

Initial import. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@272 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2007-09-29 00:59:44 +00:00
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: JvNavigationPane.PAS, released on 2004-03-28.
The Initial Developer of the Original Code is Peter Thornqvist <peter3 at sourceforge dot net>
Portions created by Peter Thornqvist are Copyright (C) 2004 Peter Thornqvist.
All Rights Reserved.
Contributor(s):
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net
Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvNavigationPane.pas 11400 2007-06-28 21:24:06Z ahuser $
// Initial port to Lazarus by Sergio Samayoa - september 2007.
// TODO: LM_NCPAINT isnt fired by lazarus, see what we can do about.
//
// 26.09.2007:
// BUG: (I think is of the JVCL base class) - also in Delphi
// - Made some panels iconic.
// - Click on popup button of the pane (TJvNavIconButton)
// - Don't select any menu option, just click and hold for a second any of
// the iconized pages.
// - Page isn't selected but button remains as down.
//
// LM_NCPAINT isn't fired in LCL (reply on forums from Luiz Americo).
// Also changing "BorderWidth" does nothing. This is inherited from TControl.
// This means that TJvExControl descendatns should deflate its bound by BorderWidth
// before painting itself and at last (after LM_PAINT) "send" LM_NCPAINT.
// This property should afect also the positioning if the controls inside.
{$mode objfpc}{$H+}
unit JvNavigationPane;
interface
uses
SysUtils, Classes, Controls, ExtCtrls, Graphics, ImgList, JvButton,
JvComponent, JvExExtCtrls, JvPageList, JvTypes, LCLIntf, LCLType, LMessages, Menus;
const
CM_PARENTSTYLEMANAGERCHANGE = CM_BASE + 1;
CM_PARENTSTYLEMANAGERCHANGED = CM_BASE + 2;
type
TJvCustomNavigationPane = class;
TJvNavIconButton = class;
TJvNavStyleLink = class;
TJvNavPaneStyleManager = class;
TMsgStyleManagerChange = record
Msg: Cardinal;
Sender: TControl;
StyleManager: TJvNavPaneStyleManager;
Result: Longint;
end;
TJvNavPanelHeader = class(TJvCustomControl)
private
FColorFrom: TColor;
FColorTo: TColor;
FImages: TCustomImageList;
FImageIndex: TImageIndex;
FChangeLink: TChangeLink;
FStyleManager: TJvNavPaneStyleManager;
FStyleLink: TJvNavStyleLink;
FWordWrap: Boolean;
FAlignment: TAlignment;
FParentStyleManager: Boolean;
procedure WMEraseBkgnd(var Msg: TLMEraseBkgnd); message LM_ERASEBKGND;
procedure SetColorFrom(const Value: TColor);
procedure SetColorTo(const Value: TColor);
procedure SetImageIndex(const Value: TImageIndex);
procedure SetImages(const Value: TCustomImageList);
procedure DoImagesChange(Sender: TObject);
procedure SetStyleManager(const Value: TJvNavPaneStyleManager);
procedure DoStyleChange(Sender: TObject);
procedure SetAlignment(const Value: TAlignment);
procedure SetWordWrap(const Value: Boolean);
procedure ParentStyleManagerChanged(var Msg: TMsgStyleManagerChange); message CM_PARENTSTYLEMANAGERCHANGED;
procedure ParentStyleManagerChange(var Msg: TLMessage); message CM_PARENTSTYLEMANAGERCHANGE;
procedure CMControlChange(var Msg: TLMessage); message CM_CONTROLCHANGE;
procedure SetParentStyleManager(const Value: Boolean);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure TextChanged; override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Align;
property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
property Anchors;
property Caption;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property OnStartDock;
property OnEndDock;
property OnUnDock;
property Enabled;
property Font;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
property ColorFrom: TColor read FColorFrom write SetColorFrom default TColor($D0835C);
property ColorTo: TColor read FColorTo write SetColorTo default TColor($903B09);
property Images: TCustomImageList read FImages write SetImages;
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
property StyleManager: TJvNavPaneStyleManager read FStyleManager write SetStyleManager;
// (p3) must be published after StyleManager
property ParentStyleManager: Boolean read FParentStyleManager write SetParentStyleManager default True;
property Height default 27;
property Width default 225;
property OnClick;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
end;
TJvNavPanelDivider = class(TJvExSplitter)
private
FColorFrom: TColor;
FColorTo: TColor;
FFrameColor: TColor;
FStyleManager: TJvNavPaneStyleManager;
FStyleLink: TJvNavStyleLink;
FAlignment: TAlignment;
FParentStyleManager: Boolean;
procedure SetColorFrom(const Value: TColor);
procedure SetColorTo(const Value: TColor);
procedure SetFrameColor(const Value: TColor);
procedure SetStyleManager(const Value: TJvNavPaneStyleManager);
procedure DoStyleChange(Sender: TObject);
procedure SetAlignment(const Value: TAlignment);
procedure ParentStyleManagerChanged(var Msg: TMsgStyleManagerChange); message CM_PARENTSTYLEMANAGERCHANGED;
procedure SetParentStyleManager(const Value: Boolean);
protected
procedure Paint; override;
procedure TextChanged; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure RequestAlign; override;
// 25.09.2007 - SESS
procedure SetAlign(Value: TAlign); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
// NB! Color is published but not used
property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
property Align default alNone;
property Anchors;
property AutoSnap default False;
property Caption;
property ColorFrom: TColor read FColorFrom write SetColorFrom default TColor($FFDBBC);
property ColorTo: TColor read FColorTo write SetColorTo default TColor($F2C0A4);
property Constraints;
property Cursor default crSizeNS;
property Enabled;
property Font;
property FrameColor: TColor read FFrameColor write SetFrameColor default TColor($6F2F0C);
property Height default 19;
property ResizeStyle default rsUpdate;
property StyleManager: TJvNavPaneStyleManager read FStyleManager write SetStyleManager;
// (p3) must be published after StyleManager
property ParentStyleManager: Boolean read FParentStyleManager write SetParentStyleManager default True;
property Width default 125;
end;
TJvOutlookSplitter = class(TJvExSplitter)
private
FColorTo: TColor;
FColorFrom: TColor;
FStyleManager: TJvNavPaneStyleManager;
FStyleLink: TJvNavStyleLink;
FParentStyleManager: Boolean;
FDragZone: Integer;
FOldCursor: TCursor;
procedure SetColorFrom(const Value: TColor);
procedure SetColorTo(const Value: TColor);
procedure SetStyleManager(const Value: TJvNavPaneStyleManager);
procedure DoStyleChange(Sender: TObject);
procedure ParentStyleManagerChanged(var Msg: TMsgStyleManagerChange); message CM_PARENTSTYLEMANAGERCHANGED;
procedure SetParentStyleManager(const Value: Boolean);
procedure SetCursor(const Value: TCursor);
function GetDragZoneRect: TRect;
function MouseInDragZone(X, Y: Integer): Boolean;
protected
procedure Paint; override;
procedure EnabledChanged; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure WMLButtonDown(var Msg: TLMLButtonDown); message LM_LBUTTONDOWN;
procedure WMMouseMove(var Msg: TLMMouseMove); message LM_MOUSEMOVE;
procedure RequestAlign; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
// NB! Color is published but not used
property Align default alBottom;
property AutoSnap default False;
property Cursor write SetCursor default crSizeNS;
// DragZone is the number of pixels in the center of the control that constitutes the draggable area.
// For example, with a left/right aligned splitter and a DragZone of 100, 50 pixels above and 50 pixels below
// the vertical midpoint can be clicked to start the sizing. Any clicks outside this area will not start a sizing operation
// If DragZone <= 0, the entire control is a drag zone
property DragZone: Integer read FDragZone write FDragZone default 0;
property ResizeStyle default rsUpdate;
property ColorFrom: TColor read FColorFrom write SetColorFrom default TColor($B78676);
property ColorTo: TColor read FColorTo write SetColorTo default TColor($A03D09);
property Height default 7;
property Enabled;
property StyleManager: TJvNavPaneStyleManager read FStyleManager write SetStyleManager;
// (p3) must be published after StyleManager
property ParentStyleManager: Boolean read FParentStyleManager write SetParentStyleManager default True;
property OnClick;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnDblClick;
property OnMouseUp;
property OnMouseMove;
end;
TJvNavPanelColors = class(TPersistent)
private
FButtonColorTo: TColor;
FButtonColorFrom: TColor;
FFrameColor: TColor;
FButtonHotColorFrom: TColor;
FButtonHotColorTo: TColor;
FButtonSelectedColorFrom: TColor;
FButtonSelectedColorTo: TColor;
FOnChange: TNotifyEvent;
FSplitterColorFrom: TColor;
FSplitterColorTo: TColor;
FDividerColorTo: TColor;
FDividerColorFrom: TColor;
FHeaderColorFrom: TColor;
FHeaderColorTo: TColor;
FButtonSeparatorColor: TColor;
FToolPanelColorFrom: TColor;
FToolPanelColorTo: TColor;
FToolPanelHeaderColorTo: TColor;
FToolPanelHeaderColorFrom: TColor;
procedure SetButtonColorFrom(const Value: TColor);
procedure SetButtonColorTo(const Value: TColor);
procedure SetFrameColor(const Value: TColor);
procedure SetButtonHotColorFrom(const Value: TColor);
procedure SetButtonHotColorTo(const Value: TColor);
procedure SetButtonSelectedColorFrom(const Value: TColor);
procedure SetButtonSelectedColorTo(const Value: TColor);
procedure SetSplitterColorFrom(const Value: TColor);
procedure SetSplitterColorTo(const Value: TColor);
procedure SetDividerColorFrom(const Value: TColor);
procedure SetDividerColorTo(const Value: TColor);
procedure SetHeaderColorFrom(const Value: TColor);
procedure SetHeaderColorTo(const Value: TColor);
procedure SetButtonSeparatorColor(const Value: TColor);
procedure SetToolPanelColorFrom(const Value: TColor);
procedure SetToolPanelColorTo(const Value: TColor);
procedure SetToolPanelHeaderColorFrom(const Value: TColor);
procedure SetToolPanelHeaderColorTo(const Value: TColor);
protected
procedure Change;
public
constructor Create;
procedure Assign(Source: TPersistent); override;
published
property ButtonColorFrom: TColor read FButtonColorFrom write SetButtonColorFrom default TColor($F7E2CD);
property ButtonColorTo: TColor read FButtonColorTo write SetButtonColorTo default TColor($F3A080);
property ButtonHotColorFrom: TColor read FButtonHotColorFrom write SetButtonHotColorFrom default TColor($DBFBFF);
property ButtonHotColorTo: TColor read FButtonHotColorTo write SetButtonHotColorTo default TColor($5FC8FB);
property ButtonSelectedColorFrom: TColor read FButtonSelectedColorFrom write SetButtonSelectedColorFrom default TColor($BBE2EA);
property ButtonSelectedColorTo: TColor read FButtonSelectedColorTo write SetButtonSelectedColorTo default TColor($389FDD);
property ButtonSeparatorColor: TColor read FButtonSeparatorColor write SetButtonSeparatorColor default clGray;
property SplitterColorFrom: TColor read FSplitterColorFrom write SetSplitterColorFrom default TColor($B78676);
property SplitterColorTo: TColor read FSplitterColorTo write SetSplitterColorTo default TColor($A03D09);
property DividerColorFrom: TColor read FDividerColorFrom write SetDividerColorFrom default TColor($FFDBBC);
property DividerColorTo: TColor read FDividerColorTo write SetDividerColorTo default TColor($F2C0A4);
property HeaderColorFrom: TColor read FHeaderColorFrom write SetHeaderColorFrom default TColor($D0835C);
property HeaderColorTo: TColor read FHeaderColorTo write SetHeaderColorTo default TColor($903B09);
property FrameColor: TColor read FFrameColor write SetFrameColor default TColor($6F2F0C);
property ToolPanelColorFrom: TColor read FToolPanelColorFrom write SetToolPanelColorFrom default clWindow;
property ToolPanelColorTo: TColor read FToolPanelColorTo write SetToolPanelColorTo default clWindow;
property ToolPanelHeaderColorFrom: TColor read FToolPanelHeaderColorFrom write SetToolPanelHeaderColorFrom default TColor($F7E2CD);
property ToolPanelHeaderColorTo: TColor read FToolPanelHeaderColorTo write SetToolPanelHeaderColorTo default TColor($F3A080);
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
TJvNavPanelFonts = class(TPersistent)
private
FHeaderFont: TFont;
FNavPanelFont: TFont;
FDividerFont: TFont;
FOnChange: TNotifyEvent;
FNavPanelHotTrackFont: TFont;
FNavPanelHotTrackFontOptions: TJvTrackFontOptions;
procedure SetDividerFont(const Value: TFont);
procedure SetHeaderFont(const Value: TFont);
procedure SetNavPanelFont(const Value: TFont);
procedure SetNavPanelHotTrackFont(const Value: TFont);
procedure SetNavPanelHotTrackFontOptions(const Value: TJvTrackFontOptions);
protected
procedure Change;
procedure DoFontChange(Sender: TObject);
public
procedure Assign(Source: TPersistent); override;
constructor Create;
destructor Destroy; override;
published
property NavPanelFont: TFont read FNavPanelFont write SetNavPanelFont;
property NavPanelHotTrackFont: TFont read FNavPanelHotTrackFont write SetNavPanelHotTrackFont;
property NavPanelHotTrackFontOptions: TJvTrackFontOptions read FNavPanelHotTrackFontOptions write SetNavPanelHotTrackFontOptions default DefaultTrackFontOptions;
property DividerFont: TFont read FDividerFont write SetDividerFont;
property HeaderFont: TFont read FHeaderFont write SetHeaderFont;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
TJvIconPanel = class(TJvCustomControl)
private
FDropButton: TJvNavIconButton;
FColors: TJvNavPanelColors;
FStyleManager: TJvNavPaneStyleManager;
FStyleLink: TJvNavStyleLink;
FOnDropDownMenu: TContextPopupEvent;
FParentStyleManager: Boolean;
procedure SetDropDownMenu(const Value: TPopupMenu);
function GetDropDownMenu: TPopupMenu;
procedure SetColors(const Value: TJvNavPanelColors);
procedure SetStyleManager(const Value: TJvNavPaneStyleManager);
procedure DoStyleChange(Sender: TObject);
procedure ParentStyleManagerChanged(var Msg: TMsgStyleManagerChange); message CM_PARENTSTYLEMANAGERCHANGED;
procedure ParentStyleManagerChange(var Msg: TLMessage); message CM_PARENTSTYLEMANAGERCHANGE;
procedure CMControlChange(var Msg: TLMessage); message CM_CONTROLCHANGE;
procedure WMEraseBkgnd(var Msg: TLMEraseBkgnd); message LM_ERASEBKGND;
procedure SetParentStyleManager(const Value: Boolean);
protected
procedure DoDropDownMenu(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
procedure DoColorsChange(Sender: TObject);
procedure Paint; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Colors: TJvNavPanelColors read FColors write SetColors;
property StyleManager: TJvNavPaneStyleManager read FStyleManager write SetStyleManager;
// (p3) must be published after StyleManager
property ParentStyleManager: Boolean read FParentStyleManager write SetParentStyleManager default True;
property DropDownMenu: TPopupMenu read GetDropDownMenu write SetDropDownMenu;
property OnDropDownMenu: TContextPopupEvent read FOnDropDownMenu write FOnDropDownMenu;
end;
TJvNavIconButtonType = (nibDropDown, nibImage, nibDropArrow, nibClose);
TJvNavIconButton = class(TJvCustomGraphicButton)
private
FChangeLink: TChangeLink;
FImages: TCustomImageList;
FImageIndex: TImageIndex;
FButtonType: TJvNavIconButtonType;
FColors: TJvNavPanelColors;
FStyleManager: TJvNavPaneStyleManager;
FStyleLink: TJvNavStyleLink;
FParentStyleManager: Boolean;
procedure SetImages(const Value: TCustomImageList);
procedure SetImageIndex(const Value: TImageIndex);
procedure DoImagesChange(Sender: TObject);
procedure SetButtonType(const Value: TJvNavIconButtonType);
procedure SetColors(const Value: TJvNavPanelColors);
procedure DoColorsChange(Sender: TObject);
procedure SetStyleManager(const Value: TJvNavPaneStyleManager);
procedure DoStyleChange(Sender: TObject);
procedure ParentStyleManagerChanged(var Msg: TMsgStyleManagerChange); message CM_PARENTSTYLEMANAGERCHANGED;
procedure SetParentStyleManager(const Value: Boolean);
function IsColorsStored: Boolean;
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Paint; override;
property OnDropDownMenu;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Action;
property Align;
property AllowAllUp;
property Anchors;
// property Caption;
property Constraints;
property Down;
property DragCursor;
property DragKind;
property OnEndDock;
property OnStartDock;
property DragMode;
property DropDownMenu;
property GroupIndex;
property Enabled;
property Font;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
property ButtonType: TJvNavIconButtonType read FButtonType write SetButtonType;
property Colors: TJvNavPanelColors read FColors write SetColors stored IsColorsStored;
property Images: TCustomImageList read FImages write SetImages;
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex;
property StyleManager: TJvNavPaneStyleManager read FStyleManager write SetStyleManager;
// (p3) must be published after StyleManager
property ParentStyleManager: Boolean read FParentStyleManager write SetParentStyleManager default True;
property Width default 22;
property Height default 22;
property OnClick;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
end;
TJvNavPanelToolButton = class(TJvCustomGraphicButton)
private
FChangeLink: TChangeLink;
FImages: TCustomImageList;
FImageIndex: TImageIndex;
FButtonType: TJvNavIconButtonType;
FDrawPartialMenuFrame: Boolean;
FTransparentDown: Boolean;
procedure DoImagesChange(Sender: TObject);
procedure SetButtonType(const Value: TJvNavIconButtonType);
procedure SetImageIndex(const Value: TImageIndex);
procedure SetImages(const Value: TCustomImageList);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Paint; override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property TransparentDown: Boolean read FTransparentDown write FTransparentDown default False;
property DrawPartialMenuFrame: Boolean read FDrawPartialMenuFrame write FDrawPartialMenuFrame default False;
property Images: TCustomImageList read FImages write SetImages;
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex;
property ButtonType: TJvNavIconButtonType read FButtonType write SetButtonType;
property Caption;
end;
TJvNavPanelButton = class(TJvCustomGraphicButton)
private
FImageIndex: TImageIndex;
FImages: TCustomImageList;
FColors: TJvNavPanelColors;
FStyleManager: TJvNavPaneStyleManager;
FStyleLink: TJvNavStyleLink;
FAlignment: TAlignment;
FWordWrap: Boolean;
FParentStyleManager: Boolean;
procedure SetImageIndex(const Value: TImageIndex);
procedure SetImages(const Value: TCustomImageList);
procedure SetColors(const Value: TJvNavPanelColors);
procedure DoColorsChange(Sender: TObject);
procedure SetStyleManager(const Value: TJvNavPaneStyleManager);
procedure DoStyleChange(Sender: TObject);
procedure SetAlignment(const Value: TAlignment);
procedure SetWordWrap(const Value: Boolean);
procedure CMDialogChar(var Msg: TCMDialogChar); message CM_DIALOGCHAR;
procedure ParentStyleManagerChanged(var Msg: TMsgStyleManagerChange); message CM_PARENTSTYLEMANAGERCHANGED;
procedure SetParentStyleManager(const Value: Boolean);
function IsColorsStored: Boolean;
protected
procedure TextChanged; override;
procedure FontChanged; override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
procedure PaintButton(ACanvas: TCanvas); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Action;
property Align;
property AllowAllUp;
property Anchors;
property Caption;
property Constraints;
property Down;
property DropDownMenu;
property DragCursor;
property DragKind;
property OnEndDock;
property OnStartDock;
property DragMode;
property Enabled;
property Font;
property GroupIndex;
property HotTrack default True;
property HotTrackFont;
property HotTrackFontOptions;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
property Width default 125;
property Height default 28;
property Colors: TJvNavPanelColors read FColors write SetColors stored IsColorsStored;
property StyleManager: TJvNavPaneStyleManager read FStyleManager write SetStyleManager;
// (p3) must be published after StyleManager
property ParentStyleManager: Boolean read FParentStyleManager write SetParentStyleManager default True;
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex;
property Images: TCustomImageList read FImages write SetImages;
property OnClick;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
end;
TJvNavPaneBackgroundImage = class(TPersistent)
private
FCenter: Boolean;
FTile: Boolean;
FTransparent: Boolean;
FProportional: Boolean;
FStretch: Boolean;
FDrawing: Boolean;
FPicture: TPicture;
FOnChange: TNotifyEvent;
procedure SetCenter(const Value: Boolean);
procedure SetPicture(const Value: TPicture);
procedure SetProportional(const Value: Boolean);
procedure SetStretch(const Value: Boolean);
procedure SetTile(const Value: Boolean);
procedure SetTransparent(const Value: Boolean);
procedure PictureChanged(Sender: TObject);
protected
procedure DrawImage(Canvas: TCanvas; ARect: TRect); virtual;
procedure Change; virtual;
function CalcRect(ADestRect: TRect): TRect;
public
constructor Create;
destructor Destroy; override;
function HasImage: Boolean;
published
property Picture: TPicture read FPicture write SetPicture;
property Stretch: Boolean read FStretch write SetStretch;
property Proportional: Boolean read FProportional write SetProportional;
property Center: Boolean read FCenter write SetCenter;
property Tile: Boolean read FTile write SetTile;
property Transparent: Boolean read FTransparent write SetTransparent;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
TJvNavPanelPage = class(TJvCustomPage)
private
FNavPanel: TJvNavPanelButton;
FIconButton: TJvNavIconButton;
FOnClick: TNotifyEvent;
FIconPanel: TJvIconPanel;
FStyleManager: TJvNavPaneStyleManager;
FStyleLink: TJvNavStyleLink;
FHeader: TJvNavPanelHeader;
FImageIndex: TImageIndex;
FParentStyleManager: Boolean;
FBackground: TJvNavPaneBackgroundImage;
procedure SetCaption(const Value: TCaption);
procedure SetIconic(const Value: Boolean);
procedure SetImageIndex(const Value: TImageIndex);
function GetCaption: TCaption;
function GetIconic: Boolean;
function GetImageIndex: TImageIndex;
procedure DoButtonClick(Sender: TObject);
function GetHint: string;
procedure SetHint(const Value: string);
procedure SetIconPanel(const Value: TJvIconPanel);
function GetColors: TJvNavPanelColors;
procedure SetColors(const Value: TJvNavPanelColors);
procedure SetStyleManager(const Value: TJvNavPaneStyleManager);
procedure DoStyleChange(Sender: TObject);
procedure SetAutoHeader(const Value: Boolean);
function GetAutoHeader: Boolean;
function GetAlignment: TAlignment;
function GetWordWrap: Boolean;
procedure SetAlignment(const Value: TAlignment);
procedure SetWordWrap(const Value: Boolean);
procedure ParentStyleManagerChanged(var Msg: TMsgStyleManagerChange); message CM_PARENTSTYLEMANAGERCHANGED;
procedure ParentStyleManagerChange(var Msg: TLMessage); message CM_PARENTSTYLEMANAGERCHANGE;
procedure CMControlChange(var Msg: TLMessage); message CM_CONTROLCHANGE;
procedure SetParentStyleManager(const Value: Boolean);
procedure SetAction(const Value: TBasicAction); // override;
procedure SetBackground(const Value: TJvNavPaneBackgroundImage);
procedure DoBackgroundChange(Sender: TObject);
protected
procedure UpdatePageList;
function GetAction: TBasicAction; override;
procedure SetParent(AParent: TWinControl); override;
procedure SetPageIndex(Value: Integer); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
property NavPanel: TJvNavPanelButton read FNavPanel;
property IconButton: TJvNavIconButton read FIconButton;
property IconPanel: TJvIconPanel read FIconPanel write SetIconPanel;
property Colors: TJvNavPanelColors read GetColors write SetColors;
property StyleManager: TJvNavPaneStyleManager read FStyleManager write SetStyleManager;
// (p3) must be published after StyleManager
property ParentStyleManager: Boolean read FParentStyleManager write SetParentStyleManager default True;
property Header: TJvNavPanelHeader read FHeader;
property Alignment: TAlignment read GetAlignment write SetAlignment;
property WordWrap: Boolean read GetWordWrap write SetWordWrap;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property AutoHeader: Boolean read GetAutoHeader write SetAutoHeader;
published
property Action: TBasicAction read GetAction write SetAction;
property Background: TJvNavPaneBackgroundImage read FBackground write SetBackground;
property Color default clWindow;
property ParentColor default False;
property Caption: TCaption read GetCaption write SetCaption;
property DragCursor;
property DragKind;
property OnStartDock;
property OnDockDrop;
property OnDockOver;
property OnUnDock;
property OnEndDock;
property DragMode;
property Iconic: Boolean read GetIconic write SetIconic default False;
property ImageIndex: TImageIndex read GetImageIndex write SetImageIndex default -1;
property Hint: string read GetHint write SetHint;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnResize;
property OnShow;
property OnStartDrag;
end;
TJvCustomNavPaneToolPanel = class;
TJvNavPaneToolButton = class(TCollectionItem)
private
FRealButton: TJvNavPanelToolButton;
procedure SetImageIndex(const Value: TImageIndex);
procedure SetEnabled(const Value: Boolean);
procedure SetAction(const Value: TBasicAction);
procedure SetHint(const Value: string);
function GetAction: TBasicAction;
function GetEnabled: Boolean;
function GetHint: string;
function GetImageIndex: TImageIndex;
public
procedure Assign(Source: TPersistent); override;
constructor Create(ACollection: Classes.TCollection); override;
destructor Destroy; override;
property Button: TJvNavPanelToolButton read FRealButton;
published
property Action: TBasicAction read GetAction write SetAction;
property Hint: string read GetHint write SetHint;
property ImageIndex: TImageIndex read GetImageIndex write SetImageIndex default -1;
property Enabled: Boolean read GetEnabled write SetEnabled default True;
end;
TJvNavPaneToolButtons = class(TOwnedCollection)
private
FPanel: TJvCustomNavPaneToolPanel;
function GetItem(Index: Integer): TJvNavPaneToolButton;
procedure SetItem(Index: Integer; const Value: TJvNavPaneToolButton);
protected
procedure Update(Item: TCollectionItem); override;
public
constructor Create(AOwner: TJvCustomNavPaneToolPanel);
function Add: TJvNavPaneToolButton;
property Items[Index: Integer]: TJvNavPaneToolButton read GetItem write SetItem; default;
end;
TJvNavPaneToolButtonClick = procedure(Sender: TObject; Index: Integer) of object;
TJvToolPanelHitTestInfo = (phtNowhere, phtAbove, phtBelow, phtToLeft, phtToRight, phtGrabber, phtHeader, phtClient);
TJvToolPanelHitTestInfos = set of TJvToolPanelHitTestInfo;
//SESS
TWMNCPaint = TLMessage;
TJvCustomNavPaneToolPanel = class(TJvCustomControl)
private
FStyleLink: TJvNavStyleLink;
FChangeLink: TChangeLink;
FStyleManager: TJvNavPaneStyleManager;
FButtonWidth: Integer;
FHeaderHeight: Integer;
FEdgeRounding: Integer;
FButtonHeight: Integer;
FImages: TCustomImageList;
FButtons: TJvNavPaneToolButtons;
FOnButtonClick: TJvNavPaneToolButtonClick;
FDropDown: TJvNavPanelToolButton;
FCloseButton: TJvNavPanelToolButton;
FOnClose: TNotifyEvent;
FShowGrabber: Boolean;
FOnDropDownMenu: TContextPopupEvent;
FParentStyleManager: Boolean;
FBackground: TJvNavPaneBackgroundImage;
FColors: TJvNavPanelColors;
FHeaderVisible: Boolean;
procedure DoStyleChange(Sender: TObject);
procedure DoImagesChange(Sender: TObject);
procedure ButtonsChanged;
procedure SetStyleManager(const Value: TJvNavPaneStyleManager);
procedure SetButtonHeight(const Value: Integer);
procedure SetButtonWidth(const Value: Integer);
procedure SetEdgeRounding(const Value: Integer);
procedure SetHeaderHeight(const Value: Integer);
procedure SetImages(const Value: TCustomImageList);
procedure SetButtons(const Value: TJvNavPaneToolButtons);
procedure InternalButtonClick(Sender: TObject);
function GetCloseButton: Boolean;
function GetDropDownMenu: TPopupMenu;
procedure SetCloseButton(const Value: Boolean);
procedure SetDropDownMenu(const Value: TPopupMenu);
procedure DoCloseClick(Sender: TObject);
procedure SetShowGrabber(const Value: Boolean);
procedure ParentStyleManagerChanged(var Msg: TMsgStyleManagerChange); message CM_PARENTSTYLEMANAGERCHANGED;
procedure ParentStyleManagerChange(var Msg: TLMessage); message CM_PARENTSTYLEMANAGERCHANGE;
procedure SetParentStyleManager(const Value: Boolean);
function GetDrawPartialMenuFrame: Boolean;
procedure SetDrawPartialMenuFrame(const Value: Boolean);
procedure SetBackground(const Value: TJvNavPaneBackgroundImage);
procedure SetColors(const Value: TJvNavPanelColors);
procedure SetHeaderVisible(const Value: Boolean);
function IsColorsStored: Boolean;
procedure CMControlChange(var Msg: TLMessage); message CM_CONTROLCHANGE;
procedure WMEraseBkgnd(var Msg: TLMEraseBkgnd); message LM_ERASEBKGND;
procedure WMNCPaint(var Msg: TWMNCPaint); message LM_NCPAINT;
procedure AlignButtons;
protected
procedure Paint; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure TextChanged; override;
procedure FontChanged; override;
procedure DoDropDownMenu(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
property EdgeRounding: Integer read FEdgeRounding write SetEdgeRounding default 9;
procedure AdjustClientRect(var Rect: TRect); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetHitTestInfoAt(X, Y: Integer): TJvToolPanelHitTestInfos;
procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer); override;
protected
property Background: TJvNavPaneBackgroundImage read FBackground write SetBackground;
property DrawPartialMenuFrame: Boolean read GetDrawPartialMenuFrame write SetDrawPartialMenuFrame default False;
property Buttons: TJvNavPaneToolButtons read FButtons write SetButtons;
property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 25;
property ButtonHeight: Integer read FButtonHeight write SetButtonHeight default 22;
property CloseButton: Boolean read GetCloseButton write SetCloseButton default True;
property Colors: TJvNavPanelColors read FColors write SetColors stored IsColorsStored;
property DropDownMenu: TPopupMenu read GetDropDownMenu write SetDropDownMenu;
property HeaderHeight: Integer read FHeaderHeight write SetHeaderHeight default 29;
property HeaderVisible: Boolean read FHeaderVisible write SetHeaderVisible default True;
property Images: TCustomImageList read FImages write SetImages;
// property ParentColor default False;
property ShowGrabber: Boolean read FShowGrabber write SetShowGrabber default True;
property StyleManager: TJvNavPaneStyleManager read FStyleManager write SetStyleManager;
property ParentStyleManager: Boolean read FParentStyleManager write SetParentStyleManager default True;
property OnButtonClick: TJvNavPaneToolButtonClick read FOnButtonClick write FOnButtonClick;
property OnClose: TNotifyEvent read FOnClose write FOnClose;
property OnDropDownMenu: TContextPopupEvent read FOnDropDownMenu write FOnDropDownMenu;
end;
TJvNavPaneToolPanel = class(TJvCustomNavPaneToolPanel)
published
property Align;
property Anchors;
property Caption;
property Constraints;
property BorderWidth;
property DragCursor;
property DragKind;
property DragMode;
property Background;
property DrawPartialMenuFrame;
property Buttons;
property ButtonWidth;
property ButtonHeight;
property CloseButton;
property Colors;
property DropDownMenu;
property HeaderHeight;
property HeaderVisible;
property Images;
property ShowGrabber;
property StyleManager;
// (p3) must be published after StyleManager
property ParentStyleManager;
property OnButtonClick;
property OnClose;
property OnDropDownMenu;
property Enabled;
property Font;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
property Width default 185;
property Height default 41;
property OnEndDock;
property OnStartDock;
property OnUnDock;
property OnClick;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
end;
TJvCustomNavigationPane = class(TJvCustomPageList)
private
FIconPanel: TJvIconPanel;
FSplitter: TJvOutlookSplitter;
FLargeImages: TCustomImageList;
FSmallImages: TCustomImageList;
FColors: TJvNavPanelColors;
FNavPanelFont: TFont;
FResizable: Boolean;
FButtonWidth: Integer;
FButtonHeight: Integer;
FStyleManager: TJvNavPaneStyleManager;
FStyleLink: TJvNavStyleLink;
FNavPanelHotTrackFont: TFont;
FNavPanelHotTrackFontOptions: TJvTrackFontOptions;
FAutoHeaders: Boolean;
FWordWrap: Boolean;
FAlignment: TAlignment;
FOnDropDownMenu: TContextPopupEvent;
FParentStyleManager: Boolean;
FBackground: TJvNavPaneBackgroundImage;
function GetDropDownMenu: TPopupMenu;
function GetSmallImages: TCustomImageList;
procedure SetDropDownMenu(const Value: TPopupMenu);
procedure SetLargeImages(const Value: TCustomImageList);
procedure SetSmallImages(const Value: TCustomImageList);
function GetMaximizedCount: Integer;
procedure SetMaximizedCount(Value: Integer);
procedure HidePanel(Index: Integer);
procedure ShowPanel(Index: Integer);
procedure SetColors(const Value: TJvNavPanelColors);
procedure SetResizable(const Value: Boolean);
function GetNavPage(Index: Integer): TJvNavPanelPage;
procedure DoSplitterCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
procedure DoColorsChange(Sender: TObject);
procedure SetNavPanelFont(const Value: TFont);
procedure SetNavPanelHotTrackFont(const Value: TFont);
procedure SetNavPanelHotTrackFontOptions(const Value: TJvTrackFontOptions);
procedure DoNavPanelFontChange(Sender: TObject);
procedure SetButtonHeight(const Value: Integer);
procedure SetButtonWidth(const Value: Integer);
procedure SetSplitterHeight(const Value: Integer);
function GetSplitterHeight: Integer;
procedure SetStyleManager(const Value: TJvNavPaneStyleManager);
procedure DoStyleChange(Sender: TObject);
procedure SetAutoHeaders(const Value: Boolean);
procedure SetAlignment(const Value: TAlignment);
procedure SetWordWrap(const Value: Boolean);
procedure ParentStyleManagerChanged(var Msg: TMsgStyleManagerChange); message CM_PARENTSTYLEMANAGERCHANGED;
procedure ParentStyleManagerChange(var Msg: TLMessage); message CM_PARENTSTYLEMANAGERCHANGE;
procedure CMControlChange(var Msg: TLMessage); message CM_CONTROLCHANGE;
procedure WMNCPaint(var Msg: TWMNCPaint); message LM_NCPAINT;
procedure WMEraseBkgnd(var Msg: TLMEraseBkgnd); message LM_ERASEBKGND;
procedure SetParentStyleManager(const Value: Boolean);
procedure SetBackground(const Value: TJvNavPaneBackgroundImage);
function GetSplitterClick: TNotifyEvent;
function GetSplitterDblClick: TNotifyEvent;
function GetSplitterMouseDown: TMouseEvent;
function GetSplitterMouseEnter: TNotifyEvent;
function GetSplitterMouseLeave: TNotifyEvent;
function GetSplitterMouseMove: TMouseMoveEvent;
function GetSplitterMouseUp: TMouseEvent;
procedure SetSplitterClick(const Value: TNotifyEvent);
procedure SetSplitterDblClick(const Value: TNotifyEvent);
procedure SetSplitterMouseDown(const Value: TMouseEvent);
procedure SetSplitterMouseEnter(const Value: TNotifyEvent);
procedure SetSplitterMouseLeave(const Value: TNotifyEvent);
procedure SetSplitterMouseMove(const Value: TMouseMoveEvent);
procedure SetSplitterMouseUp(const Value: TMouseEvent);
function GetSplitterCanResize: TCanResizeEvent;
function GetSplitterMoved: TNotifyEvent;
function GetSplitterPaint: TNotifyEvent;
procedure SetSplitterCanResize(const Value: TCanResizeEvent);
procedure SetSplitterMoved(const Value: TNotifyEvent);
procedure SetSplitterPaint(const Value: TNotifyEvent);
protected
function IsColorsStored: Boolean;
function IsNavPanelFontStored: Boolean;
function IsNavPanelFontHotTrackStored: Boolean;
function IsNavPanelHotTrackFontOptionsStored: Boolean;
procedure UpdatePages; virtual;
procedure SetActivePage(Page: TJvCustomPage); override;
procedure InsertPage(APage: TJvCustomPage); override;
procedure RemovePage(APage: TJvCustomPage); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Loaded; override;
procedure DoDropDownMenu(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
function InternalGetPageClass: TJvCustomPageClass; override;
property NavPages[Index: Integer]: TJvNavPanelPage read GetNavPage;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function HidePage(Page: TJvCustomPage): TJvCustomPage; override;
function ShowPage(Page: TJvCustomPage; PageIndex: Integer = -1): TJvCustomPage; override;
procedure UpdatePositions;
protected
property BorderWidth default 1;
property AutoHeaders: Boolean read FAutoHeaders write SetAutoHeaders default False;
property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
property Background: TJvNavPaneBackgroundImage read FBackground write SetBackground;
property ButtonHeight: Integer read FButtonHeight write SetButtonHeight default 28;
property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 22;
property NavPanelFont: TFont read FNavPanelFont write SetNavPanelFont;
property NavPanelHotTrackFont: TFont read FNavPanelHotTrackFont write SetNavPanelHotTrackFont;
property NavPanelHotTrackFontOptions: TJvTrackFontOptions read FNavPanelHotTrackFontOptions write SetNavPanelHotTrackFontOptions;
property Color default clWindow;
property Colors: TJvNavPanelColors read FColors write SetColors;
property StyleManager: TJvNavPaneStyleManager read FStyleManager write SetStyleManager;
// (p3) must be published after StyleManager
property ParentStyleManager: Boolean read FParentStyleManager write SetParentStyleManager default True;
property DropDownMenu: TPopupMenu read GetDropDownMenu write SetDropDownMenu;
property LargeImages: TCustomImageList read FLargeImages write SetLargeImages;
property MaximizedCount: Integer read GetMaximizedCount write SetMaximizedCount;
property ParentColor default False;
property Resizable: Boolean read FResizable write SetResizable default True;
property SmallImages: TCustomImageList read GetSmallImages write SetSmallImages;
property SplitterHeight: Integer read GetSplitterHeight write SetSplitterHeight default 7;
property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
property Splitter: TJvOutlookSplitter read FSplitter;
property IconPanel: TJvIconPanel read FIconPanel;
property OnDropDownMenu: TContextPopupEvent read FOnDropDownMenu write FOnDropDownMenu;
property OnSplitterCanResize: TCanResizeEvent read GetSplitterCanResize write SetSplitterCanResize;
property OnSplitterMoved: TNotifyEvent read GetSplitterMoved write SetSplitterMoved;
property OnSplitterPaint: TNotifyEvent read GetSplitterPaint write SetSplitterPaint;
property OnSplitterClick: TNotifyEvent read GetSplitterClick write SetSplitterClick;
property OnSplitterMouseEnter: TNotifyEvent read GetSplitterMouseEnter write SetSplitterMouseEnter;
property OnSplitterMouseLeave: TNotifyEvent read GetSplitterMouseLeave write SetSplitterMouseLeave;
property OnSplitterDblClick: TNotifyEvent read GetSplitterDblClick write SetSplitterDblClick;
property OnSplitterMouseDown: TMouseEvent read GetSplitterMouseDown write SetSplitterMouseDown;
property OnSplitterMouseMove: TMouseMoveEvent read GetSplitterMouseMove write SetSplitterMouseMove;
property OnSplitterMouseUp: TMouseEvent read GetSplitterMouseUp write SetSplitterMouseUp;
end;
TJvNavigationPane = class(TJvCustomNavigationPane)
public
property NavPages;
property Splitter;
property IconPanel;
published
property ActivePage;
// property Alignment;
property Align;
property Anchors;
property AutoHeaders;
property BorderWidth;
property DragCursor;
property DragKind;
property OnStartDock;
property OnDockDrop;
property OnDockOver;
property OnUnDock;
property OnEndDock;
property Background;
property ButtonHeight;
property ButtonWidth;
property Caption;
property Color;
property Colors stored IsColorsStored;
property StyleManager;
// (p3) must be published after StyleManager
property ParentStyleManager;
property Constraints;
property DragMode;
property DropDownMenu;
property Enabled;
property Font;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property SplitterHeight;
property Visible;
property LargeImages;
property MaximizedCount;
property NavPanelFont stored IsNavPanelFontStored;
property NavPanelHotTrackFont stored IsNavPanelFontHotTrackStored;
property NavPanelHotTrackFontOptions stored IsNavPanelHotTrackFontOptionsStored;
property Resizable;
property SmallImages;
// property WordWrap;
property OnChange;
property OnChanging;
property OnDropDownMenu;
property OnClick;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnStartDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnResize;
property OnSplitterCanResize;
property OnSplitterMoved;
property OnSplitterPaint;
property OnSplitterClick;
property OnSplitterMouseEnter;
property OnSplitterMouseLeave;
property OnSplitterDblClick;
property OnSplitterMouseDown;
property OnSplitterMouseMove;
property OnSplitterMouseUp;
end;
TJvNavStyleLink = class(TObject)
private
FSender: TObject;
FOnChange: TNotifyEvent;
public
destructor Destroy; override;
procedure Change; dynamic;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property Sender: TObject read FSender write FSender;
end;
TJvNavPanelTheme = (nptStandard, nptXPBlue, nptXPSilver, nptXPOlive, nptCustom);
// TJvNavPaneStyleManager = class(TJvComponent)
TJvNavPaneStyleManager = class(TComponent)
private
FColors: TJvNavPanelColors;
FTheme: TJvNavPanelTheme;
FClients: TList;
FFonts: TJvNavPanelFonts;
FOnThemeChange: TNotifyEvent;
procedure SetColors(const Value: TJvNavPanelColors);
procedure SetTheme(const Value: TJvNavPanelTheme);
procedure DoThemeChange(Sender: TObject);
procedure SetFonts(const Value: TJvNavPanelFonts);
function IsColorsStored: Boolean;
function IsFontsStored: Boolean;
protected
procedure Change; virtual;
procedure AssignTo(Dest: TPersistent); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure RegisterChanges(Value: TJvNavStyleLink);
procedure UnregisterChanges(Value: TJvNavStyleLink);
published
property Colors: TJvNavPanelColors read FColors write SetColors stored IsColorsStored;
property Fonts: TJvNavPanelFonts read FFonts write SetFonts stored IsFontsStored;
property Theme: TJvNavPanelTheme read FTheme write SetTheme nodefault;
property OnThemeChange: TNotifyEvent read FOnThemeChange write FOnThemeChange;
end;
implementation
uses
ActnList, Forms, JvJVCLUtils, JvJCLUtils;
const
cNavPanelButtonGroupIndex = 113;
cToolButtonHeight = 18;
cToolButtonOffset = 14;
cToolButtonWidth = 18;
procedure InternalStyleManagerChanged(AControl: TWinControl; AStyleManager: TJvNavPaneStyleManager);
var
Msg: TMsgStyleManagerChange;
begin
Msg.Msg := CM_PARENTSTYLEMANAGERCHANGED;
Msg.Sender := AControl;
Msg.StyleManager := AStyleManager;
Msg.Result := 0;
AControl.Broadcast(Msg);
end;
//=== { TJvIconPanel } =======================================================
constructor TJvIconPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle - [csAcceptsControls];
FStyleLink := TJvNavStyleLink.Create;
FStyleLink.OnChange := @DoStyleChange;
ControlStyle := ControlStyle + [csOpaque, csAcceptsControls];
Height := 28;
FDropButton := TJvNavIconButton.Create(Self);
FDropButton.Visible := False;
FDropButton.ButtonType := nibDropDown;
FDropButton.GroupIndex := 0;
FDropButton.Width := 22;
FDropButton.Left := Width + 10;
FDropButton.Align := alRight;
FDropButton.Parent := Self;
FDropButton.OnDropDownMenu := @DoDropDownMenu;
FColors := TJvNavPanelColors.Create;
FColors.OnChange := @DoColorsChange;
FParentStyleManager := True;
end;
destructor TJvIconPanel.Destroy;
begin
FStyleLink.Free;
FColors.Free;
// Don't free FDropButton: it is freed automatically
inherited Destroy;
end;
procedure TJvIconPanel.DoColorsChange(Sender: TObject);
begin
Invalidate;
end;
procedure TJvIconPanel.DoStyleChange(Sender: TObject);
begin
Colors := (Sender as TJvNavPaneStyleManager).Colors;
Font := (Sender as TJvNavPaneStyleManager).Fonts.NavPanelFont;
end;
function TJvIconPanel.GetDropDownMenu: TPopupMenu;
begin
Result := FDropButton.DropDownMenu
end;
procedure TJvIconPanel.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
begin
if AComponent = StyleManager then
StyleManager := nil;
end;
end;
procedure TJvIconPanel.Paint;
begin
GradientFillRect(Canvas, ClientRect, Colors.ButtonColorFrom, Colors.ButtonColorTo, fdTopToBottom, 32);
Canvas.Pen.Color := Colors.FrameColor;
if Align = alBottom then
begin
Canvas.MoveTo(0, 0);
Canvas.LineTo(Width + 1, 0);
end
else
begin
Canvas.MoveTo(0, ClientHeight - 1);
Canvas.LineTo(Width + 1, ClientHeight - 1);
end;
end;
procedure TJvIconPanel.SetColors(const Value: TJvNavPanelColors);
begin
FColors.Assign(Value);
FDropButton.Colors := Value;
end;
procedure TJvIconPanel.SetStyleManager(const Value: TJvNavPaneStyleManager);
//var
// I: Integer;
begin
if FStyleManager <> Value then
begin
ParentStyleManager := False;
if FStyleManager <> nil then
FStyleManager.UnregisterChanges(FStyleLink);
FStyleManager := Value;
if FStyleManager <> nil then
begin
FStyleManager.RegisterChanges(FStyleLink);
FStyleManager.FreeNotification(Self);
Colors := FStyleManager.Colors;
end;
end;
// FDropButton.StyleManager := Value;
InternalStyleManagerChanged(Self, Value);
// TODO: should this be removed?
// for I := 0 to ControlCount - 1 do
// if Controls[I] is TJvNavIconButton then
// TJvNavIconButton(Controls[I]).StyleManager := Value;
end;
procedure TJvIconPanel.SetDropDownMenu(const Value: TPopupMenu);
begin
FDropButton.DropDownMenu := Value;
FDropButton.Visible := Value <> nil;
end;
procedure TJvIconPanel.DoDropDownMenu(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
begin
if Assigned(FOnDropDownMenu) then
FOnDropDownMenu(Self, MousePos, Handled);
end;
procedure TJvIconPanel.ParentStyleManagerChanged(var Msg: TMsgStyleManagerChange);
begin
if (Msg.Sender <> Self) and ParentStyleManager then
begin
StyleManager := Msg.StyleManager;
ParentStyleManager := True;
InternalStyleManagerChanged(Self, Msg.StyleManager);
end;
end;
procedure TJvIconPanel.SetParentStyleManager(const Value: Boolean);
begin
if FParentStyleManager <> Value then
begin
FParentStyleManager := Value;
if FParentStyleManager and (Parent <> nil) then
Parent.Perform(CM_PARENTSTYLEMANAGERCHANGE, 0, 0);
end;
end;
procedure TJvIconPanel.CMControlChange(var Msg: TLMessage);
begin
InternalStyleManagerChanged(Self, StyleManager);
end;
procedure TJvIconPanel.WMEraseBkgnd(var Msg: TLMEraseBkgnd);
begin
Msg.Result := 1;
end;
procedure TJvIconPanel.ParentStyleManagerChange(var Msg: TLMessage);
begin
InternalStyleManagerChanged(Self, StyleManager);
end;
//=== { TJvCustomNavigationPane } ============================================
var
GlobalNavPanelPageRegistered: Boolean = False;
constructor TJvCustomNavigationPane.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if not GlobalNavPanelPageRegistered then
begin
GlobalNavPanelPageRegistered := True;
RegisterClasses([TJvNavPanelPage]);
end;
FBackground := TJvNavPaneBackgroundImage.Create;
FBackground.OnChange := @DoColorsChange;
ControlStyle := ControlStyle - [csAcceptsControls];
FStyleLink := TJvNavStyleLink.Create;
FStyleLink.OnChange := @DoStyleChange;
FButtonHeight := 28;
FButtonWidth := 22;
BorderWidth := 1;
ParentColor := False;
Color := clWindow;
ControlStyle := ControlStyle + [csOpaque];
FResizable := True;
FColors := TJvNavPanelColors.Create;
FColors.OnChange := @DoColorsChange;
FIconPanel := TJvIconPanel.Create(Self);
FIconPanel.Parent := Self;
FIconPanel.Align := alBottom;
FIconPanel.OnDropDownMenu := @DoDropDownMenu;
FNavPanelFont := TFont.Create;
FNavPanelHotTrackFont := TFont.Create;
//TODO:
//FNavPanelFont.Assign(Screen.IconFont);
FNavPanelFont.Style := [fsBold];
FNavPanelFont.OnChange := @DoNavPanelFontChange;
FNavPanelHotTrackFont.Assign(FNavPanelFont);
FNavPanelHotTrackFont.OnChange := @DoNavPanelFontChange;
FNavPanelHotTrackFontOptions := DefaultTrackFontOptions;
FSplitter := TJvOutlookSplitter.Create(Self);
with FSplitter do
begin
ResizeStyle := rsNone;
MinSize := 1;
OnCanResize := @DoSplitterCanResize;
Parent := Self;
end;
FParentStyleManager := True;
FIconPanel.SetSubComponent(True);
FSplitter.SetSubComponent(True);
end;
destructor TJvCustomNavigationPane.Destroy;
begin
FStyleLink.Free;
FColors.Free;
FNavPanelFont.Free;
FNavPanelHotTrackFont.Free;
FBackground.Free;
inherited Destroy;
end;
procedure TJvCustomNavigationPane.DoSplitterCanResize(Sender: TObject;
var NewSize: Integer; var Accept: Boolean);
var
ACount: Integer;
begin
ACount := MaximizedCount;
if NewSize < ButtonHeight div 2 then
MaximizedCount := ACount - 1
else
if NewSize > ButtonHeight + ButtonHeight div 2 then
MaximizedCount := ACount + 1;
NewSize := 0;
Accept := False;
end;
function TJvCustomNavigationPane.GetDropDownMenu: TPopupMenu;
begin
if FIconPanel <> nil then
Result := FIconPanel.DropDownMenu
else
Result := nil;
end;
function TJvCustomNavigationPane.GetSmallImages: TCustomImageList;
begin
Result := FSmallImages;
end;
function TJvCustomNavigationPane.GetMaximizedCount: Integer;
var
I: Integer;
begin
Result := 0;
for I := 0 to PageCount - 1 do
if not NavPages[I].Iconic then
Inc(Result);
end;
function TJvCustomNavigationPane.HidePage(Page: TJvCustomPage): TJvCustomPage;
begin
Result := inherited HidePage(Page);
if Result <> nil then
UpdatePositions;
end;
function TJvCustomNavigationPane.ShowPage(Page: TJvCustomPage; PageIndex: Integer): TJvCustomPage;
begin
Result := inherited ShowPage(Page, PageIndex);
if Result <> nil then
UpdatePositions;
end;
procedure TJvCustomNavigationPane.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
begin
if AComponent = LargeImages then
LargeImages := nil;
if AComponent = SmallImages then
SmallImages := nil;
if AComponent = StyleManager then
StyleManager := nil;
end;
end;
procedure TJvCustomNavigationPane.SetDropDownMenu(const Value: TPopupMenu);
begin
if FIconPanel <> nil then
FIconPanel.DropDownMenu := Value;
end;
procedure TJvCustomNavigationPane.SetLargeImages(const Value: TCustomImageList);
begin
if FLargeImages <> Value then
begin
FLargeImages := Value;
UpdatePages;
end;
end;
procedure TJvCustomNavigationPane.SetSmallImages(const Value: TCustomImageList);
begin
if FSmallImages <> Value then
begin
FSmallImages := Value;
UpdatePages;
end;
end;
procedure TJvCustomNavigationPane.HidePanel(Index: Integer);
begin
if (Index >= 0) and (Index < PageCount) then // don't hide the first panel
NavPages[Index].Iconic := True;
end;
procedure TJvCustomNavigationPane.ShowPanel(Index: Integer);
begin
if (Index >= 0) and (Index < PageCount) then
NavPages[Index].Iconic := False;
end;
procedure TJvCustomNavigationPane.SetMaximizedCount(Value: Integer);
var
I, ACount: Integer;
begin
ACount := MaximizedCount;
if Value < 0 then
Value := 0;
if Value > PageCount then
Value := PageCount;
if Value = MaximizedCount then
Exit;
while ACount > Value do
begin
HidePanel(ACount - 1);
Dec(ACount);
end;
if Value > ACount then
for I := Value downto ACount do
ShowPanel(I - 1);
UpdatePositions;
end;
procedure TJvCustomNavigationPane.UpdatePositions;
var
bw, bh, I, X, Y: Integer;
begin
if (csDestroying in ComponentState) or (FIconPanel = nil) then
Exit;
DisableAlign;
FIconPanel.DisableAlign;
try
// 25.09.2007 - SESS: Original code doesn't work in lazarus.
(*
Y := 0;
X := 0;
FSplitter.Top := Y;
FIconPanel.FDropButton.Left := Width;
FIconPanel.Top := Height - FIconPanel.Height;
Inc(Y, FSplitter.Height);
for I := 0 to PageCount - 1 do
begin
if (NavPages[I].NavPanel = nil) or (NavPages[I].IconButton = nil) then
Exit;
NavPages[I].IconButton.Left := X;
Inc(X, NavPages[I].IconButton.Width);
NavPages[I].NavPanel.Top := Y;
Inc(Y, NavPages[I].NavPanel.Height);
NavPages[I].Invalidate;
end;
*)
// 25.09.2007: Rewrited by SESS.
// Buttons heights & widths
bw := 0;
bh := 0;
for I := 0 to PageCount - 1 do
if NavPages[I].Iconic then
Inc(bw, NavPages[I].IconButton.Width)
else
Inc(bh, NavPages[I].NavPanel.Height);
// First positions
X := Self.Width - bw - FIconPanel.FDropButton.Width;
Y := Self.Height - FSplitter.Height - bh - FIconPanel.Height;
// Splitter
FSplitter.Top := Y;
Inc(Y, FSplitter.Height);
// Pages
for I := 0 to PageCount - 1 do
begin
if (NavPages[I].NavPanel = nil) or (NavPages[I].IconButton = nil) then
Exit;
if NavPages[I].Iconic then
begin
NavPages[I].IconButton.Left := X;
Inc(X, NavPages[I].IconButton.Width);
end
else
begin
NavPages[I].NavPanel.Top := Y;
Inc(Y, NavPages[I].NavPanel.Height);
end;
NavPages[I].Invalidate;
end;
// Icon panel
FIconPanel.FDropButton.Left := X;
FIconPanel.Top := Y;
finally
EnableAlign;
FIconPanel.EnableAlign;
end;
Invalidate;
end;
procedure TJvCustomNavigationPane.SetColors(const Value: TJvNavPanelColors);
begin
FColors.Assign(Value);
end;
procedure TJvCustomNavigationPane.DoColorsChange(Sender: TObject);
begin
if FIconPanel <> nil then
TJvIconPanel(FIconPanel).Colors := Colors;
UpdatePages;
FSplitter.ColorFrom := Colors.SplitterColorFrom;
FSplitter.ColorTo := Colors.SplitterColorTo;
Invalidate;
end;
procedure TJvCustomNavigationPane.Loaded;
begin
inherited Loaded;
UpdatePositions;
end;
procedure TJvCustomNavigationPane.SetResizable(const Value: Boolean);
begin
if FResizable <> Value then
begin
FResizable := Value;
FSplitter.Enabled := FResizable;
end;
end;
function TJvCustomNavigationPane.InternalGetPageClass: TJvCustomPageClass;
begin
Result := TJvNavPanelPage;
end;
function TJvCustomNavigationPane.GetNavPage(Index: Integer): TJvNavPanelPage;
begin
Result := TJvNavPanelPage(Pages[Index]);
end;
procedure TJvCustomNavigationPane.InsertPage(APage: TJvCustomPage);
begin
inherited InsertPage(APage);
if APage <> nil then
begin
TJvNavPanelPage(APage).Top := FIconPanel.Top;
if (ActivePage = nil) and not (csLoading in ComponentState) then
ActivePage := APage;
end;
UpdatePositions;
end;
procedure TJvCustomNavigationPane.SetActivePage(Page: TJvCustomPage);
begin
inherited SetActivePage(Page);
if ActivePage <> nil then
begin
TJvNavPanelPage(ActivePage).NavPanel.Down := True;
TJvNavPanelPage(ActivePage).IconButton.Down := True;
TJvNavPanelPage(ActivePage).NavPanel.Invalidate;
TJvNavPanelPage(ActivePage).IconButton.Invalidate;
ActivePage.Invalidate;
end;
end;
procedure TJvCustomNavigationPane.SetBackground(const Value: TJvNavPaneBackgroundImage);
begin
FBackground.Assign(Value);
end;
procedure TJvCustomNavigationPane.SetNavPanelFont(const Value: TFont);
begin
FNavPanelFont.Assign(Value);
end;
procedure TJvCustomNavigationPane.SetNavPanelHotTrackFont(const Value: TFont);
begin
FNavPanelHotTrackFont.Assign(Value);
end;
procedure TJvCustomNavigationPane.SetNavPanelHotTrackFontOptions(const Value: TJvTrackFontOptions);
begin
if FNavPanelHotTrackFontOptions <> Value then
begin
FNavPanelHotTrackFontOptions := Value;
UpdatePages;
end;
end;
function TJvCustomNavigationPane.IsNavPanelFontStored: Boolean;
var
F: TFont;
begin
//TODO:
(*
F := Screen.IconFont;
with FNavPanelFont do
Result := ((StyleManager = nil) or (StyleManager.Theme = nptCustom)) and ((Name <> F.Name) or (Size <> F.Size) or (Style <> [fsBold]) or
(Color <> F.Color) or (Pitch <> F.Pitch) or (Charset <> F.Charset));
*)
Result := true;
end;
function TJvCustomNavigationPane.IsNavPanelFontHotTrackStored: Boolean;
begin
Result := IsNavPanelHotTrackFontOptionsStored or IsNavPanelFontStored;
end;
function TJvCustomNavigationPane.IsNavPanelHotTrackFontOptionsStored: Boolean;
begin
Result := not (hoFollowFont in NavPanelHotTrackFontOptions);
end;
procedure TJvCustomNavigationPane.DoNavPanelFontChange(Sender: TObject);
begin
UpdatePages;
end;
procedure TJvCustomNavigationPane.RemovePage(APage: TJvCustomPage);
begin
inherited RemovePage(APage);
Invalidate;
end;
procedure TJvCustomNavigationPane.SetButtonHeight(const Value: Integer);
begin
if FButtonHeight <> Value then
begin
FButtonHeight := Value;
UpdatePages;
FIconPanel.Height := FButtonHeight;
end;
end;
procedure TJvCustomNavigationPane.SetButtonWidth(const Value: Integer);
begin
if FButtonWidth <> Value then
begin
FButtonWidth := Value;
UpdatePages;
FIconPanel.FDropButton.Width := FButtonWidth;
end;
end;
procedure TJvCustomNavigationPane.SetSplitterHeight(const Value: Integer);
begin
if FSplitter.Height <> Value then
FSplitter.Height := Value;
end;
function TJvCustomNavigationPane.GetSplitterHeight: Integer;
begin
Result := FSplitter.Height;
end;
procedure TJvCustomNavigationPane.SetStyleManager(const Value: TJvNavPaneStyleManager);
begin
if FStyleManager <> Value then
begin
ParentStyleManager := False;
if FStyleManager <> nil then
FStyleManager.UnregisterChanges(FStyleLink);
FStyleManager := Value;
if FStyleManager <> nil then
begin
FStyleManager.RegisterChanges(FStyleLink);
FStyleManager.FreeNotification(Self);
Colors := FStyleManager.Colors;
NavPanelFont := FStyleManager.Fonts.FNavPanelFont;
NavPanelHotTrackFont := FStyleManager.Fonts.FNavPanelHotTrackFont;
NavPanelHotTrackFontOptions := FStyleManager.Fonts.FNavPanelHotTrackFontOptions;
end;
// FSplitter.StyleManager := Value;
InternalStyleManagerChanged(Self, Value);
end;
end;
procedure TJvCustomNavigationPane.DoStyleChange(Sender: TObject);
begin
Colors := (Sender as TJvNavPaneStyleManager).Colors;
NavPanelFont := (Sender as TJvNavPaneStyleManager).Fonts.NavPanelFont;
NavPanelHotTrackFont := (Sender as TJvNavPaneStyleManager).Fonts.NavPanelHotTrackFont;
NavPanelHotTrackFontOptions := (Sender as TJvNavPaneStyleManager).Fonts.NavPanelHotTrackFontOptions;
end;
procedure TJvCustomNavigationPane.SetAutoHeaders(const Value: Boolean);
begin
if FAutoHeaders <> Value then
begin
FAutoHeaders := Value;
UpdatePages;
end;
end;
procedure TJvCustomNavigationPane.SetAlignment(const Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
UpdatePages;
end;
end;
procedure TJvCustomNavigationPane.SetWordWrap(const Value: Boolean);
begin
if FWordWrap <> Value then
begin
FWordWrap := Value;
UpdatePages;
end;
end;
procedure TJvCustomNavigationPane.UpdatePages;
var
I: Integer;
begin
for I := 0 to PageCount - 1 do
begin
NavPages[I].AutoHeader := AutoHeaders;
NavPages[I].NavPanel.Height := ButtonHeight;
NavPages[I].IconButton.Width := ButtonWidth;
NavPages[I].NavPanel.Colors := Colors;
NavPages[I].IconButton.Colors := Colors;
NavPages[I].NavPanel.HotTrackFontOptions := NavPanelHotTrackFontOptions;
NavPages[I].NavPanel.Font := FNavPanelFont;
NavPages[I].NavPanel.HotTrackFont := FNavPanelHotTrackFont;
NavPages[I].WordWrap := WordWrap;
NavPages[I].Alignment := Alignment;
NavPages[I].NavPanel.Images := LargeImages;
if AutoHeaders then
NavPages[I].Header.Images := LargeImages;
NavPages[I].IconButton.Images := SmallImages;
// NavPages[I].StyleManager := StyleManager;
end;
end;
procedure TJvCustomNavigationPane.DoDropDownMenu(Sender: TObject;
MousePos: TPoint; var Handled: Boolean);
begin
if Assigned(FOnDropDownMenu) then
FOnDropDownMenu(Self, MousePos, Handled);
end;
procedure TJvCustomNavigationPane.ParentStyleManagerChanged(
var Msg: TMsgStyleManagerChange);
begin
if (Msg.Sender <> Self) and ParentStyleManager then
begin
StyleManager := Msg.StyleManager;
ParentStyleManager := True;
InternalStyleManagerChanged(Self, Msg.StyleManager);
end;
end;
procedure TJvCustomNavigationPane.SetParentStyleManager(const Value: Boolean);
begin
if FParentStyleManager <> Value then
begin
FParentStyleManager := Value;
if FParentStyleManager and (Parent <> nil) then
Parent.Perform(CM_PARENTSTYLEMANAGERCHANGE, 0, 0);
end;
end;
procedure TJvCustomNavigationPane.CMControlChange(var Msg: TLMessage);
begin
InternalStyleManagerChanged(Self, StyleManager);
end;
procedure TJvCustomNavigationPane.WMNCPaint(var Msg: TWMNCPaint);
var
AColor: TColor;
begin
AColor := Color;
try
Color := Colors.FrameColor;
inherited;
finally
Color := AColor;
end;
end;
procedure TJvCustomNavigationPane.WMEraseBkgnd(var Msg: TLMEraseBkgnd);
begin
if ActivePage = nil then
begin
Canvas.Brush.Color := Color;
Canvas.FillRect(ClientRect);
FBackground.DrawImage(Canvas, ClientRect);
end;
Msg.Result := 1;
end;
procedure TJvCustomNavigationPane.ParentStyleManagerChange(var Msg: TLMessage);
begin
InternalStyleManagerChanged(Self, StyleManager);
end;
function TJvCustomNavigationPane.IsColorsStored: Boolean;
begin
Result := (StyleManager = nil) or (StyleManager.Theme = nptCustom);
end;
function TJvCustomNavigationPane.GetSplitterClick: TNotifyEvent;
begin
if FSplitter <> nil then
Result := FSplitter.OnClick
else
Result := nil;
end;
function TJvCustomNavigationPane.GetSplitterDblClick: TNotifyEvent;
begin
if FSplitter <> nil then
Result := FSplitter.OnDblClick
else
Result := nil;
end;
function TJvCustomNavigationPane.GetSplitterMouseDown: TMouseEvent;
begin
if FSplitter <> nil then
Result := FSplitter.OnMouseDown
else
Result := nil;
end;
function TJvCustomNavigationPane.GetSplitterMouseEnter: TNotifyEvent;
begin
if FSplitter <> nil then
Result := FSplitter.OnMouseEnter
else
Result := nil;
end;
function TJvCustomNavigationPane.GetSplitterMouseLeave: TNotifyEvent;
begin
if FSplitter <> nil then
Result := FSplitter.OnMouseLeave
else
Result := nil;
end;
function TJvCustomNavigationPane.GetSplitterMouseMove: TMouseMoveEvent;
begin
if FSplitter <> nil then
Result := FSplitter.OnMouseMove
else
Result := nil;
end;
function TJvCustomNavigationPane.GetSplitterMouseUp: TMouseEvent;
begin
if FSplitter <> nil then
Result := FSplitter.OnMouseUp
else
Result := nil;
end;
function TJvCustomNavigationPane.GetSplitterCanResize: TCanResizeEvent;
begin
if FSplitter <> nil then
Result := FSplitter.OnCanResize
else
Result := nil;
end;
function TJvCustomNavigationPane.GetSplitterMoved: TNotifyEvent;
begin
if FSplitter <> nil then
Result := FSplitter.OnMoved
else
Result := nil;
end;
function TJvCustomNavigationPane.GetSplitterPaint: TNotifyEvent;
begin
if FSplitter <> nil then
Result := FSplitter.OnPaint
else
Result := nil;
end;
procedure TJvCustomNavigationPane.SetSplitterCanResize(const Value: TCanResizeEvent);
begin
if FSplitter <> nil then
FSplitter.OnCanResize := Value;
end;
procedure TJvCustomNavigationPane.SetSplitterMoved(const Value: TNotifyEvent);
begin
if FSplitter <> nil then
FSplitter.OnMoved := Value;
end;
procedure TJvCustomNavigationPane.SetSplitterPaint(const Value: TNotifyEvent);
begin
if FSplitter <> nil then
FSplitter.OnPaint := Value;
end;
procedure TJvCustomNavigationPane.SetSplitterClick(const Value: TNotifyEvent);
begin
if FSplitter <> nil then
FSplitter.OnClick := Value;
end;
procedure TJvCustomNavigationPane.SetSplitterDblClick(
const Value: TNotifyEvent);
begin
if FSplitter <> nil then
FSplitter.OnDblClick := Value;
end;
procedure TJvCustomNavigationPane.SetSplitterMouseDown(
const Value: TMouseEvent);
begin
if FSplitter <> nil then
FSplitter.OnMouseDown := Value;
end;
procedure TJvCustomNavigationPane.SetSplitterMouseEnter(
const Value: TNotifyEvent);
begin
if FSplitter <> nil then
FSplitter.OnMouseEnter := Value;
end;
procedure TJvCustomNavigationPane.SetSplitterMouseLeave(
const Value: TNotifyEvent);
begin
if FSplitter <> nil then
FSplitter.OnMouseLeave := Value;
end;
procedure TJvCustomNavigationPane.SetSplitterMouseMove(
const Value: TMouseMoveEvent);
begin
if FSplitter <> nil then
FSplitter.OnMouseMove := Value;
end;
procedure TJvCustomNavigationPane.SetSplitterMouseUp(
const Value: TMouseEvent);
begin
if FSplitter <> nil then
FSplitter.OnMouseUp := Value;
end;
//=== { TJvNavIconButton } ===================================================
constructor TJvNavIconButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FStyleLink := TJvNavStyleLink.Create;
FStyleLink.OnChange := @DoStyleChange;
FColors := TJvNavPanelColors.Create;
FColors.OnChange := @DoColorsChange;
FChangeLink := TChangeLink.Create;
FChangeLink.OnChange := @DoImagesChange;
Width := 22;
Height := 22;
//TODO:
//Font := Screen.IconFont;
Font.Style := [fsBold];
FParentStyleManager := True;
end;
destructor TJvNavIconButton.Destroy;
begin
FStyleLink.Free;
FChangeLink.Free;
FColors.Free;
inherited Destroy;
end;
procedure TJvNavIconButton.DoColorsChange(Sender: TObject);
begin
Invalidate;
end;
procedure TJvNavIconButton.DoImagesChange(Sender: TObject);
begin
Invalidate;
end;
procedure TJvNavIconButton.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
if AComponent = Images then
Images := nil
else
if AComponent = StyleManager then
StyleManager := nil;
end;
procedure TJvNavIconButton.Paint;
var
Rect: TRect;
P: TPoint;
I: Integer;
h, w: integer;
begin
with Canvas do
begin
Rect := ClientRect;
Brush.Style := bsClear;
InflateRect(Rect, 0, -1);
if bsMouseInside in MouseStates then
begin
if bsMouseDown in MouseStates then
GradientFillRect(Canvas, Rect, Self.Colors.ButtonSelectedColorFrom,
Self.Colors.ButtonSelectedColorTo, fdTopToBottom, 32)
else
GradientFillRect(Canvas, Rect, Self.Colors.ButtonHotColorFrom,
Self.Colors.ButtonHotColorTo, fdTopToBottom, 32)
end
else
if Down then
GradientFillRect(Canvas, Rect, Self.Colors.ButtonSelectedColorFrom,
Self.Colors.ButtonSelectedColorTo, fdTopToBottom, 32);
case ButtonType of
nibDropDown:
begin // area should be 7x12
InflateRect(Rect, -((Rect.Right - Rect.Left) - 7) div 2, -((Rect.Bottom - Rect.Top) - 12) div 2);
if bsMouseDown in MouseStates then
OffsetRect(Rect, 1, 1);
Canvas.Pen.Color := clBlack;
P.X := Rect.Left;
P.Y := Rect.Top;
// chevron, upper
for I := 0 to 2 do
begin
Canvas.MoveTo(P.X, P.Y);
Canvas.LineTo(P.X + 2, P.Y);
Canvas.MoveTo(P.X + 4, P.Y);
Canvas.LineTo(P.X + 6, P.Y);
Inc(P.X);
Inc(P.Y);
end;
// chevron, lower
Dec(P.X);
Dec(P.Y);
for I := 0 to 2 do
begin
Canvas.MoveTo(P.X, P.Y);
Canvas.LineTo(P.X + 2, P.Y);
Canvas.MoveTo(P.X + 4, P.Y);
Canvas.LineTo(P.X + 6, P.Y);
Dec(P.X);
Inc(P.Y);
end;
// drop arrow
Inc(P.X, 1);
Inc(P.Y, 3);
for I := 0 to 3 do
begin
Canvas.MoveTo(P.X + I, P.Y + I);
Canvas.LineTo(P.X + 7 - I, P.Y + I);
end;
end;
nibImage:
begin
if (Images <> nil) and (ImageIndex >= 0) and (ImageIndex < Images.Count) then
// draw image only
Images.Draw(Canvas,
(Self.Width - Images.Width) div 2 + Ord(bsMouseDown in MouseStates),
(Self.Height - Images.Height) div 2 + Ord(bsMouseDown in MouseStates),
ImageIndex, Enabled);
end;
nibDropArrow:
begin
// area should be 9 x 5, centered
P.X := Rect.Left + (RectWidth(Rect) - 9) div 2 + Ord(bsMouseDown in MouseStates);
P.Y := Rect.Top + (RectHeight(Rect) - 5) div 2 + Ord(bsMouseDown in MouseStates);
Canvas.Pen.Color := clBlack;
for I := 0 to 4 do
begin
Canvas.MoveTo(P.X + I, P.Y + I);
Canvas.LineTo(P.X + 9 - I, P.Y + I);
end;
end;
nibClose:
begin
// area should be 8 x 8, centered
P.X := (RectWidth(ClientRect) - 8) div 2 + Ord(bsMouseDown in MouseStates);
P.Y := (RectHeight(ClientRect) - 8) div 2 + Ord(bsMouseDown in MouseStates);
Canvas.Pen.Color := clBlack;
for I := 0 to 7 do
begin
Canvas.MoveTo(P.X + I, P.Y + I);
Canvas.LineTo(P.X + I + 2, P.Y + I);
end;
Inc(P.X, 7);
for I := 0 to 7 do
begin
Canvas.MoveTo(P.X - I, P.Y + I);
Canvas.LineTo(P.X - I + 2, P.Y + I);
end;
end;
end;
if csDesigning in ComponentState then
begin
Canvas.Pen.Color := clBlack;
Canvas.Pen.Style := psDot;
Canvas.Brush.Style := bsClear;
Canvas.Rectangle(ClientRect);
end;
end;
end;
procedure TJvNavIconButton.SetColors(const Value: TJvNavPanelColors);
begin
FColors.Assign(Value);
end;
procedure TJvNavIconButton.SetImageIndex(const Value: TImageIndex);
begin
if FImageIndex <> Value then
begin
FImageIndex := Value;
Invalidate;
end;
end;
procedure TJvNavIconButton.SetImages(const Value: TCustomImageList);
begin
if FImages <> Value then
begin
if FImages <> nil then
FImages.UnregisterChanges(FChangeLink);
FImages := Value;
if FImages <> nil then
begin
FImages.FreeNotification(Self);
FImages.RegisterChanges(FChangeLink);
end;
Invalidate;
end;
end;
procedure TJvNavIconButton.SetButtonType(const Value: TJvNavIconButtonType);
begin
if FButtonType <> Value then
begin
FButtonType := Value;
Invalidate;
end;
end;
procedure TJvNavIconButton.SetStyleManager(const Value: TJvNavPaneStyleManager);
begin
if FStyleManager <> Value then
begin
ParentStyleManager := False;
if FStyleManager <> nil then
FStyleManager.UnregisterChanges(FStyleLink);
FStyleManager := Value;
if FStyleManager <> nil then
begin
FStyleManager.RegisterChanges(FStyleLink);
FStyleManager.FreeNotification(Self);
Colors := FStyleManager.Colors;
end;
end;
end;
procedure TJvNavIconButton.DoStyleChange(Sender: TObject);
begin
Colors := (Sender as TJvNavPaneStyleManager).Colors;
Font := (Sender as TJvNavPaneStyleManager).Fonts.DividerFont;
end;
procedure TJvNavIconButton.ParentStyleManagerChanged(var Msg: TMsgStyleManagerChange);
begin
if (Msg.Sender <> Self) and ParentStyleManager then
begin
StyleManager := Msg.StyleManager;
ParentStyleManager := True;
end;
end;
procedure TJvNavIconButton.SetParentStyleManager(const Value: Boolean);
begin
if FParentStyleManager <> Value then
begin
FParentStyleManager := Value;
if FParentStyleManager and (Parent <> nil) then
Parent.Perform(CM_PARENTSTYLEMANAGERCHANGE, 0, 0);
end;
end;
function TJvNavIconButton.IsColorsStored: Boolean;
begin
Result := (StyleManager = nil) or (StyleManager.Theme = nptCustom);
end;
//=== { TJvNavPanelButton } ==================================================
constructor TJvNavPanelButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAlignment := taLeftJustify;
FStyleLink := TJvNavStyleLink.Create;
FStyleLink.OnChange := @DoStyleChange;
ControlStyle := ControlStyle + [csOpaque, csDisplayDragImage];
Flat := True;
HotTrack := True;
Height := 28;
FColors := TJvNavPanelColors.Create;
FColors.OnChange := @DoColorsChange;
//TODO:
//Font := Screen.IconFont;
Font.Style := [fsBold];
HotTrackFont := Font;
HotTrackFont.Style := [fsBold];
Width := 125;
Height := 28;
FParentStyleManager := True;
end;
destructor TJvNavPanelButton.Destroy;
begin
FStyleLink.Free;
FColors.Free;
inherited Destroy;
end;
procedure TJvNavPanelButton.ActionChange(Sender: TObject;
CheckDefaults: Boolean);
begin
if Sender is TCustomAction then
with TCustomAction(Sender) do
begin
if not CheckDefaults or (Self.Caption = '') or (Self.Caption = Self.Name) then
Self.Caption := Caption;
if not CheckDefaults or Self.Enabled then
Self.Enabled := Enabled;
if not CheckDefaults or (Self.Hint = '') then
Self.Hint := Hint;
if not CheckDefaults or (Self.ImageIndex = -1) then
Self.ImageIndex := ImageIndex;
if not CheckDefaults or Self.Visible then
Self.Visible := Visible;
if not CheckDefaults or not Assigned(Self.OnClick) then
Self.OnClick := OnExecute;
end;
end;
procedure TJvNavPanelButton.DoColorsChange(Sender: TObject);
begin
Invalidate;
end;
procedure TJvNavPanelButton.DoStyleChange(Sender: TObject);
begin
Colors := (Sender as TJvNavPaneStyleManager).Colors;
Font := (Sender as TJvNavPaneStyleManager).Fonts.NavPanelFont;
HotTrackFont := (Sender as TJvNavPaneStyleManager).Fonts.NavPanelHotTrackFont;
HotTrackFontOptions := (Sender as TJvNavPaneStyleManager).Fonts.NavPanelHotTrackFontOptions;
end;
procedure TJvNavPanelButton.FontChanged;
begin
inherited FontChanged;
Invalidate;
end;
procedure TJvNavPanelButton.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
begin
if AComponent = StyleManager then
StyleManager := nil;
end;
end;
procedure TJvNavPanelButton.PaintButton(ACanvas:TCanvas);
//const
// cAlignment: array [TAlignment] of Cardinal = (DT_LEFT, DT_RIGHT, DT_CENTER);
// cWordWrap: array [Boolean] of Cardinal = (DT_SINGLELINE, DT_WORDBREAK);
var
R: TRect;
X, Y: Integer;
function IsValidImage: Boolean;
begin
Result := Assigned(Images) and (ImageIndex >= 0);
end;
begin
R := ClientRect;
if HotTrack and (bsMouseInside in MouseStates) then
begin
if bsMouseDown in MouseStates then
GradientFillRect(ACanvas, R, Colors.ButtonSelectedColorTo, Colors.ButtonSelectedColorFrom, fdTopToBottom, 32)
else
GradientFillRect(ACanvas, R, Colors.ButtonHotColorFrom, Colors.ButtonHotColorTo, fdTopToBottom, 32);
end
else
if Down then
GradientFillRect(ACanvas, R, Colors.ButtonSelectedColorFrom, Colors.ButtonSelectedColorTo, fdTopToBottom, 32)
else
if bsMouseDown in MouseStates then
GradientFillRect(ACanvas, R, Colors.ButtonSelectedColorTo, Colors.ButtonSelectedColorFrom, fdTopToBottom, 32)
else
GradientFillRect(ACanvas, ClientRect, Colors.ButtonColorFrom, Colors.ButtonColorTo, fdTopToBottom, 32);
InflateRect(R, -4, -4);
if IsValidImage then
begin
Y := (Height - Images.Height) div 2;
X := 4;
Images.Draw(ACanvas, X, Y, ImageIndex);
Inc(R.Left, Images.Width + 4);
end;
if Caption <> '' then
begin
if HotTrack and (bsMouseInside in MouseStates) and not (bsMouseDown in MouseStates) then
ACanvas.Font := HotTrackFont
else
ACanvas.Font := Font;
SetBkMode(ACanvas.Handle, TRANSPARENT);
DrawText(ACanvas, Caption, Length(Caption), R, DT_SINGLELINE or DT_VCENTER);
end;
if Colors.ButtonSeparatorColor <> clNone then
begin
ACanvas.Pen.Color := Colors.ButtonSeparatorColor;
if Align = alBottom then
begin
ACanvas.MoveTo(0, 0);
ACanvas.LineTo(Width + 1, 0);
end
else
begin
ACanvas.MoveTo(0, ClientHeight - 1);
ACanvas.LineTo(Width + 1, ClientHeight - 1);
end;
end;
end;
procedure TJvNavPanelButton.SetColors(const Value: TJvNavPanelColors);
begin
FColors.Assign(Value);
end;
procedure TJvNavPanelButton.SetStyleManager(const Value: TJvNavPaneStyleManager);
begin
if FStyleManager <> Value then
begin
ParentStyleManager := False;
if FStyleManager <> nil then
FStyleManager.UnregisterChanges(FStyleLink);
FStyleManager := Value;
if FStyleManager <> nil then
begin
FStyleManager.RegisterChanges(FStyleLink);
FStyleManager.FreeNotification(Self);
Colors := FStyleManager.Colors;
end;
end;
end;
procedure TJvNavPanelButton.SetImageIndex(const Value: TImageIndex);
begin
if FImageIndex <> Value then
begin
FImageIndex := Value;
Invalidate;
end;
end;
procedure TJvNavPanelButton.SetImages(const Value: TCustomImageList);
begin
if FImages <> Value then
begin
FImages := Value;
Invalidate;
end;
end;
procedure TJvNavPanelButton.TextChanged;
begin
inherited TextChanged;
Invalidate;
end;
procedure TJvNavPanelButton.SetAlignment(const Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
Invalidate;
end;
end;
procedure TJvNavPanelButton.SetWordWrap(const Value: Boolean);
begin
if FWordWrap <> Value then
begin
FWordWrap := Value;
Invalidate;
end;
end;
procedure TJvNavPanelButton.CMDialogChar(var Msg: TCMDialogChar);
begin
if IsAccel(Msg.CharCode, Caption) then
begin
Msg.Result := 1;
Click;
end
else
inherited;
end;
procedure TJvNavPanelButton.ParentStyleManagerChanged(
var Msg: TMsgStyleManagerChange);
begin
if (Msg.Sender <> Self) and ParentStyleManager then
begin
StyleManager := Msg.StyleManager;
ParentStyleManager := True;
end;
end;
procedure TJvNavPanelButton.SetParentStyleManager(const Value: Boolean);
begin
if FParentStyleManager <> Value then
begin
FParentStyleManager := Value;
if FParentStyleManager and (Parent <> nil) then
Parent.Perform(CM_PARENTSTYLEMANAGERCHANGE, 0, 0);
end;
end;
function TJvNavPanelButton.IsColorsStored: Boolean;
begin
Result := (StyleManager = nil) or (StyleManager.Theme = nptCustom);
end;
//=== { TJvNavPanelColors } ==================================================
constructor TJvNavPanelColors.Create;
begin
inherited Create;
// use XPBlue as standard
FButtonColorFrom := TColor($F7E2CD);
FButtonColorTo := TColor($F3A080);
FButtonSelectedColorFrom := TColor($BBE2EA);
FButtonSelectedColorTo := TColor($389FDD);
FFrameColor := TColor($6F2F0C);
FButtonHotColorFrom := TColor($DBFBFF);
FButtonHotColorTo := TColor($5FC8FB);
FDividerColorFrom := TColor($FFDBBC);
FDividerColorTo := TColor($F2C0A4);
FHeaderColorFrom := TColor($D0835C);
FHeaderColorTo := TColor($903B09);
FSplitterColorFrom := TColor($B78676);
FSplitterColorTo := TColor($A03D09);
FButtonSeparatorColor := clGray;
FToolPanelColorFrom := clWindow;
FToolPanelColorTo := clWindow;
FToolPanelHeaderColorFrom := TColor($F7E2CD);
FToolPanelHeaderColorTo := TColor($F3A080);
end;
procedure TJvNavPanelColors.Assign(Source: TPersistent);
begin
if (Source is TJvNavPanelColors) then
begin
if (Source <> Self) then
begin
FButtonColorFrom := TJvNavPanelColors(Source).ButtonColorFrom;
FButtonColorTo := TJvNavPanelColors(Source).ButtonColorTo;
FButtonHotColorFrom := TJvNavPanelColors(Source).ButtonHotColorFrom;
FButtonHotColorTo := TJvNavPanelColors(Source).ButtonHotColorTo;
FButtonSelectedColorFrom := TJvNavPanelColors(Source).ButtonSelectedColorFrom;
FButtonSelectedColorTo := TJvNavPanelColors(Source).ButtonSelectedColorTo;
FFrameColor := TJvNavPanelColors(Source).FrameColor;
FHeaderColorFrom := TJvNavPanelColors(Source).HeaderColorFrom;
FHeaderColorTo := TJvNavPanelColors(Source).HeaderColorTo;
FDividerColorFrom := TJvNavPanelColors(Source).DividerColorFrom;
FDividerColorTo := TJvNavPanelColors(Source).DividerColorTo;
FSplitterColorFrom := TJvNavPanelColors(Source).SplitterColorFrom;
FSplitterColorTo := TJvNavPanelColors(Source).SplitterColorTo;
FButtonSeparatorColor := TJvNavPanelColors(Source).ButtonSeparatorColor;
FToolPanelColorFrom := TJvNavPanelColors(Source).ToolPanelColorFrom;
FToolPanelColorTo := TJvNavPanelColors(Source).ToolPanelColorTo;
FToolPanelHeaderColorFrom := TJvNavPanelColors(Source).ToolPanelHeaderColorFrom;
FToolPanelHeaderColorTo := TJvNavPanelColors(Source).ToolPanelHeaderColorTo;
Change;
end;
end
else
inherited Assign(Source);
end;
procedure TJvNavPanelColors.Change;
begin
if Assigned(FOnChange) then
FOnChange(Self);
end;
procedure TJvNavPanelColors.SetButtonColorFrom(const Value: TColor);
begin
if FButtonColorFrom <> Value then
begin
FButtonColorFrom := Value;
Change;
end;
end;
procedure TJvNavPanelColors.SetButtonColorTo(const Value: TColor);
begin
if FButtonColorTo <> Value then
begin
FButtonColorTo := Value;
Change;
end;
end;
procedure TJvNavPanelColors.SetDividerColorFrom(const Value: TColor);
begin
if FDividerColorFrom <> Value then
begin
FDividerColorFrom := Value;
Change;
end;
end;
procedure TJvNavPanelColors.SetDividerColorTo(const Value: TColor);
begin
if FDividerColorTo <> Value then
begin
FDividerColorTo := Value;
Change;
end;
end;
procedure TJvNavPanelColors.SetFrameColor(const Value: TColor);
begin
if FFrameColor <> Value then
begin
FFrameColor := Value;
Change;
end;
end;
procedure TJvNavPanelColors.SetHeaderColorFrom(const Value: TColor);
begin
if FHeaderColorFrom <> Value then
begin
FHeaderColorFrom := Value;
Change;
end;
end;
procedure TJvNavPanelColors.SetHeaderColorTo(const Value: TColor);
begin
if FHeaderColorTo <> Value then
begin
FHeaderColorTo := Value;
Change;
end;
end;
procedure TJvNavPanelColors.SetButtonHotColorFrom(const Value: TColor);
begin
if FButtonHotColorFrom <> Value then
begin
FButtonHotColorFrom := Value;
Change;
end;
end;
procedure TJvNavPanelColors.SetButtonHotColorTo(const Value: TColor);
begin
if FButtonHotColorTo <> Value then
begin
FButtonHotColorTo := Value;
Change;
end;
end;
procedure TJvNavPanelColors.SetButtonSelectedColorFrom(const Value: TColor);
begin
if FButtonSelectedColorFrom <> Value then
begin
FButtonSelectedColorFrom := Value;
Change;
end;
end;
procedure TJvNavPanelColors.SetButtonSelectedColorTo(const Value: TColor);
begin
if FButtonSelectedColorTo <> Value then
begin
FButtonSelectedColorTo := Value;
Change;
end;
end;
procedure TJvNavPanelColors.SetSplitterColorFrom(const Value: TColor);
begin
if FSplitterColorFrom <> Value then
begin
FSplitterColorFrom := Value;
Change;
end;
end;
procedure TJvNavPanelColors.SetSplitterColorTo(const Value: TColor);
begin
if FSplitterColorTo <> Value then
begin
FSplitterColorTo := Value;
Change;
end;
end;
procedure TJvNavPanelColors.SetButtonSeparatorColor(const Value: TColor);
begin
if FButtonSeparatorColor <> Value then
begin
FButtonSeparatorColor := Value;
Change;
end;
end;
procedure TJvNavPanelColors.SetToolPanelColorFrom(const Value: TColor);
begin
if FToolPanelColorFrom <> Value then
begin
FToolPanelColorFrom := Value;
Change;
end;
end;
procedure TJvNavPanelColors.SetToolPanelColorTo(const Value: TColor);
begin
if FToolPanelColorTo <> Value then
begin
FToolPanelColorTo := Value;
Change;
end;
end;
procedure TJvNavPanelColors.SetToolPanelHeaderColorFrom(
const Value: TColor);
begin
if FToolPanelHeaderColorFrom <> Value then
begin
FToolPanelHeaderColorFrom := Value;
Change;
end;
end;
procedure TJvNavPanelColors.SetToolPanelHeaderColorTo(const Value: TColor);
begin
if FToolPanelHeaderColorTo <> Value then
begin
FToolPanelHeaderColorTo := Value;
Change;
end;
end;
//=== { TJvNavPanelFonts } ===================================================
constructor TJvNavPanelFonts.Create;
begin
inherited Create;
FDividerFont := TFont.Create;
FNavPanelFont := TFont.Create;
FNavPanelHotTrackFont := TFont.Create;
FHeaderFont := TFont.Create;
FHeaderFont.Name := 'Arial';
FHeaderFont.Size := 12;
FHeaderFont.Style := [fsBold];
FHeaderFont.Color := clWhite;
FHeaderFont.OnChange := @DoFontChange;
//TODO:
//FDividerFont.Assign(Screen.IconFont);
//FNavPanelFont.Assign(Screen.IconFont);
FNavPanelFont.Style := [fsBold];
FNavPanelHotTrackFont.Assign(FNavPanelFont);
FNavPanelHotTrackFontOptions := DefaultTrackFontOptions;
FDividerFont.OnChange := @DoFontChange;
FNavPanelFont.OnChange := @DoFontChange;
FNavPanelHotTrackFont.OnChange := @DoFontChange;
end;
destructor TJvNavPanelFonts.Destroy;
begin
FDividerFont.Free;
FHeaderFont.Free;
FNavPanelFont.Free;
FNavPanelHotTrackFont.Free;
inherited Destroy;
end;
procedure TJvNavPanelFonts.Assign(Source: TPersistent);
begin
if Source is TJvNavPanelFonts then
begin
if Source <> Self then
begin
NavPanelFont := TJvNavPanelFonts(Source).NavPanelFont;
DividerFont := TJvNavPanelFonts(Source).DividerFont;
HeaderFont := TJvNavPanelFonts(Source).HeaderFont;
end;
end
else
inherited Assign(Source);
end;
procedure TJvNavPanelFonts.Change;
begin
if Assigned(FOnChange) then
FOnChange(Self);
end;
procedure TJvNavPanelFonts.DoFontChange(Sender: TObject);
begin
Change;
end;
procedure TJvNavPanelFonts.SetDividerFont(const Value: TFont);
begin
FDividerFont.Assign(Value);
end;
procedure TJvNavPanelFonts.SetHeaderFont(const Value: TFont);
begin
FHeaderFont.Assign(Value);
end;
procedure TJvNavPanelFonts.SetNavPanelFont(const Value: TFont);
begin
FNavPanelFont.Assign(Value);
end;
procedure TJvNavPanelFonts.SetNavPanelHotTrackFont(const Value: TFont);
begin
FNavPanelHotTrackFont.Assign(Value);
end;
procedure TJvNavPanelFonts.SetNavPanelHotTrackFontOptions(const Value: TJvTrackFontOptions);
begin
if FNavPanelHotTrackFontOptions <> Value then
begin
FNavPanelHotTrackFontOptions := Value;
Change;
end;
end;
//=== { TJvNavPanelPage } ====================================================
constructor TJvNavPanelPage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FBackground := TJvNavPaneBackgroundImage.Create;
FBackground.OnChange := @DoBackgroundChange;
ParentColor := False;
Color := clWindow;
ControlStyle := ControlStyle + [csDisplayDragImage];
FStyleLink := TJvNavStyleLink.Create;
FStyleLink.OnChange := @DoStyleChange;
FNavPanel := TJvNavPanelButton.Create(Self);
FNavPanel.Visible := True;
FNavPanel.Align := alBottom;
FNavPanel.GroupIndex := cNavPanelButtonGroupIndex; // use a silly number that no one else is probable to use
FNavPanel.AllowAllUp := False;
FIconButton := TJvNavIconButton.Create(Self);
FIconButton.ButtonType := nibImage;
FIconButton.Visible := False;
FIconButton.Align := alRight;
FIconButton.Width := 0;
FIconButton.GroupIndex := cNavPanelButtonGroupIndex;
FIconButton.AllowAllUp := False;
FNavPanel.OnClick := @DoButtonClick;
FIconButton.OnClick := @DoButtonClick;
ImageIndex := -1;
FParentStyleManager := True;
end;
destructor TJvNavPanelPage.Destroy;
begin
FStyleLink.Free;
FBackground.Free;
inherited Destroy;
end;
type
TJvCustomGraphicButtonAccess = class(TJvCustomGraphicButton)
public
property Down;
end;
procedure TJvNavPanelPage.DoButtonClick(Sender: TObject);
begin
{ We cannot test for NavPanel.Down if the Sender is a icon button }
if (Sender is TJvCustomGraphicButton) and TJvCustomGraphicButtonAccess(Sender).Down then
begin
if Parent <> nil then
TJvCustomNavigationPane(Parent).ActivePage := Self; // this sets "Down" as well
if Assigned(FOnClick) then
FOnClick(Self);
end;
end;
procedure TJvNavPanelPage.DoStyleChange(Sender: TObject);
begin
Colors := (Sender as TJvNavPaneStyleManager).Colors;
NavPanel.Font := (Sender as TJvNavPaneStyleManager).Fonts.NavPanelFont;
NavPanel.HotTrackFont := (Sender as TJvNavPaneStyleManager).Fonts.NavPanelHotTrackFont;
NavPanel.HotTrackFontOptions := (Sender as TJvNavPaneStyleManager).Fonts.NavPanelHotTrackFontOptions;
end;
function TJvNavPanelPage.GetCaption: TCaption;
begin
if NavPanel = nil then
Result := ''
else
Result := NavPanel.Caption;
end;
function TJvNavPanelPage.GetColors: TJvNavPanelColors;
begin
Result := NavPanel.Colors;
end;
function TJvNavPanelPage.GetHint: string;
begin
if NavPanel = nil then
Result := ''
else
Result := NavPanel.Hint;
end;
function TJvNavPanelPage.GetIconic: Boolean;
begin
if NavPanel = nil then
Result := False
else
Result := not NavPanel.Visible;
end;
function TJvNavPanelPage.GetImageIndex: TImageIndex;
begin
if NavPanel = nil then
Result := FImageIndex
else
Result := NavPanel.ImageIndex;
end;
procedure TJvNavPanelPage.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
begin
if AComponent = IconPanel then
IconPanel := nil
else
if AComponent = StyleManager then
StyleManager := nil;
end;
end;
procedure TJvNavPanelPage.SetCaption(const Value: TCaption);
begin
if NavPanel <> nil then
NavPanel.Caption := Value;
// TODO: StripHotkey
(*
if AutoHeader then
Header.Caption := StripHotkey(Value);
*)
end;
procedure TJvNavPanelPage.SetColors(const Value: TJvNavPanelColors);
begin
NavPanel.Colors := Value;
IconButton.Colors := Value;
if AutoHeader then
begin
Header.ColorFrom := Value.HeaderColorFrom;
Header.ColorTo := Value.HeaderColorTo;
end;
end;
procedure TJvNavPanelPage.SetStyleManager(const Value: TJvNavPaneStyleManager);
begin
if FStyleManager <> Value then
begin
ParentStyleManager := False;
if FStyleManager <> nil then
FStyleManager.UnregisterChanges(FStyleLink);
FStyleManager := Value;
if FStyleManager <> nil then
begin
FStyleManager.RegisterChanges(FStyleLink);
FStyleManager.FreeNotification(Self);
Colors := FStyleManager.Colors;
end;
end;
// FNavPanel.StyleManager := Value;
// FIconButton.StyleManager := Value;
// if AutoHeader then
// Header.StyleManager := Value;
end;
procedure TJvNavPanelPage.SetHint(const Value: string);
begin
NavPanel.Hint := Value;
IconButton.Hint := Value;
end;
procedure TJvNavPanelPage.SetIconic(const Value: Boolean);
begin
NavPanel.Visible := not Value;
IconButton.Visible := Value;
NavPanel.Height := TJvCustomNavigationPane(Parent).ButtonHeight * Ord(NavPanel.Visible);
IconButton.Width := TJvCustomNavigationPane(Parent).ButtonWidth * Ord(IconButton.Visible);
UpdatePageList;
end;
procedure TJvNavPanelPage.SetIconPanel(const Value: TJvIconPanel);
begin
if (FIconPanel <> Value) and not (csDestroying in ComponentState) then
begin
FIconPanel := Value;
if IconButton <> nil then
begin
if FIconPanel <> nil then
begin
IconButton.Parent := FIconPanel;
FIconPanel.FreeNotification(Self);
end
else
IconButton.Parent := nil;
end;
end;
end;
procedure TJvNavPanelPage.SetImageIndex(const Value: TImageIndex);
begin
FImageIndex := Value;
NavPanel.ImageIndex := Value;
IconButton.ImageIndex := Value;
if AutoHeader then
Header.ImageIndex := Value;
end;
procedure TJvNavPanelPage.SetPageIndex(Value: Integer);
begin
inherited SetPageIndex(Value);
UpdatePageList;
end;
procedure TJvNavPanelPage.SetParent( AParent: TWinControl);
begin
inherited SetParent(AParent);
if (FNavPanel = nil) or (FIconButton = nil) or (csDestroying in ComponentState) then
Exit;
NavPanel.Parent := AParent;
if AParent is TJvCustomNavigationPane then
begin
IconPanel := TJvCustomNavigationPane(AParent).FIconPanel;
// StyleManager := TJvCustomNavigationPane(AParent).StyleManager;
NavPanel.Colors := TJvCustomNavigationPane(AParent).Colors;
NavPanel.StyleManager := StyleManager;
NavPanel.Height := TJvCustomNavigationPane(AParent).ButtonHeight;
NavPanel.Images := TJvCustomNavigationPane(AParent).LargeImages;
NavPanel.Font := TJvCustomNavigationPane(AParent).NavPanelFont;
NavPanel.HotTrackFont := TJvCustomNavigationPane(AParent).NavPanelHotTrackFont;
NavPanel.HotTrackFontOptions := TJvCustomNavigationPane(AParent).NavPanelHotTrackFontOptions;
IconButton.Images := TJvCustomNavigationPane(AParent).SmallImages;
IconButton.Width := TJvCustomNavigationPane(AParent).ButtonWidth;
AutoHeader := TJvCustomNavigationPane(AParent).AutoHeaders;
end
else
IconButton.Parent := nil;
end;
procedure TJvNavPanelPage.UpdatePageList;
begin
if PageList <> nil then
TJvCustomNavigationPane(PageList).UpdatePositions;
end;
procedure TJvNavPanelPage.SetAutoHeader(const Value: Boolean);
begin
if AutoHeader <> Value then
begin
FreeAndNil(FHeader);
if Value then
begin
FHeader := TJvNavPanelHeader.Create(nil);
FHeader.ColorFrom := Colors.HeaderColorFrom;
FHeader.ColorTo := Colors.HeaderColorTo;
FHeader.Images := NavPanel.Images;
FHeader.ImageIndex := ImageIndex;
//TODO: StripHotkey
//FHeader.Caption := StripHotkey(Caption);
FHeader.Caption := Caption;
// make sure header is top-most
FHeader.Top := -10;
FHeader.Parent := Self;
FHeader.Align := alTop;
FHeader.Alignment := Alignment;
FHeader.WordWrap := WordWrap;
end;
end;
end;
function TJvNavPanelPage.GetAutoHeader: Boolean;
begin
Result := FHeader <> nil;
end;
function TJvNavPanelPage.GetAlignment: TAlignment;
begin
if NavPanel <> nil then
Result := NavPanel.Alignment
else
Result := taLeftJustify;
end;
function TJvNavPanelPage.GetWordWrap: Boolean;
begin
if NavPanel <> nil then
Result := NavPanel.WordWrap
else
Result := False;
end;
procedure TJvNavPanelPage.SetAlignment(const Value: TAlignment);
begin
if NavPanel <> nil then
NavPanel.Alignment := Value;
if AutoHeader then
Header.Alignment := Value;
end;
procedure TJvNavPanelPage.SetWordWrap(const Value: Boolean);
begin
if NavPanel <> nil then
NavPanel.WordWrap := Value;
if AutoHeader then
Header.WordWrap := Value;
end;
procedure TJvNavPanelPage.ParentStyleManagerChanged(var Msg: TMsgStyleManagerChange);
begin
if (Msg.Sender <> Self) and ParentStyleManager then
begin
StyleManager := Msg.StyleManager;
ParentStyleManager := True;
InternalStyleManagerChanged(Self, Msg.StyleManager);
end;
end;
procedure TJvNavPanelPage.SetParentStyleManager(const Value: Boolean);
begin
if FParentStyleManager <> Value then
begin
FParentStyleManager := Value;
if FParentStyleManager and (Parent <> nil) then
Parent.Perform(CM_PARENTSTYLEMANAGERCHANGE, 0, 0);
end;
end;
procedure TJvNavPanelPage.CMControlChange(var Msg: TLMessage);
begin
InternalStyleManagerChanged(Self, StyleManager);
end;
procedure TJvNavPanelPage.ParentStyleManagerChange(var Msg: TLMessage);
begin
InternalStyleManagerChanged(Self, StyleManager);
end;
procedure TJvNavPanelPage.SetBackground(const Value: TJvNavPaneBackgroundImage);
begin
FBackground.Assign(Value);
end;
procedure TJvNavPanelPage.DoBackgroundChange(Sender: TObject);
begin
Invalidate;
end;
procedure TJvNavPanelPage.Paint;
begin
inherited Paint;
if FBackground.HasImage then
FBackground.DrawImage(Canvas, ClientRect)
else
if (Parent is TJvCustomNavigationPane) and TJvCustomNavigationPane(Parent).Background.HasImage then
TJvCustomNavigationPane(Parent).Background.DrawImage(Canvas, ClientRect);
end;
function TJvNavPanelPage.GetAction: TBasicAction;
begin
Result := inherited GetAction;
end;
procedure TJvNavPanelPage.SetAction(const Value: TBasicAction);
begin
inherited Action := Value;
FNavPanel.Action := Value;
FIconButton.Action := Value;
end;
procedure TJvNavPanelPage.ActionChange(Sender: TObject;
CheckDefaults: Boolean);
begin
if Sender is TCustomAction then
with TCustomAction(Sender) do
begin
if not CheckDefaults or (Self.Caption = '') or (Self.Caption = Self.Name) then
Self.Caption := Caption;
if not CheckDefaults or Self.Enabled then
Self.Enabled := Enabled; // NB! This disables resizing if the top-most button is disabled (due to TSplitter.FindControl)
if not CheckDefaults or (Self.Hint = '') then
Self.Hint := Hint;
if not CheckDefaults or (Self.ImageIndex = -1) then
Self.ImageIndex := ImageIndex;
if not CheckDefaults or Self.Visible then
Self.Visible := Visible;
if not CheckDefaults or not Assigned(Self.OnClick) then
Self.OnClick := OnExecute;
end;
end;
//=== { TJvOutlookSplitter } =================================================
constructor TJvOutlookSplitter.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque];
FStyleLink := TJvNavStyleLink.Create;
FStyleLink.OnChange := @DoStyleChange;
FColorFrom := TColor($B78676);
FColorTo := TColor($A03D09);
Align := alBottom;
AutoSnap := False;
ResizeStyle := rsUpdate;
Height := 7;
Cursor := crSizeNS;
FParentStyleManager := True;
end;
destructor TJvOutlookSplitter.Destroy;
begin
FStyleLink.Free;
FStyleLink := nil;
inherited Destroy;
end;
procedure TJvOutlookSplitter.EnabledChanged;
begin
inherited EnabledChanged;
Invalidate;
end;
procedure TJvOutlookSplitter.DoStyleChange(Sender: TObject);
begin
with (Sender as TJvNavPaneStyleManager).Colors do
begin
FColorFrom := SplitterColorFrom;
FColorTo := SplitterColorTo;
Invalidate;
end;
end;
procedure TJvOutlookSplitter.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
if AComponent = StyleManager then
StyleManager := nil;
end;
procedure TJvOutlookSplitter.Paint;
var
I: Integer;
R: TRect;
begin
R := ClientRect;
if Align in [alTop, alBottom] then
begin
GradientFillRect(Canvas, R, ColorFrom, ColorTo, fdTopToBottom, R.Bottom - R.Top);
Inc(R.Left, (R.Right - R.Left) div 2 - 20);
Inc(R.Top, (R.Bottom - R.Top) div 2 - 1);
R.Right := R.Left + 2;
R.Bottom := R.Top + 2;
if Enabled then
for I := 0 to 9 do // draw the dots
begin
Canvas.Brush.Color := cl3DDkShadow;
Canvas.FillRect(R);
OffsetRect(R, 1, 1);
Canvas.Brush.Color := clWhite;
Canvas.FillRect(R);
Canvas.Brush.Color := ColorFrom; // (p3) this is probably not the right color, but it's close enough for me...
Canvas.FillRect(Rect(R.Left, R.Top, R.Left + 1, R.Top + 1));
OffsetRect(R, 3, -1);
end;
end
else
begin
GradientFillRect(Canvas, R, ColorFrom, ColorTo, fdLeftToRight, R.Right - R.Left);
Inc(R.Top, (R.Bottom - R.Top) div 2 - 20);
Inc(R.Left, (R.Right - R.Left) div 2 - 1);
R.Right := R.Left + 2;
R.Bottom := R.Top + 2;
if Enabled then
for I := 0 to 9 do // draw the dots
begin
Canvas.Brush.Color := cl3DDkShadow;
Canvas.FillRect(R);
OffsetRect(R, 1, 1);
Canvas.Brush.Color := clWhite;
Canvas.FillRect(R);
Canvas.Brush.Color := ColorFrom;
Canvas.FillRect(Rect(R.Left, R.Top, R.Left + 1, R.Top + 1));
OffsetRect(R, -1, 3);
end;
end;
end;
procedure TJvOutlookSplitter.SetColorFrom(const Value: TColor);
begin
if FColorFrom <> Value then
begin
FColorFrom := Value;
Invalidate;
end;
end;
procedure TJvOutlookSplitter.SetStyleManager(const Value: TJvNavPaneStyleManager);
begin
if FStyleManager <> Value then
begin
ParentStyleManager := False;
if FStyleManager <> nil then
FStyleManager.UnregisterChanges(FStyleLink);
FStyleManager := Value;
if FStyleManager <> nil then
begin
FStyleManager.RegisterChanges(FStyleLink);
FStyleManager.FreeNotification(Self);
ColorFrom := FStyleManager.Colors.SplitterColorFrom;
ColorTo := FStyleManager.Colors.SplitterColorTo;
end;
end;
end;
procedure TJvOutlookSplitter.SetColorTo(const Value: TColor);
begin
if FColorTo <> Value then
begin
FColorTo := Value;
Invalidate;
end;
end;
procedure TJvOutlookSplitter.ParentStyleManagerChanged(var Msg: TMsgStyleManagerChange);
begin
if (Msg.Sender <> Self) and ParentStyleManager then
begin
StyleManager := Msg.StyleManager;
ParentStyleManager := True;
end;
end;
procedure TJvOutlookSplitter.SetParentStyleManager(const Value: Boolean);
begin
if FParentStyleManager <> Value then
begin
FParentStyleManager := Value;
if FParentStyleManager and (Parent <> nil) then
Parent.Perform(CM_PARENTSTYLEMANAGERCHANGE, 0, 0);
end;
end;
function TJvOutlookSplitter.GetDragZoneRect: TRect;
begin
Result := ClientRect;
if DragZone <> 0 then
begin
if Align in [alLeft, alRight] then
begin
if DragZone < RectHeight(Result) then
begin
Result.Top := (RectHeight(Result) - DragZone) div 2;
Result.Bottom := Result.Top + DragZone;
end;
end
else
if Align in [alTop, alBottom] then
begin
if DragZone < RectWidth(Result) then
begin
Result.Left := (RectWidth(Result) - DragZone) div 2;
Result.Right := Result.Left + DragZone;
end;
end;
end;
end;
function TJvOutlookSplitter.MouseInDragZone(X, Y: Integer): Boolean;
begin
Result := (DragZone <= 0) or PtInRect(GetDragZoneRect, Point(X, Y));
end;
procedure TJvOutlookSplitter.WMLButtonDown(var Msg: TLMLButtonDown);
begin
if MouseInDragZone(Msg.XPos, Msg.YPos) then
inherited;
end;
procedure TJvOutlookSplitter.WMMouseMove(var Msg: TLMMouseMove);
begin
inherited;
if MouseInDragZone(Msg.XPos, Msg.YPos) then
begin
if Cursor <> FOldCursor then
inherited Cursor := FOldCursor;
end
else
begin
if Cursor <> crDefault then
begin
FOldCursor := Cursor;
inherited Cursor := crDefault;
end;
end;
end;
procedure TJvOutlookSplitter.SetCursor(const Value: TCursor);
begin
inherited Cursor := Value;
FOldCursor := Value;
end;
procedure TJvOutlookSplitter.RequestAlign;
begin
if (Cursor = crSizeWE) or (Cursor = crSizeNS) then
begin
if Align in [alLeft, alRight] then
Cursor := crSizeWE
else
Cursor := crSizeNS;
end;
end;
//=== { TJvNavPanelHeader } ==================================================
constructor TJvNavPanelHeader.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FChangeLink := TChangeLink.Create;
FChangeLink.OnChange := @DoImagesChange;
FStyleLink := TJvNavStyleLink.Create;
FStyleLink.OnChange := @DoStyleChange;
ControlStyle := ControlStyle + [csOpaque, csAcceptsControls];
FColorFrom := TColor($D0835C);
FColorTo := TColor($903B09);
Font.Name := 'Arial';
Font.Size := 12;
Font.Style := [fsBold];
Font.Color := clWhite;
Height := 27;
Width := 225;
FParentStyleManager := True;
end;
destructor TJvNavPanelHeader.Destroy;
begin
FChangeLink.Free;
FStyleLink.Free;
inherited Destroy;
end;
procedure TJvNavPanelHeader.DoImagesChange(Sender: TObject);
begin
Invalidate;
end;
procedure TJvNavPanelHeader.DoStyleChange(Sender: TObject);
begin
Font := (Sender as TJvNavPaneStyleManager).Fonts.HeaderFont;
with (Sender as TJvNavPaneStyleManager).Colors do
begin
FColorFrom := HeaderColorFrom;
FColorTo := HeaderColorTo;
Invalidate;
end;
end;
procedure TJvNavPanelHeader.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
if AComponent = Images then
Images := nil
else
if AComponent = StyleManager then
StyleManager := nil;
end;
procedure TJvNavPanelHeader.Paint;
const
cAlignment: array[TAlignment] of Cardinal = (DT_LEFT, DT_RIGHT, DT_CENTER);
cWordWrap: array[Boolean] of Cardinal = (DT_SINGLELINE, DT_WORDBREAK);
var
R, TempRect: TRect;
X, Y, H: Integer;
function IsValidImage: Boolean;
begin
Result := (Images <> nil) and (ImageIndex >= 0) and (ImageIndex < Images.Count);
end;
begin
R := ClientRect;
GradientFillRect(Canvas, R, ColorFrom, ColorTo, fdTopToBottom, 32);
H := Canvas.TextHeight(Caption);
if Caption <> '' then
begin
Canvas.Font := Font;
InflateRect(R, -4, 0);
SetBkMode(Canvas.Handle, TRANSPARENT);
TempRect := R;
DrawText(Canvas, Caption, Length(Caption), TempRect,
DT_CALCRECT or cAlignment[Alignment] or cWordWrap[WordWrap] or DT_VCENTER or DT_NOPREFIX or DT_END_ELLIPSIS);
if WordWrap then
OffsetRect(R, 0, (Height - H) div 2);
if IsValidImage and (Alignment = taCenter) then
OffsetRect(R, 0, -Images.Height div 2);
DrawText(Canvas, Caption, Length(Caption), R,
cAlignment[Alignment] or cWordWrap[WordWrap] or DT_VCENTER or DT_NOPREFIX or DT_END_ELLIPSIS);
end;
if IsValidImage then
begin
Y := (Height - Images.Height) div 2;
case Alignment of
taLeftJustify:
X := R.Right - Images.Width;
taRightJustify:
X := R.Left + 4;
else // taCenter
begin
if Caption <> '' then
begin
if WordWrap then
Y := R.Top + H + 4
else
Y := (Height + Canvas.TextHeight('Wq')) div 2 + 4;
end;
X := (Width - Images.Width) div 2;
end;
end;
if Y > Height - Images.Height - 4 then
Y := Height - Images.Height - 4;
Images.Draw(Canvas, X, Y, ImageIndex, True);
end;
end;
procedure TJvNavPanelHeader.SetColorFrom(const Value: TColor);
begin
if FColorFrom <> Value then
begin
FColorFrom := Value;
Invalidate;
end;
end;
procedure TJvNavPanelHeader.SetStyleManager(const Value: TJvNavPaneStyleManager);
begin
if FStyleManager <> Value then
begin
ParentStyleManager := False;
if FStyleManager <> nil then
FStyleManager.UnregisterChanges(FStyleLink);
FStyleManager := Value;
if FStyleManager <> nil then
begin
FStyleManager.RegisterChanges(FStyleLink);
FStyleManager.FreeNotification(Self);
FColorFrom := FStyleManager.Colors.HeaderColorFrom;
FColorTo := FStyleManager.Colors.HeaderColorTo;
Font := FStyleManager.Fonts.HeaderFont;
Invalidate;
end;
InternalStyleManagerChanged(Self, Value);
end;
end;
procedure TJvNavPanelHeader.SetColorTo(const Value: TColor);
begin
if FColorTo <> Value then
begin
FColorTo := Value;
Invalidate;
end;
end;
procedure TJvNavPanelHeader.SetImageIndex(const Value: TImageIndex);
begin
if FImageIndex <> Value then
begin
FImageIndex := Value;
Invalidate;
end;
end;
procedure TJvNavPanelHeader.SetImages(const Value: TCustomImageList);
begin
if FImages <> Value then
begin
if FImages <> nil then
FImages.UnregisterChanges(FChangeLink);
FImages := Value;
if FImages <> nil then
begin
FImages.RegisterChanges(FChangeLink);
FImages.FreeNotification(Self);
end;
Invalidate;
end;
end;
procedure TJvNavPanelHeader.TextChanged;
begin
inherited TextChanged;
Invalidate;
end;
procedure TJvNavPanelHeader.WMEraseBkgnd(var Msg: TLMEraseBkgnd);
begin
Msg.Result := 1;
end;
procedure TJvNavPanelHeader.SetAlignment(const Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
Invalidate;
end;
end;
procedure TJvNavPanelHeader.SetWordWrap(const Value: Boolean);
begin
if FWordWrap <> Value then
begin
FWordWrap := Value;
Invalidate;
end;
end;
procedure TJvNavPanelHeader.ParentStyleManagerChanged(var Msg: TMsgStyleManagerChange);
begin
if (Msg.Sender <> Self) and ParentStyleManager then
begin
StyleManager := Msg.StyleManager;
ParentStyleManager := True;
InternalStyleManagerChanged(Self, Msg.StyleManager);
end;
end;
procedure TJvNavPanelHeader.ParentStyleManagerChange(var Msg: TLMessage);
begin
InternalStyleManagerChanged(Self, StyleManager);
end;
procedure TJvNavPanelHeader.SetParentStyleManager(const Value: Boolean);
begin
if FParentStyleManager <> Value then
begin
FParentStyleManager := Value;
if FParentStyleManager and (Parent <> nil) then
Parent.Perform(CM_PARENTSTYLEMANAGERCHANGE, 0, 0);
end;
end;
procedure TJvNavPanelHeader.CMControlChange(var Msg: TLMessage);
begin
// a control was inserted or removed
InternalStyleManagerChanged(Self, StyleManager);
end;
//=== { TJvNavPanelDivider } =================================================
constructor TJvNavPanelDivider.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAlignment := taLeftJustify;
FStyleLink := TJvNavStyleLink.Create;
FStyleLink.OnChange := @DoStyleChange;
Align := alNone;
AutoSnap := False;
ResizeStyle := rsUpdate;
ControlStyle := ControlStyle + [csOpaque];
FColorFrom := TColor($FFDBBC);
FColorTo := TColor($F2C0A4);
FFrameColor := TColor($6F2F0C);
Cursor := crSizeNS;
//TODO:
//Font := Screen.IconFont;
Height := 19;
Width := 125;
FParentStyleManager := True;
end;
// 25.09.2007 - SESS
// When align is assigned height is lost
procedure TJvNavPanelDivider.SetAlign(Value: TAlign);
var
SaveHeight: integer;
begin
SaveHeight := Height;
inherited SetAlign(Value);
Height := SaveHeight;
end;
destructor TJvNavPanelDivider.Destroy;
begin
FStyleLink.Free;
FStyleLink := nil;
inherited Destroy;
end;
procedure TJvNavPanelDivider.TextChanged;
begin
inherited TextChanged;
Invalidate;
end;
procedure TJvNavPanelDivider.DoStyleChange(Sender: TObject);
begin
Font := (Sender as TJvNavPaneStyleManager).Fonts.DividerFont;
with (Sender as TJvNavPaneStyleManager).Colors do
begin
FColorFrom := DividerColorFrom;
FColorTo := DividerColorTo;
Self.FFrameColor := FrameColor;
Invalidate;
end;
end;
procedure TJvNavPanelDivider.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
begin
if AComponent = StyleManager then
StyleManager := nil;
end;
end;
procedure TJvNavPanelDivider.Paint;
const
cAlignment: array[TAlignment] of Cardinal = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
R: TRect;
begin
R := ClientRect;
GradientFillRect(Canvas, R, ColorFrom, ColorTo, fdTopToBottom, 32);
if Caption <> '' then
begin
Canvas.Font := Font;
case Alignment of
taLeftJustify:
Inc(R.Left, 7);
taRightJustify:
Dec(R.Right, 7);
end;
SetBkMode(Canvas.Handle, TRANSPARENT);
DrawText(Canvas, Caption, Length(Caption), R,
DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX or DT_EDITCONTROL or cAlignment[Alignment]);
end;
Canvas.Pen.Color := FrameColor;
Canvas.MoveTo(0, ClientHeight - 1);
Canvas.LineTo(Width, ClientHeight - 1);
end;
procedure TJvNavPanelDivider.SetColorFrom(const Value: TColor);
begin
if FColorFrom <> Value then
begin
FColorFrom := Value;
Invalidate;
end;
end;
procedure TJvNavPanelDivider.SetStyleManager(const Value: TJvNavPaneStyleManager);
begin
if FStyleManager <> Value then
begin
ParentStyleManager := False;
if FStyleManager <> nil then
FStyleManager.UnregisterChanges(FStyleLink);
FStyleManager := Value;
if FStyleManager <> nil then
begin
FStyleManager.RegisterChanges(FStyleLink);
FStyleManager.FreeNotification(Self);
ColorFrom := FStyleManager.Colors.DividerColorFrom;
ColorTo := FStyleManager.Colors.DividerColorTo;
Font := FStyleManager.Fonts.DividerFont;
end;
end;
end;
procedure TJvNavPanelDivider.SetColorTo(const Value: TColor);
begin
if FColorTo <> Value then
begin
FColorTo := Value;
Invalidate;
end;
end;
procedure TJvNavPanelDivider.SetFrameColor(const Value: TColor);
begin
if FFrameColor <> Value then
begin
FFrameColor := Value;
Invalidate;
end;
end;
procedure TJvNavPanelDivider.SetAlignment(const Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
Invalidate;
end;
end;
procedure TJvNavPanelDivider.ParentStyleManagerChanged(var Msg: TMsgStyleManagerChange);
begin
if (Msg.Sender <> Self) and ParentStyleManager then
begin
StyleManager := Msg.StyleManager;
ParentStyleManager := True;
end;
end;
procedure TJvNavPanelDivider.SetParentStyleManager(const Value: Boolean);
begin
if FParentStyleManager <> Value then
begin
FParentStyleManager := Value;
if FParentStyleManager and (Parent <> nil) then
Parent.Perform(CM_PARENTSTYLEMANAGERCHANGE, 0, 0);
end;
end;
procedure TJvNavPanelDivider.RequestAlign;
begin
if (Cursor = crSizeWE) or (Cursor = crSizeNS) then
begin
if Align in [alLeft, alRight] then
Cursor := crSizeWE
else
Cursor := crSizeNS;
end;
end;
//=== { TJvNavPaneStyleManager } =============================================
constructor TJvNavPaneStyleManager.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FClients := TList.Create;
FColors := TJvNavPanelColors.Create;
FFonts := TJvNavPanelFonts.Create;
FColors.OnChange := @DoThemeChange;
FFonts.OnChange := @DoThemeChange;
FTheme := nptCustom; // (p3) required to trigger the change method
Theme := nptStandard;
end;
destructor TJvNavPaneStyleManager.Destroy;
begin
while FClients.Count > 0 do
UnregisterChanges(TJvNavStyleLink(FClients.Last));
FClients.Free;
FClients := nil;
FColors.Free;
FFonts.Free;
inherited Destroy;
end;
procedure TJvNavPaneStyleManager.Assign(Source: TPersistent);
var
SourceColors: TJvNavPanelColors;
SourceFonts: TJvNavPanelFonts;
begin
SourceFonts := nil;
if Source is TJvNavPaneStyleManager then
begin
Theme := TJvNavPaneStyleManager(Source).Theme;
if Theme = nptCustom then
begin
SourceColors := TJvNavPaneStyleManager(Source).Colors;
SourceFonts := TJvNavPaneStyleManager(Source).Fonts;
end
else
Exit;
end
else
if Source is TJvIconPanel then
SourceColors := TJvIconPanel(Source).Colors
else
if Source is TJvNavIconButton then
SourceColors := TJvNavIconButton(Source).Colors
else
if Source is TJvNavPanelButton then
SourceColors := TJvNavPanelButton(Source).Colors
else
if Source is TJvNavPanelPage then
SourceColors := TJvNavPanelPage(Source).Colors
else
if Source is TJvCustomNavigationPane then
SourceColors := TJvCustomNavigationPane(Source).Colors
else
begin
inherited Assign(Source);
Exit;
end;
FColors.Assign(SourceColors);
if SourceFonts <> nil then
FFonts.Assign(SourceFonts);
end;
procedure TJvNavPaneStyleManager.AssignTo(Dest: TPersistent);
var
DestColors: TJvNavPanelColors;
DestFonts: TJvNavPanelFonts;
begin
DestFonts := nil;
if Dest is TJvNavPaneStyleManager then
begin
TJvNavPaneStyleManager(Dest).Theme := Theme;
if Theme = nptCustom then
begin
DestColors := TJvNavPaneStyleManager(Dest).Colors;
DestFonts := TJvNavPaneStyleManager(Dest).Fonts;
end
else
Exit;
end
else
if Dest is TJvIconPanel then
DestColors := TJvIconPanel(Dest).Colors
else
if Dest is TJvNavIconButton then
DestColors := TJvNavIconButton(Dest).Colors
else
if Dest is TJvNavPanelButton then
DestColors := TJvNavPanelButton(Dest).Colors
else
if Dest is TJvNavPanelPage then
DestColors := TJvNavPanelPage(Dest).Colors
else
if Dest is TJvCustomNavigationPane then
DestColors := TJvCustomNavigationPane(Dest).Colors
else
begin
inherited AssignTo(Dest);
Exit;
end;
DestColors.Assign(Colors);
if DestFonts <> nil then
DestFonts.Assign(Fonts);
end;
procedure TJvNavPaneStyleManager.Change;
var
I: Integer;
begin
if FClients <> nil then
for I := 0 to FClients.Count - 1 do
TJvNavStyleLink(FClients[I]).Change;
if Assigned(FOnThemeChange) then
FOnThemeChange(Self);
end;
procedure TJvNavPaneStyleManager.DoThemeChange(Sender: TObject);
begin
Theme := nptCustom;
Change;
end;
procedure TJvNavPaneStyleManager.RegisterChanges(Value: TJvNavStyleLink);
begin
Value.Sender := Self;
if FClients <> nil then
FClients.Add(Value);
end;
procedure TJvNavPaneStyleManager.SetColors(const Value: TJvNavPanelColors);
begin
FColors.Assign(Value);
end;
procedure TJvNavPaneStyleManager.SetFonts(const Value: TJvNavPanelFonts);
begin
FFonts.Assign(Value);
end;
procedure TJvNavPaneStyleManager.SetTheme(const Value: TJvNavPanelTheme);
begin
if FTheme <> Value then
begin
FColors.OnChange := nil;
FFonts.OnChange := nil;
try
case Value of
nptStandard:
begin
FColors.ButtonColorFrom := TColor($FFFFFF);
FColors.ButtonColorTo := TColor($BDBEBD);
FColors.ButtonSelectedColorFrom := TColor($DECFCE);
FColors.ButtonSelectedColorTo := TColor($DECFCE);
FColors.FrameColor := TColor($848484);
FColors.ButtonHotColorFrom := TColor($C68284);
FColors.ButtonHotColorTo := TColor($C68284);
FColors.DividerColorFrom := TColor($EFF3EF);
FColors.DividerColorTo := TColor($C6C3C6);
FColors.HeaderColorFrom := TColor($848284);
FColors.HeaderColorTo := TColor($848284);
FColors.SplitterColorFrom := TColor($C6C3C6);
FColors.SplitterColorTo := TColor($8C8E8C);
FColors.ButtonSeparatorColor := clGray;
FColors.ToolPanelColorFrom := clWindow;
FColors.ToolPanelColorTo := clWindow;
FColors.ToolPanelHeaderColorFrom := TColor($FFFFFF);
FColors.ToolPanelHeaderColorTo := TColor($BDBEBD);
FFonts.HeaderFont.Color := clWindow;
FFonts.NavPanelFont.Color := clWindowText;
FFonts.NavPanelHotTrackFont.Color := clWindow;
FFonts.DividerFont.Color := clWindowText;
end;
nptXPBlue:
begin
FColors.ButtonColorFrom := TColor($F7E2CD);
FColors.ButtonColorTo := TColor($F3A080);
FColors.ButtonSelectedColorFrom := TColor($BBE2EA);
FColors.ButtonSelectedColorTo := TColor($389FDD);
FColors.FrameColor := TColor($6F2F0C);
FColors.ButtonHotColorFrom := TColor($DBFBFF);
FColors.ButtonHotColorTo := TColor($5FC8FB);
FColors.DividerColorFrom := TColor($FFDBBC);
FColors.DividerColorTo := TColor($F2C0A4);
FColors.HeaderColorFrom := TColor($D0835C);
FColors.HeaderColorTo := TColor($903B09);
FColors.SplitterColorFrom := TColor($B78676);
FColors.SplitterColorTo := TColor($A03D09);
FColors.ButtonSeparatorColor := TColor($602D00); // SESS
FColors.ToolPanelColorFrom := clWindow;
FColors.ToolPanelColorTo := clWindow;
FColors.ToolPanelHeaderColorFrom := TColor($F7E2CD);
FColors.ToolPanelHeaderColorTo := TColor($F3A080);
FFonts.HeaderFont.Color := clWindow;
FFonts.NavPanelFont.Color := clWindowText;
FFonts.NavPanelHotTrackFont.Color := clWindowText;
FFonts.DividerFont.Color := clWindowText;
end;
nptXPSilver:
begin
FColors.ButtonColorFrom := TColor($F4E2E1);
FColors.ButtonColorTo := TColor($B09494);
FColors.ButtonSelectedColorFrom := TColor($BBE2EA);
FColors.ButtonSelectedColorTo := TColor($389FDD);
FColors.FrameColor := TColor($527D92);
FColors.ButtonHotColorFrom := TColor($DBFBFF);
FColors.ButtonHotColorTo := TColor($5FC8FB);
FColors.DividerColorFrom := TColor($F8F3F4);
FColors.DividerColorTo := TColor($EADADB);
FColors.HeaderColorFrom := TColor($BAA8BA);
FColors.HeaderColorTo := TColor($917275);
FColors.SplitterColorFrom := TColor($B8ABA9);
FColors.SplitterColorTo := TColor($81767E);
FColors.ButtonSeparatorColor := TColor($947C7C);
FColors.ToolPanelColorFrom := clWindow;
FColors.ToolPanelColorTo := clWindow;
FColors.ToolPanelHeaderColorFrom := TColor($F4E2E1);
FColors.ToolPanelHeaderColorTo := TColor($B09494);
FFonts.HeaderFont.Color := clWindow;
FFonts.NavPanelFont.Color := clWindowText;
FFonts.NavPanelHotTrackFont.Color := clWindowText;
FFonts.DividerFont.Color := clWindowText;
end;
nptXPOlive:
begin
FColors.ButtonColorFrom := TColor($D6F3E3);
FColors.ButtonColorTo := TColor($93BFB2);
FColors.ButtonSelectedColorFrom := TColor($BBE2EA);
FColors.ButtonSelectedColorTo := TColor($389FDD);
FColors.FrameColor := TColor($5A7972);
FColors.ButtonHotColorFrom := TColor($DBFBFF);
FColors.ButtonHotColorTo := TColor($5FC8FB);
FColors.DividerColorFrom := TColor($D2F4EE);
FColors.DividerColorTo := TColor($B5DFD8);
FColors.HeaderColorFrom := TColor($94BFB4);
FColors.HeaderColorTo := TColor($427665);
FColors.SplitterColorFrom := TColor($758D81);
FColors.SplitterColorTo := TColor($3A584D);
FColors.ButtonSeparatorColor := TColor($588060);
FColors.ToolPanelColorFrom := clWindow;
FColors.ToolPanelColorTo := clWindow;
FColors.ToolPanelHeaderColorFrom := TColor($D6F3E3);
FColors.ToolPanelHeaderColorTo := TColor($93BFB2);
FFonts.HeaderFont.Color := clWindow;
FFonts.NavPanelFont.Color := clWindowText;
FFonts.NavPanelHotTrackFont.Color := clWindowText;
FFonts.DividerFont.Color := clWindowText;
end;
nptCustom:
begin
// do nothing
end;
end;
FTheme := Value;
Change;
finally
FColors.OnChange := @DoThemeChange;
FFonts.OnChange := @DoThemeChange;
end;
end;
end;
procedure TJvNavPaneStyleManager.UnregisterChanges(Value: TJvNavStyleLink);
var
I: Integer;
begin
if FClients <> nil then
for I := 0 to FClients.Count - 1 do
if FClients[I] = Pointer(Value) then
begin
Value.Sender := nil;
FClients.Delete(I);
Break;
end;
end;
function TJvNavPaneStyleManager.IsColorsStored: Boolean;
begin
Result := Theme = nptCustom;
end;
function TJvNavPaneStyleManager.IsFontsStored: Boolean;
begin
Result := Theme = nptCustom;
end;
//=== { TJvNavStyleLink } ====================================================
destructor TJvNavStyleLink.Destroy;
begin
if Sender is TJvNavPaneStyleManager then
TJvNavPaneStyleManager(Sender).UnregisterChanges(Self);
inherited Destroy;
end;
procedure TJvNavStyleLink.Change;
begin
if Assigned(FOnChange) then
FOnChange(Sender);
end;
//=== { TJvCustomNavPaneToolPanel } ==========================================
constructor TJvCustomNavPaneToolPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FHeaderVisible := True;
ParentColor := False;
FColors := TJvNavPanelColors.Create;
FColors.OnChange := @DoImagesChange;
FBackground := TJvNavPaneBackgroundImage.Create;
FBackground.OnChange := @DoImagesChange;
ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
csOpaque, csDoubleClicks, csReplicatable];
FButtons := TJvNavPaneToolButtons.Create(Self);
FStyleLink := TJvNavStyleLink.Create;
FStyleLink.OnChange := @DoStyleChange;
FChangeLink := TChangeLink.Create;
FChangeLink.OnChange := @DoImagesChange;
{
FColorFrom := TColor($F7E2CD);
FColorTo := TColor($F3A080);
FButtonColor := TColor($A03D09);
}
FButtonWidth := 25;
FButtonHeight := 22;
FHeaderHeight := 29;
FEdgeRounding := 9;
FShowGrabber := True;
//TODO:
//Font := Screen.IconFont;
Font.Style := [fsBold];
FCloseButton := TJvNavPanelToolButton.Create(Self);
FCloseButton.ButtonType := nibClose;
FCloseButton.Parent := Self;
FCloseButton.Visible := True;
FCloseButton.OnClick := @DoCloseClick;
FDropDown := TJvNavPanelToolButton.Create(Self);
FDropDown.Visible := False;
FDropDown.ButtonType := nibDropArrow;
FDropDown.OnDropDownMenu := @DoDropDownMenu;
FDropDown.Parent := Self;
Width := 185;
Height := 41;
FParentStyleManager := True;
end;
destructor TJvCustomNavPaneToolPanel.Destroy;
begin
FStyleLink.Free;
FChangeLink.Free;
FButtons.Free;
FBackground.Free;
FColors.Free;
inherited Destroy;
end;
procedure TJvCustomNavPaneToolPanel.ButtonsChanged;
var
I: Integer;
B: TJvNavPanelToolButton;
begin
if HeaderVisible then
for I := 0 to Buttons.Count - 1 do
begin
B := Buttons[I].Button;
B.Visible := False;
B.SetBounds(0, 0, ButtonWidth - 3, ButtonHeight - 2);
B.Images := Images;
if B.Action = nil then
B.OnClick := @InternalButtonClick;
B.Tag := I;
B.Parent := Self;
end;
Invalidate;
end;
procedure TJvCustomNavPaneToolPanel.DoCloseClick(Sender: TObject);
begin
if Assigned(FOnClose) then
FOnClose(Self);
end;
procedure TJvCustomNavPaneToolPanel.DoDropDownMenu(Sender: TObject;
MousePos: TPoint; var Handled: Boolean);
begin
if Assigned(FOnDropDownMenu) then
FOnDropDownMenu(Self, MousePos, Handled);
end;
procedure TJvCustomNavPaneToolPanel.DoImagesChange(Sender: TObject);
begin
ButtonsChanged;
end;
procedure TJvCustomNavPaneToolPanel.DoStyleChange(Sender: TObject);
begin
Font := (Sender as TJvNavPaneStyleManager).Fonts.NavPanelFont;
Colors := (Sender as TJvNavPaneStyleManager).Colors;
end;
procedure TJvCustomNavPaneToolPanel.FontChanged;
begin
inherited FontChanged;
Invalidate;
end;
function TJvCustomNavPaneToolPanel.GetCloseButton: Boolean;
begin
Result := FCloseButton.Visible; // and HeaderVisible;
end;
function TJvCustomNavPaneToolPanel.GetDropDownMenu: TPopupMenu;
begin
if not (csDestroying in ComponentState) then
Result := FDropDown.DropDownMenu
else
Result := nil;
end;
function TJvCustomNavPaneToolPanel.GetHitTestInfoAt(X, Y: Integer): TJvToolPanelHitTestInfos;
function InRange(Value, Min, Max: Integer): Boolean;
begin
Result := (Value >= Min) and (Value <= Max);
end;
begin
if not Visible then
begin
Result := [phtNowhere];
Exit;
end;
Result := [];
if X < 0 then
Include(Result, phtToLeft);
if X > ClientWidth then
Include(Result, phtToRight);
if Y < 0 then
Include(Result, phtAbove);
if Y > ClientHeight then
Include(Result, phtBelow);
if InRange(Y, 0, HeaderHeight - EdgeRounding) then
if InRange(X, 0, ClientWidth) then
begin
Include(Result, phtHeader);
if (X <= 16) and ShowGrabber then
Include(Result, phtGrabber);
end;
if InRange(X, 0, ClientWidth) and InRange(Y, HeaderHeight, ClientHeight) then
Include(Result, phtClient);
end;
procedure TJvCustomNavPaneToolPanel.InternalButtonClick(Sender: TObject);
begin
if Assigned(FOnButtonClick) then
FOnButtonClick(Self, TJvNavPanelToolButton(Sender).Tag);
end;
procedure TJvCustomNavPaneToolPanel.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
begin
if AComponent = Images then
Images := nil
else
if AComponent = StyleManager then
StyleManager := nil
else
if AComponent = DropDownMenu then
DropDownMenu := nil;
end;
end;
procedure TJvCustomNavPaneToolPanel.Paint;
var
R, R2: TRect;
I, X, Y: Integer;
B: TJvNavPanelToolButton;
begin
// first, fill the background
Canvas.Lock;
try
R := ClientRect;
if HeaderVisible then
Inc(R.Top, HeaderHeight);
GradientFillRect(Canvas, R, Colors.ToolPanelColorFrom, Colors.ToolPanelColorTo, fdTopToBottom, 255);
FBackground.DrawImage(Canvas, R);
R := ClientRect;
if HeaderVisible then
begin
R.Bottom := HeaderHeight - EdgeRounding;
R.Bottom := R.Top + HeaderHeight;
GradientFillRect(Canvas, R, Colors.ToolPanelHeaderColorFrom, Colors.ToolPanelHeaderColorTo, fdTopToBottom, 255);
// draw the drag dots
R2 := Rect(R.Left, R.Top + (HeaderHeight - cToolButtonHeight) div 2 + 2, R.Left + 2, R.Top + (HeaderHeight - cToolButtonHeight) div 2 + 4);
OffsetRect(R2, 6, 0);
if ShowGrabber then
begin
for I := 0 to 3 do
begin
Canvas.Brush.Color := clWhite;
OffsetRect(R2, 1, 1);
Canvas.FillRect(R2);
Canvas.Brush.Color := Colors.FrameColor;
OffsetRect(R2, -1, -1);
Canvas.FillRect(R2);
OffsetRect(R2, 0, 4);
end;
// draw the text
Inc(R.Left, 16);
end
else
Inc(R.Left, 12);
Canvas.Font := Self.Font;
if (DropDownMenu = nil) and not (csDesigning in ComponentState) then
begin
OffsetRect(R, 2, -1); // line up with where button caption should have been
SetBkMode(Canvas.Handle, TRANSPARENT);
if CloseButton then
R := Rect(R.Left, R.Top, FCloseButton.Left, R.Bottom);
DrawText(Canvas, Caption, Length(Caption), R, DT_SINGLELINE or DT_VCENTER or DT_LEFT or DT_END_ELLIPSIS);
end;
// draw the client areas top rounding, set pixels directly to avoid messing up any background image
// just a simple "arrow" in each corner in the same color as the gradient
// left corner
Y := HeaderHeight;
X := 0;
for I := 0 to 3 do
Canvas.Pixels[X, Y + I] := Colors.ToolPanelHeaderColorTo;
Inc(X);
for I := 0 to 2 do
Canvas.Pixels[X, Y + I] := Colors.ToolPanelHeaderColorTo;
Inc(X);
for I := 0 to 1 do
Canvas.Pixels[X, Y + I] := Colors.ToolPanelHeaderColorTo;
Inc(X);
Canvas.Pixels[X, Y] := Colors.ToolPanelHeaderColorTo;
// Inc(X);
// Canvas.Pixels[X, Y] := Colors.HeaderColorTo;
// right corner
Y := HeaderHeight;
X := ClientWidth - 1;
for I := 0 to 4 do
Canvas.Pixels[X, Y + I] := Colors.ToolPanelHeaderColorTo;
Dec(X);
for I := 0 to 2 do
Canvas.Pixels[X, Y + I] := Colors.ToolPanelHeaderColorTo;
Dec(X);
for I := 0 to 1 do
Canvas.Pixels[X, Y + I] := Colors.ToolPanelHeaderColorTo;
Dec(X);
Canvas.Pixels[X, Y] := Colors.ToolPanelHeaderColorTo;
Dec(X);
Canvas.Pixels[X, Y] := Colors.HeaderColorTo;
// draw the button area
R := ClientRect;
Inc(R.Top, HeaderHeight);
Inc(R.Right);
Canvas.Brush.Color := Colors.FrameColor;
Canvas.Pen.Style := psClear;
if Buttons.Count > 0 then
begin
R2 := Rect(R.Left, R.Top, R.Left + ButtonWidth * Buttons.Count - 1, R.Top + ButtonHeight);
Canvas.RoundRect(R2.Left, R2.Top, R2.Right, R2.Bottom, EdgeRounding, EdgeRounding);
// square two corners
Canvas.FillRect(Rect(R2.Right - EdgeRounding, R2.Top, R2.Right - 1, R2.Top + EdgeRounding));
Canvas.FillRect(Rect(R2.Left, R2.Bottom - EdgeRounding, R2.Left + EdgeRounding, R2.Bottom - 1));
Canvas.Pen.Style := psSolid;
Y := R2.Top;
// adjust the buttons and draw the dividers
for I := 0 to Buttons.Count - 1 do
begin
X := R2.Left + ButtonWidth * I;
B := Buttons[I].Button;
B.SetBounds(X + 3, Y + 2, ButtonWidth - 6, ButtonHeight - 4);
B.Visible := True;
if I > 0 then
begin
Canvas.Pen.Color := TColor($E7EBEF);
Canvas.MoveTo(X, R2.Top + 2);
Canvas.LineTo(X, R2.Bottom - 3);
end;
if I < Buttons.Count - 1 then
begin
Canvas.Pen.Color := TColor($CED3D6);
Canvas.MoveTo(X + ButtonWidth - 1, R2.Top + 1);
Canvas.LineTo(X + ButtonWidth - 1, R2.Bottom - 4);
end;
end;
end;
end;
finally
Canvas.Unlock;
end;
end;
procedure TJvCustomNavPaneToolPanel.AlignButtons;
var
AOffset: Integer;
begin
if HeaderVisible and ShowGrabber then
AOffset := cToolButtonOffset
else
AOffset := 4;
if (Parent <> nil) and (HeaderHeight > cToolButtonHeight) then
begin
FCloseButton.SetBounds(ClientWidth - cToolButtonWidth - 2, (HeaderHeight - cToolButtonHeight) div 2, cToolButtonWidth, cToolButtonHeight);
if FCloseButton.Visible or (csDesigning in ComponentState) then
FDropDown.SetBounds(AOffset, (HeaderHeight - cToolButtonHeight) div 2, ClientWidth - cToolButtonWidth - AOffset - 2, cToolButtonHeight)
else
FDropDown.SetBounds(AOffset, (HeaderHeight - cToolButtonHeight) div 2, ClientWidth - AOffset - 4, cToolButtonHeight);
end
else
begin
FCloseButton.SetBounds(0, 0, 0, 0);
FDropDown.SetBounds(0, 0, 0, 0);
end;
end;
procedure TJvCustomNavPaneToolPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
AlignButtons;
end;
procedure TJvCustomNavPaneToolPanel.SetButtonHeight(const Value: Integer);
begin
if FButtonHeight <> Value then
begin
FButtonHeight := Value;
Invalidate;
end;
end;
procedure TJvCustomNavPaneToolPanel.SetButtons(const Value: TJvNavPaneToolButtons);
begin
FButtons.Assign(Value);
end;
procedure TJvCustomNavPaneToolPanel.SetButtonWidth(const Value: Integer);
begin
if FButtonWidth <> Value then
begin
FButtonWidth := Value;
Invalidate;
end;
end;
procedure TJvCustomNavPaneToolPanel.SetCloseButton(const Value: Boolean);
begin
if FCloseButton.Visible <> Value then
begin
FCloseButton.Visible := Value;
SetBounds(Left, Top, Width, Height);
end;
end;
procedure TJvCustomNavPaneToolPanel.SetDropDownMenu(const Value: TPopupMenu);
begin
if FDropDown.DropDownMenu <> Value then
begin
FDropDown.DropDownMenu := Value;
FDropDown.Visible := (Value <> nil); // and HeaderVisible;
SetBounds(Left, Top, Width, Height);
Invalidate;
end;
end;
procedure TJvCustomNavPaneToolPanel.SetEdgeRounding(const Value: Integer);
begin
if FEdgeRounding <> Value then
begin
FEdgeRounding := Value;
Invalidate;
end;
end;
procedure TJvCustomNavPaneToolPanel.SetHeaderHeight(const Value: Integer);
begin
if FHeaderHeight <> Value then
begin
FHeaderHeight := Value;
Invalidate;
end;
end;
procedure TJvCustomNavPaneToolPanel.SetImages(const Value: TCustomImageList);
var
I: Integer;
begin
if FImages <> Value then
begin
if FImages <> nil then
FImages.UnregisterChanges(FChangeLink);
FImages := Value;
if FImages <> nil then
begin
FImages.RegisterChanges(FChangeLink);
FImages.FreeNotification(Self);
end;
for I := 0 to Buttons.Count - 1 do
Buttons[I].Button.Images := FImages;
Invalidate;
end;
end;
procedure TJvCustomNavPaneToolPanel.SetShowGrabber(const Value: Boolean);
begin
if FShowGrabber <> Value then
begin
FShowGrabber := Value;
Invalidate;
end;
end;
procedure TJvCustomNavPaneToolPanel.SetStyleManager(const Value: TJvNavPaneStyleManager);
begin
if FStyleManager <> Value then
begin
ParentStyleManager := False;
if FStyleManager <> nil then
FStyleManager.UnregisterChanges(FStyleLink);
FStyleManager := Value;
if FStyleManager <> nil then
begin
FStyleManager.RegisterChanges(FStyleLink);
FStyleManager.FreeNotification(Self);
Colors := FStyleManager.Colors;
Invalidate;
end;
InternalStyleManagerChanged(Self, StyleManager);
end;
end;
procedure TJvCustomNavPaneToolPanel.ParentStyleManagerChanged(var Msg: TMsgStyleManagerChange);
begin
if (Msg.Sender <> Self) and ParentStyleManager then
begin
StyleManager := Msg.StyleManager;
ParentStyleManager := True;
InternalStyleManagerChanged(Self, Msg.StyleManager);
end;
end;
procedure TJvCustomNavPaneToolPanel.TextChanged;
begin
inherited TextChanged;
FDropDown.Caption := Caption;
Invalidate;
end;
procedure TJvCustomNavPaneToolPanel.SetParentStyleManager(const Value: Boolean);
begin
if FParentStyleManager <> Value then
begin
FParentStyleManager := Value;
if FParentStyleManager and (Parent <> nil) then
Parent.Perform(CM_PARENTSTYLEMANAGERCHANGE, 0, 0);
end;
end;
procedure TJvCustomNavPaneToolPanel.CMControlChange(var Msg: TLMessage);
begin
InternalStyleManagerChanged(Self, StyleManager);
end;
procedure TJvCustomNavPaneToolPanel.WMEraseBkgnd(var Msg: TLMEraseBkgnd);
begin
Msg.Result := 1;
end;
procedure TJvCustomNavPaneToolPanel.WMNCPaint(var Msg: TWMNCPaint);
var
AColor: TColor;
begin
AColor := Color;
Color := Colors.FrameColor;
inherited;
Color := AColor;
end;
procedure TJvCustomNavPaneToolPanel.ParentStyleManagerChange(var Msg: TLMessage);
begin
InternalStyleManagerChanged(Self, StyleManager);
end;
function TJvCustomNavPaneToolPanel.GetDrawPartialMenuFrame: Boolean;
begin
if FDropDown <> nil then
Result := FDropDown.DrawPartialMenuFrame
else
Result := False;
end;
procedure TJvCustomNavPaneToolPanel.SetDrawPartialMenuFrame(const Value: Boolean);
begin
if FDropDown <> nil then
FDropDown.DrawPartialMenuFrame := Value;
end;
procedure TJvCustomNavPaneToolPanel.SetBackground(const Value: TJvNavPaneBackgroundImage);
begin
FBackground.Assign(Value);
end;
procedure TJvCustomNavPaneToolPanel.SetColors(const Value: TJvNavPanelColors);
begin
FColors.Assign(Value);
end;
procedure TJvCustomNavPaneToolPanel.SetHeaderVisible(const Value: Boolean);
begin
if FHeaderVisible <> Value then
begin
FHeaderVisible := Value;
FCloseButton.Visible := CloseButton;
FDropDown.Visible := (FDropDown.DropDownMenu <> nil); // and Value;
ButtonsChanged;
end;
end;
function TJvCustomNavPaneToolPanel.IsColorsStored: Boolean;
begin
Result := (StyleManager = nil) or (StyleManager.Theme = nptCustom);
end;
//=== { TJvNavPaneToolButton } ===============================================
procedure TJvNavPaneToolButton.Assign(Source: TPersistent);
begin
if Source is TJvNavPaneToolButton then
begin
// if Source <> Self then
begin
Action := TJvNavPaneToolButton(Source).Action;
Hint := TJvNavPaneToolButton(Source).Hint;
ImageIndex := TJvNavPaneToolButton(Source).ImageIndex;
Enabled := TJvNavPaneToolButton(Source).Enabled
end;
end
else
inherited Assign(Source);
end;
constructor TJvNavPaneToolButton.Create(ACollection: Classes.TCollection);
begin
FRealButton := TJvNavPanelToolButton.Create(nil);
FRealButton.ButtonType := nibImage;
FRealButton.ImageIndex := -1;
inherited Create(ACollection);
end;
destructor TJvNavPaneToolButton.Destroy;
begin
FRealButton.Free;
inherited Destroy;
end;
function TJvNavPaneToolButton.GetAction: TBasicAction;
begin
Result := FRealButton.Action;
end;
function TJvNavPaneToolButton.GetEnabled: Boolean;
begin
Result := FRealButton.Enabled;
end;
function TJvNavPaneToolButton.GetHint: string;
begin
Result := FRealButton.Hint;
end;
function TJvNavPaneToolButton.GetImageIndex: TImageIndex;
begin
Result := FRealButton.ImageIndex;
end;
procedure TJvNavPaneToolButton.SetAction(const Value: TBasicAction);
begin
FRealButton.Action := Value;
FRealButton.ActionChange(Value, False);
end;
procedure TJvNavPaneToolButton.SetEnabled(const Value: Boolean);
begin
FRealButton.Enabled := Value;
end;
procedure TJvNavPaneToolButton.SetHint(const Value: string);
begin
FRealButton.Hint := Value;
end;
procedure TJvNavPaneToolButton.SetImageIndex(const Value: TImageIndex);
begin
FRealButton.ImageIndex := Value;
end;
//=== { TJvNavPaneToolButtons } ==============================================
constructor TJvNavPaneToolButtons.Create(AOwner: TJvCustomNavPaneToolPanel);
begin
inherited Create(AOwner, TJvNavPaneToolButton);
FPanel := AOwner;
end;
function TJvNavPaneToolButtons.Add: TJvNavPaneToolButton;
begin
Result := TJvNavPaneToolButton(inherited Add);
end;
function TJvNavPaneToolButtons.GetItem(Index: Integer): TJvNavPaneToolButton;
begin
Result := TJvNavPaneToolButton(inherited Items[Index]);
end;
procedure TJvNavPaneToolButtons.SetItem(Index: Integer;
const Value: TJvNavPaneToolButton);
begin
inherited Items[Index] := Value;
end;
procedure TJvNavPaneToolButtons.Update(Item: TCollectionItem);
begin
inherited Update(Item);
if FPanel <> nil then
FPanel.ButtonsChanged;
end;
//=== { TJvNavPanelToolButton } ==============================================
constructor TJvNavPanelToolButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FChangeLink := TChangeLink.Create;
FChangeLink.OnChange := @DoImagesChange;
DrawPartialMenuFrame := False;
TransparentDown := False;
HotTrack := True;
end;
destructor TJvNavPanelToolButton.Destroy;
begin
FChangeLink.Free;
inherited Destroy;
end;
procedure TJvNavPanelToolButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
if Sender is TCustomAction then
with TCustomAction(Sender) do
begin
if not CheckDefaults or Self.Enabled then
Self.Enabled := Enabled;
if not CheckDefaults or (Self.Hint = '') then
Self.Hint := Hint;
if not CheckDefaults or (Self.ImageIndex = -1) then
Self.ImageIndex := ImageIndex;
if not CheckDefaults or Self.Visible then
Self.Visible := Visible;
if not CheckDefaults or not Assigned(Self.OnClick) then
Self.OnClick := OnExecute;
end;
end;
procedure TJvNavPanelToolButton.DoImagesChange(Sender: TObject);
begin
Invalidate;
end;
procedure TJvNavPanelToolButton.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = Images) then
Images := nil;
end;
procedure TJvNavPanelToolButton.Paint;
label
DrawButton;
var
R: TRect;
I: Integer;
begin
// inherited Paint;
if MouseStates <> [] then
begin
Canvas.Pen.Color := TColor($6B2408);
if bsMouseInside in MouseStates then
Canvas.Brush.Color := TColor($D6BEB5);
if (bsMouseDown in MouseStates) or Down then
begin
if TransparentDown then
Canvas.Brush.Style := bsClear; // (p3) don't draw background - looks better IMO
if (ButtonType = nibDropArrow) and (DropDownMenu <> nil) then
begin
Canvas.Brush.Color := clWindow;
Canvas.Pen.Color := cl3DDkShadow;
if DrawPartialMenuFrame then
begin
Canvas.FillRect(ClientRect); // if Brush.Style = bsClear, this does nothing
Canvas.MoveTo(0, Height);
Canvas.LineTo(0, 0);
Canvas.LineTo(Width - 1, 0);
Canvas.LineTo(Width - 1, Height);
// (p3) yucky! first goto in JVCL?!!!
goto DrawButton;
end;
end
else
Canvas.Brush.Color := TColor($B59284);
end;
Canvas.Rectangle(ClientRect);
end;
DrawButton:
case ButtonType of
nibDropArrow: // dropdown arrow is 7x4, right-aligned
begin
R := ClientRect;
if Caption <> '' then
begin
InflateRect(R, -2, -2);
Canvas.Font := Font;
SetBkMode(Canvas.Handle, TRANSPARENT);
InflateRect(R, -2, 0);
Dec(R.Right, 3 + 7);
DrawText(Canvas, Caption, Length(Caption), R, DT_LEFT or DT_VCENTER or DT_NOPREFIX or DT_END_ELLIPSIS);
Inc(R.Right, 3 + 7);
InflateRect(R, 2, 0);
end;
R.Left := R.Right - 11;
Dec(R.Right, 4);
R.Top := (RectHeight(ClientRect) - 4) div 2;
Canvas.Pen.Color := clWindowText;
for I := 0 to 3 do
begin
Canvas.MoveTo(R.Left, R.Top);
Canvas.LineTo(R.Right, R.Top);
Dec(R.Right);
Inc(R.Left);
Inc(R.Top);
end;
end;
nibClose:
begin
// close button is 8x8, centered
if bsMouseDown in MouseStates then
Canvas.Pen.Color := clHighlightText
else
Canvas.Pen.Color := clWindowText;
R := ClientRect;
InflateRect(R, -(RectWidth(R) div 2 - 4), -(RectHeight(R) div 2 - 4));
if Odd(Height) or Odd(Width) then
begin
Inc(R.Right);
Inc(R.Bottom);
end;
// (p3) this isn't exactly the same as MS's but good enough for me :)
for I := 0 to 7 do
begin
Canvas.MoveTo(R.Left + I, R.Top + I);
Canvas.LineTo(R.Left + I + 2, R.Top + I);
end;
for I := 0 to 7 do
begin
Canvas.MoveTo(R.Right - I, R.Top + I);
Canvas.LineTo(R.Right - I - 2, R.Top + I);
end;
end;
nibImage:
if Assigned(Images) then
Images.Draw(Canvas,
(Width - Images.Width) div 2, (Height - Images.Height) div 2,
ImageIndex, Enabled);
else
//TODO:
//raise EJVCLException.CreateRes(@RsEUnsupportedButtonType);
raise Exception.Create('RsEUnsupportedButtonType');
end;
end;
procedure TJvNavPanelToolButton.SetButtonType(const Value: TJvNavIconButtonType);
begin
if FButtonType <> Value then
begin
FButtonType := Value;
Invalidate;
end;
end;
procedure TJvNavPanelToolButton.SetImageIndex(const Value: TImageIndex);
begin
if FImageIndex <> Value then
begin
FImageIndex := Value;
Invalidate;
end;
end;
procedure TJvNavPanelToolButton.SetImages(const Value: TCustomImageList);
begin
if FImages <> Value then
begin
if FImages <> nil then
FImages.UnregisterChanges(FChangeLink);
FImages := Value;
if FImages <> nil then
begin
FImages.RegisterChanges(FChangeLink);
FImages.FreeNotification(Self);
end;
Invalidate;
end;
end;
//=== { TJvNavPaneBackgroundImage } ==========================================
constructor TJvNavPaneBackgroundImage.Create;
begin
inherited Create;
FPicture := TPicture.Create;
FPicture.OnChange := @PictureChanged;
end;
destructor TJvNavPaneBackgroundImage.Destroy;
begin
FPicture.Free;
inherited Destroy;
end;
function TJvNavPaneBackgroundImage.CalcRect(ADestRect: TRect): TRect;
var
W, H, CW, CH: Integer;
XYAspect: Double;
begin
W := Picture.Width;
H := Picture.Height;
CW := ADestRect.Right - ADestRect.Left;
CH := ADestRect.Bottom - ADestRect.Top;
if Stretch or (Proportional and ((W > CW) or (H > CH))) then
begin
if Proportional and (W > 0) and (H > 0) then
begin
XYAspect := W / H;
if W > H then
begin
W := CW;
H := Trunc(CW / XYAspect);
if H > CH then // woops, too big
begin
H := CH;
W := Trunc(CH * XYAspect);
end;
end
else
begin
H := CH;
W := Trunc(CH * XYAspect);
if W > CW then // woops, too big
begin
W := CW;
H := Trunc(CW / XYAspect);
end;
end;
end
else
begin
W := CW;
H := CH;
end;
end;
with Result do
begin
Left := ADestRect.Left;
Top := ADestRect.Top;
Right := ADestRect.Left + W;
Bottom := ADestRect.Top + H;
end;
if Center then
OffsetRect(Result, (CW - W) div 2, (CH - H) div 2);
end;
procedure TJvNavPaneBackgroundImage.Change;
begin
FDrawing := True;
if Assigned(FOnChange) then
FOnChange(Self);
FDrawing := False;
end;
procedure TJvNavPaneBackgroundImage.DrawImage(Canvas: TCanvas; ARect: TRect);
procedure TileImage;
var
X, Y: Integer;
G: TGraphic;
begin
G := Picture.Graphic;
X := ARect.Left;
Y := ARect.Top;
while Y < ARect.Bottom do
begin
Canvas.Draw(X, Y, G); // this doesn't clip on the right or bottom sides of ARect :(
Inc(X, G.Width);
if X > ARect.Right then
begin
X := ARect.Left;
Inc(Y, G.Height);
end;
end;
end;
begin
if (Picture.Graphic = nil) or (Picture.Width = 0) or (Picture.Height = 0) then
Exit;
if Tile then
TileImage
else
with Canvas do
StretchDraw(CalcRect(ARect), Picture.Graphic);
end;
function TJvNavPaneBackgroundImage.HasImage: Boolean;
begin
with Picture do
Result := (Graphic <> nil) and (Width <> 0) and (Height <> 0);
end;
procedure TJvNavPaneBackgroundImage.PictureChanged(Sender: TObject);
var
G: TGraphic;
begin
G := Picture.Graphic;
//TODO:
(*
if G <> nil then
if not ( (G is TMetaFile) or (G is TIcon)) then
G.Transparent := FTransparent;
*)
if not FDrawing then
Change;
end;
procedure TJvNavPaneBackgroundImage.SetCenter(const Value: Boolean);
begin
if FCenter <> Value then
begin
FCenter := Value;
PictureChanged(Self);
end;
end;
procedure TJvNavPaneBackgroundImage.SetPicture(const Value: TPicture);
begin
FPicture.Assign(Value);
end;
procedure TJvNavPaneBackgroundImage.SetProportional(const Value: Boolean);
begin
if FProportional <> Value then
begin
FProportional := Value;
PictureChanged(Self);
end;
end;
procedure TJvNavPaneBackgroundImage.SetStretch(const Value: Boolean);
begin
if FStretch <> Value then
begin
FStretch := Value;
PictureChanged(Self);
end;
end;
procedure TJvNavPaneBackgroundImage.SetTile(const Value: Boolean);
begin
if FTile <> Value then
begin
FTile := Value;
PictureChanged(Self);
end;
end;
procedure TJvNavPaneBackgroundImage.SetTransparent(const Value: Boolean);
begin
if FTransparent <> Value then
begin
FTransparent := Value;
PictureChanged(Self)
end;
end;
procedure TJvCustomNavPaneToolPanel.AdjustClientRect(var Rect: TRect);
begin
if HeaderVisible then
begin
Rect.Top := Rect.Top + HeaderHeight + EdgeRounding;
if Buttons.Count > 0 then
Rect.Top := Rect.Top + ButtonHeight - EdgeRounding;
end;
InflateRect(Rect, -2, -2);
inherited AdjustClientRect(Rect);
end;
{initialization
RegisterClasses([TJvNavPanelPage]);} // ahuser: moved to TJvCustomNavigationPane.Create
end.
Reference in New Issue Copy Permalink