jvqoutlookbar.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
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鰎nqvist [peter3 at sourceforge dot net]
Portions created by Peter Th鰎nqvist are Copyright (C) 2002 Peter Th鰎nqvist.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Description:
  Outlook style control. Simpler than TJvLookout)
   Hierarchy:
    TJvCustomOutlookBar
      Pages: TJvOutlookBarPages
        Page: TJvOutlookBarPage
          Buttons: TJvOutlookBarButtons
            Button: TJvOutlookBarButton

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvQOutlookBar.pas,v 1.31 2005/02/20 23:43:39 asnepvangers Exp $

unit JvQOutlookBar;

{$I jvcl.inc}

interface

uses
  SysUtils, Classes, QActnList,
  Qt, QWindows, QMessages, QButtons, QControls, QGraphics, QImgList, QForms, QStdCtrls, QExtCtrls, 
  JvQJCLUtils, JvQThemes, JvQComponent, JvQExButtons;

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 IsCaptionLinked: Boolean; override;
    function IsImageIndexLinked: Boolean; override;
    function IsOnExecuteLinked: Boolean; override;
    function IsEnabledLinked: Boolean;override;  
    procedure SetCaption(const Value: TCaption); override; 
    procedure SetEnabled(Value: Boolean); override;
    procedure SetImageIndex(Value: Integer); override;
    procedure SetOnExecute(Value: TNotifyEvent); override;
    property Client: TJvOutlookBarButton read FClient write FClient;
  end;

  TJvOutlookBarButtonActionLinkClass = class of TJvOutlookBarButtonActionLink;
  TJvOutlookBarButton = class(TCollectionItem)
  private
    FActionLink: TJvOutlookBarButtonActionLink;
    FImageIndex: TImageIndex;
    FCaption: TCaption;
    FTag: Integer;
    FDown: Boolean;
    FEnabled: Boolean;
    FAutoToggle: Boolean;
    FOnClick: TNotifyEvent;
    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);
    function GetOutlookBar: TJvCustomOutlookBar;
  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
    procedure Click; dynamic;
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure EditCaption;
  published
    property Action: TBasicAction read GetAction write SetAction;
    property Caption: TCaption read FCaption write SetCaption;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex;
    property Tag: Integer 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 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;
    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;
    function GetOutlookBar: TJvCustomOutlookBar;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure EditCaption;
    property DownButton: TJvOutlookBarButton read GetDownButton write SetDownButton;
    property DownIndex: Integer read GetDownIndex write SetDownIndex;
  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 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;

  TJvCustomOutlookBar = class(TJvCustomControl)
  private
    FTopButton: TSpeedButton;
    FBtmButton: TSpeedButton;
    FPages: TJvOutlookBarPages;
    FLargeChangeLink: TChangeLink;
    FSmallChangeLink: TChangeLink;
    FPageChangeLink: TChangeLink;
    FActivePageIndex: Integer;
    FButtonSize: TJvBarButtonSize;
    FSmallImages: TCustomImageList;
    FLargeImages: TCustomImageList;
    FPageButtonHeight: Integer;
    FBorderStyle: TBorderStyle;
    FNextActivePage: Integer;
    FPressedPageBtn: Integer; 
    FOnPageChange: TOutlookBarPageChange;
    FOnPageChanging: TOutlookBarPageChanging;
    FButtonRect: TRect;
    FLastButtonIndex: Integer;
    FPressedButtonIndex: Integer;
    FOnButtonClick: TOutlookBarButtonClick;
    FPopUpObject: TObject;
    FEdit: TCustomEdit;
    FOnEditButton: TOutlookBarEditCaption;
    FOnEditPage: TOutlookBarEditCaption;
    FOnCustomDraw: TJvOutlookBarCustomDrawEvent;
    FPageImages: TCustomImageList;
    procedure SetPages(const Value: TJvOutlookBarPages);
    procedure DoChangeLinkChange(Sender: TObject);
    procedure SetActivePageIndex(const Value: Integer);
    procedure SetButtonSize(const Value: TJvBarButtonSize);
    procedure SetLargeImages(const Value: TCustomImageList);
    procedure SetSmallImages(const Value: TCustomImageList);
    procedure SetPageImages(const Value: TCustomImageList);
    procedure SetPageButtonHeight(const Value: Integer);
    procedure SetBorderStyle(const Value: TBorderStyle); 
    function DrawTopPages: Integer;
    procedure DrawCurrentPage(PageIndex: Integer);
    procedure DrawPageButton(R: TRect; Index: Integer; Pressed: Boolean);
    procedure DrawBottomPages(StartIndex: Integer);
    procedure DrawButtons(Index: Integer);
    procedure DrawArrowButtons(Index: Integer);
    procedure DrawButtonFrame(PageIndex, ButtonIndex, PressedIndex: Integer);
    function DrawPicture(R: TRect; Picture: TPicture): Boolean;
    procedure DoDwnClick(Sender: TObject);
    procedure DoUpClick(Sender: TObject);
    procedure RedrawRect(R: TRect; Erase: Boolean = False);
    procedure CMCaptionEditing(var Msg: TMessage); message CM_CAPTION_EDITING;
    procedure CMCaptionEditAccept(var Msg: TMessage); message CM_CAPTION_EDIT_ACCEPT;
    procedure CMCaptionEditCancel(var Msg: TMessage); message CM_CAPTION_EDIT_CANCEL; 
    procedure DoButtonEdit(NewText: string; B: TJvOutlookBarButton);
    procedure DoPageEdit(NewText: string; P: TJvOutlookBarPage);
    function GetActivePage: TJvOutlookBarPage;
    function GetActivePageIndex: Integer;
  protected 
    function WantKey(Key: Integer; Shift: TShiftState;
      const KeyText: WideString): Boolean; override; 
    procedure FontChanged; override; 
    function GetButtonHeight(PageIndex: Integer): Integer;
    function GetButtonFrameRect(PageIndex, ButtonIndex: Integer): TRect;
    function GetButtonTextRect(PageIndex, ButtonIndex: Integer): TRect;
    function GetButtonRect(PageIndex, ButtonIndex: Integer): TRect;
    function GetPageButtonRect(Index: Integer): TRect;
    function GetPageTextRect(Index: Integer): TRect;
    function GetPageRect(Index: Integer): TRect;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseEnter(Control: TControl); override;
    procedure MouseLeave(Control: TControl); override;
    procedure ColorChanged; override;
    function DoPageChanging(Index: Integer): Boolean; virtual;
    procedure DoPageChange(Index: Integer); virtual;
    procedure DoButtonClick(Index: Integer); virtual;
    procedure DoContextPopup( const  MousePos: TPoint; var Handled: Boolean); override;
    function DoDrawBackGround: Boolean;
    function DoDrawPage(ARect: TRect; Index: Integer): Boolean;
    function DoDrawPageButton(ARect: TRect; Index: Integer; Down: Boolean): Boolean;
    function DoDrawButton(ARect: TRect; Index: Integer; Down, Inside: Boolean): Boolean;
    function DoDrawButtonFrame(ARect: TRect; Index: Integer; Down, Inside: Boolean): Boolean;
    function DoCustomDraw(ARect: TRect; Stage: TJvOutlookBarCustomDrawStage; Index: Integer; Down, Inside: Boolean): Boolean; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure InitiateAction; override;
    function GetButtonAtPos(P: TPoint): TJvOutlookBarButton;
    function GetPageButtonAtPos(P: TPoint): TJvOutlookBarPage;
  protected
    property PopUpObject: TObject read FPopUpObject write FPopUpObject;
    property Width default 100;
    property Height default 220;
    property TopButton: TSpeedButton read FTopButton;
    property BtmButton: TSpeedButton read FBtmButton;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle 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 default 19;
    property ActivePageIndex: Integer read GetActivePageIndex write SetActivePageIndex default 0; 
    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;
  public
    property ActivePage: TJvOutlookBarPage read GetActivePage;
  end;

  TJvOutlookBar = class(TJvCustomOutlookBar)
  public
    property PopUpObject;
  published
    property Align;
    property Pages;
    property LargeImages;
    property SmallImages;
    property PageImages;
    property ButtonSize;
    property PageButtonHeight;
    property ActivePageIndex; 
    property OnButtonClick;
    property OnCustomDraw;
    property OnEditButton;
    property OnPageChange;
    property OnPageChanging;
    property OnEditPage;
    property Action;
    property Anchors; 
    property BorderStyle;
    property Color;
    property Constraints;
    property Cursor;
    property DragMode;
    property Font;
    property Height;
    property HelpContext;
    //PRY 2002.06.04 
    property HelpKeyword;
    property HelpType; 
    // PRY END
    property Hint;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property Width;
    property OnClick;
    property OnDblClick;
    property OnContextPopup;
  end;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Math,
  JvQConsts;

{$IFDEF MSWINDOWS}
{$R ..\Resources\JvOutlookBar.res}
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
{$R ../Resources/JvOutlookBar.res}
{$ENDIF UNIX}

const
  cButtonLeftOffset = 4;
  cButtonTopOffset = 2;
  cInitRepeatPause = 400;
  cRepeatPause = 100;

function MethodsEqual(const Method1, Method2: TMethod): Boolean;
begin
  Result := (Method1.Code = Method2.Code) and (Method1.Data = Method2.Data);
end;

//=== { TJvOutlookBarEdit } ==================================================

type
  TJvOutlookBarEdit = class(TCustomEdit)
  private
    FCanvas: TControlCanvas; 
    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;