mxoutlookbar.pas

Delphi控件源码 Delphi控件源码

     TmxOutlookBarHeader = Class( TCustomControl )
     Private

          FBitmap: TBitmap;
          FImageIndex: TImageIndex;
          FBitmapCopy: TBitmapCopy;
          FMouseInHeader: Boolean;
          FButtonDown: Boolean;
          FGradient: TGradient;
          FHeaderSettings: THeaderSettings;
          FFirstVisibleButton: Integer;

          FAutoSort: Boolean;
          FScrollUp: TScrollButton;
          FScrollDown: TScrollButton;

          FFirstButtonTop: Integer;

          FOnChange: TNotifyEvent;
          FOnCheckScroll: TEventCheckScroll;
          FOnScroll: TNotifyEvent;
          FOnHide: TNotifyEvent;
          FOnShow: TNotifyEvent;
          FOnCanSort: TEventCanSortButtons;
          FOnSort: TNotifyEvent;

          Procedure DoSettingsChange( Sender: TObject );

          Procedure WMSetFocus( Var Message: TWMSetFocus ); Message WM_SETFOCUS;
          Procedure WMKillFocus( Var Message: TWMSetFocus ); Message WM_KILLFOCUS;
          Function CheckChild( Child: TControl ): Boolean;
          Procedure CMDialogChar( Var Message: TCMDialogChar ); Message cm_DialogChar;
          Procedure CMVisibleChanged( Var Message: TMessage ); Message CM_VISIBLECHANGED;
          Procedure CMColorChanged( Var Message: TMessage ); Message CM_COLORCHANGED;
          Procedure CMMouseEnter( Var Message: TMessage ); Message CM_MOUSEENTER;
          Procedure CMMouseLeave( Var Message: TMessage ); Message CM_MOUSELEAVE;

          Function GetHeaderIndex: Integer;
          Function GetParentBar: TmxOutlookBar;
          Function GetHeaderHeight: Integer;

          Procedure SetBitmap( Const Value: TBitmap );
          Procedure SetHeaderIndex( Value: Integer );
          Procedure SetImageIndex( Value: TImageIndex );
          Procedure SetBitmapCopy( Value: TBitmapCopy );
          Procedure SetAutoSort( Value: Boolean );
          Procedure SetFirstButtonTop( Value: Integer );
          Procedure PaintTileBackground( Rect: TRect );

          Procedure OnHeaderResized( Sender: TObject );

          Function GetChild( Child: TControl ): TOutlookButton;
          Function GetChildByIndex( Index: Integer ): TOutlookButton;
          Function CreateNewOutlookButton: TOutlookButton;

     Protected

{$IFDEF DELPHI4_UP}
          Procedure AdjustClientRect( Var Rect: TRect ); Override;
          Procedure DragOver( Source: TObject; X, Y: Integer; State: TDragState; Var Accept: Boolean ); Override;
{$ENDIF}
          Procedure KeyDown( Var Key: Word; Shift: TShiftState ); Override;
          Procedure MouseMove( Shift: TShiftState; X, Y: Integer ); Override;
          Procedure MouseDown( Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); Override;
          Procedure MouseUp( Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); Override;
          Procedure Notification( AComponent: TComponent; Operation: TOperation ); Override;
          Procedure CMDesignHitTest( Var Msg: TCMDesignHitTest ); Message CM_DESIGNHITTEST;
          Procedure CMTextChanged( Var Msg: TMessage ); Message CM_TEXTCHANGED;
          Procedure CMFontChanged( Var Msg: TMessage ); Message CM_FONTCHANGED;
          Procedure Paint; Override;
          Procedure Change; Virtual;
          Procedure InternalSortButtons;
          Procedure AutoSortButtons;

     Public

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

          Function GetButtonCount: Integer;
          Function GetButtonByIndex( Index: Integer ): TOutlookButton;

          Function CreateButton( Caption: String ): TOutlookButton;
          Procedure AddButton( OutlookButton: TOutlookButton );
          Procedure DeleteButton( Index: Integer );

          Procedure SortButtons;

          Function IsUpButtonNeed: Boolean;
          Function IsDownButtonNeed: Boolean;

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

     Published

          Property AutoSort: Boolean Read FAutoSort Write SetAutoSort;
          Property Bitmap: TBitmap Read FBitmap Write SetBitmap;
          Property BitmapCopy: TBitmapCopy Read FBitmapCopy Write SetBitmapCopy Default bcSrcCopy;
          Property Caption;
          Property Color;
          Property FirstButtonTop: Integer Read FFirstButtonTop Write SetFirstButtonTop;
          Property Gradient: TGradient Read FGradient Write FGradient;
          Property HeaderSettings: THeaderSettings Read FHeaderSettings Write FHeaderSettings;
          Property HeaderIndex: Integer Read GetHeaderIndex Write SetHeaderIndex;
          Property ImageIndex: TImageIndex Read FImageIndex Write SetImageIndex Default -1;
          Property PopupMenu;
          Property TabStop;
          Property Visible;

          Property OnCanSort: TEventCanSortButtons Read FOnCanSort Write FOnCanSort;
          Property OnChange: TNotifyEvent Read FOnChange Write FOnChange;
          Property OnCheckScroll: TEventCheckScroll Read FOnCheckScroll Write FOnCheckScroll;
          Property OnEnter;
          Property OnClick;
          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;
          Property OnResize;
{$ENDIF}
          Property OnScroll: TNotifyEvent Read FOnScroll Write FOnScroll;
          Property OnSort: TNotifyEvent Read FOnSort Write FOnSort;
          Property OnHide: TNotifyEvent Read FOnHide Write FOnHide;
          Property OnShow: TNotifyEvent Read FOnShow Write FOnShow;
     End;

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

     TmxOutlookBar = Class( TCustomControl )
     Private

          FBevelInner: TPanelBevel;
          FBevelOuter: TPanelBevel;
          FBevelWidth: TBevelWidth;
          FActiveHeader: TmxOutlookBarHeader;
          FMouseInControl: TmxOutlookBarHeader;
          FBorderStyle: TBorderStyle;
          FCommonStyle: Boolean;
          FFlat: Boolean;
          FImages: TCustomImageList;
          FImageChangeLink: TChangeLink;
          FButtonDown: Boolean;
          FScrolling: Boolean; // ***  Internal use only ***
          FHeaderHeight: Integer;
          FVersion: Integer;

