mxoutlookbar.pas

Delphi控件源码 Delphi控件源码

// ****************************************************************************
// * An Outlook style sidebar component for Delphi.
// ****************************************************************************
// * Copyright 2001, Lajos Farkas. All Rights Reserved.
// ****************************************************************************
// * This component can be freely used and distributed in commercial and
// * private environments, provied this notice is not modified in any way.
// ****************************************************************************
// * Feel free to contact me if you have any questions, comments or suggestions
// * at [e-mail]
// ****************************************************************************
// * Date last modified: 2001.07.16
// ****************************************************************************
// * TmxOutlookBar v1.34
// ****************************************************************************
// * Description:
// *
// * The TmxOutlookBar 100% native VCL  component with many added features to
// * support the look, feel, and behavior introduced in Microsoft  Office 97,
// * 2000, and new Internet Explorer. It has got many features  including
// * scrolling headers, icon  highlighting and positioning, small and large
// * icons,gradient and bitmap backgrounds. The header sections and buttons
// * can be  added, deleted and  moved  at design time. The  header tabs can
// * have individual  font,  alignment,  tabcolor,  glyph, tiled background
// * images. And many many more posibilities.
// ****************************************************************************

Unit mxOutlookBar;

Interface

{$I max.inc}
{$R ARROWGLYPH.RES}

// *************************************************************************************
// ** List of used units
// *************************************************************************************

Uses
     Windows,
     Messages,
     SysUtils,
     Classes,
     Graphics,
     Dialogs,
     Buttons,
     Controls,
     Forms,
     CommCtrl,
{$IFDEF DELPHI4_UP}
     Imglist,
{$ENDIF}
     stdctrls,
     Extctrls;

Const
     mxOutlookVersion = $0122; // ** 1.34 **
     DefaultHeaderHeight = 22;

Type
     // ************************************************************************
     // ************************************************************************
     // ************************************************************************

     TButtonStyle = ( bsSmall, bsLarge );
     TSelectionType = ( stStandard, stExpanded );
     TBitmapCopy = ( bcMergeCopy, bcMergePaint, bcSrcCopy, bcSrcErase, bcSrcPaint );
{$IFDEF DELPHI4_UP}
     TGlyphLayout = ( glGlyphLeft, glGlyphRight, glGlyphCenter );
{$ENDIF}
     TArrowStyle = ( asUp, asDown );
     TButtonIndex = -1..32767;

{$IFNDEF Delphi5Up}
     TImageIndex = Type Integer;
{$ENDIF}

     TGradientType = ( gtl2r, gts2c, gtt2b, gttb2c );
     TBackStyle = ( bsNormal, bsGradient );

     // ************************************************************************
     // ************************************************************************
     // ************************************************************************

     TmxOutlookBar = Class;
     TmxOutlookBarHeader = Class;

     // ************************************************************************
     // ************************************************************************
     // ************************************************************************

     TEventCanChangeHeader = Procedure( Sender: TObject; NewHeader: TmxOutlookBarHeader; Var CanChange: Boolean ) Of Object;
     TEventCanSortButtons = Procedure( Sender: TObject; Var CanSort: Boolean ) Of Object;
     TEventHeaderChange = Procedure( Sender: TObject; OldIndex, NewIndex: Integer ) Of Object;
     TEventCheckScroll = Procedure( Sender: TObject; Var ScrollUpNeed, ScrollDownNeed, Automatic: Boolean ) Of Object;

     // ************************************************************************
     // ************************************************************************
     // ************************************************************************

     TOutlookButton = Class( TCustomControl )
     Private

          FMouseInButton: Boolean;
          FButtonDown: Boolean;
          FButtonStyle: TButtonStyle;
          FCaption: String;
          FLargeImages: TCustomImageList;
          FSmallImages: TCustomImageList;
          FLargeImageChangeLink: TChangeLink;
          FSmallImageChangeLink: TChangeLink;
          FImageIndex: TImageIndex;
          FTransparent: Boolean;
          FAutoSize: Boolean;
          FResizingEnabled: Boolean; // *** Internal Use Only ***

          Procedure WMSetFocus( Var Message: TWMSetFocus ); Message WM_SETFOCUS;
          Procedure WMKillFocus( Var Message: TWMSetFocus ); Message WM_KILLFOCUS;
          Procedure WMLButtonDown( Var Message: TWMLButtonDown ); Message WM_LBUTTONDOWN;

          Procedure CMDialogChar( Var Message: TCMDialogChar ); Message cm_DialogChar;

          Procedure ImageListChange( Sender: TObject );
          Procedure SetLargeImages( Value: TCustomImageList );
          Procedure SetSmallImages( Value: TCustomImageList );
          Procedure SetButtonStyle( Const Value: TButtonStyle );
          Procedure SetCaption( Value: String );
          Procedure SetImageIndex( Value: TImageIndex );
          Procedure SetButtonIndex( Value: TButtonIndex );
          Procedure SetTransparent( Value: Boolean );
          Procedure SetAutoSize( Value: Boolean );
          Function GetButtonIndex: TButtonIndex;
{$IFDEF DELPHI4_UP}
          Procedure OnButtonResized( Sender: TObject; Var NewWidth, NewHeight: Integer; Var Resize: Boolean );
{$ENDIF}

     Protected

          Procedure KeyDown( Var Key: Word; Shift: TShiftState ); Override;
          Procedure Notification( AComponent: TComponent; Operation: TOperation ); Override;
          Procedure CMMouseEnter( Var Message: TMessage ); Message CM_MOUSEENTER;
          Procedure CMMouseLeave( Var Message: TMessage ); Message CM_MOUSELEAVE;
          Procedure CMTextChanged( Var Msg: TMessage ); Message CM_TEXTCHANGED;
          Procedure CMFontChanged( Var Msg: TMessage ); Message CM_FONTCHANGED;
          Procedure MouseDown( Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); Override;
          Procedure MouseUp( Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); Override;
          Procedure Paint; Override;

     Public

          Constructor Create( AOwner: TComponent ); Override;
          Destructor Destroy; Override;

