You've already forked lazarus-ccr
5296af1508
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6969 8e941d3f-bd1b-0410-a28a-d453659cc2b4
3279 lines
96 KiB
ObjectPascal
3279 lines
96 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
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: JvOLBar.PAS, released on 2002-05-26.
|
|
|
|
The Initial Developer of the Original Code is Peter Thörnqvist [peter3 at sourceforge dot net]
|
|
Portions created by Peter Thörnqvist are Copyright (C) 2002 Peter Thörnqvist.
|
|
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.delphi-jedi.org
|
|
|
|
Description:
|
|
Outlook style control. Simpler than TJvLookout)
|
|
Hierarchy:
|
|
TJvCustomOutlookBar
|
|
Pages: TJvOutlookBarPages
|
|
Page: TJvOutlookBarPage
|
|
Buttons: TJvOutlookBarButtons
|
|
Button: TJvOutlookBarButton
|
|
|
|
Known Issues:
|
|
VISTA/THEMING CHANGES: WARREN POSTMA, NOV 2007 :
|
|
Vista paint fix, and support for completely user decided color
|
|
schemes, such as white on black, for low-visibility-users
|
|
(high contrast black on white) support.
|
|
Outlook bar buttons now have color properties (instead of
|
|
assuming we will use the clBtnFace type system colors)
|
|
-----------------------------------------------------------------------------}
|
|
// $Id$
|
|
|
|
unit JvOutlookBar;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
|
|
interface
|
|
|
|
uses
|
|
LCLType, LCLIntf, LMessages, Types, LCLVersion,
|
|
SysUtils, Classes, ActnList,
|
|
Buttons, Controls, Graphics, ImgList, Forms, StdCtrls, ExtCtrls, Themes,
|
|
JvJCLUtils, JvComponent;
|
|
|
|
const
|
|
CM_CAPTION_EDITING = CM_BASE + 756;
|
|
CM_CAPTION_EDIT_ACCEPT = CM_CAPTION_EDITING + 1;
|
|
CM_CAPTION_EDIT_CANCEL = CM_CAPTION_EDITING + 2;
|
|
|
|
type
|
|
TJvBarButtonSize = (olbsLarge, olbsSmall);
|
|
TJvCustomOutlookBar = class;
|
|
TJvOutlookBarButton = class;
|
|
|
|
TJvOutlookBarButtonActionLink = class(TActionLink)
|
|
private
|
|
FClient: TJvOutlookBarButton;
|
|
protected
|
|
procedure AssignClient(AClient: TObject); override;
|
|
function IsOnExecuteLinked: Boolean; override;
|
|
procedure SetCaption(const Value: string); override;
|
|
procedure SetEnabled(Value: Boolean); override;
|
|
procedure SetImageIndex(Value: Integer); override;
|
|
procedure SetOnExecute(Value: TNotifyEvent); override;
|
|
property Client: TJvOutlookBarButton read FClient write FClient;
|
|
public
|
|
function IsCaptionLinked: Boolean; override;
|
|
function IsEnabledLinked: Boolean; override;
|
|
function IsImageIndexLinked: Boolean; override;
|
|
end;
|
|
|
|
TJvOutlookBarButtonActionLinkClass = class of TJvOutlookBarButtonActionLink;
|
|
TJvOutlookBarButton = class(TCollectionItem)
|
|
private
|
|
FActionLink: TJvOutlookBarButtonActionLink;
|
|
FImageIndex: TImageIndex;
|
|
FCaption: TCaption;
|
|
FTag: NativeInt;
|
|
FDown: Boolean;
|
|
FEnabled: Boolean;
|
|
FAutoToggle: Boolean;
|
|
FOnClick: TNotifyEvent;
|
|
FLinkedObject: TObject;
|
|
procedure SetCaption(const Value: TCaption);
|
|
procedure SetImageIndex(const Value: TImageIndex);
|
|
procedure SetDown(const Value: Boolean);
|
|
procedure Change;
|
|
procedure SetEnabled(const Value: Boolean);
|
|
procedure SetAction(Value: TBasicAction);
|
|
protected
|
|
function GetDisplayName: string; override;
|
|
function GetActionLinkClass: TJvOutlookBarButtonActionLinkClass; dynamic;
|
|
function GetAction: TBasicAction; virtual;
|
|
procedure DoActionChange(Sender: TObject);
|
|
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic;
|
|
public
|
|
constructor Create(ACollection: Classes.TCollection); override;
|
|
destructor Destroy; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure Click; dynamic;
|
|
procedure EditCaption;
|
|
function GetOutlookBar: TJvCustomOutlookBar;
|
|
|
|
// A property for user's usage, allowing to link an object to the button
|
|
property LinkedObject: TObject read FLinkedObject write FLinkedObject;
|
|
published
|
|
property Action: TBasicAction read GetAction write SetAction;
|
|
property Caption: TCaption read FCaption write SetCaption;
|
|
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex;
|
|
property Tag: NativeInt read FTag write FTag;
|
|
property Down: Boolean read FDown write SetDown default False;
|
|
property AutoToggle: Boolean read FAutoToggle write FAutoToggle;
|
|
property Enabled: Boolean read FEnabled write SetEnabled default True;
|
|
property OnClick: TNotifyEvent read FOnClick write FOnClick;
|
|
end;
|
|
|
|
TJvOutlookBarButtons = class(TOwnedCollection)
|
|
private
|
|
function GetItem(Index: Integer): TJvOutlookBarButton;
|
|
procedure SetItem(Index: Integer; const Value: TJvOutlookBarButton);
|
|
protected
|
|
procedure Update(Item: TCollectionItem); override;
|
|
public
|
|
constructor Create(AOwner: TPersistent);
|
|
function Add: TJvOutlookBarButton;
|
|
procedure Assign(Source: TPersistent); override;
|
|
function IndexOf(AButton: TJvOutlookBarButton): Integer;
|
|
function Insert(Index: Integer): TJvOutlookBarButton;
|
|
property Items[Index: Integer]: TJvOutlookBarButton read GetItem write SetItem; default;
|
|
end;
|
|
|
|
TJvOutlookBarPage = class(TCollectionItem)
|
|
private
|
|
FPicture: TPicture;
|
|
FCaption: TCaption;
|
|
FColor: TColor;
|
|
FButtonSize: TJvBarButtonSize;
|
|
FParentButtonSize: Boolean;
|
|
FParentFont: Boolean;
|
|
FParentColor: Boolean;
|
|
FTopButtonIndex: Integer;
|
|
FButtons: TJvOutlookBarButtons;
|
|
FFont: TFont;
|
|
FDownFont: TFont;
|
|
FImageIndex: TImageIndex;
|
|
FAlignment: TAlignment;
|
|
FEnabled: Boolean;
|
|
FLinkedObject: TObject;
|
|
procedure SetButtonSize(const Value: TJvBarButtonSize);
|
|
procedure SetCaption(const Value: TCaption);
|
|
procedure SetColor(const Value: TColor);
|
|
procedure SetPicture(const Value: TPicture);
|
|
procedure Change;
|
|
procedure SetParentButtonSize(const Value: Boolean);
|
|
procedure SetParentColor(const Value: Boolean);
|
|
procedure SetTopButtonIndex(const Value: Integer);
|
|
procedure SetButtons(const Value: TJvOutlookBarButtons);
|
|
procedure SetParentFont(const Value: Boolean);
|
|
procedure SetFont(const Value: TFont);
|
|
procedure SetImageIndex(const Value: TImageIndex);
|
|
procedure SetAlignment(const Value: TAlignment);
|
|
procedure DoFontChange(Sender: TObject);
|
|
procedure SetDownFont(const Value: TFont);
|
|
function GetDownButton: TJvOutlookBarButton;
|
|
function GetDownIndex: Integer;
|
|
procedure SetDownButton(Value: TJvOutlookBarButton);
|
|
procedure SetDownIndex(Value: Integer);
|
|
procedure SetEnabled(const Value: Boolean);
|
|
protected
|
|
procedure DoPictureChange(Sender: TObject);
|
|
function GetDisplayName: string; override;
|
|
public
|
|
constructor Create(ACollection: Classes.TCollection); override;
|
|
destructor Destroy; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure EditCaption;
|
|
function GetOutlookBar: TJvCustomOutlookBar;
|
|
property DownButton: TJvOutlookBarButton read GetDownButton write SetDownButton;
|
|
property DownIndex: Integer read GetDownIndex write SetDownIndex;
|
|
// A property for user's usage, allowing to link an objet to the page.
|
|
property LinkedObject: TObject read FLinkedObject write FLinkedObject;
|
|
published
|
|
property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
|
|
property Buttons: TJvOutlookBarButtons read FButtons write SetButtons;
|
|
property ButtonSize: TJvBarButtonSize read FButtonSize write SetButtonSize;
|
|
property Caption: TCaption read FCaption write SetCaption;
|
|
property Color: TColor read FColor write SetColor default clDefault;
|
|
property DownFont: TFont read FDownFont write SetDownFont;
|
|
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
|
|
property Font: TFont read FFont write SetFont;
|
|
property Picture: TPicture read FPicture write SetPicture;
|
|
property ParentButtonSize: Boolean read FParentButtonSize write SetParentButtonSize default True;
|
|
property ParentFont: Boolean read FParentFont write SetParentFont default False;
|
|
property ParentColor: Boolean read FParentColor write SetParentColor;
|
|
property TopButtonIndex: Integer read FTopButtonIndex write SetTopButtonIndex;
|
|
property Enabled: Boolean read FEnabled write SetEnabled default True;
|
|
end;
|
|
|
|
TJvOutlookBarPages = class(TOwnedCollection)
|
|
private
|
|
function GetItem(Index: Integer): TJvOutlookBarPage;
|
|
procedure SetItem(Index: Integer; const Value: TJvOutlookBarPage);
|
|
protected
|
|
procedure Update(Item: TCollectionItem); override;
|
|
public
|
|
constructor Create(AOwner: TPersistent);
|
|
function Add: TJvOutlookBarPage;
|
|
function IndexOf(APage: TJvOutlookBarPage): Integer;
|
|
function Insert(Index: Integer): TJvOutlookBarPage;
|
|
procedure Assign(Source: TPersistent); override;
|
|
property Items[Index: Integer]: TJvOutlookBarPage read GetItem write SetItem; default;
|
|
end;
|
|
|
|
TOutlookBarPageChanging = procedure(Sender: TObject; Index: Integer; var AllowChange: Boolean) of object;
|
|
TOutlookBarPageChange = procedure(Sender: TObject; Index: Integer) of object;
|
|
TOutlookBarButtonClick = procedure(Sender: TObject; Index: Integer) of object;
|
|
TOutlookBarEditCaption = procedure(Sender: TObject; var NewText: string;
|
|
Index: Integer; var Allow: Boolean) of object;
|
|
|
|
TJvOutlookBarCustomDrawStage = (odsBackground, odsPageButton, odsPage, odsButton, odsButtonFrame);
|
|
TJvOutlookBarCustomDrawEvent = procedure(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
|
|
AStage: TJvOutlookBarCustomDrawStage; AIndex: Integer; ADown, AInside: Boolean; var DefaultDraw: Boolean) of object;
|
|
|
|
TJvPageBtnProps = class
|
|
private
|
|
FOwner: TJvCustomOutlookBar;
|
|
FHighlight: TColor;
|
|
FFace: TColor;
|
|
FShadow: TColor;
|
|
FDkShadow: TColor;
|
|
FBorderWidth: Integer;
|
|
procedure SetDkShadow(const Value: TColor);
|
|
procedure SetFace(const Value: TColor);
|
|
procedure SetHighlight(const Value: TColor);
|
|
procedure SetShadow(const Value: TColor);
|
|
procedure SetBorderWidth(const Value: INteger);
|
|
public
|
|
constructor Create(owner:TJvCustomOUtlookBar);
|
|
public
|
|
property Shadow:TColor read FShadow write SetShadow default clBtnShadow;
|
|
property Highlight:TColor read FHighlight write SetHighlight default clBtnHighlight;
|
|
property DkShadow:TColor read FDkShadow write SetDkShadow default cl3DDkShadow;
|
|
property Face:TColor read FFace write SetFace default clBtnFace;
|
|
property BorderWidth : Integer read FBorderWidth write SetBorderWidth default 1;
|
|
end;
|
|
|
|
TJvCustomOutlookBar = class(TJvCustomControl)
|
|
private
|
|
FPageBtnProps: TJvPageBtnProps;
|
|
FUpButton: TSpeedButton;
|
|
FDownButton: TSpeedButton;
|
|
FPages: TJvOutlookBarPages;
|
|
FLargeChangeLink: TChangeLink;
|
|
FSmallChangeLink: TChangeLink;
|
|
FPageChangeLink: TChangeLink;
|
|
FActivePageIndex: Integer;
|
|
FButtonSize: TJvBarButtonSize;
|
|
FLargeImages: TCustomImageList;
|
|
FLargeImagesWidth: Integer;
|
|
FSmallImages: TCustomImageList;
|
|
FSmallImagesWidth: Integer;
|
|
FPageButtonHeight: Integer;
|
|
FNextActivePage: Integer;
|
|
FPressedPageBtn: Integer;
|
|
FHotPageBtn: Integer;
|
|
FThemedBackGround: Boolean;
|
|
FThemed: Boolean;
|
|
FOnPageChange: TOutlookBarPageChange;
|
|
FOnPageChanging: TOutlookBarPageChanging;
|
|
FButtonRect: TRect;
|
|
FLastButtonIndex: Integer;
|
|
FPressedButtonIndex: Integer;
|
|
FOnButtonClick: TOutlookBarButtonClick;
|
|
FPopUpObject: TObject;
|
|
FEdit: TCustomEdit;
|
|
FOnEditButton: TOutlookBarEditCaption;
|
|
FOnEditPage: TOutlookBarEditCaption;
|
|
FOnCustomDraw: TJvOutlookBarCustomDrawEvent;
|
|
FPageImages: TCustomImageList;
|
|
FPageImagesWidth: Integer;
|
|
FDisabledFontColor1: TColor;
|
|
FDisabledFontColor2: TColor;
|
|
FWordWrap: Boolean;
|
|
function GetActivePage: TJvOutlookBarPage;
|
|
function GetActivePageIndex: Integer;
|
|
function IsStoredPageButtonHeight: Boolean;
|
|
procedure SetActivePageIndex(const Value: Integer);
|
|
procedure SetButtonSize(const Value: TJvBarButtonSize);
|
|
procedure SetDisabledFontColor1(const Value: TColor);
|
|
procedure SetDisabledFontColor2(const Value: TColor);
|
|
procedure SetLargeImages(const Value: TCustomImageList);
|
|
procedure SetPageButtonHeight(const Value: Integer);
|
|
procedure SetPageImages(const Value: TCustomImageList);
|
|
procedure SetPages(const Value: TJvOutlookBarPages);
|
|
procedure SetSmallImages(const Value: TCustomImageList);
|
|
procedure SetThemed(const Value: Boolean);
|
|
procedure SetThemedBackground(const Value: Boolean);
|
|
procedure SetWordWrap(const Value: Boolean);
|
|
procedure CMCaptionEditAccept(var Msg: TLMessage); message CM_CAPTION_EDIT_ACCEPT;
|
|
procedure CMCaptionEditCancel(var Msg: TLMessage); message CM_CAPTION_EDIT_CANCEL;
|
|
procedure CMCaptionEditing(var Msg: TLMessage); message CM_CAPTION_EDITING;
|
|
procedure CMDialogChar(var Msg: TCMDialogChar); message CM_DIALOGCHAR;
|
|
protected
|
|
function CalcPageButtonHeight: Integer;
|
|
procedure CalculatePreferredSize(var PreferredWidth,
|
|
PreferredHeight: integer; WithThemeSpace: Boolean); override;
|
|
procedure ColorChanged; override;
|
|
{$IF LCL_FullVersion >= 1080000}
|
|
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
|
|
const AXProportion, AYProportion: Double); override;
|
|
{$ENDIF}
|
|
procedure DoButtonClick(Index: Integer); virtual;
|
|
procedure DoButtonEdit(NewText: string; B: TJvOutlookBarButton);
|
|
procedure DoChangeLinkChange(Sender: TObject);
|
|
procedure DoContextPopup( MousePos: TPoint; var Handled: Boolean); override;
|
|
function DoCustomDraw(ARect: TRect; Stage: TJvOutlookBarCustomDrawStage;
|
|
Index: Integer; Down, Inside: Boolean): Boolean; virtual;
|
|
function DoDrawBackGround: Boolean;
|
|
function DoDrawButton(ARect: TRect; Index: Integer; Down, Inside: Boolean): Boolean;
|
|
function DoDrawButtonFrame(ARect: TRect; Index: Integer; Down, Inside: Boolean): Boolean;
|
|
function DoDrawPage(ARect: TRect; Index: Integer): Boolean;
|
|
function DoDrawPageButton(ARect: TRect; Index: Integer; Down: Boolean): Boolean;
|
|
procedure DoDwnClick(Sender: TObject);
|
|
function DoPageChanging(Index: Integer): Boolean; virtual;
|
|
procedure DoPageChange(Index: Integer); virtual;
|
|
procedure DoPageEdit(NewText: string; P: TJvOutlookBarPage);
|
|
procedure DoUpClick(Sender: TObject);
|
|
(*
|
|
{$IF LCL_FullVersion >= 1090000}
|
|
function DoEraseBackground(ACanvas: TCanvas; Param: LPARAM): Boolean; override;
|
|
{$ENDIF}
|
|
*)
|
|
procedure DrawArrowButtons(Index: Integer);
|
|
procedure DrawBottomPages(StartIndex: Integer);
|
|
procedure DrawButtonFrame(PageIndex, ButtonIndex, PressedIndex: Integer);
|
|
procedure DrawButtons(Index: Integer);
|
|
procedure DrawCurrentPage(PageIndex: Integer);
|
|
procedure DrawPageButton(R: TRect; Index: Integer; Pressed: Boolean);
|
|
function DrawPicture(R: TRect; Picture: TPicture): Boolean;
|
|
function DrawTopPages: Integer;
|
|
|
|
procedure FontChanged; override;
|
|
class function GetControlClassDefaultSize: TSize; override;
|
|
function GetButtonFrameRect(PageIndex, ButtonIndex: Integer): TRect;
|
|
function GetButtonHeight(PageIndex, ButtonIndex: Integer): Integer;
|
|
function GetButtonRect(PageIndex, ButtonIndex: Integer): TRect;
|
|
function GetButtonTextRect(PageIndex, ButtonIndex: Integer): TRect;
|
|
function GetButtonTextSize(PageIndex, ButtonIndex: Integer): TSize;
|
|
function GetButtonTopHeight(PageIndex, ButtonIndex: Integer): Integer;
|
|
function GetPageButtonRect(Index: Integer): TRect;
|
|
function GetPageTextRect(Index: Integer): TRect;
|
|
function GetPageRect(Index: Integer): TRect;
|
|
function GetRealImageSize(AImageList: TCustomImageList; AImagesWidth: Integer): TSize;
|
|
function IsThemedStored: Boolean;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseEnter(Control: TControl); override;
|
|
procedure MouseLeave(Control: TControl); override;
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure Paint; override;
|
|
procedure RedrawRect(R: TRect; Erase: Boolean = False);
|
|
procedure Resize; override;
|
|
property PopUpObject: TObject read FPopUpObject write FPopUpObject;
|
|
property UpButton: TSpeedButton read FUpButton;
|
|
property DownButton: TSpeedButton read FDownButton;
|
|
property BorderStyle default bsSingle;
|
|
// property Font;
|
|
property Color default clBtnShadow;
|
|
property Pages: TJvOutlookBarPages read FPages write SetPages;
|
|
property LargeImages: TCustomImageList read FLargeImages write SetLargeImages;
|
|
property SmallImages: TCustomImageList read FSmallImages write SetSmallImages;
|
|
property PageImages: TCustomImageList read FPageImages write SetPageImages;
|
|
property ButtonSize: TJvBarButtonSize read FButtonSize write SetButtonSize default olbsLarge;
|
|
property PageButtonHeight: Integer read FPageButtonHeight write SetPageButtonHeight stored IsStoredPageButtonHeight;
|
|
property ActivePageIndex: Integer read GetActivePageIndex write SetActivePageIndex default 0;
|
|
property Themed: Boolean read FThemed write SetThemed stored IsThemedStored;
|
|
property ThemedBackground: Boolean read FThemedBackGround write SetThemedBackground default True;
|
|
property PageBtnProps: TJvPageBtnProps read FPageBtnProps;
|
|
property DisabledFontColor1: TColor read FDisabledFontColor1 write SetDisabledFontColor1; //clWhite;
|
|
property DisabledFontColor2: TColor read FDisabledFontColor2 write SetDisabledFontColor2; //clGrayText;
|
|
property OnPageChanging: TOutlookBarPageChanging read FOnPageChanging write FOnPageChanging;
|
|
property OnPageChange: TOutlookBarPageChange read FOnPageChange write FOnPageChange;
|
|
property OnButtonClick: TOutlookBarButtonClick read FOnButtonClick write FOnButtonClick;
|
|
property OnEditButton: TOutlookBarEditCaption read FOnEditButton write FOnEditButton;
|
|
property OnEditPage: TOutlookBarEditCaption read FOnEditPage write FOnEditPage;
|
|
property OnCustomDraw: TJvOutlookBarCustomDrawEvent read FOnCustomDraw write FOnCustomDraw;
|
|
|
|
{$IF LCL_FullVersion >= 1090000}
|
|
private
|
|
procedure SetLargeImagesWidth(const AValue: Integer);
|
|
procedure SetPageImagesWidth(const AValue: Integer);
|
|
procedure SetSmallImagesWidth(const AValue: Integer);
|
|
protected
|
|
property LargeImagesWidth: Integer read FLargeImagesWidth write SetLargeImagesWidth default 0;
|
|
property SmallImagesWidth: Integer read FSmallImagesWidth write SetSmallImagesWidth default 0;
|
|
property PageImagesWidth: Integer read FPageImagesWidth write SetPageImagesWidth default 0;
|
|
{$ENDIF}
|
|
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure InitiateAction; override;
|
|
{$IF LCL_FullVersion >= 1080000}
|
|
procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
|
|
{$ENDIF}
|
|
function GetButtonAtPos(P: TPoint): TJvOutlookBarButton;
|
|
function GetPageButtonAtPos(P: TPoint): TJvOutlookBarPage;
|
|
public
|
|
property ActivePage: TJvOutlookBarPage read GetActivePage;
|
|
property WordWrap: Boolean read FWordWrap write SetWordWrap default True;
|
|
end;
|
|
|
|
TJvOutlookBar = class(TJvCustomOutlookBar)
|
|
public
|
|
property DisabledFontColor1;
|
|
property DisabledFontColor2;
|
|
property PageBtnProps;
|
|
property PopUpObject;
|
|
|
|
published
|
|
property Action;
|
|
property ActivePageIndex;
|
|
property Align;
|
|
property Anchors;
|
|
property BiDiMode;
|
|
property BorderSpacing;
|
|
property BorderStyle;
|
|
property ButtonSize;
|
|
property ChildSizing;
|
|
property Color;
|
|
property Constraints;
|
|
property Cursor;
|
|
property DockSite;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property Font;
|
|
property Height;
|
|
property HelpContext;
|
|
property HelpKeyword;
|
|
property HelpType;
|
|
property Hint;
|
|
property LargeImages;
|
|
property Pages;
|
|
property PageButtonHeight;
|
|
property PageImages;
|
|
property ParentBiDiMode;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property SmallImages;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Themed;
|
|
property ThemedBackground;
|
|
property Visible;
|
|
property Width;
|
|
property WordWrap;
|
|
property OnButtonClick;
|
|
property OnClick;
|
|
property OnContextPopup;
|
|
property OnCustomDraw;
|
|
property OnDblClick;
|
|
property OnDockDrop;
|
|
property OnDockOver;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEditButton;
|
|
property OnEditPage;
|
|
property OnEndDock;
|
|
property OnEndDrag;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnPageChange;
|
|
property OnPageChanging;
|
|
property OnStartDock;
|
|
property OnStartDrag;
|
|
property OnUnDock;
|
|
{$IF LCL_FullVersion >= 1090000}
|
|
property LargeImagesWidth;
|
|
property SmallImagesWidth;
|
|
property PageImagesWidth;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
Math,
|
|
JvThemes,
|
|
JvConsts, JvJVCLUtils;
|
|
|
|
{$R ..\..\resource\jvoutlookbar.res}
|
|
|
|
type
|
|
THackOutlookBar = class(TJvCustomOutlookBar);
|
|
|
|
const
|
|
cTextMargins = 3;
|
|
cMinTextWidth = 32;
|
|
cButtonLeftOffset = 4;
|
|
cButtonTopOffset = 2;
|
|
// cInitRepeatPause = 400;
|
|
// cRepeatPause = 100;
|
|
|
|
UP_DOWN_DEFAULT_SIZE = 14;
|
|
|
|
(*
|
|
{$IFDEF MSWINDOWS}
|
|
function JclCheckWinVersion(Major, Minor: Integer): Boolean;
|
|
begin
|
|
Result := CheckWin32Version(Major, Minor);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function IsVista:Boolean;
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
Result := JclCheckWinVersion(6, 0);
|
|
{$ELSE}
|
|
Result := false;
|
|
{$ENDIF}
|
|
end; *)
|
|
|
|
function MethodsEqual(const Method1, Method2: TMethod): Boolean;
|
|
begin
|
|
Result := (Method1.Code = Method2.Code) and (Method1.Data = Method2.Data);
|
|
end;
|
|
|
|
function GetUniquePageName(OLBar: TJvCustomOutlookBar): string;
|
|
const
|
|
cPrefix = 'JvOutlookBarPage';
|
|
cTemplate = cPrefix + '%d';
|
|
var
|
|
K: Integer;
|
|
Tmp: string;
|
|
|
|
function IsUnique(const S: string): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := False;
|
|
for I := 0 to THackOutlookBar(OLBar).Pages.Count - 1 do
|
|
if AnsiSameText(THackOutlookBar(OLBar).Pages[I].Caption, S) then
|
|
Exit;
|
|
Result := True;
|
|
end;
|
|
|
|
begin
|
|
Result := cPrefix;
|
|
if OLBar <> nil then
|
|
for K := 1 to MaxInt - 1 do
|
|
begin
|
|
Tmp := Format(cTemplate, [K]);
|
|
if IsUnique(Tmp) then
|
|
begin
|
|
Result := Tmp;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetUniqueButtonName(OLBar: TJvCustomOutlookBar): string;
|
|
const
|
|
cPrefix = 'JvOutlookBarButton';
|
|
cTemplate = cPrefix + '%d';
|
|
var
|
|
K: Integer;
|
|
Tmp: string;
|
|
|
|
function IsUnique(const S: string): Boolean;
|
|
var
|
|
I, J: Integer;
|
|
begin
|
|
Result := False;
|
|
for I := 0 to THackOutlookBar(OLBar).Pages.Count - 1 do
|
|
for J := 0 to THackOutlookBar(OLBar).Pages[I].Buttons.Count - 1 do
|
|
if AnsiSameText(THackOutlookBar(OLBar).Pages[I].Buttons[J].Caption, S) then
|
|
Exit;
|
|
Result := True;
|
|
end;
|
|
|
|
begin
|
|
Result := cPrefix;
|
|
if OLBar <> nil then
|
|
for K := 1 to MaxInt - 1 do
|
|
begin
|
|
Tmp := Format(cTemplate, [K]);
|
|
if IsUnique(Tmp) then
|
|
begin
|
|
Result := Tmp;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function HighDpi_Suffix: String;
|
|
begin
|
|
Result := '';
|
|
if Screen.SystemFont.PixelsPerInch >= 168 then
|
|
Result := Result + '_200'
|
|
else
|
|
if Screen.SystemFont.PixelsPerInch >= 120 then
|
|
Result := Result + '_150';
|
|
end;
|
|
|
|
|
|
//=== { TJvOutlookBarEdit } ==================================================
|
|
|
|
type
|
|
TJvOutlookBarEdit = class(TCustomEdit)
|
|
private
|
|
FCanvas: TControlCanvas;
|
|
procedure WMNCPaint(var Msg: TLMessage); message LM_NCPAINT;
|
|
procedure EditAccept;
|
|
procedure EditCancel;
|
|
function GetCanvas: TCanvas;
|
|
protected
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
procedure KeyPress(var Key: Char); override;
|
|
public
|
|
constructor CreateInternal(AOwner: TComponent; AParent: TWinControl; AObject: TObject);
|
|
destructor Destroy; override;
|
|
procedure ShowEdit(const AText: string; R: TRect);
|
|
property Canvas: TCanvas read GetCanvas;
|
|
end;
|
|
|
|
constructor TJvOutlookBarEdit.CreateInternal(AOwner: TComponent;
|
|
AParent: TWinControl; AObject: TObject);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FCanvas := TControlCanvas.Create;
|
|
FCanvas.Control := Self;
|
|
AutoSize := True;
|
|
Visible := False;
|
|
Parent := AParent;
|
|
BorderStyle := bsNone;
|
|
ParentFont := False;
|
|
Tag := NativeInt(AObject);
|
|
end;
|
|
|
|
destructor TJvOutlookBarEdit.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
// (rom) destroy Canvas AFTER inherited Destroy
|
|
FCanvas.Free;
|
|
end;
|
|
|
|
procedure TJvOutlookBarEdit.EditAccept;
|
|
begin
|
|
Parent.Perform(CM_CAPTION_EDIT_ACCEPT, WPARAM(Self), LPARAM(Tag));
|
|
Hide;
|
|
end;
|
|
|
|
procedure TJvOutlookBarEdit.EditCancel;
|
|
begin
|
|
Parent.Perform(CM_CAPTION_EDIT_CANCEL, WPARAM(Self), LPARAM(Tag));
|
|
Hide;
|
|
end;
|
|
|
|
function TJvOutlookBarEdit.GetCanvas: TCanvas;
|
|
begin
|
|
Result := FCanvas;
|
|
end;
|
|
|
|
procedure TJvOutlookBarEdit.KeyDown(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
case Key of
|
|
VK_RETURN:
|
|
begin
|
|
Key := 0;
|
|
EditAccept;
|
|
if Handle = GetCapture then
|
|
ReleaseCapture;
|
|
// Hide;
|
|
// Free;
|
|
// Screen.Cursor := crDefault;
|
|
end;
|
|
VK_ESCAPE:
|
|
begin
|
|
Key := 0;
|
|
if Handle = GetCapture then
|
|
ReleaseCapture;
|
|
EditCancel;
|
|
// Hide;
|
|
// Free;
|
|
// Screen.Cursor := crDefault;
|
|
end;
|
|
end;
|
|
inherited KeyDown(Key, Shift);
|
|
end;
|
|
|
|
procedure TJvOutlookBarEdit.KeyPress(var Key: Char);
|
|
begin
|
|
if Key = Cr then
|
|
Key := #0; // remove beep
|
|
inherited KeyPress(Key);
|
|
end;
|
|
|
|
procedure TJvOutlookBarEdit.MouseDown(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
if not PtInRect(ClientRect, Point(X, Y)) or ((Button = mbRight) and Visible) then
|
|
begin
|
|
if Handle = GetCapture then
|
|
ReleaseCapture;
|
|
EditCancel;
|
|
// Screen.Cursor := crDefault;
|
|
// FEdit.Hide;
|
|
// FEdit.Free;
|
|
// FEdit := nil;
|
|
end
|
|
else
|
|
begin
|
|
ReleaseCapture;
|
|
// Screen.Cursor := crIBeam;
|
|
SetCapture(Handle);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvOutlookBarEdit.ShowEdit(const AText: string; R: TRect);
|
|
begin
|
|
Hide;
|
|
Text := AText;
|
|
SetBounds(R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top);
|
|
Show;
|
|
SetCapture(Handle);
|
|
SelStart := 0;
|
|
SelLength := Length(Text);
|
|
SetFocus;
|
|
end;
|
|
|
|
|
|
procedure TJvOutlookBarEdit.WMNCPaint(var Msg: TLMessage);
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
Exit;
|
|
GetCanvas; // make Delphi 5 compiler happy // andreas
|
|
inherited;
|
|
(*
|
|
DC := GetWindowDC(Handle);
|
|
try
|
|
FCanvas.Handle := DC;
|
|
Windows.GetClientRect(Handle, RC);
|
|
GetWindowRect(Handle, RW);
|
|
MapWindowPoints(0, Handle, RW, 2);
|
|
|
|
OffsetRect(RC, -RW.Left, -RW.Top);
|
|
ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom);
|
|
OffsetRect(RW, -RW.Left, -RW.Top);
|
|
|
|
FCanvas.Brush.Color := clBlack;
|
|
Windows.FrameRect(DC,RW,FCanvas.Brush.Handle);
|
|
InflateRect(RW,-1,-1);
|
|
|
|
{ FCanvas.Brush.Color := clBlack;
|
|
Windows.FrameRect(DC,RW,FCanvas.Brush.Handle);
|
|
InflateRect(RW,-1,-1);
|
|
|
|
FCanvas.Brush.Color := clBlack;
|
|
Windows.FrameRect(DC,RW,FCanvas.Brush.Handle);
|
|
InflateRect(RW,-1,-1); }
|
|
|
|
{ Erase parts not drawn }
|
|
IntersectClipRect(DC, RW.Left, RW.Top, RW.Right, RW.Bottom);
|
|
finally
|
|
ReleaseDC(Handle, DC);
|
|
end;
|
|
*)
|
|
end;
|
|
|
|
(*
|
|
//=== { TJvRepeatButton } ====================================================
|
|
|
|
type
|
|
// auto-repeating button using a timer (stolen from Borland's Spin.pas sample component)
|
|
TJvRepeatButton = class(TSpeedButton) //TJvExSpeedButton)
|
|
private
|
|
FRepeatTimer: TTimer;
|
|
procedure TimerExpired(Sender: TObject);
|
|
protected
|
|
procedure VisibleChanged; override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
public
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
procedure TJvRepeatButton.VisibleChanged;
|
|
begin
|
|
inherited VisibleChanged;
|
|
if not Visible then
|
|
FreeAndNil(FRepeatTimer);
|
|
end;
|
|
|
|
destructor TJvRepeatButton.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvRepeatButton.MouseDown(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
if FRepeatTimer = nil then
|
|
FRepeatTimer := TTimer.Create(Self);
|
|
FRepeatTimer.OnTimer := @TimerExpired;
|
|
FRepeatTimer.Interval := cInitRepeatPause;
|
|
FRepeatTimer.Enabled := True;
|
|
end;
|
|
|
|
procedure TJvRepeatButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
FreeAndNil(FRepeatTimer);
|
|
end;
|
|
|
|
procedure TJvRepeatButton.TimerExpired(Sender: TObject);
|
|
begin
|
|
FRepeatTimer.Interval := cRepeatPause;
|
|
if (FState = bsDown) and MouseCapture then
|
|
try
|
|
Click;
|
|
except
|
|
FRepeatTimer.Enabled := False;
|
|
raise;
|
|
end;
|
|
end;
|
|
*)
|
|
|
|
//=== { TJvOutlookBarButtonActionLink } ======================================
|
|
|
|
procedure TJvOutlookBarButtonActionLink.AssignClient(AClient: TObject);
|
|
begin
|
|
Client := AClient as TJvOutlookBarButton;
|
|
end;
|
|
|
|
function TJvOutlookBarButtonActionLink.IsCaptionLinked: Boolean;
|
|
begin
|
|
Result := inherited IsCaptionLinked and
|
|
(Client.Caption = (Action as TCustomAction).Caption);
|
|
end;
|
|
|
|
function TJvOutlookBarButtonActionLink.IsEnabledLinked: Boolean;
|
|
begin
|
|
Result := inherited IsEnabledLinked and
|
|
(Client.Enabled = (Action as TCustomAction).Enabled);
|
|
end;
|
|
|
|
function TJvOutlookBarButtonActionLink.IsImageIndexLinked: Boolean;
|
|
begin
|
|
Result := inherited IsImageIndexLinked and
|
|
(Client.ImageIndex = (Action as TCustomAction).ImageIndex);
|
|
end;
|
|
|
|
function TJvOutlookBarButtonActionLink.IsOnExecuteLinked: Boolean;
|
|
begin
|
|
Result := inherited IsOnExecuteLinked and
|
|
MethodsEqual(TMethod(Client.OnClick), TMethod(Action.OnExecute));
|
|
end;
|
|
|
|
procedure TJvOutlookBarButtonActionLink.SetCaption(const Value: string);
|
|
begin
|
|
if IsCaptionLinked then
|
|
Client.Caption := Value;
|
|
end;
|
|
|
|
procedure TJvOutlookBarButtonActionLink.SetEnabled(Value: Boolean);
|
|
begin
|
|
if IsEnabledLinked then
|
|
Client.Enabled := Value;
|
|
end;
|
|
|
|
procedure TJvOutlookBarButtonActionLink.SetImageIndex(Value: Integer);
|
|
begin
|
|
if IsImageIndexLinked then
|
|
Client.ImageIndex := Value;
|
|
end;
|
|
|
|
procedure TJvOutlookBarButtonActionLink.SetOnExecute(Value: TNotifyEvent);
|
|
begin
|
|
if IsOnExecuteLinked then
|
|
Client.OnClick := Value;
|
|
end;
|
|
|
|
//=== { TJvOutlookBarButton } ================================================
|
|
|
|
constructor TJvOutlookBarButton.Create(ACollection: Classes.TCollection);
|
|
begin
|
|
inherited Create(ACollection);
|
|
FEnabled := True;
|
|
end;
|
|
|
|
destructor TJvOutlookBarButton.Destroy;
|
|
var
|
|
OBPage: TJvOutlookBarPage;
|
|
OB: TJvOutlookBar;
|
|
begin
|
|
OBPage := TJvOutlookBarPage(TJvOutlookBarButtons(Self.Collection).Owner);
|
|
OB := TJvOutlookBar(TJvOutlookBarPages(OBPage.Collection).Owner);
|
|
if Assigned(OB) then
|
|
begin
|
|
if OB.FPressedButtonIndex = Index then
|
|
OB.FPressedButtonIndex := -1;
|
|
if OB.FLastButtonIndex = Index then
|
|
OB.FLastButtonIndex := -1;
|
|
OB.Invalidate;
|
|
end;
|
|
|
|
// Mantis 3688
|
|
FActionLink.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvOutlookBarButton.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TJvOutlookBarButton then
|
|
begin
|
|
Caption := TJvOutlookBarButton(Source).Caption;
|
|
ImageIndex := TJvOutlookBarButton(Source).ImageIndex;
|
|
Down := TJvOutlookBarButton(Source).Down;
|
|
AutoToggle := TJvOutlookBarButton(Source).AutoToggle;
|
|
Tag := TJvOutlookBarButton(Source).Tag;
|
|
Enabled := TJvOutlookBarButton(Source).Enabled;
|
|
Change;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TJvOutlookBarButton.Change;
|
|
begin
|
|
if (Collection <> nil) and (TJvOutlookBarButtons(Collection).Owner <> nil) and
|
|
(TCollectionItem(TJvOutlookBarButtons(Collection).Owner).Collection <> nil) and
|
|
(TCustomControl(TJvOutlookBarPages(TCollectionItem(TJvOutlookBarButtons(Collection).Owner).Collection).Owner) <> nil)
|
|
then
|
|
TCustomControl(TJvOutlookBarPages(TCollectionItem(TJvOutlookBarButtons(Collection).Owner).Collection).Owner).Invalidate;
|
|
end;
|
|
|
|
procedure TJvOutlookBarButton.EditCaption;
|
|
begin
|
|
SendMessage(TCustomControl(TJvOutlookBarPages(TCollectionItem(TJvOutlookBarButtons(Collection).Owner).Collection).Owner).Handle,
|
|
CM_CAPTION_EDITING, WPARAM(Self), 0);
|
|
end;
|
|
|
|
function TJvOutlookBarButton.GetDisplayName: string;
|
|
begin
|
|
if Caption <> '' then
|
|
Result := Caption
|
|
else
|
|
Result := inherited GetDisplayName;
|
|
end;
|
|
|
|
procedure TJvOutlookBarButton.SetCaption(const Value: TCaption);
|
|
begin
|
|
if FCaption <> Value then
|
|
begin
|
|
FCaption := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvOutlookBarButton.SetImageIndex(const Value: TImageIndex);
|
|
begin
|
|
if FImageIndex <> Value then
|
|
begin
|
|
FImageIndex := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvOutlookBarButton.SetDown(const Value: Boolean);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Value <> FDown then
|
|
begin
|
|
FDown := Value;
|
|
if FDown then
|
|
for I := 0 to TJvOutlookBarButtons(Collection).Count - 1 do
|
|
if TJvOutlookBarButtons(Collection).Items[I] <> Self then
|
|
TJvOutlookBarButtons(Collection).Items[I].Down := False;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvOutlookBarButton.SetEnabled(const Value: Boolean);
|
|
begin
|
|
if FEnabled <> Value then
|
|
begin
|
|
FEnabled := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvOutlookBarButton.Click;
|
|
begin
|
|
// Mantis 3689
|
|
{ Call OnClick if assigned and not equal to associated action's OnExecute.
|
|
If associated action's OnExecute assigned then call it, otherwise, call
|
|
OnClick. }
|
|
if Assigned(FOnClick) and Assigned(Action) and (@FOnClick <> @Action.OnExecute) then
|
|
FOnClick(Self)
|
|
else
|
|
if (GetOutlookBar <> nil) and (FActionLink <> nil) and not (csDesigning in GetOutlookBar.ComponentState) then
|
|
FActionLink.Execute(GetOutlookBar)
|
|
else
|
|
if Assigned(FOnClick) then
|
|
FOnClick(Self);
|
|
end;
|
|
|
|
function TJvOutlookBarButton.GetAction: TBasicAction;
|
|
begin
|
|
if FActionLink <> nil then
|
|
Result := FActionLink.Action
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TJvOutlookBarButton.GetActionLinkClass: TJvOutlookBarButtonActionLinkClass;
|
|
begin
|
|
Result := TJvOutlookBarButtonActionLink;
|
|
end;
|
|
|
|
procedure TJvOutlookBarButton.ActionChange(Sender: TObject;
|
|
CheckDefaults: Boolean);
|
|
begin
|
|
if Sender is TCustomAction then
|
|
with TCustomAction(Sender) do
|
|
begin
|
|
if not CheckDefaults or (Self.Caption = '') then
|
|
Self.Caption := Caption;
|
|
if not CheckDefaults or Self.Enabled then
|
|
Self.Enabled := Enabled;
|
|
if not CheckDefaults or (Self.ImageIndex = -1) then
|
|
Self.ImageIndex := ImageIndex;
|
|
if not CheckDefaults or not Assigned(Self.OnClick) then
|
|
Self.OnClick := OnExecute;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvOutlookBarButton.DoActionChange(Sender: TObject);
|
|
begin
|
|
if Sender = Action then
|
|
ActionChange(Sender, False);
|
|
end;
|
|
|
|
procedure TJvOutlookBarButton.SetAction(Value: TBasicAction);
|
|
begin
|
|
if (FActionLink <> nil) and (FActionLink.Action <> nil) then
|
|
FActionLink.Action.RemoveFreeNotification(GetOutlookBar);
|
|
if Value = nil then
|
|
begin
|
|
FActionLink.Free;
|
|
FActionLink := nil;
|
|
end
|
|
else
|
|
begin
|
|
if FActionLink = nil then
|
|
FActionLink := GetActionLinkClass.Create(Self);
|
|
FActionLink.Action := Value;
|
|
FActionLink.OnChange := @DoActionChange;
|
|
ActionChange(Value, csLoading in Value.ComponentState);
|
|
if GetOutlookBar <> nil then
|
|
Value.FreeNotification(GetOutlookBar); // delegates notification to owner!
|
|
end;
|
|
end;
|
|
|
|
function TJvOutlookBarButton.GetOutlookBar: TJvCustomOutlookBar;
|
|
begin
|
|
if TJvOutlookBarButtons(Collection).Owner is TJvOutlookBarPage then
|
|
Result := TJvOutlookBarPage(TJvOutlookBarButtons(Collection).Owner).GetOutlookBar
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
//=== { TJvOutlookBarButtons } ===============================================
|
|
|
|
constructor TJvOutlookBarButtons.Create(AOwner: TPersistent);
|
|
begin
|
|
inherited Create(AOwner, TJvOutlookBarButton);
|
|
end;
|
|
|
|
function TJvOutlookBarButtons.Add: TJvOutlookBarButton;
|
|
begin
|
|
Result := TJvOutlookBarButton(inherited Add);
|
|
Result.Caption := GetUniqueButtonName(Result.GetOutlookBar);
|
|
Result.DisplayName := Result.Caption;
|
|
end;
|
|
|
|
procedure TJvOutlookBarButtons.Assign(Source: TPersistent);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Source is TJvOutlookBarButtons then
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
for I := 0 to TJvOutlookBarButtons(Source).Count - 1 do
|
|
Add.Assign(TJvOutlookBarButtons(Source)[I]);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function TJvOutlookBarButtons.GetItem(Index: Integer): TJvOutlookBarButton;
|
|
begin
|
|
Result := TJvOutlookBarButton(inherited Items[Index]);
|
|
end;
|
|
|
|
function TJvOutlookBarButtons.IndexOf(AButton: TJvOutlookBarButton): Integer;
|
|
begin
|
|
for Result := 0 to Count-1 do
|
|
if AButton = GetItem(Result) then exit;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TJvOutlookBarButtons.Insert(Index: Integer): TJvOutlookBarButton;
|
|
begin
|
|
Result := TJvOutlookBarButton(inherited Insert(Index));
|
|
end;
|
|
|
|
procedure TJvOutlookBarButtons.SetItem(Index: Integer;
|
|
const Value: TJvOutlookBarButton);
|
|
begin
|
|
inherited Items[Index] := Value;
|
|
end;
|
|
|
|
procedure TJvOutlookBarButtons.Update(Item: TCollectionItem);
|
|
begin
|
|
inherited Update(Item);
|
|
if Owner <> nil then
|
|
TJvOutlookBarPage(Owner).Changed(False);
|
|
end;
|
|
|
|
|
|
//=== { TJvOutlookBarPage } ==================================================
|
|
|
|
constructor TJvOutlookBarPage.Create(ACollection: Classes.TCollection);
|
|
begin
|
|
inherited Create(ACollection);
|
|
FFont := TFont.Create;
|
|
FFont.OnChange := @DoFontChange;
|
|
FDownFont := TFont.Create;
|
|
FDownFont.OnChange := @DoFontChange;
|
|
FParentColor := True;
|
|
FPicture := TPicture.Create;
|
|
FPicture.OnChange := @DoPictureChange;
|
|
FAlignment := taCenter;
|
|
FImageIndex := -1;
|
|
FEnabled := True;
|
|
FButtons := TJvOutlookBarButtons.Create(Self);
|
|
if (ACollection <> nil) and (TJvOutlookBarPages(ACollection).Owner <> nil) then
|
|
begin
|
|
FButtonSize := TJvCustomOutlookBar(TJvOutlookBarPages(ACollection).Owner).ButtonSize;
|
|
Font := TJvCustomOutlookBar(TJvOutlookBarPages(ACollection).Owner).Font;
|
|
DownFont := Font;
|
|
end else
|
|
begin
|
|
FButtonSize := olbsLarge;
|
|
end;
|
|
FColor := clDefault;
|
|
Font.Color := clWhite;
|
|
FParentButtonSize := True;
|
|
end;
|
|
|
|
destructor TJvOutlookBarPage.Destroy;
|
|
begin
|
|
FButtons.Free;
|
|
FPicture.Free;
|
|
FFont.Free;
|
|
FDownFont.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.Assign(Source: TPersistent);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Source is TJvOutlookBarPage then
|
|
begin
|
|
Caption := TJvOutlookBarPage(Source).Caption;
|
|
Picture := TJvOutlookBarPage(Source).Picture;
|
|
Color := TJvOutlookBarPage(Source).Color;
|
|
DownFont.Assign(TJvOutlookBarPage(Source).DownFont);
|
|
ButtonSize := TJvOutlookBarPage(Source).ButtonSize;
|
|
ParentButtonSize := TJvOutlookBarPage(Source).ParentButtonSize;
|
|
ParentColor := TJvOutlookBarPage(Source).ParentColor;
|
|
Enabled := TJvOutlookBarPage(Source).Enabled;
|
|
Buttons.Clear;
|
|
for I := 0 to TJvOutlookBarPage(Source).Buttons.Count - 1 do
|
|
Buttons.Add.Assign(TJvOutlookBarPage(Source).Buttons[I]);
|
|
Change;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.Change;
|
|
begin
|
|
if (Collection <> nil) and (TJvOutlookBarPages(Collection).UpdateCount = 0) then
|
|
TJvOutlookBarPages(Collection).Update(Self);
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.SetTopButtonIndex(const Value: Integer);
|
|
begin
|
|
if (FTopButtonIndex <> Value) and (Value >= 0) and (Value < Buttons.Count) then
|
|
begin
|
|
FTopButtonIndex := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.SetButtons(const Value: TJvOutlookBarButtons);
|
|
begin
|
|
FButtons.Assign(Value);
|
|
Change;
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.SetCaption(const Value: TCaption);
|
|
begin
|
|
if FCaption <> Value then
|
|
begin
|
|
FCaption := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.SetButtonSize(const Value: TJvBarButtonSize);
|
|
begin
|
|
if FButtonSize <> Value then
|
|
begin
|
|
FButtonSize := Value;
|
|
if not (csReading in TComponent(TJvOutlookBarPages(Collection).Owner).ComponentState) then
|
|
FParentButtonSize := False;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.SetColor(const Value: TColor);
|
|
begin
|
|
if FColor <> Value then
|
|
begin
|
|
FColor := Value;
|
|
FParentColor := False;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.SetFont(const Value: TFont);
|
|
begin
|
|
FFont.Assign(Value);
|
|
FParentFont := False;
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.SetEnabled(const Value: Boolean);
|
|
begin
|
|
if FEnabled <> Value then
|
|
begin
|
|
FEnabled := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.SetPicture(const Value: TPicture);
|
|
begin
|
|
FPicture.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.SetParentButtonSize(const Value: Boolean);
|
|
begin
|
|
if FParentButtonSize <> Value then
|
|
begin
|
|
FParentButtonSize := Value;
|
|
if Value then
|
|
begin
|
|
FButtonSize := (TJvOutlookBarPages(Collection).Owner as TJvCustomOutlookBar).ButtonSize;
|
|
Change;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.SetParentColor(const Value: Boolean);
|
|
begin
|
|
if FParentColor <> Value then
|
|
begin
|
|
FParentColor := Value;
|
|
if Value then
|
|
begin
|
|
FColor := (TJvOutlookBarPages(Collection).Owner as TJvCustomOutlookBar).Color;
|
|
Change;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.SetParentFont(const Value: Boolean);
|
|
begin
|
|
if FParentFont <> Value then
|
|
begin
|
|
if Value then
|
|
Font := (TJvOutlookBarPages(Collection).Owner as TJvCustomOutlookBar).Font;
|
|
FParentFont := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.EditCaption;
|
|
begin
|
|
SendMessage(TCustomControl(TJvOutlookBarPages(Collection).Owner).Handle, CM_CAPTION_EDITING, WPARAM(Self), 1);
|
|
end;
|
|
|
|
function TJvOutlookBarPage.GetDisplayName: string;
|
|
begin
|
|
if Caption <> '' then
|
|
Result := Caption
|
|
else
|
|
Result := inherited GetDisplayName;
|
|
end;
|
|
|
|
function TJvOutlookBarPage.GetOutlookBar: TJvCustomOutlookBar;
|
|
begin
|
|
if TJvOutlookBarPages(Collection).Owner is TJvCustomOutlookBar then
|
|
Result := TJvCustomOutlookBar(TJvOutlookBarPages(Collection).Owner)
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.SetImageIndex(const Value: TImageIndex);
|
|
begin
|
|
if FImageIndex <> Value then
|
|
begin
|
|
FImageIndex := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.SetAlignment(const Value: TAlignment);
|
|
begin
|
|
if FAlignment <> Value then
|
|
begin
|
|
FAlignment := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.SetDownFont(const Value: TFont);
|
|
begin
|
|
if Value <> FDownFont then
|
|
FDownFont.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.DoFontChange(Sender: TObject);
|
|
begin
|
|
Change;
|
|
if Sender <> FDownFont then
|
|
FParentFont := False;
|
|
end;
|
|
|
|
function TJvOutlookBarPage.GetDownButton: TJvOutlookBarButton;
|
|
var
|
|
lIndex: Integer;
|
|
begin
|
|
lIndex := DownIndex;
|
|
if lIndex <> -1 then
|
|
Result := Buttons[lIndex]
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.SetDownButton(Value: TJvOutlookBarButton);
|
|
begin
|
|
if Value = nil then
|
|
DownIndex := -1
|
|
else
|
|
DownIndex := Value.Index;
|
|
end;
|
|
|
|
function TJvOutlookBarPage.GetDownIndex: Integer;
|
|
begin
|
|
for Result := 0 to Buttons.Count - 1 do
|
|
if Buttons[Result].Down then
|
|
Exit;
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.SetDownIndex(Value: Integer);
|
|
begin
|
|
if (Value >= 0) and (Value < Buttons.Count) then
|
|
Buttons[Value].Down := True;
|
|
end;
|
|
|
|
|
|
//=== { TJvOutlookBarPages } =================================================
|
|
|
|
constructor TJvOutlookBarPages.Create(AOwner: TPersistent);
|
|
begin
|
|
inherited Create(AOwner, TJvOutlookBarPage);
|
|
end;
|
|
|
|
function TJvOutlookBarPages.Add: TJvOutlookBarPage;
|
|
begin
|
|
Result := TJvOutlookBarPage(inherited Add);
|
|
Result.Caption := GetUniquePageName(Result.GetOutlookBar);
|
|
Result.DisplayName := Result.Caption;
|
|
end;
|
|
|
|
procedure TJvOutlookBarPages.Assign(Source: TPersistent);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Source is TJvOutlookBarPages then
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
for I := 0 to TJvOutlookBarPages(Source).Count - 1 do
|
|
Add.Assign(TJvOutlookBarPages(Source)[I]);
|
|
finally
|
|
EndUpdate
|
|
end;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function TJvOutlookBarPages.GetItem(Index: Integer): TJvOutlookBarPage;
|
|
begin
|
|
Result := TJvOutlookBarPage(inherited Items[Index]);
|
|
end;
|
|
|
|
function TJvOutlookBarPages.IndexOf(APage: TJvOutlookBarPage): Integer;
|
|
begin
|
|
for Result := 0 to Count-1 do
|
|
if APage = GetItem(Result) then exit;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TJvOutlookBarPages.Insert(Index: Integer): TJvOutlookBarPage;
|
|
begin
|
|
Result := TJvOutlookBarPage(inherited Insert(Index));
|
|
end;
|
|
|
|
procedure TJvOutlookBarPages.SetItem(Index: Integer;
|
|
const Value: TJvOutlookBarPage);
|
|
begin
|
|
inherited Items[Index] := Value;
|
|
end;
|
|
|
|
procedure TJvOutlookBarPages.Update(Item: TCollectionItem);
|
|
begin
|
|
inherited Update(Item);
|
|
if Owner <> nil then
|
|
TJvCustomOutlookBar(Owner).Repaint;
|
|
end;
|
|
|
|
(*
|
|
//=== { TJvThemedTopBottomButton } ===========================================
|
|
|
|
type
|
|
TJvThemedTopBottomButton = class(TJvRepeatButton)
|
|
private
|
|
FIsUpBtn: Boolean;
|
|
protected
|
|
procedure Paint; override;
|
|
// procedure WMEraseBkgnd(var Msg: TLMEraseBkgnd); message LM_ERASEBKGND;
|
|
end;
|
|
|
|
procedure TJvThemedTopBottomButton.Paint;
|
|
var
|
|
Button: TThemedScrollBar;
|
|
Details: TThemedElementDetails;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
Exit;
|
|
|
|
if StyleServices.Enabled and (not Flat) then
|
|
begin
|
|
if not Enabled then
|
|
Button := tsArrowBtnUpDisabled
|
|
else
|
|
if FState in [bsDown, bsExclusive] then
|
|
Button := tsArrowBtnUpPressed
|
|
else
|
|
if MouseInControl then
|
|
Button := tsArrowBtnUpHot
|
|
else
|
|
Button := tsArrowBtnUpNormal;
|
|
|
|
if not FIsUpBtn then
|
|
Button := TThemedScrollBar(Ord(tsArrowBtnDownNormal) + Ord(Button) - Ord(tsArrowBtnUpNormal));
|
|
|
|
Details := StyleServices.GetElementDetails(Button);
|
|
|
|
StyleServices.DrawElement(Canvas.Handle, Details, ClientRect, nil); //@ClipRect);
|
|
end
|
|
else
|
|
inherited Paint;
|
|
end;
|
|
{
|
|
procedure TJvThemedTopBottomButton.WMEraseBkgnd(var Msg: TLMEraseBkgnd);
|
|
begin
|
|
Msg.Result := 1;
|
|
end;
|
|
}
|
|
*)
|
|
|
|
//=== { TJvCustomOutlookBar } ================================================
|
|
|
|
constructor TJvCustomOutlookBar.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
FWordWrap := True;
|
|
FPageBtnProps := TJvPageBtnProps.Create(self);
|
|
DoubleBuffered := True;
|
|
FThemed := StyleServices.Enabled;
|
|
FThemedBackground := true;
|
|
|
|
ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque];
|
|
IncludeThemeStyle(Self, [csNeedsBorderPaint]);
|
|
FDisabledFontColor1 := clWhite;
|
|
FDisabledFontColor2 := clGrayText;
|
|
|
|
FUpButton := TSpeedButton.Create(self); //TJvRepeatButton.Create(Self);
|
|
with FUpButton do
|
|
begin
|
|
Parent := Self;
|
|
Visible := False;
|
|
Transparent := False;
|
|
OnClick := @DoUpClick;
|
|
if csDesigning in ComponentState then
|
|
Top := -1000;
|
|
end;
|
|
|
|
FDownButton := TSpeedButton.Create(Self); //TJvRepeatButton.Create(Self);
|
|
with FDownButton do
|
|
begin
|
|
Parent := Self;
|
|
Visible := False;
|
|
Transparent := False;
|
|
OnClick := @DoDwnClick;
|
|
if csDesigning in ComponentState then
|
|
Top := -1000;
|
|
end;
|
|
|
|
FPages := TJvOutlookBarPages.Create(Self);
|
|
FLargeChangeLink := TChangeLink.Create;
|
|
FLargeChangeLink.OnChange := @DoChangeLinkChange;
|
|
FSmallChangeLink := TChangeLink.Create;
|
|
FSmallChangeLink.OnChange := @DoChangeLinkChange;
|
|
FPageChangeLink := TChangeLink.Create;
|
|
FPageChangeLink.OnChange := @DoChangeLinkChange;
|
|
FEdit := TJvOutlookBarEdit.CreateInternal(Self, Self, nil);
|
|
FEdit.Top := -1000;
|
|
|
|
// set up defaults
|
|
Color := clBtnShadow;
|
|
BorderStyle := bsSingle;
|
|
|
|
FButtonSize := olbsLarge;
|
|
FPageButtonHeight := 0;
|
|
FPressedPageBtn := -1;
|
|
FNextActivePage := -1;
|
|
FLastButtonIndex := -1;
|
|
FPressedButtonIndex := -1;
|
|
FHotPageBtn := -1;
|
|
FThemedBackGround := True;
|
|
ActivePageIndex := 0;
|
|
|
|
with GetControlClassDefaultSize do
|
|
SetInitialBounds(0, 0, CX, CY);
|
|
end;
|
|
|
|
destructor TJvCustomOutlookBar.Destroy;
|
|
begin
|
|
// FEdit.Free;
|
|
FLargeChangeLink.Free;
|
|
FSmallChangeLink.Free;
|
|
FPageChangeLink.Free;
|
|
FPages.Free;
|
|
FPageBtnProps.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.CalcPageButtonHeight: Integer;
|
|
var
|
|
OldFont: HFONT;
|
|
begin
|
|
OldFont := SelectObject(Canvas.Handle, Canvas.Font.Handle);
|
|
try
|
|
Canvas.Font.Assign(Font);
|
|
if Canvas.Font.IsDefault then
|
|
Canvas.Font := Screen.SystemFont;
|
|
if FPageButtonHeight = 0 then
|
|
Result := Canvas.TextHeight('Tg') + Scale96ToForm(4)
|
|
else
|
|
Result := FPageButtonHeight;
|
|
finally
|
|
SelectObject(Canvas.Handle, OldFont);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.CalculatePreferredSize(var PreferredWidth,
|
|
PreferredHeight: integer; WithThemeSpace: Boolean);
|
|
begin
|
|
inherited;
|
|
PreferredWidth := 100;
|
|
PreferredHeight := 220;
|
|
if (FPageButtonHeight = 0) and HandleAllocated then
|
|
FPageButtonHeight := Canvas.TextHeight('Tg') + 4;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.DoDwnClick(Sender: TObject);
|
|
begin
|
|
if FDownButton.Visible then
|
|
with Pages[ActivePageIndex] do
|
|
if TopButtonIndex < Buttons.Count then
|
|
TopButtonIndex := TopButtonIndex + 1;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.DoUpClick(Sender: TObject);
|
|
begin
|
|
if FUpButton.Visible then
|
|
with Pages[ActivePageIndex] do
|
|
if TopButtonIndex > 0 then
|
|
TopButtonIndex := TopButtonIndex - 1;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.DoChangeLinkChange(Sender: TObject);
|
|
begin
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
var
|
|
I, J: Integer;
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if Operation = opRemove then
|
|
begin
|
|
if AComponent = FLargeImages then
|
|
LargeImages := nil
|
|
else
|
|
if AComponent = FSmallImages then
|
|
SmallImages := nil
|
|
else
|
|
if AComponent = FPageImages then
|
|
PageImages := nil;
|
|
if (AComponent is TBasicAction) and not (csDestroying in ComponentState) then
|
|
begin
|
|
for I := 0 to Pages.Count - 1 do
|
|
for J := 0 to Pages[I].Buttons.Count - 1 do
|
|
if AComponent = Pages[I].Buttons[J].Action then
|
|
Pages[I].Buttons[J].Action := nil;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ Warren modified this so you can have some weird page button colors that aren't standard windows colors }
|
|
procedure TJvCustomOutlookBar.DrawPageButton(R: TRect; Index: Integer; Pressed: Boolean);
|
|
var
|
|
SavedDC, ATop: Integer;
|
|
SavedColor: TColor;
|
|
Flags: Cardinal;
|
|
HasImage: Boolean;
|
|
Details: TThemedElementDetails;
|
|
margin: Integer;
|
|
{$IF LCL_FullVersion >= 1090000}
|
|
pageImageRes: TScaledImageListResolution;
|
|
f: Double;
|
|
ppi: Integer;
|
|
{$ENDIF}
|
|
begin
|
|
Assert(Assigned(FPageBtnProps));
|
|
ATop := R.Top + 1;
|
|
|
|
// Background and frame
|
|
if Themed then begin
|
|
if Pressed then
|
|
Details := StyleServices.GetElementDetails(tbPushButtonPressed)
|
|
else
|
|
if Index = FHotPageBtn then
|
|
Details := StyleServices.GetElementDetails(tbPushButtonHot)
|
|
else
|
|
Details := StyleServices.GetElementDetails(tbPushButtonNormal);
|
|
InflateRect(R, 1, 1);
|
|
StyleServices.DrawElement(Canvas.Handle, Details, R);
|
|
end else
|
|
if Pressed then
|
|
begin
|
|
if BorderStyle = bsNone then
|
|
Frame3D(Canvas, R, FPageBtnProps.Shadow, FPageBtnProps.Highlight, FPageBtnProps.BorderWidth)
|
|
else
|
|
begin
|
|
Frame3D(Canvas, R, FPageBtnProps.DkShadow, FPageBtnProps.Highlight, FPageBtnProps.BorderWidth);
|
|
Frame3D(Canvas, R, FPageBtnProps.Shadow, FPageBtnProps.Face, FPageBtnProps.BorderWidth);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if BorderStyle = bsNone then
|
|
Frame3D(Canvas, R, FPageBtnProps.Highlight, FPageBtnProps.Shadow, FPageBtnProps.BorderWidth)
|
|
else
|
|
begin
|
|
Frame3D(Canvas, R, FPageBtnProps.Highlight, FPageBtnProps.DkShadow, FPageBtnProps.BorderWidth);
|
|
Frame3D(Canvas, R, FPageBtnProps.Face, FPageBtnProps.Shadow, FPageBtnProps.BorderWidth);
|
|
end;
|
|
end;
|
|
|
|
// Icon
|
|
Flags := DT_CENTER or DT_VCENTER or DT_SINGLELINE;
|
|
HasImage := Assigned(PageImages) and (Pages[Index].ImageIndex >= 0) and (Pages[Index].ImageIndex < PageImages.Count);
|
|
SavedDC := SaveDC(Canvas.Handle);
|
|
try
|
|
margin := Scale96ToForm(4);
|
|
if HasImage then begin
|
|
{$IF LCL_FullVersion >= 1090000}
|
|
f := GetCanvasScalefactor;
|
|
ppi := Font.PixelsPerInch;
|
|
if FPageImages <> nil then
|
|
pageImageRes := FPageImages.ResolutionForPPI[FPageImagesWidth, ppi, f];
|
|
pageImageRes.Draw(Canvas, margin, ATop, Pages[Index].ImageIndex, Pages[Index].Enabled);
|
|
{$ELSE}
|
|
PageImages.Draw(Canvas, margin, ATop, Pages[Index].ImageIndex, Pages[Index].Enabled);
|
|
{$ENDIF}
|
|
end;
|
|
case Pages[Index].Alignment of
|
|
taLeftJustify:
|
|
begin
|
|
if HasImage then
|
|
Inc(R.Left, PageImages.Width + 2*margin)
|
|
else
|
|
Inc(R.Left, margin);
|
|
Flags := DT_LEFT or DT_VCENTER or DT_SINGLELINE;
|
|
end;
|
|
taCenter:
|
|
if HasImage then
|
|
Inc(R.Left, PageImages.Width + margin);
|
|
taRightJustify:
|
|
begin
|
|
if HasImage then
|
|
Inc(R.Left, PageImages.Width + 2*margin);
|
|
Dec(R.Right, margin);
|
|
Flags := DT_RIGHT or DT_VCENTER or DT_SINGLELINE;
|
|
end;
|
|
end;
|
|
finally
|
|
RestoreDC(Canvas.Handle, SavedDC);
|
|
end;
|
|
|
|
// Text
|
|
SetBkMode(Canvas.Handle, TRANSPARENT);
|
|
OffsetRect(R, 0, -1);
|
|
SavedColor := Canvas.Font.Color;
|
|
try
|
|
if Themed then begin
|
|
if not Pages[Index].Enabled then begin
|
|
OffsetRect(R, 1, 1);
|
|
Details := StyleServices.GetElementDetails(tbPushButtonPressed)
|
|
end;
|
|
StyleServices.DrawText(Canvas, Details, Pages[Index].Caption, R, Flags or DT_END_ELLIPSIS, 0);
|
|
end else begin
|
|
if not Pages[Index].Enabled then
|
|
begin
|
|
OffsetRect(R, 1, 1);
|
|
Canvas.Font.Color := FDisabledFontColor1; //clWhite;
|
|
DrawText(Canvas, Pages[Index].Caption, -1, R, Flags or DT_END_ELLIPSIS);
|
|
OffsetRect(R, -1, -1);
|
|
Canvas.Font.Color := FDisabledFontColor2; //clGrayText;
|
|
end;
|
|
DrawText(Canvas, Pages[Index].Caption, -1, R, Flags or DT_END_ELLIPSIS);
|
|
end;
|
|
finally
|
|
Canvas.Font.Color := SavedColor;
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.DrawTopPages: Integer;
|
|
var
|
|
R: TRect;
|
|
I: Integer;
|
|
ToolBar: TThemedToolBar;
|
|
Details: TThemedElementDetails;
|
|
ClipRect: TRect;
|
|
pgBtnHeight: Integer;
|
|
begin
|
|
Result := -1;
|
|
if csDestroying in ComponentState then
|
|
Exit;
|
|
|
|
R := GetPageButtonRect(0);
|
|
pgBtnHeight := R.Bottom - R.Top;
|
|
|
|
for I := 0 to Pages.Count - 1 do
|
|
begin
|
|
if DoDrawPageButton(R, I, FPressedPageBtn = I) then
|
|
begin
|
|
if Themed then // Warren changed.
|
|
begin
|
|
if (FPressedPageBtn = I) or (FHotPageBtn = I) then
|
|
ToolBar := ttbButtonPressed
|
|
else
|
|
ToolBar := ttbButtonHot;
|
|
Details := StyleServices.GetElementDetails(ToolBar);
|
|
|
|
if BorderStyle = bsNone then
|
|
begin
|
|
ClipRect := R;
|
|
InflateRect(R, 1, 1);
|
|
StyleServices.DrawElement(Canvas.Handle, Details, R, @ClipRect);
|
|
InflateRect(R, -1, -1);
|
|
end else
|
|
StyleServices.DrawElement(Canvas.Handle, Details, R);
|
|
|
|
{ Determine text color }
|
|
if FPressedPageBtn = I then
|
|
ToolBar := ttbButtonPressed
|
|
else if FHotPageBtn = I then
|
|
ToolBar := ttbButtonHot
|
|
else
|
|
ToolBar := ttbButtonNormal;
|
|
Details := StyleServices.GetElementDetails(ToolBar);
|
|
end else
|
|
begin
|
|
Canvas.Brush.Color := PageBtnProps.Face;// clBtnFace;
|
|
Canvas.FillRect(R);
|
|
end;
|
|
DrawPageButton(R, I, FPressedPageBtn = I);
|
|
end;
|
|
OffsetRect(R, 0, pgBtnHeight);
|
|
if I >= ActivePageIndex then
|
|
begin
|
|
Result := I;
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := Pages.Count - 1;
|
|
end;
|
|
|
|
{ Draw the buttons inside each page }
|
|
procedure TJvCustomOutlookBar.DrawButtons(Index: Integer);
|
|
var
|
|
I: Integer;
|
|
R, R2, R3: TRect;
|
|
C: TColor;
|
|
SavedDC: Integer;
|
|
flags: Integer;
|
|
Details: TThemedElementDetails;
|
|
dist: Integer;
|
|
{$IF LCL_FullVersion >= 1090000}
|
|
LargeImageRes, SmallImageRes: TScaledImageListResolution;
|
|
f: Double;
|
|
ppi: Integer;
|
|
{$ENDIF}
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
Exit;
|
|
if (Index < 0) or (Index >= Pages.Count) or (Pages[Index].Buttons = nil) or
|
|
(Pages[Index].Buttons.Count <= 0)
|
|
then
|
|
Exit;
|
|
|
|
{$IF LCL_FullVersion >= 1090000}
|
|
f := GetCanvasScalefactor;
|
|
ppi := Font.PixelsPerInch;
|
|
if FLargeImages <> nil then
|
|
LargeImageRes := FLargeImages.ResolutionForPPI[FLargeImagesWidth, ppi, f];
|
|
if FSmallImages <> nil then
|
|
smallImageRes := FSmallImages.ResolutionForPPI[SmallImagesWidth, ppi, f];
|
|
{$ENDIF}
|
|
|
|
R2 := GetPageRect(Index);
|
|
R := GetButtonRect(Index, Pages[Index].TopButtonIndex);
|
|
C := Canvas.Pen.Color;
|
|
try
|
|
Canvas.Brush.Style := bsClear;
|
|
for I := Pages[Index].TopButtonIndex to Pages[Index].Buttons.Count - 1 do
|
|
begin
|
|
if Pages[Index].Buttons[I].Down then
|
|
DrawButtonFrame(Index, I, I);
|
|
|
|
if DoDrawButton(R, I, Pages[Index].Buttons[I].Down, I = FLastButtonIndex) then
|
|
case Pages[Index].ButtonSize of
|
|
olbsLarge:
|
|
begin
|
|
SavedDC := SaveDC(Canvas.Handle);
|
|
try
|
|
if LargeImages <> nil then begin
|
|
dist := Scale96ToForm(4);
|
|
{$IF LCL_FullVersion >= 1090000}
|
|
largeImageRes.Draw(Canvas,
|
|
R.Left + ((R.Right - R.Left) - largeImageRes.Width) div 2,
|
|
R.Top + dist,
|
|
Pages[Index].Buttons[I].ImageIndex,
|
|
Pages[Index].Enabled and Pages[Index].Buttons[I].Enabled
|
|
);
|
|
{$ELSE}
|
|
LargeImages.Draw(Canvas,
|
|
R.Left + ((R.Right - R.Left) - LargeImages.Width) div 2,
|
|
R.Top + dist,
|
|
Pages[Index].Buttons[I].ImageIndex,
|
|
Pages[Index].Enabled and Pages[Index].Buttons[I].Enabled
|
|
);
|
|
{$ENDIF}
|
|
end;
|
|
finally
|
|
RestoreDC(Canvas.Handle, SavedDC);
|
|
end;
|
|
R3 := GetButtonTextRect(ActivePageIndex, I);
|
|
SetBkMode(Canvas.Handle, TRANSPARENT);
|
|
if FWordWrap and (LargeImages <> nil) then
|
|
Flags := DT_WORDBREAK or DT_CENTER or DT_VCENTER
|
|
else
|
|
Flags := DT_EXPANDTABS or DT_SINGLELINE or DT_CENTER or DT_VCENTER or DT_END_ELLIPSIS;
|
|
if Pages[Index].Buttons[I].Down then
|
|
Canvas.Font.Assign(Pages[Index].DownFont)
|
|
else
|
|
Canvas.Font.Assign(Pages[Index].Font);
|
|
if Themed and (Pages[Index].Color = clDefault) then begin
|
|
if Pages[Index].Enabled and Pages[Index].Buttons[I].Enabled then
|
|
Details := StyleServices.GetElementDetails(ttbButtonNormal)
|
|
else
|
|
Details := StyleServices.GetElementDetails(ttbButtonDisabled);
|
|
StyleServices.DrawText(Canvas, Details, Pages[Index].Buttons[I].Caption, R3, Flags, 0);
|
|
end else begin
|
|
if not Pages[Index].Enabled or not Pages[Index].Buttons[I].Enabled then
|
|
begin
|
|
if ColorToRGB(Pages[Index].Color) = ColorToRGB(clGrayText) then
|
|
Canvas.Font.Color := FPageBtnProps.Face //clBtnFace
|
|
else
|
|
Canvas.Font.Color := clGrayText;
|
|
end;
|
|
DrawText(Canvas.Handle, PChar(Pages[Index].Buttons[I].Caption), -1, R3, Flags);
|
|
end;
|
|
end;
|
|
|
|
olbsSmall:
|
|
begin
|
|
SavedDC := SaveDC(Canvas.Handle);
|
|
try
|
|
if SmallImages <> nil then begin
|
|
dist := Scale96ToForm(2);
|
|
{$IF LCL_FullVersion >= 1090000}
|
|
smallImageRes.Draw(Canvas,
|
|
R.Left + dist, R.Top + dist,
|
|
Pages[Index].Buttons[I].ImageIndex,
|
|
Pages[Index].Enabled and Pages[Index].Buttons[I].Enabled
|
|
);
|
|
{$ELSE}
|
|
SmallImages.Draw(Canvas,
|
|
R.Left + dist, R.Top + dist,
|
|
Pages[Index].Buttons[I].ImageIndex,
|
|
Pages[Index].Enabled and Pages[Index].Buttons[I].Enabled
|
|
);
|
|
{$ENDIF}
|
|
end;
|
|
finally
|
|
RestoreDC(Canvas.Handle, SavedDC);
|
|
end;
|
|
R3 := GetButtonTextRect(ActivePageIndex, I);
|
|
// InflateRect(R3, -Scale96ToForm(4), 0);
|
|
SetBkMode(Canvas.Handle, TRANSPARENT);
|
|
Flags := DT_EXPANDTABS or DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_NOCLIP or DT_EDITCONTROL;
|
|
if Pages[Index].Buttons[I].Down then
|
|
Canvas.Font.Assign(Pages[Index].DownFont)
|
|
else
|
|
Canvas.Font.Assign(Pages[Index].Font);
|
|
if Themed and (Pages[Index].Color = clDefault) then
|
|
begin
|
|
if Pages[Index].Enabled and Pages[Index].Buttons[I].Enabled then
|
|
Details := StyleServices.GetElementDetails(ttbButtonNormal)
|
|
else
|
|
Details := StyleServices.GetElementDetails(ttbButtonDisabled);
|
|
StyleServices.DrawText(Canvas, Details, Pages[Index].Buttons[I].Caption, R3, Flags, 0);
|
|
end else
|
|
begin
|
|
if not Pages[Index].Enabled or not Pages[Index].Buttons[I].Enabled then
|
|
begin
|
|
if ColorToRGB(Pages[Index].Color) = ColorToRGB(clGrayText) then
|
|
Canvas.Font.Color := FPageBtnProps.Face//clBtnFace
|
|
else
|
|
Canvas.Font.Color := clGrayText;
|
|
end;
|
|
DrawText(Canvas.Handle, PChar(Pages[Index].Buttons[I].Caption), -1, R3, Flags);
|
|
end;
|
|
end;
|
|
end;
|
|
OffsetRect(R, 0, GetButtonHeight(Index, I));
|
|
if R.Top >= R2.Bottom then
|
|
Break;
|
|
end;
|
|
finally
|
|
Canvas.Font := Self.Font;
|
|
Canvas.Pen.Color := C;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.DrawArrowButtons(Index: Integer);
|
|
var
|
|
R: TRect;
|
|
h, w, margin, delta: Integer;
|
|
png: TPortableNetworkGraphic;
|
|
resName: String;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
Exit;
|
|
if (Index < 0) or (Index >= Pages.Count) or (Pages[Index].Buttons = nil) or
|
|
(Pages[Index].Buttons.Count <= 0) then
|
|
begin
|
|
FUpButton.Visible := False;
|
|
FDownButton.Visible := False;
|
|
end
|
|
else
|
|
begin
|
|
R := GetPageRect(Index);
|
|
h := Scale96ToForm(UP_DOWN_DEFAULT_SIZE-1);
|
|
w := Scale96ToForm(UP_DOWN_DEFAULT_SIZE);
|
|
margin := Scale96ToForm(4);
|
|
delta := h + margin;
|
|
FUpButton.Visible := (Pages.Count > 0) and
|
|
(R.Top < R.Bottom - delta) and
|
|
(Pages[Index].TopButtonIndex > 0);
|
|
FDownButton.Visible := (Pages.Count > 0) and
|
|
(R.Top < R.Bottom - delta) and
|
|
(R.Bottom - R.Top < GetButtonTopHeight(Index, Pages[Index].Buttons.Count - 1) + GetButtonHeight(Index, Pages[Index].Buttons.Count - 1));
|
|
// remove the last - ButtonHeight to show arrow
|
|
// button when the bottom of the last button is beneath the edge
|
|
end;
|
|
|
|
if UpButton.Visible then begin
|
|
UpButton.SetBounds(ClientWidth - w - margin, R.Top + margin, w, h);
|
|
if (UpButton.Glyph.Width = 0) then begin
|
|
png := TPortableNetworkGraphic.Create;
|
|
try
|
|
resName := 'jvcustomoutlookbaruparrow' + HighDPI_Suffix;
|
|
png.LoadFromResourceName(HInstance, resName);
|
|
UpButton.Glyph.Assign(png);
|
|
finally
|
|
png.Free;
|
|
end;
|
|
end
|
|
else
|
|
if csDesigning in ComponentState then
|
|
UpButton.Top := -1000;
|
|
|
|
end;
|
|
if DownButton.Visible then begin
|
|
DownButton.SetBounds(ClientWidth - w - margin, R.Bottom - margin - h, w, h);
|
|
png := TPortableNetworkGraphic.Create;
|
|
try
|
|
resName := 'jvcustomoutlookbardownarrow' + HighDPI_Suffix;
|
|
png.LoadFromResourceName(HInstance, resName);
|
|
DownButton.Glyph.Assign(png);
|
|
finally
|
|
png.Free;
|
|
end;
|
|
end
|
|
else
|
|
if csDesigning in ComponentState then
|
|
DownButton.Top := -1000;
|
|
UpButton.Enabled := UpButton.Visible and Pages[Index].Enabled;
|
|
DownButton.Enabled := DownButton.Visible and Pages[Index].Enabled;
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.DrawPicture(R: TRect; Picture: TPicture): Boolean;
|
|
var
|
|
Bmp: TBitmap;
|
|
begin
|
|
Result := Assigned(Picture) and Assigned(Picture.Graphic) and not Picture.Graphic.Empty;
|
|
if csDestroying in ComponentState then
|
|
Exit;
|
|
if Result then
|
|
begin
|
|
Bmp := TBitmap.Create;
|
|
try
|
|
Bmp.Assign(Picture.Graphic);
|
|
Canvas.Brush.Bitmap := Bmp;
|
|
Canvas.FillRect(R);
|
|
Canvas.Brush.Bitmap := nil;
|
|
finally
|
|
Bmp.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.DrawCurrentPage(PageIndex: Integer);
|
|
var
|
|
R: TRect;
|
|
AColor: TColor;
|
|
Details: TThemedElementDetails;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
Exit;
|
|
if (PageIndex < 0) or (PageIndex >= Pages.Count) or (Pages[PageIndex].Buttons = nil) then
|
|
Exit;
|
|
|
|
R := GetPageRect(PageIndex);
|
|
AColor := Canvas.Brush.Color;
|
|
try
|
|
Canvas.Brush.Color := Pages[PageIndex].Color;
|
|
Canvas.Font := Self.Font;
|
|
if DoDrawPage(R, PageIndex) then
|
|
begin
|
|
if not DrawPicture(R, Pages[PageIndex].Picture) then
|
|
begin
|
|
if (Canvas.Brush.Color = clDefault) and ThemedBackground and Themed then
|
|
begin
|
|
Details := StyleServices.GetElementDetails(tebNormalGroupBackground); //tebHeaderBackgroundNormal);
|
|
StyleServices.DrawElement(Canvas.Handle, Details, R);
|
|
end
|
|
else
|
|
begin
|
|
if Canvas.Brush.Color = clDefault then
|
|
Canvas.Brush.Color := Self.Color;
|
|
Canvas.FillRect(R);
|
|
end;
|
|
end;
|
|
end;
|
|
DrawButtonFrame(ActivePageIndex, FLastButtonIndex, FPressedButtonIndex);
|
|
DrawButtons(PageIndex);
|
|
finally
|
|
Canvas.Brush.Color := AColor;
|
|
Canvas.Brush.Style := bsClear;
|
|
SetBkMode(Canvas.Handle, TRANSPARENT);
|
|
end;
|
|
DrawArrowButtons(PageIndex);
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.DrawBottomPages(StartIndex: Integer);
|
|
var
|
|
R: TRect;
|
|
I: Integer;
|
|
Details: TThemedElementDetails;
|
|
ClipRect: TRect;
|
|
ToolBar: TThemedToolBar;
|
|
pgBtnHeight: Integer;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
Exit;
|
|
R := GetPageButtonRect(Pages.Count - 1);
|
|
pgBtnHeight := R.Bottom - R.Top;
|
|
for I := Pages.Count - 1 downto StartIndex do
|
|
begin
|
|
if DoDrawPageButton(R, I, FPressedPageBtn = I) then
|
|
begin
|
|
if Themed then
|
|
begin
|
|
if (FPressedPageBtn = I) or (FHotPageBtn = I) then
|
|
ToolBar := ttbButtonPressed
|
|
else
|
|
ToolBar := ttbButtonHot;
|
|
Details := StyleServices.GetElementDetails(ToolBar);
|
|
|
|
if BorderStyle = bsNone then
|
|
begin
|
|
ClipRect := R;
|
|
InflateRect(R, 1, 1);
|
|
StyleServices.DrawElement(Canvas.Handle, Details, R, @ClipRect);
|
|
InflateRect(R, -1, -1);
|
|
end else
|
|
StyleServices.DrawElement(Canvas.Handle, Details, R);
|
|
|
|
{ Determine text color }
|
|
if FPressedPageBtn = I then
|
|
ToolBar := ttbButtonPressed
|
|
else if FHotPageBtn = I then
|
|
ToolBar := ttbButtonHot
|
|
else
|
|
ToolBar := ttbButtonNormal;
|
|
Details := StyleServices.GetElementDetails(ToolBar);
|
|
end else
|
|
begin
|
|
Canvas.Brush.Color := FPageBtnProps.Face;//clBtnFace;
|
|
Canvas.FillRect(R);
|
|
end;
|
|
DrawPageButton(R, I, FPressedPageBtn = I);
|
|
end;
|
|
OffsetRect(R, 0, -pgBtnHeight);
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.GetPageButtonAtPos(P: TPoint): TJvOutlookBarPage;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
// TODO: rewrite more optimal (no loop)
|
|
for I := 0 to Pages.Count - 1 do
|
|
begin
|
|
if PtInRect(GetPageButtonRect(I), P) then
|
|
begin
|
|
Result := Pages[I];
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.GetPageButtonRect(Index: Integer): TRect;
|
|
var
|
|
pgBtnHeight: Integer;
|
|
begin
|
|
Result := Rect(0, 0, 0, 0);
|
|
if (Index < 0) or (Index >= Pages.Count) then
|
|
Exit;
|
|
pgBtnHeight := CalcPageButtonHeight;
|
|
Result := Rect(0, 0, ClientWidth, pgBtnHeight);
|
|
if Index <= ActivePageIndex then
|
|
OffsetRect(Result, 0, pgBtnHeight * Index)
|
|
else
|
|
OffsetRect(Result, 0, (ClientHeight - pgBtnHeight * (Pages.Count - Index)));
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.GetPageTextRect(Index: Integer): TRect;
|
|
var
|
|
dist: Integer;
|
|
begin
|
|
Result := GetPageButtonRect(Index);
|
|
dist := Scale96ToForm(2);
|
|
InflateRect(Result, -dist, -dist);
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.GetButtonTextSize(
|
|
PageIndex, ButtonIndex: Integer): TSize;
|
|
var
|
|
R: TRect;
|
|
DC: HDC;
|
|
S: string;
|
|
OldFont: HFONT;
|
|
txtMargins, minTxtWidth: Integer;
|
|
begin
|
|
DC := Canvas.Handle;
|
|
OldFont := SelectObject(DC, Canvas.Font.Handle);
|
|
try
|
|
Canvas.Font.Assign(Pages[PageIndex].Font);
|
|
S := Pages[PageIndex].Buttons[ButtonIndex].Caption;
|
|
if (Pages[PageIndex].ButtonSize = olbsLarge) and FWordWrap then
|
|
begin
|
|
txtMargins := Scale96ToForm(cTextMargins);
|
|
minTxtWidth := Scale96ToForm(cMinTextWidth);
|
|
R := Rect(0, 0, Max(ClientWidth - (2 * txtMargins), minTxtWidth), 0);
|
|
Result.cy := DrawText(DC, PChar(S), Length(S), R, DT_WORDBREAK or DT_CALCRECT or DT_CENTER or DT_VCENTER);
|
|
Result.cx := R.Right;
|
|
end else
|
|
Result := Canvas.TextExtent(S);
|
|
finally
|
|
SelectObject(DC, OldFont);
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.GetPageRect(Index: Integer): TRect;
|
|
var
|
|
pgBtnHeight: Integer;
|
|
begin
|
|
if (Index < 0) or (Index >= Pages.Count) then
|
|
Result := Rect(0, 0, 0, 0)
|
|
else
|
|
begin
|
|
pgBtnHeight := CalcPageButtonHeight;
|
|
Result := Rect(
|
|
0,
|
|
pgBtnHeight * Index + pgBtnHeight,
|
|
ClientWidth,
|
|
ClientHeight - (Pages.Count - Index) * PgBtnHeight + pgBtnHeight
|
|
);
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.GetRealImageSize(AImageList: TCustomImageList;
|
|
AImagesWidth: Integer): TSize;
|
|
{$IF LCL_FullVersion >= 1090000}
|
|
var
|
|
imgRes: TScaledImageListResolution;
|
|
begin
|
|
imgRes := AImageList.ResolutionForPPI[AImagesWidth, Font.PixelsPerInch, GetCanvasScaleFactor];
|
|
Result.CX := imgRes.Width;
|
|
Result.CY := imgRes.Height;
|
|
end;
|
|
{$ELSE}
|
|
begin
|
|
Result.CX := AImageList.Width;
|
|
Result.CY := AImageList.Height;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TJvCustomOutlookBar.GetButtonAtPos(P: TPoint): TJvOutlookBarButton;
|
|
var
|
|
I: Integer;
|
|
R, B: TRect;
|
|
begin
|
|
// this always returns the button in the visible part of the active page (if any)
|
|
Result := nil;
|
|
if (ActivePageIndex < 0) or (ActivePageIndex >= Pages.Count) then
|
|
Exit;
|
|
R := GetPageRect(ActivePageIndex);
|
|
for I := Pages[ActivePageIndex].TopButtonIndex to Pages[ActivePageIndex].Buttons.Count - 1 do
|
|
begin
|
|
B := GetButtonRect(ActivePageIndex, I);
|
|
if PtInRect(B, P) then
|
|
begin
|
|
Result := Pages[ActivePageIndex].Buttons[I];
|
|
Exit;
|
|
end;
|
|
if B.Top >= R.Bottom then
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.GetButtonRect(PageIndex, ButtonIndex: Integer): TRect;
|
|
var
|
|
H, W: Integer;
|
|
dist: Integer;
|
|
leftOffs, topOffs: Integer;
|
|
begin
|
|
Result := Rect(0, 0, 0, 0);
|
|
if (PageIndex < 0) or (PageIndex >= Pages.Count) or
|
|
(ButtonIndex < 0) or (ButtonIndex >= Pages[PageIndex].Buttons.Count) then
|
|
Exit;
|
|
H := GetButtonHeight(PageIndex, ButtonIndex);
|
|
topOffs := Scale96ToForm(cButtonTopOffset);
|
|
leftOffs := Scale96ToForm(cButtonLeftOffset);
|
|
case Pages[PageIndex].ButtonSize of
|
|
olbsLarge:
|
|
if FLargeImages <> nil then
|
|
begin
|
|
W := GetRealImageSize(FLargeImages, FLargeImagesWidth).CX;
|
|
dist := Scale96ToForm(4);
|
|
Result := Rect(0, 0, Max(W, GetButtonTextSize(PageIndex, ButtonIndex).cx) + dist, H);
|
|
OffsetRect(Result, (ClientWidth - (Result.Right - Result.Left)) div 2, topOffs);
|
|
end else
|
|
Result := Rect(0, 0, ClientWidth, cButtonTopOffset + H);
|
|
|
|
olbsSmall:
|
|
if FSmallImages <> nil then
|
|
begin
|
|
W := GetRealImageSize(FSmallImages, FSmallImagesWidth).CX;
|
|
dist := Scale96ToForm(8);
|
|
Result := Rect(0, 0, W + GetButtonTextSize(PageIndex, ButtonIndex).cx + dist, H);
|
|
OffsetRect(Result, leftOffs, topOffs);
|
|
end else
|
|
Result := Rect(0, 0, ClientWidth, topOffs + H);
|
|
end;
|
|
OffsetRect(Result, 0, GetButtonTopHeight(PageIndex, ButtonIndex) + GetPageRect(PageIndex).Top);
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.GetButtonFrameRect(PageIndex, ButtonIndex: Integer): TRect;
|
|
var
|
|
imgSize: TSize;
|
|
delta: Integer;
|
|
btnTopOffs, btnLeftOffs: Integer;
|
|
begin
|
|
Result := Rect(0, 0, 0, 0);
|
|
if (PageIndex < 0) or (PageIndex >= Pages.Count) or
|
|
(ButtonIndex < 0) or (ButtonIndex >= Pages[PageIndex].Buttons.Count) then
|
|
Exit;
|
|
btnTopOffs := Scale96ToForm(cButtonTopOffset);
|
|
btnLeftOffs := Scale96ToForm(cButtonLeftOffset);
|
|
case Pages[PageIndex].ButtonSize of
|
|
olbsLarge:
|
|
if FLargeImages <> nil then
|
|
begin
|
|
imgSize := GetRealImageSize(FLargeImages, FLargeImagesWidth);
|
|
delta := Scale96ToForm(6);
|
|
Result := Rect(0, 0, imgSize.CX + delta, imgSize.CY + delta);
|
|
OffsetRect(Result,
|
|
(ClientWidth - (Result.Right - Result.Left)) div 2,
|
|
btnTopOffs + GetButtonTopHeight(PageIndex, ButtonIndex) + GetPageRect(PageIndex).Top + 1
|
|
);
|
|
end else
|
|
begin
|
|
Result := Rect(0, 0, ClientWidth, GetButtonHeight(PageIndex, ButtonIndex));
|
|
OffsetRect(Result, 0,
|
|
btnTopOffs + GetButtonTopHeight(PageIndex, ButtonIndex) + GetPageRect(PageIndex).Top + 1);
|
|
end;
|
|
|
|
olbsSmall:
|
|
if FSmallImages <> nil then
|
|
begin
|
|
imgSize := GetRealImageSize(FSmallImages, FSmallImagesWidth);
|
|
delta := Scale96ToForm(4);
|
|
Result := Rect(0, 0, imgSize.CX + delta, imgSize.CY + delta);
|
|
OffsetRect(Result,
|
|
btnLeftOffs,
|
|
btnTopOffs + GetButtonTopHeight(PageIndex, ButtonIndex) + GetPageRect(PageIndex).Top
|
|
);
|
|
end else
|
|
begin
|
|
Result := Rect(0, 0, ClientWidth, GetButtonHeight(PageIndex, ButtonIndex));
|
|
OffsetRect(Result,
|
|
0,
|
|
btnTopOffs + GetButtonTopHeight(PageIndex, ButtonIndex) + GetPageRect(PageIndex).Top
|
|
);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.GetButtonTextRect(PageIndex, ButtonIndex: Integer): TRect;
|
|
var
|
|
textSize, imgSize: TSize;
|
|
ButtonHeight: Integer;
|
|
dist2, dist4: Integer;
|
|
begin
|
|
Result := Rect(0, 0, 0, 0);
|
|
if Pages[PageIndex].Buttons.Count <= ButtonIndex then
|
|
Exit;
|
|
Result := GetButtonRect(PageIndex, ButtonIndex);
|
|
dist2 := Scale96ToForm(2);
|
|
dist4 := Scale96ToForm(4);
|
|
case Pages[PageIndex].ButtonSize of
|
|
olbsLarge:
|
|
if FLargeImages <> nil then
|
|
begin
|
|
Result.Top := Result.Bottom - GetButtonTextSize(PageIndex, ButtonIndex).CY - dist2;
|
|
OffsetRect(Result, 0, -dist4);
|
|
end;
|
|
olbsSmall:
|
|
if FSmallImages <> nil then
|
|
begin
|
|
textSize := GetButtonTextSize(PageIndex, ButtonIndex);
|
|
imgSize := GetRealImageSize(FSmallImages, FSmallImagesWidth);
|
|
ButtonHeight := GetButtonHeight(PageIndex, ButtonIndex);
|
|
Result.Left := imgSize.CX + Scale96ToForm(14);
|
|
Result.Top := Result.Top + (ButtonHeight - textSize.cy) div 2;
|
|
Result.Bottom := Result.Top + textSize.cy + dist2;
|
|
Result.Right := Result.Left + textSize.cx + dist4;
|
|
OffsetRect(Result, 0, -(ButtonHeight - (Result.Bottom - Result.Top)) div 4);
|
|
end else
|
|
InflateRect(Result, -dist4, 0);
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.IsThemedStored: Boolean;
|
|
begin
|
|
Result := not StyleServices.Enabled;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.Paint;
|
|
var
|
|
I: Integer;
|
|
R: TRect;
|
|
Details: TThemedElementDetails;
|
|
ClipRect: TRect;
|
|
Rgn: HRGN;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
Exit;
|
|
|
|
Canvas.Font := Self.Font;
|
|
if Canvas.Font.IsDefault then
|
|
Canvas.Font := Screen.SystemFont;
|
|
Canvas.Brush.Color := Self.Color;
|
|
if Pages.Count = 0 then // we only need to draw the background when there are no pages
|
|
begin
|
|
if ThemedBackground and Themed then
|
|
begin
|
|
R := ClientRect;
|
|
ClipRect := R;
|
|
InflateRect(R, 1, 0);
|
|
Details := StyleServices.GetElementDetails(tebNormalGroupBackground);
|
|
StyleServices.DrawElement(Canvas.Handle, Details, R, @ClipRect);
|
|
end
|
|
else
|
|
begin
|
|
if DoDrawBackGround then
|
|
Canvas.FillRect(ClientRect);
|
|
end;
|
|
end
|
|
else
|
|
I := 1;
|
|
|
|
{
|
|
if IsVista then // Warren Vista paint bug workaround
|
|
Canvas.FillRect(ClientRect);
|
|
}
|
|
|
|
SetBkMode(Canvas.Handle, TRANSPARENT);
|
|
I := DrawTopPages;
|
|
if I >= 0 then
|
|
begin
|
|
Rgn := 0;
|
|
try
|
|
if Pages.Count > 1 then
|
|
begin
|
|
// Button icons are not allowed to be painted into the bottom pages panels
|
|
R := GetPageButtonRect(I + 1);
|
|
Rgn := CreateRectRgn(0, 0, 1, 1);
|
|
GetClipRgn(Canvas.Handle, Rgn);
|
|
ExcludeClipRect(Canvas.Handle, R.Left, R.Top, R.Right, ClientHeight);
|
|
end;
|
|
DrawCurrentPage(I);
|
|
finally
|
|
if Rgn <> 0 then
|
|
begin
|
|
SelectClipRgn(Canvas.Handle, Rgn);
|
|
DeleteObject(Rgn);
|
|
end;
|
|
end;
|
|
end;
|
|
DrawBottomPages(I + 1);
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.DoPageChanging(Index: Integer): Boolean;
|
|
begin
|
|
Result := True;
|
|
if (Index > -1) and Assigned(FOnPageChanging) then
|
|
FOnPageChanging(Self, Index, Result);
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.DoPageChange(Index: Integer);
|
|
begin
|
|
if (Index > -1) and Assigned(FOnPageChange) then
|
|
FOnPageChange(Self, Index);
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.DoButtonClick(Index: Integer);
|
|
begin
|
|
if (Index > -1) then
|
|
begin
|
|
with ActivePage.Buttons[Index] do
|
|
begin
|
|
if AutoToggle then
|
|
Down := not Down;
|
|
Click;
|
|
end;
|
|
if Assigned(FOnButtonClick) then
|
|
FOnButtonClick(Self, Index);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.SetActivePageIndex(const Value: Integer);
|
|
begin
|
|
if (Value >= 0) and (Value < FPages.Count) then
|
|
begin
|
|
FPressedPageBtn := -1; // reset cache
|
|
// remove old button info
|
|
FLastButtonIndex := -1;
|
|
FPressedButtonIndex := -1;
|
|
FButtonRect := Rect(0, 0, 0, 0);
|
|
if FActivePageIndex <> Value then
|
|
begin
|
|
if not DoPageChanging(Value) then
|
|
Exit;
|
|
FActivePageIndex := Value;
|
|
DoPageChange(Value);
|
|
end;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
{ -- wp
|
|
procedure TJvCustomOutlookBar.SetBorderStyle(const Value: TBorderStyle);
|
|
begin
|
|
if FBorderStyle <> Value then
|
|
begin
|
|
FBorderStyle := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
}
|
|
|
|
procedure TJvCustomOutlookBar.SetButtonSize(const Value: TJvBarButtonSize);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
FButtonSize := Value;
|
|
Pages.BeginUpdate;
|
|
try
|
|
for I := 0 to Pages.Count - 1 do
|
|
if Pages[I].ParentButtonSize then
|
|
begin
|
|
Pages[I].ParentButtonSize := False;
|
|
Pages[I].ParentButtonSize := True; // reset flag
|
|
end;
|
|
finally
|
|
Pages.EndUpdate; // calls invalidate
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.SetDisabledFontColor1(const Value: TColor); {Warren add}
|
|
begin
|
|
FDisabledFontColor1 := Value;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.SetDisabledFontColor2(const Value: TColor); {Warren add}
|
|
begin
|
|
FDisabledFontColor2 := Value;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.SetLargeImages(const Value: TCustomImageList);
|
|
begin
|
|
if ReplaceImageListReference(Self, Value, FLargeImages, FLargeChangeLink) then
|
|
Invalidate;
|
|
end;
|
|
|
|
{$IF LCL_FullVersion >= 1090000}
|
|
procedure TJvCustomOutlookBar.SetLargeImagesWidth(const AValue: Integer);
|
|
begin
|
|
if AValue = FLargeImagesWidth then exit;
|
|
FLargeImagesWidth := AValue;
|
|
Invalidate;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TJvCustomOutlookBar.IsStoredPageButtonHeight: Boolean;
|
|
begin
|
|
Result := FPageButtonHeight <> 0;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.SetPageButtonHeight(const Value: Integer);
|
|
begin
|
|
if FPageButtonHeight <> Value then
|
|
begin
|
|
FPageButtonHeight := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.SetPages(const Value: TJvOutlookBarPages);
|
|
begin
|
|
FPages.Assign(Value); // Assign calls Invalidate
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.SetSmallImages(const Value: TCustomImageList);
|
|
begin
|
|
if ReplaceImageListReference(Self, Value, FSmallImages, FSmallChangeLink) then
|
|
Invalidate;
|
|
end;
|
|
|
|
{$IF LCL_FullVersion >= 1090000}
|
|
procedure TJvCustomOutlookBar.SetSmallImagesWidth(const AValue: Integer);
|
|
begin
|
|
if AValue = FSmallImagesWidth then exit;
|
|
FSmallImagesWidth := AValue;
|
|
Invalidate;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TJvCustomOutlookBar.SetThemed(const Value: Boolean);
|
|
begin
|
|
if Value and (not ThemeServices.ThemesEnabled) then
|
|
{ Warren added ability to theme/detheme this component for yourself instead of just checking if XP is themed.}
|
|
exit;
|
|
FThemed := Value;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.SetWordWrap(const Value: Boolean);
|
|
begin
|
|
if Value <> FWordWrap then
|
|
begin
|
|
FWordWrap := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.DrawButtonFrame(PageIndex, ButtonIndex, PressedIndex: Integer);
|
|
var
|
|
R: TRect;
|
|
Details: TThemedElementDetails;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
Exit;
|
|
if (ButtonIndex < 0) or (PageIndex < 0) or (PageIndex >= Pages.Count) or
|
|
(ButtonIndex < Pages[PageIndex].TopButtonIndex) then
|
|
Exit;
|
|
R := GetButtonFrameRect(PageIndex, ButtonIndex);
|
|
if DoDrawButtonFrame(R, ButtonIndex, (PressedIndex = ButtonIndex) or Pages[PageIndex].Buttons[ButtonIndex].Down, True) then
|
|
begin
|
|
if Themed then
|
|
begin
|
|
if (PressedIndex = ButtonIndex) or (Pages[PageIndex].Buttons[ButtonIndex].Down) then
|
|
Details := ThemeServices.GetElementDetails(ttbButtonPressed)
|
|
else
|
|
Details := ThemeServices.GetElementDetails(ttbButtonHot);
|
|
ThemeServices.DrawElement(Canvas.Handle, Details, R);
|
|
end
|
|
else
|
|
begin
|
|
if (PressedIndex = ButtonIndex) or (Pages[PageIndex].Buttons[ButtonIndex].Down) then
|
|
Frame3D(Canvas, R, clBlack, clWhite, 1)
|
|
else
|
|
Frame3D(Canvas, R, clWhite, clBlack, 1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.MouseDown(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
P: TJvOutlookBarPage;
|
|
B: TJvOutlookBarButton;
|
|
begin
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
if Button = mbRight then
|
|
Exit;
|
|
P := GetPageButtonAtPos(Point(X, Y));
|
|
if (P <> nil) and (P.Enabled) and (P.Index <> FNextActivePage) then
|
|
begin
|
|
FNextActivePage := P.Index;
|
|
if FNextActivePage <> ActivePageIndex then
|
|
begin // draw button pressed
|
|
FPressedPageBtn := FNextActivePage;
|
|
RedrawRect(GetPageButtonRect(FNextActivePage));
|
|
end;
|
|
Exit;
|
|
end
|
|
else
|
|
begin
|
|
if (FNextActivePage > -1) and Pages[FNextActivePage].Enabled then
|
|
RedrawRect(GetPageButtonRect(FNextActivePage));
|
|
FNextActivePage := -1;
|
|
FPressedPageBtn := -1;
|
|
end;
|
|
B := GetButtonAtPos(Point(X, Y));
|
|
if (B <> nil) and B.Enabled and (Pages[ActivePageIndex].Enabled) then
|
|
begin
|
|
FLastButtonIndex := B.Index;
|
|
FPressedButtonIndex := B.Index;
|
|
FButtonRect := GetButtonFrameRect(ActivePageIndex, B.Index);
|
|
RedrawRect(FButtonRect);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
P: TJvOutlookBarPage;
|
|
B: TJvOutlookBarButton;
|
|
R: TRect;
|
|
begin
|
|
inherited MouseMove(Shift, X, Y);
|
|
{ TODO -oJv :
|
|
1. check whether the mouse is down on a page button and whether the mouse has moved from
|
|
the currently pressed page button }
|
|
P := GetPageButtonAtPos(Point(X, Y));
|
|
if Themed then
|
|
begin
|
|
if ((P = nil) and (FHotPageBtn >= 0)) or (Assigned(P) and (P.Index <> FHotPageBtn)) then
|
|
begin
|
|
if FHotPageBtn >= 0 then
|
|
begin
|
|
R := GetPageButtonRect(FHotPageBtn);
|
|
RedrawRect(R);
|
|
end;
|
|
if Assigned(P) then
|
|
FHotPageBtn := P.Index
|
|
else
|
|
FHotPageBtn := -1;
|
|
if FHotPageBtn >= 0 then
|
|
begin
|
|
R := GetPageButtonRect(FHotPageBtn);
|
|
RedrawRect(R);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if FPressedPageBtn > -1 then
|
|
begin
|
|
if (P = nil) or (P.Index <> FPressedPageBtn) then
|
|
begin
|
|
R := GetPageButtonRect(FPressedPageBtn);
|
|
RedrawRect(R);
|
|
FPressedPageBtn := -1;
|
|
end;
|
|
end
|
|
else
|
|
if (P <> nil) and (P.Index <> ActivePageIndex) and P.Enabled then
|
|
begin
|
|
if P.Index = FNextActivePage then
|
|
begin
|
|
FPressedPageBtn := FNextActivePage;
|
|
RedrawRect(GetPageButtonRect(FPressedPageBtn));
|
|
Exit;
|
|
end;
|
|
end;
|
|
// TODO: check for button highlight
|
|
B := GetButtonAtPos(Point(X, Y));
|
|
if (B <> nil) and B.Enabled and (Pages[ActivePageIndex].Enabled) then
|
|
begin
|
|
if B.Index <> FLastButtonIndex then
|
|
begin
|
|
RedrawRect(FButtonRect, True);
|
|
FButtonRect := GetButtonFrameRect(ActivePageIndex, B.Index);
|
|
RedrawRect(FButtonRect);
|
|
FLastButtonIndex := B.Index;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if FLastButtonIndex > -1 then
|
|
RedrawRect(FButtonRect);
|
|
FLastButtonIndex := -1;
|
|
FButtonRect := Rect(0, 0, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.MouseUp(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
P: TJvOutlookBarPage;
|
|
B: TJvOutlookBarButton;
|
|
begin
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
if Button = mbRight then
|
|
Exit;
|
|
if (FNextActivePage > -1) and (FNextActivePage <> ActivePageIndex) then
|
|
begin
|
|
P := GetPageButtonAtPos(Point(X, Y));
|
|
if (P <> nil) and (P.Index = FNextActivePage) then
|
|
ActivePageIndex := FNextActivePage;
|
|
end;
|
|
FNextActivePage := -1;
|
|
|
|
B := GetButtonAtPos(Point(X, Y));
|
|
if B <> nil then
|
|
begin
|
|
if B.Index = FPressedButtonIndex then
|
|
DoButtonClick(FPressedButtonIndex);
|
|
FLastButtonIndex := B.Index;
|
|
FPressedButtonIndex := -1;
|
|
FButtonRect := GetButtonFrameRect(ActivePageIndex, FLastButtonIndex);
|
|
RedrawRect(FButtonRect);
|
|
end
|
|
else
|
|
begin
|
|
FButtonRect := GetButtonFrameRect(ActivePageIndex, FLastButtonIndex);
|
|
FLastButtonIndex := -1;
|
|
FPressedButtonIndex := -1;
|
|
RedrawRect(FButtonRect);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.MouseEnter(Control: TControl);
|
|
begin
|
|
if csDesigning in ComponentState then
|
|
Exit;
|
|
RedrawRect(FButtonRect);
|
|
inherited MouseEnter(Control);
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.MouseLeave(Control: TControl);
|
|
var
|
|
R: TRect;
|
|
begin
|
|
if csDesigning in ComponentState then
|
|
Exit;
|
|
inherited MouseLeave(Control);
|
|
RedrawRect(FButtonRect);
|
|
FPressedPageBtn := -1;
|
|
FLastButtonIndex := -1;
|
|
if Themed and (FHotPageBtn >= 0) then
|
|
begin
|
|
R := GetPageButtonRect(FHotPageBtn);
|
|
RedrawRect(R);
|
|
FHotPageBtn := -1;
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.GetButtonTopHeight(PageIndex,
|
|
ButtonIndex: Integer): Integer;
|
|
var
|
|
I: integer;
|
|
begin
|
|
Result := 0;
|
|
if (PageIndex < 0) or (PageIndex >= Pages.Count) or
|
|
(ButtonIndex < 0) or (ButtonIndex >= Pages[PageIndex].Buttons.Count) then
|
|
Exit;
|
|
|
|
if (Pages[PageIndex].ButtonSize = olbsLarge) and FWordWrap then
|
|
for I := Pages[PageIndex].TopButtonIndex to ButtonIndex - 1 do
|
|
Result := Result + GetButtonHeight(PageIndex, I)
|
|
else
|
|
Result := (ButtonIndex - Pages[PageIndex].TopButtonIndex) * GetButtonHeight(PageIndex, ButtonIndex);
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.GetButtonHeight(PageIndex, ButtonIndex: Integer): Integer;
|
|
var
|
|
TM: TTextMetric;
|
|
textSize: TSize;
|
|
imgSize: TSize;
|
|
OldFont: HFONT;
|
|
LargeOffset: Integer;
|
|
SmallOffset: Integer;
|
|
begin
|
|
OldFont := SelectObject(Canvas.Handle, Canvas.Font.Handle);
|
|
try
|
|
Canvas.Font.Assign(Font);
|
|
GetTextMetrics(Canvas.Handle, TM{%H-});
|
|
Result := TM.tmHeight + TM.tmExternalLeading;
|
|
if (PageIndex >= 0) and (PageIndex < Pages.Count) then
|
|
begin
|
|
textSize := GetButtonTextSize(PageIndex, ButtonIndex);
|
|
largeOffset := Scale96ToForm(8);
|
|
smallOffset := Scale96ToForm(4);
|
|
case Pages[PageIndex].ButtonSize of
|
|
olbsLarge:
|
|
if FLargeImages <> nil then begin
|
|
imgSize := GetRealImageSize(FLargeImages, FLargeImagesWidth);
|
|
Result := Max(Result, imgSize.CY + textSize.CY + largeOffset)
|
|
end else
|
|
Result := textSize.cy + largeOffset;
|
|
|
|
olbsSmall:
|
|
if SmallImages <> nil then begin
|
|
imgSize := GetRealImageSize(FSmallImages, FSmallImagesWidth);
|
|
Result := Max(imgSize.CY, textSize.cy) + smallOffset
|
|
end else
|
|
Result := textSize.cy + smallOffset;
|
|
end;
|
|
end;
|
|
Inc(Result, smallOffset);
|
|
finally
|
|
SelectObject(Canvas.Handle, OldFont);
|
|
end;
|
|
end;
|
|
|
|
(*
|
|
{$IF LCL_FullVersion >= 1090000}
|
|
function TJvCustomOutlookBar.DoEraseBackground(ACanvas: TCanvas; Param: LPARAM): Boolean;
|
|
begin
|
|
// don't redraw background: we always fill it anyway
|
|
Result := True;
|
|
end;
|
|
{$ENDIF}
|
|
*)
|
|
|
|
procedure TJvCustomOutlookBar.RedrawRect(R: TRect; Erase: Boolean = False);
|
|
begin
|
|
InvalidateRect(Handle, @R, Erase);
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.CMCaptionEditing(var Msg: TLMessage);
|
|
var
|
|
R: TRect;
|
|
B: TJvOutlookBarButton;
|
|
P: TJvOutlookBarPage;
|
|
begin
|
|
TJvOutlookBarEdit(FEdit).Tag := NativeInt(Msg.WParam);
|
|
// TJvOutlookBarEdit(FEdit).Font.Name := Pages[ActivePageIndex].Font.Name;
|
|
// TJvOutlookBarEdit(FEdit).Font.Size := Pages[ActivePageIndex].Font.Size;
|
|
case Msg.LParam of
|
|
0: // button
|
|
begin
|
|
B := TJvOutlookBarButton(Msg.WParam);
|
|
R := GetButtonTextRect(ActivePageIndex, B.Index);
|
|
R.Left := Max(R.Left, 0);
|
|
R.Right := ClientWidth; //Min(R.Right, ClientWidth);
|
|
TJvOutlookBarEdit(FEdit).ShowEdit(B.Caption, R);
|
|
end;
|
|
1: // page
|
|
begin
|
|
P := TJvOutlookBarPage(Msg.WParam);
|
|
R := GetPageTextRect(P.Index);
|
|
TJvOutlookBarEdit(FEdit).ShowEdit(P.Caption, R);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.DoContextPopup( MousePos: TPoint;
|
|
var Handled: Boolean);
|
|
var
|
|
P: TPersistent;
|
|
begin
|
|
P := GetPageButtonAtPos(MousePos);
|
|
if Assigned(P) then
|
|
PopUpObject := P
|
|
else
|
|
begin
|
|
P := GetButtonAtPos(MousePos);
|
|
if Assigned(P) then
|
|
PopUpObject := P;
|
|
end;
|
|
if P = nil then
|
|
PopUpObject := Self;
|
|
inherited DoContextPopup(MousePos, Handled);
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.DoButtonEdit(NewText: string; B: TJvOutlookBarButton);
|
|
var
|
|
Allow: Boolean;
|
|
begin
|
|
Allow := True;
|
|
if Assigned(FOnEditButton) then
|
|
FOnEditButton(Self, NewText, B.Index, Allow);
|
|
if Allow then
|
|
B.Caption := NewText;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.DoPageEdit(NewText: string; P: TJvOutlookBarPage);
|
|
var
|
|
Allow: Boolean;
|
|
begin
|
|
Allow := True;
|
|
if Assigned(FOnEditPage) then
|
|
FOnEditPage(Self, NewText, P.Index, Allow);
|
|
if Allow then
|
|
P.Caption := NewText;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.CMCaptionEditAccept(var Msg: TLMessage);
|
|
begin
|
|
with Msg do
|
|
begin
|
|
if TObject(LParam) is TJvOutlookBarButton then
|
|
DoButtonEdit(TJvOutlookBarEdit(WParam).Text, TJvOutlookBarButton(LParam))
|
|
else
|
|
if TObject(LParam) is TJvOutlookBarPage then
|
|
DoPageEdit(TJvOutlookBarEdit(WParam).Text, TJvOutlookBarPage(LParam));
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.CMCaptionEditCancel(var Msg: TLMessage);
|
|
begin
|
|
{ with Msg do
|
|
begin
|
|
if TObject(LParam) is TJvOutlookBarButton then
|
|
DoButtonEditCancel(TJvOutlookBarButton(LParam))
|
|
else TObject(LParam) is TJvOutlookBarPage then
|
|
DoPageEditCancel(TJvOutlookBarPage(LParam));
|
|
end;
|
|
}
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.GetActivePage: TJvOutlookBarPage;
|
|
begin
|
|
if (FActivePageIndex > -1) and (FActivePageIndex < FPages.Count) then
|
|
Result := FPages[FActivePageIndex]
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.GetActivePageIndex: Integer;
|
|
begin
|
|
if (FActivePageIndex < 0) or (FActivePageIndex >= FPages.Count) then
|
|
FActivePageIndex := 0;
|
|
Result := FActivePageIndex;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.SetThemedBackground(const Value: Boolean);
|
|
begin
|
|
if Value <> FThemedBackGround then
|
|
begin
|
|
FThemedBackGround := Value;
|
|
if Themed then
|
|
Invalidate;
|
|
{
|
|
if ([csDesigning, csLoading] * ComponentState = []) and Themed then
|
|
Repaint;
|
|
}
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.ColorChanged;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
inherited ColorChanged;
|
|
for I := 0 to Pages.Count - 1 do
|
|
if Pages[I].ParentColor then
|
|
begin
|
|
Pages[I].ParentColor := False;
|
|
Pages[I].ParentColor := True; // reset flag
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.FontChanged;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
inherited FontChanged;
|
|
for I := 0 to FPages.Count - 1 do
|
|
if FPages[I].ParentFont then
|
|
begin //set the font of the buttons as well
|
|
FPages[I].ParentFont := False;
|
|
FPages[I].Font := Self.Font;
|
|
FPages[I].ParentFont := True; // reset flag
|
|
end;
|
|
end;
|
|
|
|
class function TJvCustomOutlookBar.GetControlClassDefaultSize: TSize;
|
|
begin
|
|
Result.CX := 100;
|
|
Result.CY := 220;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.CMDialogChar(var Msg: TCMDialogChar);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if CanFocus then
|
|
begin
|
|
// first check the buttons on the active page, then check the pages
|
|
if (ActivePage <> nil) and (ActivePage.Enabled) then
|
|
begin
|
|
for I := 0 to ActivePage.Buttons.Count - 1 do
|
|
if ActivePage.Buttons[I].Enabled and IsAccel(Msg.CharCode, ActivePage.Buttons[I].Caption) then
|
|
begin
|
|
Msg.Result := 1;
|
|
DoButtonClick(I);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
for I := 0 to Pages.Count - 1 do
|
|
if Pages[I].Enabled and IsAccel(Msg.CharCode, Pages[I].Caption) then
|
|
begin
|
|
Msg.Result := 1;
|
|
ActivePageIndex := I;
|
|
Exit;
|
|
end;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
{$IF LCL_FullVersion >= 1080000}
|
|
procedure TJvCustomOutlookBar.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
|
|
const AXProportion, AYProportion: Double);
|
|
begin
|
|
inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion);
|
|
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
|
|
begin
|
|
DisableAutoSizing;
|
|
try
|
|
if IsStoredPageButtonHeight then
|
|
FPageButtonHeight := round(FPageButtonHeight * AYProportion);
|
|
finally
|
|
EnableAutoSizing;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.FixDesignFontsPPI(const ADesignTimePPI: Integer);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
inherited;
|
|
for i:=0 to Pages.Count-1 do begin
|
|
DoFixDesignFontPPI(Pages[i].Font, ADesignTimePPI);
|
|
DoFixDesignFontPPI(Pages[i].DownFont, ADesignTimePPI);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TJvCustomOutlookBar.DoCustomDraw(ARect: TRect; Stage: TJvOutlookBarCustomDrawStage;
|
|
Index: Integer; Down, Inside: Boolean): Boolean;
|
|
begin
|
|
Result := True;
|
|
if Assigned(FOnCustomDraw) then
|
|
FOnCustomDraw(Self, Canvas, ARect, Stage, Index, Down, Inside, Result);
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.DoDrawBackGround: Boolean;
|
|
begin
|
|
Result := DoCustomDraw(ClientRect, odsBackground, -1, False, False);
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.DoDrawButton(ARect: TRect; Index: Integer; Down, Inside: Boolean): Boolean;
|
|
begin
|
|
Result := DoCustomDraw(ARect, odsButton, Index, Down, Inside);
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.DoDrawButtonFrame(ARect: TRect; Index: Integer;
|
|
Down, Inside: Boolean): Boolean;
|
|
begin
|
|
Result := DoCustomDraw(ARect, odsButtonFrame, Index, Down, Inside);
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.DoDrawPage(ARect: TRect; Index: Integer): Boolean;
|
|
begin
|
|
Result := DoCustomDraw(ARect, odsPage, Index, False, Index = ActivePageIndex);
|
|
end;
|
|
|
|
function TJvCustomOutlookBar.DoDrawPageButton(ARect: TRect; Index: Integer; Down: Boolean): Boolean;
|
|
begin
|
|
Result := DoCustomDraw(ARect, odsPageButton, Index, Down, Index = ActivePageIndex);
|
|
end;
|
|
|
|
procedure TJvOutlookBarPage.DoPictureChange(Sender: TObject);
|
|
begin
|
|
Change;
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.SetPageImages(const Value: TCustomImageList);
|
|
begin
|
|
if ReplaceImageListReference(Self, Value, FPageImages, FPageChangeLink) then
|
|
Invalidate;
|
|
end;
|
|
|
|
{$IF LCL_FullVersion >= 1090000}
|
|
procedure TJvCustomOutlookBar.SetPageImagesWidth(const AValue: Integer);
|
|
begin
|
|
if AValue = FPageImagesWidth then exit;
|
|
FPageImagesWidth := AValue;
|
|
Invalidate;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TJvCustomOutlookBar.InitiateAction;
|
|
var
|
|
I, J: Integer;
|
|
begin
|
|
inherited InitiateAction;
|
|
for I := 0 to Pages.Count - 1 do
|
|
for J := 0 to Pages[I].Buttons.Count - 1 do
|
|
Pages[I].Buttons[J].ActionChange(Pages[I].Buttons[J].Action, csLoading in ComponentState);
|
|
end;
|
|
|
|
procedure TJvCustomOutlookBar.Resize;
|
|
begin
|
|
if HandleAllocated then Invalidate;
|
|
inherited;
|
|
end;
|
|
|
|
|
|
//---- Warren added page button properties Nov 2008
|
|
|
|
constructor TJvPageBtnProps.Create(owner: TJvCustomOUtlookBar);
|
|
begin
|
|
FOwner := owner;
|
|
FShadow := clBtnShadow;
|
|
FHighlight := clBtnHighlight;
|
|
FDkShadow := cl3DDkShadow;
|
|
FFace := clBtnFace;
|
|
FBorderWidth := 1;
|
|
end;
|
|
|
|
procedure TJvPageBtnProps.SetBorderWidth(const Value: INteger);
|
|
begin
|
|
FBorderWidth := Value;
|
|
end;
|
|
|
|
procedure TJvPageBtnProps.SetDkShadow(const Value: TColor);
|
|
begin
|
|
FDkShadow := Value;
|
|
end;
|
|
|
|
procedure TJvPageBtnProps.SetFace(const Value: TColor);
|
|
begin
|
|
FFace := Value;
|
|
end;
|
|
|
|
procedure TJvPageBtnProps.SetHighlight(const Value: TColor);
|
|
begin
|
|
FHighlight := Value;
|
|
end;
|
|
|
|
procedure TJvPageBtnProps.SetShadow(const Value: TColor);
|
|
begin
|
|
FShadow := Value;
|
|
end;
|
|
|
|
end.
|