{$IFDEF HEADERSCROLL}
          FScrollSpeed: Integer;
{$ENDIF}

          FOnChange: TEventHeaderChange;
          FOnCanChange: TEventCanChangeHeader;

          FHeaderSettings: THeaderSettings;

          Procedure DoSettingsChange( Sender: TObject );
          Procedure BarResized( Sender: TObject );
          Procedure CMMouseLeave( Var Message: TMessage ); Message CM_MOUSELEAVE;

{$IFDEF DELPHI4_UP}
          Procedure CMBorderChanged( Var Message: TMessage ); Message CM_BORDERCHANGED;
{$ENDIF}
          Procedure CMCtl3DChanged( Var Message: TMessage ); Message CM_CTL3DCHANGED;
          Procedure CMSysColorChange( Var Message: TMessage ); Message CM_SYSCOLORCHANGE;
          Procedure CMColorChanged( Var Message: TMessage ); Message CM_COLORCHANGED;
          Procedure CMEnabledChanged( Var Message: TMessage ); Message CM_ENABLEDCHANGED;

          Function CheckChild( Child: TControl ): Boolean;
          Function GetChild( Child: TControl ): TmxOutlookBarHeader;
          Function GetChildByIndex( Index: Integer ): TmxOutlookBarHeader;
          Function GetHeaderRect( Index: Integer ): TRect;
          Function GetUnVisibleHeaderCountToIndex( Index: Integer ): Integer;
          Function GetUnVisibleHeaderCountAfterIndex( Index: Integer ): Integer;

          Procedure ImageListChange( Sender: TObject );

          Procedure SetBorderStyle( Value: TBorderStyle );
          Procedure SetCommonStyle( Value: Boolean );
          Procedure SetFlat( Value: Boolean );
          Procedure SetHeaderHeight( Value: Integer );
          Procedure SetHeaderSizes;
          Procedure SetImages( Value: TCustomImageList );
{$IFDEF HEADERSCROLL}
          Procedure SetScrollSpeed( Value: integer );
{$ENDIF}
          Function CreateNewOutlookHeader: TmxOutlookBarHeader;

          Procedure SetVersion( Value: String );
          Function GetVersion: String;

     Protected

          Procedure WMGetDlgCode( Var Msg: TWMGetDlgCode ); Message WM_GETDLGCODE;
          Procedure CMFontChanged( Var Msg: TMessage ); Message CM_FONTCHANGED;
{$IFDEF DELPHI4_UP}
          Procedure AdjustClientRect( Var Rect: TRect ); Override;
{$ENDIF}
          Procedure CreateParams( Var Params: TCreateParams ); Override;
          Procedure ChangeHeader( OutlookSideBarHeader: TmxOutlookBarHeader );
          Procedure Paint; Override;
          Procedure SetActiveHeader( Const Value: TmxOutlookBarHeader );
          Procedure Notification( AComponent: TComponent; Operation: TOperation ); Override;
          Procedure KeyDown( Var Key: Word; Shift: TShiftState ); Override;
          Procedure SetBevelInner( Value: TPanelBevel );
          Procedure SetBevelOuter( Value: TPanelBevel );
          Procedure SetBevelWidth( Value: TBevelWidth );

          Property MouseInControl: TmxOutlookBarHeader Read FMouseInControl Write FMouseInControl;

     Public

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

          Function GetHeaderCount: Integer;
          Function GetHeaderIndex: Integer;

          Function GetPrevHeader( OutlookSideBarHeader: TmxOutlookBarHeader ): TmxOutlookBarHeader;
          Function GetNextHeader( OutlookSideBarHeader: TmxOutlookBarHeader ): TmxOutlookBarHeader;

          Procedure CreateHeader( Const Caption: String );
          Procedure AddHeader( OutlookSideBarHeader: TmxOutlookBarHeader );
          Procedure DeleteHeader( Index: Integer );

          Function GetHeaderByIndex( Index: Integer ): TmxOutlookBarHeader; 

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

     Published

          Property ActiveHeader: TmxOutlookBarHeader Read FActiveHeader Write SetActiveHeader;
{$IFDEF DELPHI4_UP}
          Property Anchors;
          Property Caption; // ** 1.2
          Property Font;
{$ENDIF}
          Property Align;
          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 BorderStyle: TBorderStyle Read FBorderStyle Write SetBorderStyle Default bsNone;
{$IFDEF DELPHI4_UP}
          Property BorderWidth;
{$ENDIF}
          Property ButtonDown: Boolean Read FButtonDown Write FButtonDown;
{$IFDEF DELPHI4_UP}
          Property Constraints;
{$ENDIF}
          Property Color;
          Property CommonStyle: Boolean Read FCommonStyle Write SetCommonStyle;
          Property Ctl3D;
          Property Enabled;
          Property Flat: Boolean Read FFlat Write SetFlat Default False;
          Property HeaderHeight: Integer Read FHeaderHeight Write SetHeaderHeight;
          Property HeaderSettings: THeaderSettings Read FHeaderSettings Write FHeaderSettings;
          Property Images: TCustomImageList Read FImages Write SetImages;
          Property PopupMenu;

