dxstatusbar.pas

胜天进销存源码,国产优秀的进销存

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressStatusBar                                             }
{                                                                    }
{       Copyright (c) 1998-2008 Developer Express Inc.               }
{       ALL RIGHTS RESERVED                                          }
{                                                                    }
{   The entire contents of this file is protected by U.S. and        }
{   International Copyright Laws. Unauthorized reproduction,         }
{   reverse-engineering, and distribution of all or any portion of   }
{   the code contained in this file is strictly prohibited and may   }
{   result in severe civil and criminal penalties and will be        }
{   prosecuted to the maximum extent possible under the law.         }
{                                                                    }
{   RESTRICTIONS                                                     }
{                                                                    }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES            }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE     }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSSTATUSBAR AND ALL              }
{   ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
{                                                                    }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED       }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE         }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE        }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT   }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                       }
{                                                                    }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON        }
{   ADDITIONAL RESTRICTIONS.                                         }
{                                                                    }
{********************************************************************}

unit dxStatusBar;

{$I cxVer.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Graphics, ImgList, Forms,
  ExtCtrls, dxThemeManager, cxClasses, cxGraphics, cxControls, cxLookAndFeels;

type
  TdxStatusBarPainterClass = class of TdxStatusBarPainter;
  TdxCustomStatusBar = class;
  TdxStatusBarPanel = class;
  TdxStatusBarPanels = class;
  TdxStatusBarPanelStyle = class;
  TdxStatusBarPanelClass = class of TdxStatusBarPanel;

  { TdxStatusBarPanelStyle }

  TdxStatusBarPanelStyle = class(TPersistent)
  private
    FAlignment: TAlignment;
    FColor: TColor;
    FFont: TFont;
    FIsColorAssigned: Boolean;
    FOwner: TdxStatusBarPanel;
    FParentFont: Boolean;
    procedure FontChanged(Sender: TObject);
    function GetColor: TColor;
    function GetStatusBarControl: TdxCustomStatusBar;
    function IsColorStored: Boolean;
    function IsFontStored: Boolean;
    procedure SetAlignment(Value: TAlignment);
    procedure SetColor(Value: TColor);
    procedure SetFont(Value: TFont);
    procedure SetParentFont(Value: Boolean);
  protected
    procedure AdjustTextColor(var AColor: TColor; Active: Boolean); virtual;
    function CanDelete: Boolean; virtual;
    function CanSizing: Boolean; virtual;
    procedure Changed; virtual;
    procedure CheckSizeGripRect(var R: TRect); virtual;
    function DefaultColor: TColor; virtual;
    procedure DoAssign(ASource: TPersistent); virtual;
    procedure DrawContent(ACanvas: TcxCanvas; R: TRect; APainter: TdxStatusBarPainterClass); virtual;
    function GetMinWidth: Integer; virtual;
    function GetPanelFixed: Boolean;
    class function GetVersion: Integer; virtual;
    function InternalBevel: Boolean; virtual;
    procedure Loaded; virtual;
    procedure PanelVisibleChanged; virtual;
    procedure ParentFontChanged; virtual;
  public
    constructor Create(AOwner: TdxStatusBarPanel); virtual;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure RestoreDefaults; virtual;
    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
    property Color: TColor read GetColor write SetColor stored IsColorStored;
    property Font: TFont read FFont write SetFont stored IsFontStored;
    property Owner: TdxStatusBarPanel read FOwner;
    property ParentFont: Boolean read FParentFont write SetParentFont default True;
    property StatusBarControl: TdxCustomStatusBar read GetStatusBarControl;
  end;

  TdxStatusBarPanelStyleClass = class of TdxStatusBarPanelStyle;

  { TdxStatusBarTextPanelStyle }

  TdxStatusBarEllipsisType = (dxetNone, dxetTruncate, dxetSmartPath);
  TdxStatusBarEllipsisTypes = set of TdxStatusBarEllipsisType;

  TdxStatusBarTextEvent = procedure(Sender: TObject; const R: TRect; var AText: string) of object;

  TdxStatusBarTextPanelStyle = class(TdxStatusBarPanelStyle)
  private
    FAutoHint: Boolean;
    FEllipsisType: TdxStatusBarEllipsisType;
    FImageIndex: TImageIndex;
    FOnGetText: TdxStatusBarTextEvent;
    procedure SetAutoHint(Value: Boolean);
    procedure SetEllipsisType(Value: TdxStatusBarEllipsisType);
    procedure SetImageIndex(Value: TImageIndex);
  protected
    procedure DoAssign(ASource: TPersistent); override;
    procedure DrawContent(ACanvas: TcxCanvas; R: TRect; APainter: TdxStatusBarPainterClass); override;
  public
    constructor Create(AOwner: TdxStatusBarPanel); override;
    procedure RestoreDefaults; override;
  published
    property Alignment;
    property AutoHint: Boolean read FAutoHint write SetAutoHint default False;
    property Color;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
    property EllipsisType: TdxStatusBarEllipsisType read FEllipsisType write SetEllipsisType default dxetNone;
    property Font;
    property ParentFont;
    property OnGetText: TdxStatusBarTextEvent read FOnGetText write FOnGetText;
  end;

  { TdxStatusBarStateIndicatorPanelStyle }

  TdxStatusBarStateIndicatorType = (sitOff, sitYellow, sitBlue, sitGreen, sitRed,
    sitTeal, sitPurple);

  TdxStatusBarStateIndicatorItem = class(TCollectionItem)
  private
    FIndicatorBitmap: TBitmap;
    FIndicatorType: TdxStatusBarStateIndicatorType;
    FVisible: Boolean;
    procedure SetIndicatorType(Value: TdxStatusBarStateIndicatorType);
    procedure SetVisible(Value: Boolean);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property IndicatorType: TdxStatusBarStateIndicatorType read FIndicatorType write SetIndicatorType default sitOff;
    property Visible: Boolean read FVisible write SetVisible default True;
  end;

  TdxStatusBarStateIndicators = class(TCollection)
  private
    FOnChange: TNotifyEvent;
    function GetItem(Index: Integer): TdxStatusBarStateIndicatorItem;
    procedure SetItem(Index: Integer; Value: TdxStatusBarStateIndicatorItem);
  protected
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create;
    function Add: TdxStatusBarStateIndicatorItem;
    function Insert(Index: Integer): TdxStatusBarStateIndicatorItem;
    property Items[Index: Integer]: TdxStatusBarStateIndicatorItem read GetItem write SetItem; default;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TdxStatusBarStateIndicatorPanelStyle = class(TdxStatusBarPanelStyle)
  private
    FSpacing: Integer;
    FIndicators: TdxStatusBarStateIndicators;
    function GetIndicators: TdxStatusBarStateIndicators;
    procedure IndicatorChangeHandler(Sender: TObject);
    procedure SetIndicators(Value: TdxStatusBarStateIndicators);
    procedure SetSpacing(Value: Integer);
  protected
    function CanSizing: Boolean; override;
    procedure DoAssign(ASource: TPersistent); override;
    procedure DrawContent(ACanvas: TcxCanvas; R: TRect; APainter: TdxStatusBarPainterClass); override;
    function GetMinWidth: Integer; override;
  public
    constructor Create(AOwner: TdxStatusBarPanel); override;
    destructor Destroy; override;
    procedure RestoreDefaults; override;
  published
    property Color;
    property Indicators: TdxStatusBarStateIndicators read GetIndicators write SetIndicators;
    property Spacing: Integer read FSpacing write SetSpacing default 4;
  end;

  { TdxStatusBarKeyboardStatePanelStyle }

  TdxStatusBarKeyboardStateWatchedKey = class
  private
    FKeyCode: Integer;
    FKeyState: Integer;
    procedure SetKeyState(Value: Integer);
  public
    constructor Create(AKeyCode: Integer);
    function GetCurrentState: Integer;
    property KeyCode: Integer read FKeyCode;
    property KeyState: Integer read FKeyState write SetKeyState;
  end;

  TdxStatusBarKeyboardStateNotifier = class
  private
    FKeys: array of TdxStatusBarKeyboardStateWatchedKey;
    FStatusBar: TdxCustomStatusBar;
    FTimer: TTimer;
  protected
    procedure Execute(Sender: TObject);
  public
    constructor Create(AStatusBar: TdxCustomStatusBar);
    destructor Destroy; override;
    procedure SubScribeKey(AKeyCode: Integer);
    procedure UnSubScribeKey(AKeyCode: Integer);
  end;

  TdxStatusBarKeyboardState = (dxksCapsLock, dxksNumLock, dxksScrollLock, dxksInsert);
  TdxStatusBarKeyboardStates = set of TdxStatusBarKeyboardState;

  TdxStatusBarKeyStateAppearance = class(TPersistent)
  private
    FId: TdxStatusBarKeyboardState;
    FCode: Integer;
    FActiveFontColor: TColor;
    FInactiveFontColor: TColor;
    FActiveCaption: string;
    FInactiveCaption: string;
    FOnChange: TNotifyEvent;
    procedure SetActiveFontColor(Value: TColor);
    procedure SetInactiveFontColor(Value: TColor);
    procedure SetActiveCaption(const Value: string);
    procedure SetInactiveCaption(const Value: string);
  protected
    procedure Changed; virtual;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  public
    constructor Create(AId: TdxStatusBarKeyboardState; ACode: Integer;
      const AActiveCaption: string; AActiveFontColor: TColor;
      const AInactiveCaption: string; AInactiveFontColor: TColor;
      AChangeHandler: TNotifyEvent);
    procedure Assign(Source: TPersistent); override;
    function GetRectWidth(ACanvas: TcxCanvas): Integer;
    property Code: Integer read FCode;
    property Id: TdxStatusBarKeyboardState read FId;
  published
    property ActiveFontColor: TColor read FActiveFontColor write SetActiveFontColor default clWindowText;
    property InactiveFontColor: TColor read FInactiveFontColor write SetInactiveFontColor default clBtnShadow;
    property ActiveCaption: string read FActiveCaption write SetActiveCaption;
    property InactiveCaption: string read FInactiveCaption write SetInactiveCaption;
  end;

  TdxStatusBarKeyboardStatePanelStyle = class(TdxStatusBarPanelStyle)
  private
    FFullRect: Boolean;
    FKeyboardStates: TdxStatusBarKeyboardStates;
    FKeyInfos: array[0..3] of TdxStatusBarKeyStateAppearance;
    FNotifier: TdxStatusBarKeyboardStateNotifier;
    function GetCapsLockAppearance: TdxStatusBarKeyStateAppearance;
    function GetInsertAppearance: TdxStatusBarKeyStateAppearance;
    function GetNumLockAppearance: TdxStatusBarKeyStateAppearance;
    function GetScrollLockAppearance: TdxStatusBarKeyStateAppearance;
    procedure NamesChangeHandler(Sender: TObject);
    procedure SetCapsLockAppearance(Value: TdxStatusBarKeyStateAppearance);
    procedure SetFullRect(Value: Boolean);
    procedure SetInsertAppearance(Value: TdxStatusBarKeyStateAppearance);
    procedure SetKeyboardStates(Value: TdxStatusBarKeyboardStates);
    procedure SetNumLockAppearance(Value: TdxStatusBarKeyStateAppearance);
    procedure SetScrollLockAppearance(Value: TdxStatusBarKeyStateAppearance);
  protected
    function CanSizing: Boolean; override;
    procedure DoAssign(ASource: TPersistent); override;
    procedure DrawContent(ACanvas: TcxCanvas; R: TRect; APainter: TdxStatusBarPainterClass); override;
    function GetMinWidth: Integer; override;
    function InternalBevel: Boolean; override;
  public
    constructor Create(AOwner: TdxStatusBarPanel); override;
    destructor Destroy; override;
    procedure RestoreDefaults; override;
  published
    property Color;
    property Font;
    property KeyboardStates: TdxStatusBarKeyboardStates read FKeyboardStates write SetKeyboardStates
      default [dxksCapsLock, dxksNumLock, dxksScrollLock, dxksInsert];
    property FullRect: Boolean read FFullRect write SetFullRect default False;
    property CapsLockKeyAppearance: TdxStatusBarKeyStateAppearance read GetCapsLockAppearance write SetCapsLockAppearance;
    property NumLockKeyAppearance: TdxStatusBarKeyStateAppearance read GetNumLockAppearance write SetNumLockAppearance;
    property ScrollLockKeyAppearance: TdxStatusBarKeyStateAppearance read GetScrollLockAppearance write SetScrollLockAppearance;
    property InsertKeyAppearance: TdxStatusBarKeyStateAppearance read GetInsertAppearance write SetInsertAppearance;
    property ParentFont;
  end;

  { TdxStatusBarContainerPanelStyle }

  TdxStatusBarContainerPanelStyle = class;

  TdxStatusBarContainerControl = class(TcxControl)
  private
    FPanelStyle: TdxStatusBarContainerPanelStyle;
  protected
    procedure Paint; override;
    function MayFocus: Boolean; override;
    function NeedsScrollBars: Boolean; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TdxStatusBarContainerPanelStyle = class(TdxStatusBarPanelStyle)
  private
    FAlignControl: Boolean;
    FContainer: TdxStatusBarContainerControl;
    procedure SetContainer(Value: TdxStatusBarContainerControl);
  protected
    function CanDelete: Boolean; override;
    procedure DoAssign(ASource: TPersistent); override;
    procedure DrawContent(ACanvas: TcxCanvas; R: TRect; APainter: TdxStatusBarPainterClass); override;
    procedure PanelVisibleChanged; override;
  public
    constructor Create(AOwner: TdxStatusBarPanel); override;
    destructor Destroy; override;
    procedure RestoreDefaults; override;
  published
    property AlignControl: Boolean read FAlignControl write FAlignControl default True;
    property Container: TdxStatusBarContainerControl read FContainer write SetContainer;
  end;

  { TdxStatusBarPanel }

  TdxStatusBarPanelBevel = (dxpbNone, dxpbLowered, dxpbRaised);
  TdxStatusBarDrawPanelEvent = procedure(Sender: TdxStatusBarPanel; ACanvas: TcxCanvas;
    const ARect: TRect; var ADone: Boolean) of object;

  TdxStatusBarPanel = class(TCollectionItem)
  private
    FBevel: TdxStatusBarPanelBevel;
    FBiDiMode: TBiDiMode;
    FFixed: Boolean;
    FIsMinWidthAssigned: Boolean;
    FIsWidthAssigned: Boolean;
    FMinWidth: Integer;
    FPanelStyle: TdxStatusBarPanelStyle;
    FPanelStyleClass: TdxStatusBarPanelStyleClass;
    FPanelStyleEvents: TNotifyEvent;
    FParentBiDiMode: Boolean;
    FText: string;
    FVisible: Boolean;
    FWidth: Integer;
    FOnClick: TNotifyEvent;
    FOnDblClick: TNotifyEvent;
    FOnDrawPanel: TdxStatusBarDrawPanelEvent;

    function GetFixed: Boolean;
    function GetLookAndFeel: TcxLookAndFeel;
    function GetMinWidth: Integer;
    function GetPanelStyleClassName: string;
    function GetStatusBarControl: TdxCustomStatusBar;
    function GetWidth: Integer;
    function IsBiDiModeStored: Boolean;
    function IsMinWidthStored: Boolean;
    function IsWidthStored: Boolean;
    procedure SetBevel(Value: TdxStatusBarPanelBevel);
    procedure SetBiDiMode(Value: TBiDiMode);
    procedure SetFixed(Value: Boolean);
    procedure SetMinWidth(Value: Integer);
    procedure SetPanelStyle(Value: TdxStatusBarPanelStyle);
    procedure SetPanelStyleClass(const Value: TdxStatusBarPanelStyleClass);
    procedure SetPanelStyleClassName(Value: string);
    procedure SetParentBiDiMode(Value: Boolean);
    procedure SetText(const Value: string);
    procedure SetVisible(Value: Boolean);
    procedure SetWidth(Value: Integer);
  protected
    procedure Click; virtual;
    procedure CreatePanelStyle; virtual;
    procedure DblClick; virtual;
    function DefaultMinWidth: Integer; virtual;
    function DefaultWidth: Integer; virtual;
    procedure DestroyPanelStyle; virtual;
    function GetDisplayName: string; override;
    procedure Loaded;
    function PaintMinWidth: Integer; virtual;
    function PaintWidth: Integer; virtual;
    procedure PreparePaintWidth(var AWidth: Integer); virtual;
    procedure StatusBarPanelStyleChanged; virtual;
    property LookAndFeel: TcxLookAndFeel read GetLookAndFeel;