cxbuttons.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,149 行 · 第 1/5 页

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressEditors                                               }
{                                                                    }
{       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 EXPRESSEDITORS 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 cxButtons;

{$I cxVer.inc}

interface

uses
  Windows, Messages, dxThemeManager,
  Types, Classes, Controls, Graphics, StdCtrls, Forms, Menus, ImgList,
  cxGraphics, cxLookAndFeels, cxLookAndFeelPainters, Buttons, cxControls,
  cxContainer, cxClasses;

const
  CM_DROPDOWNPOPUPMENU = WM_DX + 1;
  CM_CLOSEUPPOPUPMENU = WM_DX + 2;
  cxDropDownButtonWidth = 15;

type
  TcxCustomButton = class;
  TcxButtonKind = (cxbkStandard, cxbkDropDown, cxbkDropDownButton);
  TcxButtonAssignedColor = (cxbcDefault, cxbcDefaultText, cxbcDisabled, cxbcDisabledText,
    cxbcHot, cxbcHotText, cxbcNormal, cxbcNormalText, cxbcPressed, cxbcPressedText);
  TcxButtonAssignedColors = set of TcxButtonAssignedColor;
  TcxButtonGetDrawParamsEvent = procedure(Sender: TcxCustomButton;
    AState: TcxButtonState; var AColor: TColor; AFont: TFont) of object;

  { TcxButtonColors }

  TcxButtonColors = class(TPersistent)
  private
    FButton: TcxCustomButton;
    FAssignedColors: TcxButtonAssignedColors;
    FColors: array[TcxButtonAssignedColor] of TColor;
    function GetColor(const Index: Integer): TColor;
    function IsColorStored(const Index: Integer): Boolean;
    procedure SetAssignedColors(Value: TcxButtonAssignedColors);
    procedure SetColor(const Index: Integer; const Value: TColor);
    function TcxButtonState2TcxButtonAssignedColor(AState: TcxButtonState; ATextColor: Boolean): TcxButtonAssignedColor;
  protected
    function GetColorByState(const AState: TcxButtonState): TColor;
    function GetTextColorByState(const AState: TcxButtonState): TColor;
  public
    constructor Create(AOwner: TcxCustomButton);
    procedure Assign(Source: TPersistent); override;
  published
    property AssignedColors: TcxButtonAssignedColors read FAssignedColors write SetAssignedColors stored False;
    property Default: TColor index Ord(cxbcDefault) read GetColor write SetColor stored IsColorStored;
    property DefaultText: TColor index Ord(cxbcDefaultText) read GetColor write SetColor stored IsColorStored;
    property Normal: TColor index Ord(cxbcNormal) read GetColor write SetColor stored IsColorStored;
    property NormalText: TColor index Ord(cxbcNormalText) read GetColor write SetColor stored IsColorStored;
    property Hot: TColor index Ord(cxbcHot) read GetColor write SetColor stored IsColorStored;
    property HotText: TColor index Ord(cxbcHotText) read GetColor write SetColor stored IsColorStored;
    property Pressed: TColor index Ord(cxbcPressed) read GetColor write SetColor stored IsColorStored;
    property PressedText: TColor index Ord(cxbcPressedText) read GetColor write SetColor stored IsColorStored;
    property Disabled: TColor index Ord(cxbcDisabled) read GetColor write SetColor stored IsColorStored;
    property DisabledText: TColor index Ord(cxbcDisabledText) read GetColor write SetColor stored IsColorStored;
  end;

  { TcxGlyphList }

  TcxGlyphList = class(TcxImageList)
  private
    FUsed: TBits;
    FCount: Integer;
    function AllocateIndex(ABitmap: TBitmap): Integer;
  public
    constructor CreateSize(AWidth, AHeight: Integer);
    destructor Destroy; override;
    function Add(AImage, AMask: TBitmap): Integer; reintroduce;
    function AddMasked(AImage: TBitmap; AMaskColor: TColor): Integer; reintroduce;
    procedure Delete(AIndex: Integer);
    property Count: Integer read FCount;
  end;

  TcxImageInfo = class
  private
    FGlyph: TBitmap;
    FImages: TCustomImageList;
    FImageIndex: Integer;
    function GetOnChange: TNotifyEvent;
    procedure SetGlyph(Value: TBitmap);
    procedure SetImages(Value: TCustomImageList);
    procedure SetImageIndex(Value: Integer);
    procedure SetOnChange(Value: TNotifyEvent);
  protected
    function GetImageSize: TSize;
    function IsImageAssigned: Boolean;
    procedure GlyphChanged;
    property Glyph: TBitmap read FGlyph write SetGlyph;
    property Images: TCustomImageList read FImages write SetImages;
    property ImageIndex: Integer read FImageIndex write SetImageIndex;
  public
    constructor Create;
    destructor Destroy; override;
    property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
  end;

  { TcxButtonGlyph }

  TcxButtonGlyph = class
  private
    FGlyphList: TcxGlyphList;
    FIndexs: array[TButtonState] of Integer;
    FNumGlyphs: TNumGlyphs;
    FOnChange: TNotifyEvent;

    FImageInfo: TcxImageInfo;

    function GetGlyph: TBitmap;
    function GetImageList: TCustomImageList;
    function GetImageIndex: Integer;
    procedure SetGlyph(Value: TBitmap);
    procedure SetImageList(Value: TCustomImageList);
    procedure SetImageIndex(Value: Integer);

    function GetImageSize: TSize;
    function GetTransparentColor: TColor;
    procedure GlyphChanged(Sender: TObject);
    procedure SetNumGlyphs(Value: TNumGlyphs);
    procedure Invalidate;
    function CreateButtonGlyph(AState: TcxButtonState): Integer; virtual;
    procedure DrawButtonGlyph(ACanvas: TCanvas; const AGlyphPos: TPoint;
      AState: TcxButtonState);
    procedure DrawButtonText(ACanvas: TCanvas; const ACaption: TCaption;
      ATextBounds: TRect; AState: TcxButtonState; ABiDiFlags: LongInt;
      ANativeStyle: Boolean{$IFDEF DELPHI7}; AWordWrap: Boolean{$ENDIF});
    procedure CalcButtonLayout(ACanvas: TCanvas; const AClient: TRect;
      const AOffset: TPoint; const ACaption: TCaption; ALayout: TButtonLayout;
      AMargin, ASpacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
      ABiDiFlags: LongInt{$IFDEF DELPHI7}; AWordWrap: Boolean{$ENDIF});
  protected
    function CanWordWrapText{$IFDEF DELPHI7}(AWordWrap: Boolean){$ENDIF}: Boolean;
    function GetTextOffsets(ALayout: TButtonLayout): TRect; virtual;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Draw(ACanvas: TCanvas; const AClient: TRect; const AOffset: TPoint;
      const ACaption: TCaption; ALayout: TButtonLayout; AMargin, ASpacing: Integer;
      AState: TcxButtonState ; ABiDiFlags: LongInt;
      ANativeStyle: Boolean{$IFDEF DELPHI7}; AWordWrap: Boolean{$ENDIF});

    property ImageInfo: TcxImageInfo read FImageInfo;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property ImageList: TCustomImageList read GetImageList write SetImageList;
    property ImageIndex: Integer read GetImageIndex write SetImageIndex;

    property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs;
    property TransparentColor: TColor read GetTransparentColor;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TcxButtonGlyphClass = class of TcxButtonGlyph;

  { TcxButtonActionLink }

  TcxButtonActionLink = class(TButtonActionLink)
  private
    function GetClient: TcxCustomButton;
    property Client: TcxCustomButton read GetClient;
  protected
    procedure SetImageIndex(Value: Integer); override;
  public
    destructor Destroy; override;
  end;

  { TcxCustomButton }

  TcxButtonDropDownMenuPopupEvent = procedure(Sender: TObject;
    var APopupMenu: TPopupMenu; var AHandled: Boolean) of object;

  TcxButton = class;

  TcxCustomButton = class(TButton,
    IdxSkinSupport,
    IcxMouseTrackingCaller,
    IcxLookAndFeelContainer)
  private
    FAutoSize: Boolean;
    FIsPressed, FIsDefault: Boolean;
    FCanvas: TcxCanvas;
    FColors: TcxButtonColors;
    FControlCanvas: TControlCanvas;
    FLockDown: Boolean;
    FDoPopup: Boolean;
    FDropDownMenu: TPopupMenu;
    FIsFocused: Boolean;
    FIsMouseClick: Boolean;
    FKind: TcxButtonKind;
    FLookAndFeel: TcxLookAndFeel;
    FPopupAlignment: TPopupAlignment;
    FPopupMenu: TComponent;
    FUseSystemPaint: Boolean; // deprecated

    // speed button support
    FAllowAllUp: Boolean;
    FCanBeFocused: Boolean;
    FDown: Boolean;
    FGroupIndex: Integer;

    // glyph support
    FGlyph: TcxButtonGlyph;
    FLayout: TButtonLayout;
    FMargin: Integer;
    FMenuVisible: Boolean;
    FMouseInControl: Boolean;
    FSpacing: Integer;

    // events
    FOnDropDownMenuPopup: TcxButtonDropDownMenuPopupEvent;
    FOnGetDrawParams: TcxButtonGetDrawParamsEvent;

    procedure InitializeCanvasColors(out AState: TcxButtonState; out AColor: TColor);
    // glyph support
    procedure SetGlyph(Value: TBitmap);
    function GetGlyph: TBitmap;
    function GetNumGlyphs: TNumGlyphs;
    procedure SetNumGlyphs(Value: TNumGlyphs);
    procedure GlyphChanged(Sender: TObject);
    procedure SetLayout(Value: TButtonLayout);
    procedure SetSpacing(Value: Integer);
    procedure SetMargin(Value: Integer);
    procedure DrawItem(const DrawItemStruct: TDrawItemStruct);
    procedure UpdateImageInfo;

    procedure WMCaptureChanged(var Message: TMessage); message WM_CAPTURECHANGED;
    procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure CMCloseupPopupMenu(var Message: TMessage); message CM_CLOSEUPPOPUPMENU;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMDropDownPopupMenu(var Message: TMessage); message CM_DROPDOWNPOPUPMENU;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
    procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
    procedure CNSysKeyDown(var Message: TWMSysKeyDown); message CN_SYSKEYDOWN;
    procedure CMButtonPressed(var Message: TMessage); message CM_BUTTONPRESSED;

    procedure ExcludeDropDownButtonRect(var R: TRect);
    procedure DoDropDownMenu;
    function GetBorderRect(AState: TcxButtonState): TRect;
    function GetContentRect: TRect;
    function GetDropDownMenuAlignment(APopupPoint: TPoint;
      AEstimatedAlignment: TPopupAlignment): TPopupAlignment;
    function GetDropDownMenuPopupPoint(ADropDownMenu: TPopupMenu): TPoint;
    procedure InternalPaint;
    procedure InternalRecreateWindow;
    function IsColorsStored: Boolean;
    function IsHotTrack: Boolean;
    procedure LookAndFeelChanged(Sender: TcxLookAndFeel;
      AChangedValues: TcxLookAndFeelValues);
    procedure SetButtonAutoSize(Value: Boolean);
    procedure SetColors(const Value: TcxButtonColors);
    procedure SetKind(const Value: TcxButtonKind);
    procedure SetLookAndFeel(Value: TcxLookAndFeel);
    procedure SetPopupMenu(Value: TComponent);

    // speed button support
    procedure CheckShowMenu(const P: TPoint);
    function GetButtonState: TcxButtonState;
    function GetMenuButtonBounds: TRect;
    function GetSpeedButtonMode: Boolean;
    procedure SetAllowAllUp(AValue: Boolean);
    procedure SetCanBeFocused(AValue: Boolean);
    procedure SetDown(AValue: Boolean);
    procedure SetGroupIndex(AValue: Integer);
    procedure UpdateGroup;
  protected
    procedure WndProc(var Message: TMessage); override;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    function CanResize(var NewWidth, NewHeight: Integer): Boolean; override;
    function GetActionLinkClass: TControlActionLinkClass; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); 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 Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure CreateHandle; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DestroyWindowHandle; override;
    function GetPalette: HPALETTE; override;
    procedure SetButtonStyle(ADefault: Boolean); override;
    procedure DoContextPopup(MousePos: TPoint;
      var Handled: Boolean); override;
    function DoOnDropDownMenuPopup(var APopupMenu: TPopupMenu): Boolean; virtual;
    function DoShowPopupMenu(APopupMenu: TComponent;
      X, Y: Integer): Boolean; virtual;
    function GetGlyphClass: TcxButtonGlyphClass; virtual;
    function GetPainterClass: TcxCustomLookAndFeelPainterClass; virtual;
    function StandardButton: Boolean; virtual;
    procedure UpdateSize;

    //IcxMouseTrackingCaller
    procedure IcxMouseTrackingCaller.MouseLeave = ButtonMouseLeave;
    procedure ButtonMouseLeave;

    // IcxLookAndFeelContainer
    function GetLookAndFeel: TcxLookAndFeel;

    property AutoSize: Boolean read FAutoSize write SetButtonAutoSize default False;
    property Colors: TcxButtonColors read FColors write SetColors stored IsColorsStored;
    property DropDownMenu: TPopupMenu read FDropDownMenu write FDropDownMenu;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property Kind: TcxButtonKind read FKind write SetKind default cxbkStandard;
    property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
    property Margin: Integer read FMargin write SetMargin default -1;
    property NumGlyphs: TNumGlyphs read GetNumGlyphs write SetNumGlyphs default 1;
    property PopupAlignment: TPopupAlignment read FPopupAlignment
      write FPopupAlignment default paLeft;
    property Spacing: Integer read FSpacing write SetSpacing default 4;
    property UseSystemPaint: Boolean read FUseSystemPaint
      write FUseSystemPaint default False; // deprecated
    property OnDropDownMenuPopup: TcxButtonDropDownMenuPopupEvent
      read FOnDropDownMenuPopup write FOnDropDownMenuPopup;
    property OnGetDrawParams: TcxButtonGetDrawParamsEvent
      read FOnGetDrawParams write FOnGetDrawParams;

    // speed button support
    property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
    property CanBeFocused: Boolean read FCanBeFocused write SetCanBeFocused default True;
    property Down: Boolean read FDown write SetDown default False;
    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
    property SpeedButtonMode: Boolean read GetSpeedButtonMode;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Click; override;
    function CanFocus: Boolean; override;
    function GetOptimalSize: TSize; virtual;
    function UpdateAction(Action: TBasicAction): Boolean; override;
    property LookAndFeel: TcxLookAndFeel read FLookAndFeel write SetLookAndFeel;
  published
    property PopupMenu: TComponent read FPopupMenu write SetPopupMenu;
  end;

  { TcxButton }

  TcxButton = class(TcxCustomButton)
  published