{$IFDEF HEADERSCROLL}
          Property ScrollSpeed: Integer Read FScrollSpeed Write SetScrollSpeed;
{$ENDIF}

          Property TabStop;
          Property TabOrder;
          Property Version: String Read GetVersion Write SetVersion;
          Property Visible;

          Property OnChange: TEventHeaderChange Read FOnChange Write FOnChange;
          Property OnCanChange: TEventCanChangeHeader Read FOnCanChange Write FOnCanChange;
          Property OnClick;
          Property OnDblClick;

{$IFDEF DELPHI4_UP} // ** v1.2
          Property DockSite;
          Property DragCursor;
          Property DragKind;
          Property DragMode;
          Property OnDockDrop;
          Property OnDragDrop;
          Property OnDragOver;
          Property OnEndDock;
          Property OnEndDrag;
          Property OnGetSiteInfo;
          Property OnStartDock;
          Property OnUndock;
{$ENDIF}

{$IFDEF DELPHI4_UP}
          Property OnCanResize;
{$ENDIF}
          Property OnEnter;
          Property OnExit;
          Property OnKeyDown;
          Property OnKeyPress;
          Property OnKeyUp;
          Property OnMouseDown;
          Property OnMouseMove;
          Property OnMouseUp;
{$IFDEF DELPHI4_UP}
          Property OnMouseWheel;
          Property OnMouseWheelDown;
          Property OnMouseWheelUp;
          Property OnResize;
{$ENDIF}
     End;

Implementation

Const
     Alignments: Array[ TAlignment ] Of Longint = ( DT_LEFT, DT_RIGHT, DT_CENTER );

Type
     TWinControlClass = Class( TWinControl );

// *************************************************************************************
// *************************************************************************************
// *************************************************************************************
// ** TOutlookButton.Create, 4/12/01 3:42:02 PM
// *************************************************************************************
// *************************************************************************************
// *************************************************************************************

Constructor TOutlookButton.Create( AOwner: TComponent );
Begin
     Inherited Create( AOwner );
     ControlStyle := [ csCaptureMouse, csClickEvents, csDoubleClicks, csOpaque ];
     FButtonDown := FALSE;
     FMouseInButton := FALSE;
     FButtonStyle := bsLarge;
     Height := 60;