fcoutlooklist.pas

一套及时通讯的原码

unit fcOutlookList;
{
//
// Components : TfcOutlookList
//
// Copyright (c) 1999 by Woll2Woll Software
// 6/18/99 - Add DitherColor property for selected item.
// 7/27/99 - PYW - Added GlyphOffset and Alignment support for OutlookItems
// 9/10/99 - Make certain that selected color is the same as the hottracktextcolor.
// 12/6/99 - Action list support for event
// 1/06/00 - Fix for outlook item focus when it opens a form over button.  PYW
// 3/23/00 - Fix problem where mouse click in outlooklist buttons not detected
//           if mouse is moved
// 3/24/2000 - PYW - Made sure Item is visible when checking if point is in ItemRect.
// 3/28/01 - RSW - Don't use inherited as it may call accelerators if capture is true
// 10/10/01 - PYW - Actionlink not getting freed.
// 2/7/2002 - Added to handle case where ItemClick deletes an item.
// 5/10/2002- PYW - Moved before inherited.
}

interface

{$i fcIfDef.pas}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, fcCustomDraw, fcCommon, CommCtrl, Buttons, fcCollection, fcClearPanel,
  fcimager, actnlist,
  {$ifdef fcDelphi7Up}
  Themes,
  {$endif}
  {$ifdef ThemeManager}
  thememgr, themesrv, uxtheme,
  {$endif}
  {$ifdef fcDelphi4Up}
  ImgList,
  {$endif}
  ExtCtrls;

type
  TfcCustomOutlookList = class;
  TfcOutlookListItem = class;

  TfcScrollButtonStyle = (sbNone, sbUp, sbDown);

  TfcOutlookPanel = class(TCustomControl)
  private
    FAnimating: Boolean;
    FTransparent: Boolean;
    FInEraseBkGnd: Boolean;
    FOutlookPage: TPersistent;

    procedure SetTransparent(Value: Boolean);

    procedure CMControlListChange(var Message: TCMControlListChange); message CM_CONTROLLISTCHANGE;
    procedure WMEraseBkgnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
  protected
    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
    procedure Paint; override;
    procedure WndProc(var Message: TMessage); override;
  public
    FPreventUpdate: Boolean;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property Animating: Boolean read FAnimating write FAnimating;
    property OutlookPage: TPersistent read FOutlookPage write FOutlookPage;
    property Transparent: Boolean read FTransparent write SetTransparent;
  end;

  TfcCustomOutlookListItemEvent = procedure(OutlookList: TfcCustomOutlookList; Item: TfcOutlookListItem) of object;
  TfcOutlookListDrawItemEvent = procedure(OutlookList: TfcCustomOutlookList; Item: TfcOutlookListItem;
    var GlyphPos, TextPos: TPoint; var DefaultDrawing: Boolean) of object;

  TfcOutlookItemActionLink = class(TActionLink)
  protected
    FItem: TfcOutlookListItem;
    procedure AssignClient(AClient: TObject); override;
    function IsCaptionLinked: Boolean; override;
    function IsEnabledLinked: Boolean; override;
    function IsHintLinked: Boolean; override;
    function IsVisibleLinked: Boolean; override;
    function IsOnExecuteLinked: Boolean; override;
{    function DoShowHint(var HintStr: string): Boolean; virtual;}
    procedure SetCaption(const Value: string); override;
    procedure SetEnabled(Value: Boolean); override;
    procedure SetHint(const Value: string); override;
    procedure SetVisible(Value: Boolean); override;
//    procedure SetOnExecute(Value: TNotifyEvent); override;
  end;
  TfcOutlookItemActionLinkClass = class of TfcOutlookItemActionLink;


  TfcOutlookListItem = class(TfcCollectionItem)
  private
    // Property Storage Variables
    FActionLink: TfcOutlookItemActionLink;
    FButtonRect: TRect;
    FItemRect: TRect;
    FImageIndex: Integer;
    FMouseDownOnItem: Boolean;
    FMouseOnItem: Boolean;
    FSelected: Boolean;
    FSeparation: Integer;
    FText: string;
    {$ifdef fcDelphi4Up}
    FTextAlignment: TAlignment;
    FGlyphOffset: integer;
    {$endif}
    FOnClick: TfcCustomOutlookListItemEvent;
    FEnabled: boolean;
    FVisible: boolean;
    FHint: string;