//    property AutoSize;
    property CanBeFocused;
    property GroupIndex;
    property Down; 
    property AllowAllUp;
    property Action;
    property Anchors;
    property BiDiMode;
    property Cancel;
    property Caption;
    property Colors;
    property Constraints;
    property Default;
    property DropDownMenu;
    property Enabled;
    property Glyph;
    property Kind;
    property Layout;
    property LookAndFeel;
    property Margin;
    property ModalResult;
    property NumGlyphs;
    property ParentBiDiMode;
    property ParentShowHint;
    property PopupAlignment;
    property ShowHint;
    property Spacing;
    property TabOrder;
    property TabStop;
    property UseSystemPaint; // deprecated
    property Visible;
    property OnDropDownMenuPopup;
    property OnEnter;
    property OnExit;
    property OnGetDrawParams;
  end;

function GetButtonPainterClass(ALookAndFeel: TcxLookAndFeel): TcxCustomLookAndFeelPainterClass;

implementation

uses
  dxUxTheme, CommCtrl, dxThemeConsts,
  cxGeometry, SysUtils, Consts, Dialogs, ActnList, Math;

const
  cxBtnStdVertTextOffsetCorrection = -1;
  TextRectCorrection: TRect = (Left: 1; Top: 0; Right: 2; Bottom: 0);

function GetButtonPainterClass(ALookAndFeel: TcxLookAndFeel): TcxCustomLookAndFeelPainterClass;