jvlookout.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
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: JvLookOut.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

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvLookOut.pas,v 1.48 2005/03/09 08:55:19 peter3 Exp $

unit JvLookOut;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils, Classes,
  Windows, Messages,  
  Graphics, Controls, Forms, StdCtrls, ExtCtrls, Buttons, Menus, ImgList,
  {$IFDEF VisualCLX}
  Qt,
  {$ENDIF VisualCLX}
  JvJCLUtils, JvTypes, JvConsts, JvComponent, JvThemes, JvExControls, JvExButtons;

const
  CM_IMAGESIZECHANGED = CM_BASE + 100;
  CM_LEAVEBUTTON = CM_BASE + 101;

type
  TJvButtonBorder = (bbDark, bbLight, bbMono);

  TJvUpArrowBtn = class(TJvExSpeedButton, IJvDenySubClassing)
  private
    FTimer: TTimer;
    FAutoRepeat: Boolean;
    FDown: Boolean;
    FFlat: Boolean;
    procedure SetFlat(Value: Boolean);
    {$IFDEF VCL}
    procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
    {$ENDIF VCL}
  protected
    procedure OnTime(Sender: TObject); virtual;
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseEnter(Control: TControl); override;
    procedure MouseLeave(Control: TControl); override;
  public
    procedure Click; override;
    constructor Create(AOwner: TComponent); override;
  published
    property Flat: Boolean read FFlat write SetFlat default False;
    property AutoRepeat: Boolean read FAutoRepeat write FAutoRepeat default True;
  end;

  TJvDwnArrowBtn = class(TJvUpArrowBtn)
  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure OnTime(Sender: TObject); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TJvLookOutEditedEvent = procedure(Sender: TObject; var Caption: string) of object;

  TJvCustomLookOutButton = class(TJvGraphicControl)
  private
    FEdit: TEdit;
    FData: Pointer;
    FParentImageSize: Boolean;
    FDown: Boolean;
    FStayDown: Boolean;
    FCentered: Boolean;
    FImageIndex: TImageIndex;
    FSpacing: Integer;
    FOffset: Integer;
    FImageSize: TJvImageSize;
    FImageRect: TRect;
    FTextRect: TRect;
    FFillColor: TColor;
    FHighlightFont: TFont;
    FButtonBorder: TJvButtonBorder;
    FPopUpMenu: TPopupMenu;
    FCaption: TCaption;
    FGroupIndex: Integer;
    FSmallImages: TImageList;
    FLargeImages: TImageList;
    FOnEdited: TJvLookOutEditedEvent;
    FLargeImageChangeLink: TChangeLink;
    FSmallImageChangeLink: TChangeLink;
    procedure SetGroupIndex(Value: Integer);
    procedure UpdateExclusive;
    procedure SetCentered(Value: Boolean);
    procedure SetDown(Value: Boolean);
    procedure SetOffset(Value: Integer);
    procedure SetFillColor(Value: TColor);
    procedure SetHighlightFont(Value: TFont);
    procedure SetSpacing(Value: Integer);
    procedure SetParentImageSize(Value: Boolean);
    procedure SetButtonBorder(Value: TJvButtonBorder);
    procedure SetCaption(Value: TCaption);
    procedure SetSmallImages(Value: TImageList);
    procedure SetLargeImages(Value: TImageList);
    procedure SetImageIndex(Value: TImageIndex);
    procedure SetImageSize(Value: TJvImageSize);
    procedure DrawSmallImages;
    procedure DrawLargeImages;
    procedure ImageListChange(Sender: TObject);
    procedure CMButtonPressed(var Msg: TCMButtonPressed); message CM_JVBUTTONPRESSED;
    procedure CMParentImageSizeChanged(var Msg: TMessage); message CM_IMAGESIZECHANGED;
    procedure CMLeaveButton(var Msg: TMessage); message CM_LEAVEBUTTON;
    function ParentVisible: Boolean;
  protected
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    function GetActionLinkClass: TControlActionLinkClass; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure DoOnEdited(var Caption: string); virtual;
    procedure EditKeyDown(Sender: TObject; var Key: Char);
    procedure EditMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer);
    procedure PaintFrame; virtual;
    procedure SetParent({$IFDEF VisualCLX} const {$ENDIF} AParent: TWinControl); override;
    procedure Paint; override;
    procedure MouseEnter(Control: TControl); override;
    procedure MouseLeave(Control: TControl); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    function WantKey(Key: Integer; Shift: TShiftState;
      const KeyText: WideString): Boolean; override;
    procedure VisibleChanged; override;

    property FillColor: TColor read FFillColor write SetFillColor default clNone;
    property Offset: Integer read FOffset write SetOffset default 0;
    property ButtonBorder: TJvButtonBorder read FButtonBorder write SetButtonBorder default bbDark;
    property Caption: TCaption read FCaption write SetCaption;
    property Centered: Boolean read FCentered write SetCentered;
    property Down: Boolean read FStayDown write SetDown default False;
    // (rom) renamed
    property HighlightFont: TFont read FHighlightFont write SetHighlightFont;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex;
    property ImageSize: TJvImageSize read FImageSize write SetImageSize default isLarge;
    property ParentImageSize: Boolean read FParentImageSize write SetParentImageSize default True;
    property PopupMenu: TPopupMenu read FPopUpMenu write FPopUpMenu;
    property LargeImages: TImageList read FLargeImages write SetLargeImages;
    property Spacing: Integer read FSpacing write SetSpacing default 4; { border offset from bitmap }
    property SmallImages: TImageList read FSmallImages write SetSmallImages;
    property Data: Pointer read FData write FData;
    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
    property OnEdited: TJvLookOutEditedEvent read FOnEdited write FOnEdited;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Click; override;
    procedure Assign(Source: TPersistent); override;
    procedure EditCaption;
  end;

  TJvLookOutButton = class(TJvCustomLookOutButton)
  public
    property Data;
  published
    property Action;
    property Align;
    property Anchors;
    property ButtonBorder;
    property Caption;
    property Constraints;
    property Down;
    {$IFDEF VCL}
    property DragCursor;
    {$ENDIF VCL}
    property DragMode;
    property Enabled;
    property Font;
    property GroupIndex;
    property Height default 60;
    property HighlightFont;
    property ImageIndex;
    property ImageSize;
    property LargeImages;
    property Left;
    property ParentFont;
    property ParentImageSize;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property SmallImages;
    property Spacing;
    property Top;
    property Visible;
    property Width default 60;
    property OnClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEdited;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

  TJvExpressButton = class(TJvCustomLookOutButton)
  public
    constructor Create(AOwner: TComponent); override;
    property Data;
  published
    property Action;
    property Align;
    property Anchors;
    property ButtonBorder default bbLight;
    property Caption;
    property Constraints;
    property Down;
    {$IFDEF VCL}
    property DragCursor;
    {$ENDIF VCL}
    property DragMode;
    property Enabled;
    property FillColor default clBtnFace;
    property Font;
    property GroupIndex;
    property Height default 60;
    property HighlightFont;
    property ImageIndex;
    property ImageSize;
    property LargeImages;
    property Left;
    property Offset default 1;
    property ParentFont default false;
    property ParentImageSize;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property SmallImages;
    property Spacing;
    property Top;
    property Visible;
    property Width default 60;
    property OnClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEdited;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

  TJvLookOut = class;
  TJvLookOutPage = class(TJvCustomControl)
  private
    FEdit: TEdit;
    FInScroll: Boolean;
    FAutoRepeat: Boolean;
    FAutoCenter: Boolean;
    FParentImageSize: Boolean;
    FDown: Boolean;
    FShowPressed: Boolean;
    FMargin: Integer;
    FTopControl: Integer;
    FPopUpMenu: TPopupMenu;
    FOnClick: TNotifyEvent;
    FDownArrow: TJvDwnArrowBtn;
    FScrolling: Integer;
    FUpArrow: TJvUpArrowBtn;
    FCaption: TCaption;
    FBitmap: TBitmap;
    FImageSize: TJvImageSize;
    FManager: TJvLookOut;
    FOnCollapse: TNotifyEvent;
    FHighlightFont: TFont;
    FButtons: TList;
    FActiveButton: TJvCustomLookOutButton;
    FOnEdited: TJvLookOutEditedEvent;
    procedure SetActiveButton(Value: TJvCustomLookOutButton);
    procedure EditMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure EditKeyDown(Sender: TObject; var Key: Char);
    procedure SetAutoRepeat(Value: Boolean);
    procedure SetHighlightFont(Value: TFont);
    procedure SetImageSize(Value: TJvImageSize);
    procedure SetParentImageSize(Value: Boolean);
    procedure SetBitmap(Value: TBitmap); {$IFDEF VisualCLX} reintroduce; {$ENDIF}
    procedure SetCaption(Value: TCaption);
    procedure SetMargin(Value: Integer);
    procedure SetButton(Index: Integer; Value: TJvLookOutButton);
    function GetButton(Index: Integer): TJvLookOutButton;
    function GetButtonCount: Integer;
    procedure SetAutoCenter(Value: Boolean);
    function IsVisible(Control: TControl): Boolean;
    procedure CMParentImageSizeChanged(var Msg: TMessage); message CM_IMAGESIZECHANGED;
    procedure TileBitmap;
  protected
    function WantKey(Key: Integer; Shift: TShiftState;
      const KeyText: WideString): Boolean; override;
    procedure MouseLeave(Control: TControl); override;
    procedure EnabledChanged; override;
    procedure DoOnEdited(var Caption: string); virtual;
    procedure UpArrowClick(Sender: TObject); virtual;
    procedure DownArrowClick(Sender: TObject); virtual;
    procedure DrawTopButton; virtual;
    procedure CalcArrows; virtual;
    procedure ScrollChildren(Start: Word); virtual;
    procedure AlignControls(Control: TControl; var Rect: TRect); override;
    procedure SetParent({$IFDEF VisualCLX} const {$ENDIF} AParent: TWinControl); override;
    procedure CreateWnd; override;
    procedure SmoothScroll(AControl: TControl; NewTop, AInterval: Integer; Smooth: Boolean); virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure Paint; override;
    property AutoCenter: Boolean read FAutoCenter write SetAutoCenter;
  public
    procedure Click; override;
    procedure DownArrow;
    procedure UpArrow;
    function AddButton: TJvLookOutButton;
    procedure ExchangeButtons(Button1, Button2: TJvCustomLookOutButton); virtual;
    procedure EditCaption; virtual;
    procedure DisableAdjust;
    procedure EnableAdjust;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Buttons[Index: Integer]: TJvLookOutButton read GetButton write SetButton;
    property ButtonCount: Integer read GetButtonCount;
    property ActiveButton: TJvCustomLookOutButton read FActiveButton write SetActiveButton;
  published
    property Align;
    property AutoRepeat: Boolean read FAutoRepeat write SetAutoRepeat default False;
    property Bitmap: TBitmap read FBitmap write SetBitmap;
    property ImageSize: TJvImageSize read FImageSize write SetImageSize default isLarge;
    property HighlightFont: TFont read FHighlightFont write SetHighlightFont;
    property ParentImageSize: Boolean read FParentImageSize write SetParentImageSize default True;
    property ShowPressed: Boolean read FShowPressed write FShowPressed default False;
    property Caption: TCaption read FCaption write SetCaption;
    property Color;
    {$IFDEF VCL}
    property DragCursor;
    {$ENDIF VCL}
    property DragMode;
    property ShowHint;
    property Visible;
    property Enabled;
    property Font;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu: TPopupMenu read FPopUpMenu write FPopUpMenu;
    property Left;
    property Top;
    property Width;
    property Height;
    property Cursor;
    property Hint;
    property Margin: Integer read FMargin write SetMargin default 0;
    property OnEdited: TJvLookOutEditedEvent read FOnEdited write FOnEdited;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnStartDrag;
  end;

  TJvLookOut = class(TJvCustomControl)
  private
    FAutoSize: Boolean;
    FSmooth: Boolean;
    FBorderStyle: TBorderStyle;
    FOnCollapse: TNotifyEvent;
    FOnClick: TNotifyEvent;
    FActivePage: TJvLookOutPage;
    FCurrentPage: TJvLookOutPage;
    FPages: TList;
    FImageSize: TJvImageSize;
    FFlatButtons: Boolean;
    procedure SetImageSize(Value: TJvImageSize);
    procedure SetBorderStyle(Value: TBorderStyle);
    procedure UpdateControls;
    procedure DoCollapse(Sender: TObject);
    procedure SetActiveOutlook(Value: TJvLookOutPage);
    function GetActiveOutlook: TJvLookOutPage;
    function GetPageCount: Integer;
    function GetPage(Index: Integer): TJvLookOutPage;
    procedure SetPage(Index: Integer; Value: TJvLookOutPage);
    procedure SetFlatButtons(Value: Boolean);
    {$IFDEF VCL}
    procedure WMNCCalcSize(var Msg: TWMNCCalcSize); message WM_NCCALCSIZE;
    {$ENDIF VCL}
    procedure WMNCPaint(var Msg: TMessage); message WM_NCPAINT;
  protected
    procedure SetAutoSize(Value: Boolean); {$IFDEF VCL} override; {$ENDIF}
    procedure SmoothScroll(AControl: TControl; NewTop, AInterval: Integer; Smooth: Boolean); virtual;
    procedure Paint; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function AddPage: TJvLookOutPage;
    property Pages[Index: Integer]: TJvLookOutPage read GetPage write SetPage;
    property PageCount: Integer read GetPageCount;
  published
    property ActivePage: TJvLookOutPage read GetActiveOutlook write SetActiveOutlook;
    property Align;
    property Anchors;
    property Constraints;
    property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    property Color default clBtnShadow;
    property FlatButtons: Boolean read FFlatButtons write SetFlatButtons default False;
    {$IFDEF VCL}
    property DragCursor;
    {$ENDIF VCL}
    property DragMode;
    property ImageSize: TJvImageSize read FImageSize write SetImageSize default isLarge;
    property ShowHint;
    property Smooth: Boolean read FSmooth write FSmooth default False;
    property Visible;
    property Enabled;
    property Left;
    property Top;
    property Width default 92;
    property Height default 300;
    property Cursor;
    property Hint;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnStartDrag;
  end;

  TJvExpress = class(TJvLookOutPage, IJvDenySubClassing)
  private
    FBorderStyle: TBorderStyle;
    FButtonHeight: Integer;
    procedure SetButtonHeight(Value: Integer);
  protected
    procedure CalcArrows; override;
    procedure ScrollChildren(Start: Word); override;
    procedure DrawTopButton; override;
    procedure Paint; override;