//    FOnExecuteAction: TNotifyEvent;

    // Property Access methods
    function GetSelected: Boolean;
    function GetOutlookList: TfcCustomOutlookList;
    procedure SetImageIndex(Value: Integer);
    procedure SetMouseDownOnItem(Value: Boolean);
    procedure SetMouseOnItem(Value: Boolean);
    procedure SetSeparation(Value: Integer);
    procedure SetSelected(Value: Boolean);
    procedure SetText(Value: string);
    {$ifdef fcDelphi4Up}
    procedure SetGlyphOffset(Value: Integer);
    procedure SetTextAlignment(Value: TAlignment);
    {$endif}
    function GetAction: TBasicAction;
    procedure SetAction(Value: TBasicAction);
    procedure DoActionChange(Sender: TObject);
    procedure SetEnabled(Value: boolean);
    procedure SetVisible(Value: boolean);
    procedure SetHint(Value: String);
  protected
    function GetItemSize(IncludePadding: Boolean): TSize;
    function IsVisible(Completely: Boolean): Boolean; virtual;
    function SpacingSize: Integer; virtual;
    procedure Paint; virtual;
    procedure PaintButton(IconRect: TRect); virtual;
    function GetDisplayName: string; override;

    property ButtonRect: TRect read FButtonRect;
    property ActionLink: TfcOutlookItemActionLink read FActionLink write FActionLink;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;

    function DisplayRect(Code: TDisplayCode; AStartPos: Integer): TRect;
    function IsDown: Boolean; virtual;
    procedure Invalidate(Erase: Boolean); virtual;
    property ItemRect: TRect read FItemRect;
    property MouseDownOnItem: Boolean read FMouseDownOnItem write SetMouseDownOnItem;
    property MouseOnItem: Boolean read FMouseOnItem write SetMouseOnItem;
    property OutlookList: TfcCustomOutlookList read GetOutlookList;