{$IFDEF DELPHI4_UP}
          Function CanFocus: Boolean; Override;
{$ENDIF}

     Published

{$IFDEF DELPHI4_UP}
          Property Action;
{$ENDIF}
          Property AutoSize: Boolean Read FAutoSize Write SetAutoSize Default TRUE;
          Property ButtonStyle: TButtonStyle Read FButtonStyle Write SetButtonStyle Default bsLarge;
          Property ButtonIndex: TButtonIndex Read GetButtonIndex Write SetButtonIndex;
          Property Caption: String Read FCaption Write SetCaption;
          Property Color;
          Property Enabled;
          Property Font;
          Property ImageIndex: TImageIndex Read FImageIndex Write SetImageIndex Default -1;
          Property LargeImages: TCustomImageList Read FLargeImages Write SetLargeImages;
          Property ParentColor;
          Property PopupMenu;
          Property SmallImages: TCustomImageList Read FSmallImages Write SetSmallImages;
          Property TabStop;
          Property Transparent: Boolean Read FTransparent Write SetTransparent;

{$IFDEF DELPHI4_UP} // ** v1.2
          Property DragCursor;
          Property DragKind;
          Property DragMode;
          Property OnDragDrop;
          Property OnDragOver;
          Property OnEndDrag;
{$ENDIF}
          Property OnClick;
          Property OnEnter;
          Property OnDblClick;
          Property OnExit;
          Property OnKeyDown;
          Property OnKeyPress;
          Property OnKeyUp;
          Property OnMouseDown;
          Property OnMouseMove;
          Property OnMouseUp;
{$IFDEF DELPHI4_UP}
          Property OnMouseWheel;
          Property OnMouseWheelDown;
          Property OnMouseWheelUp;
{$ENDIF}
     End;

     // ************************************************************************
     // ************************************************************************
     // ************************************************************************

     TGradient = Class( TPersistent )
     Private

          FGradientType: TGradientType;
          FStartColor: TColor;
          FEndColor: TColor;
          FBackStyle: TBackStyle;

          FOnChange: TNotifyEvent;

     Protected

          Procedure Change; Dynamic;
          Procedure AssignTo( Dest: TPersistent ); Override;

          Procedure SetColor( Index: Integer; Value: TColor );
          Procedure SetGradientType( Value: TGradientType );
          Procedure SetBackStyle( Value: TBackStyle );

     Public

          Constructor Create; Virtual;
          Procedure PaintGradient( ACanvas: TCanvas; ARect: TRect );

          Property OnChange: TNotifyEvent Read FOnChange Write FOnChange;

     Published

          Property BackStyle: TBackStyle Read FBackStyle Write SetBackStyle Default bsNormal;
          Property GradientType: TGradientType Read FGradientType Write SetGradientType Default gtt2b;
          Property StartColor: TColor Index 1 Read FStartColor Write SetColor Default clBlack;
          Property EndColor: TColor Index 2 Read FEndColor Write SetColor Default clBlue;

     End;

     // ************************************************************************
     // ************************************************************************
     // ************************************************************************

     THeaderSettings = Class( TPersistent )
     Private

          FAlignment: TAlignment;
          FBevelInner: TPanelBevel;
          FBevelOuter: TPanelBevel;
          FBevelWidth: TBevelWidth;
          FHeaderColor: TColor;
          FHeaderFont: TFont;
          FHighlightFont: TFont;
          FKeySupport: Boolean;
{$IFDEF DELPHI4_UP}
          FLayout: TGlyphLayout;
{$ENDIF}
          FAutoScroll: Boolean;
          FButtonSizes: Array[ 1..3 ] Of Integer;
          FButtonStyle: TButtonStyle;

          FOnChange: TNotifyEvent;

     Protected

          Procedure Change; Dynamic;
          Procedure AssignTo( Dest: TPersistent ); Override;

          Procedure SetAlignment( Value: TAlignment );
          Procedure SetBevelInner( Value: TPanelBevel );
          Procedure SetBevelOuter( Value: TPanelBevel );
          Procedure SetBevelWidth( Value: TBevelWidth );
          Procedure SetHeaderColor( Value: TColor );
          Procedure SetHeaderFont( Value: TFont );
          Procedure SetHighlightFont( Const Value: TFont );
{$IFDEF DELPHI4_UP}
          Procedure SetLayout( Value: TGlyphLayout );
{$ENDIF}
          Procedure SetAutoScroll( Value: Boolean );
          Procedure SetKeySupport( Value: Boolean );
          Procedure SetButtonSize( Index: Integer; Value: Integer );
          Procedure SetButtonStyle( Const Value: TButtonStyle );

          Function GetButtonSize( Index: Integer ): Integer;

     Public

          Constructor Create( DefaultFont: TFont ); Virtual;
          Destructor Destroy; Override;

          Property OnChange: TNotifyEvent Read FOnChange Write FOnChange;

     Published

          Property Alignment: TAlignment Read FAlignment Write SetAlignment Default taCenter;
          Property AutoScroll: Boolean Read FAutoScroll Write SetAutoScroll Default True;
          Property BevelInner: TPanelBevel Read FBevelInner Write SetBevelInner Default bvNone;
          Property BevelOuter: TPanelBevel Read FBevelOuter Write SetBevelOuter Default bvRaised;
          Property BevelWidth: TBevelWidth Read FBevelWidth Write SetBevelWidth Default 1;
          Property ButtonStyle: TButtonStyle Read FButtonStyle Write SetButtonStyle Default bsLarge;
          Property HeaderColor: TColor Read FHeaderColor Write SetHeaderColor;
          Property HeaderFont: TFont Read FHeaderFont Write SetHeaderFont;
          Property HighlightFont: TFont Read FHighlightFont Write SetHighlightFont;
          Property KeySupport: Boolean Read FKeySupport Write SetKeySupport;
{$IFDEF DELPHI4_UP}
          Property Layout: TGlyphLayout Read FLayout Write SetLayout Default glGlyphLeft;
{$ENDIF}
          Property LargeWidth: Integer Index 1 Read GetButtonSize Write SetButtonSize;
          Property LargeHeight: Integer Index 2 Read GetButtonSize Write SetButtonSize;
          Property SmallHeight: Integer Index 3 Read GetButtonSize Write SetButtonSize;

     End;

     // ************************************************************************
     // ************************************************************************
     // ************************************************************************

     TScrollButton = Class( TSpeedButton )
     Private

          FArrowStyle: TArrowStyle;

          Procedure SetArrowStyle( Value: TArrowStyle );

     Protected

          Procedure CMDesignHitTest( Var Msg: TCMDesignHitTest ); Message CM_DESIGNHITTEST;

     Public

          Constructor Create( AOwner: TComponent ); Override;

     Published

          Property ArrowStyle: TArrowStyle Read FArrowStyle Write SetArrowStyle;

     End;

     // ************************************************************************
     // ************************************************************************
     // ************************************************************************