//    property OnExecuteAction: TNotifyEvent read FOnExecuteAction write FOnExecuteAction;
  published
    property Action: TBasicAction read GetAction write SetAction;
    property ImageIndex: Integer read FImageIndex write SetImageIndex;
    property Selected: Boolean read GetSelected write SetSelected;
    property Separation: Integer read FSeparation write SetSeparation;
    property Tag;
    property Text: string read FText write SetText;
    property OnClick: TfcCustomOutlookListItemEvent read FOnClick write FOnClick;

    {$ifdef fcDelphi4Up}
    property TextAlignment: TAlignment read FTextAlignment write SetTextAlignment default taCenter;
    property GlyphOffset: integer read FGlyphOffset write SetGlyphOffset default 0;
    {$endif}

    property Enabled: boolean read FEnabled write SetEnabled default True;
    property Visible: boolean read FVisible write SetVisible default True;
    property Hint: String read FHint write SetHint;

  end;

  TfcOutlookListItemClass = class of TfcOutlookListItem;

  TfcOutlookListItems = class(TfcCollection)
  private
    FOutlookList: TfcCustomOutlookList;
  protected
    // Overriden methods
    function GetOwner: TPersistent; override;

    // Property access methods
    function GetItems(Index: Integer): TfcOutlookListItem;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(AOutlookList: TfcCustomOutlookList; ACollectionItemClass: TfcOutlookListItemClass); virtual;

    function Add: TfcOutlookListItem;
    function AddItem: TfcCollectionItem; override;

    property OutlookList: TfcCustomOutlookList read FOutlookList;
    property Items[Index: Integer]: TfcOutlookListItem read GetItems; default;
  end;

  TfcOutlookHotTrackStyle = (hsIconHilite, hsItemHilite);
  TfcCustomOutlookListClickStyle = (csClick, csSelect);

  TfcCustomOutlookList = class(TfcOutlookPanel)
  private
    // Property Storage Variables
    FBorderStyle: TBorderStyle;
    FClickStyle: TfcCustomOutlookListClickStyle;
    FHotTrackStyle: TfcOutlookHotTrackStyle;
    FHotTrackTextColor: TColor;
    FItemDisabledTextColor: TColor;
    FImageList: TCustomImageList;
    FItemLayout: TButtonLayout;
    FItemHighlightColor: TColor;
    FItemHotTrackColor: TColor;
    FItemShadowColor: TColor;
    FItems: TfcOutlookListItems;
    FItemSpacing: Integer;
    FItemsWidth: Integer;
    FLayout: TfcLayout;
    FPaintBitmap: TBitmap;
    FScrollInterval: Integer;
    FOnItemClick: TfcCustomOutlookListItemEvent;
    FOnItemChange: TfcCustomOutlookListItemEvent;
    FOnDrawItem: TfcOutlookListDrawItemEvent;
    FTopItem: TfcOutlookListItem;

    FUpButtonRect, FDownButtonRect: TRect;
    FScrollButtonDown: TfcScrollButtonStyle;
    FScrollButtonsVisible: Boolean;
    FMouseInScrollButton: TfcScrollButtonStyle;
    FChangeLink: TChangeLink;
    FOldCapture: HWND;
    FOutlookPage: TPersistent;
    {$ifdef fcDelphi4Up}
    FItemSelectedDitherColor: TColor;
    {$endif}
    HintWindow: THintWindow;
    HintTimerCount: integer;
    HintTimer: TTimer;
    procedure HintTimerEvent(Sender: TObject);
    procedure FreeHintWindow;

    // Property Access methods
    function GetListItems(Index: Integer): TfcOutlookListItem;
    function GetBottomItem: TfcOutlookListItem;
    function GetPaintCanvas: TCanvas;
    function GetSelected: TfcOutlookListItem;
    function GetTopItem: TfcOutlookListItem;
    procedure SetBorderStyle(Value: TBorderStyle);
    procedure SetClickStyle(Value: TfcCustomOutlookListClickStyle);
    procedure SetImageList(Value: TCustomImageList);
    procedure SetItemHighlightColor(Value: TColor);
    procedure SetItemDisabledTextColor(Value: TColor);
    procedure SetItemLayout(Value: TButtonLayout);
    procedure SetItemShadowColor(Value: TColor);
    procedure SetItems(Value: TfcOutlookListItems);
    procedure SetItemSpacing(Value: Integer);
    procedure SetItemsWidth(Value: Integer);
    procedure SetLayout(Value: TfcLayout);
    procedure SetMouseInScrollButton(Value: TfcScrollButtonStyle);
    procedure SetScrollButtonsVisible(Value: Boolean);
    procedure SetTopItem(Value: TfcOutlookListItem);
    Function GetImager: TfcCustomImager;
    Function IsEffectiveItemHilite: boolean;

    // Message Handlers
    procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
    procedure WMEraseBkgnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
    procedure CNChar(var Message: TWMChar); message CN_CHAR;
  protected
    // Overridden Methods
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Loaded; 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 Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Paint; override;
    procedure UpdateButtonRects; virtual;
    procedure ValidateInsert(AComponent: TComponent); override;

    // Virtual Methods
    function ScrollButtonVisible(Button: TfcScrollButtonStyle): Boolean; virtual;
    procedure DoDrawItem(Item: TfcOutlookListItem; var GlyphPos, TextPos: TPoint; var DefaultDrawing: Boolean); virtual;
    procedure ImageListChange(Sender: TObject); virtual;
    procedure InvalidateScrollButton(Button: TfcScrollButtonStyle); virtual;
    procedure ItemClick(Item: TfcOutlookListItem); virtual;
    procedure ScrollButtonClick; virtual;
    procedure UpdateMouseOnItem; virtual;
    procedure UpdateScrollButtonsRect; virtual;

    property MouseInScrollButton: TfcScrollButtonStyle read FMouseInScrollButton write SetMouseInScrollButton;
  public
    Patch: Variant;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function GetPriorVisibleItem(item: TfcOutlookListItem): TfcOutlookListItem;
    function GetNextVisibleItem(item: TfcOutlookListItem): TfcOutlookListItem;
    function GetItemAt(x, y: Integer): TfcOutlookListItem; virtual;
    procedure PaintScrollButton(Button: TfcScrollButtonStyle); virtual;
    function GetFirstVisibleItem: TfcOutlookListItem; virtual;

    property ListItems[Index: Integer]: TfcOutlookListItem read GetListItems;
    property BottomItem: TfcOutlookListItem read GetBottomItem;
    property Selected: TfcOutlookListItem read GetSelected;
    property TopItem: TfcOutlookListItem read GetTopItem write SetTopItem;

    property PaintCanvas: TCanvas read GetPaintCanvas;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle;
    property ClickStyle: TfcCustomOutlookListClickStyle read FClickStyle write SetClickStyle;
    property HotTrackStyle: TfcOutlookHotTrackStyle read FHotTrackStyle write FHotTrackStyle;
    property HotTrackTextColor: TColor read FHotTrackTextColor write FHotTrackTextColor;
    property ItemDisabledTextColor: TColor read FItemDisabledTextColor write SetItemDisabledTextColor default clBtnFace;
    property Images: TCustomImageList read FImageList write SetImageList;
    property ItemHighlightColor: TColor read FItemHighlightColor write SetItemHighlightColor;
    property ItemHotTrackColor: TColor read FItemHotTrackColor write FItemHotTrackColor;
    property ItemLayout: TButtonLayout read FItemLayout write SetItemLayout;
    property ItemShadowColor: TColor read FItemShadowColor write SetItemShadowColor;
    property Items: TfcOutlookListItems read FItems write SetItems;
    property ItemSpacing: Integer read FItemSpacing write SetItemSpacing;
    property ItemsWidth: Integer read FItemsWidth write SetItemsWidth;
    property Layout: TfcLayout read FLayout write SetLayout;
    property OutlookPage: TPersistent read FOutlookPage write FOutlookPage;
    property ScrollButtonsVisible: Boolean read FScrollButtonsVisible write SetScrollButtonsVisible;
    property ScrollInterval: Integer read FScrollInterval write FScrollInterval;
    { RSW - 6/18/99 }
    {$ifdef fcDelphi4Up}
    property ItemSelectedDitherColor: TColor read FItemSelectedDitherColor write FItemSelectedDitherColor;
    {$endif}

    property OnDrawItem: TfcOutlookListDrawItemEvent read FOnDrawItem write FOnDrawItem;
    property OnItemClick: TfcCustomOutlookListItemEvent read FOnItemClick write FOnItemClick;
    property OnItemChange: TfcCustomOutlookListItemEvent read FOnItemChange write FOnItemChange;
  end;

  TfcOutlookList = class(TfcCustomOutlookList)
  published
    property Align;
    property BorderStyle;
    property ClickStyle;
    property Color;
    property DragCursor;
    property DragMode;
    property Font;
    property HotTrackStyle;
    property Images;
    property ItemDisabledTextColor;
    property ItemHighlightColor;
    property ItemHotTrackColor;
    property ItemLayout;
    property ItemShadowColor;
    {$ifdef fcDelphi4Up}
    property ItemSelectedDitherColor;
    {$endif}
    property Items;
    property ItemSpacing;
    property ItemsWidth;
    property Layout;
    property PopupMenu;
    property ScrollButtonsVisible;
    property ScrollInterval;
    property ShowHint;
    property Transparent;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnEndDrag;
    property OnItemClick;
    property OnItemChange;
    property OnMouseDown;
    property OnMouseUp;
    property OnMouseMove;
    property OnStartDrag;
  end;

implementation

uses fcOutlookBar;

const ScrollTimerID = 100;

constructor TfcOutlookPanel.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle + [csAcceptsControls];
  Transparent := True; { RSW - 3/19/99 (Necessary to paint imager }
end;