tntjvspeedbutton.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvSpeedButton.pas, released on 2003-10-19.

The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 2001,2002 SGB Software
All Rights Reserved.

Contributor(s):
  Polaris Software
  Peter Thornqvist [peter3 at sourceforge dot net]
  Dejoy Den

Changes:
2003-10-19:
  * Moved TJvSpeedButton from JvxCtrls to this unit
2005-05-20:(dejoy)
  * TJvSpeedButton implemented interface of IJvHotTrack.
2005-06-04:(dejoy)
  * fixed bug: memory leak in TJvCustomSpeedButton.Paint;

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvSpeedButton.pas,v 1.51 2005/10/28 08:37:23 marquardt Exp $

unit TntJvSpeedButton;

{$I jvcl.inc}
{$I TntCompilers.inc}
{$D-}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils, Classes,
  {$IFDEF VCL}
  CommCtrl,
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  Qt,
  {$ENDIF VisualCLX}
  Windows, Messages,
  Controls, Graphics, Forms, ExtCtrls, Buttons, Menus, ImgList, ActnList,
  JvExControls, JvComponent, JvConsts, JvTypes, JvJCLUtils, JvJVCLUtils, JvSpeedButton,
  JvThemes, TntClasses, TntControls, TntClasses2, TntJvExControls;

type
  (***
  TJvNumGlyphs = 1..5;
  TJvDropDownMenuPos = (dmpBottom, dmpRight);
  TJvButtonState = (rbsUp, rbsDisabled, rbsDown, rbsExclusive, rbsInactive);

  {$IFDEF VisualCLX}
  TButtonStyle = JvQThemes.TButtonStyle;
  {$ENDIF VisualCLX}

  {Inserted by (ag) 2004-09-04}
  TJvSpeedButtonHotTrackOptions = TJvHotTrackOptions;
  {Insert End}
  **)

  TTntJvxButtonGlyph = class;

  TTntJvCustomSpeedButton0 = class(TTntJvExGraphicControl, IJvHotTrack)
  private
    FAllowAllUp: Boolean;
    FAllowTimer: Boolean;
    FDown: Boolean;
    FDragging: Boolean;
    FDropDownMenu: TPopupMenu;
    FFlat: Boolean;
    FFontSave: TFont;
    FGlyph: TTntJvxButtonGlyph;
    FGroupIndex: Integer;
    FHotTrack: Boolean;
    FHotTrackFont: TFont;
    FHotTrackFontOptions: TJvTrackFontOptions;
    FHotTrackOptions: TJvHotTrackOptions;
    FInactiveGrayed: Boolean;
    FInitRepeatPause: Word;
    FLayout: TButtonLayout;
    FMargin: Integer;
    FMarkDropDown: Boolean;
    FMenuPosition: TJvDropDownMenuPos;
    FMenuTracking: Boolean;
    FModalResult: TModalResult;
    FRepeatPause: Word;
    FRepeatTimer: TTimer;
    FSpacing: Integer;
    FStyle: TButtonStyle;
    FTransparent: Boolean;
    FDoubleBuffered: Boolean;
    function GetAlignment: TAlignment;
    function GetGrayNewStyle: Boolean;
    function GetWordWrap: Boolean;
    procedure SetAlignment(Value: TAlignment);
    procedure SetAllowAllUp(Value: Boolean);
    procedure SetAllowTimer(Value: Boolean);
    procedure SetDown(Value: Boolean);
    procedure SetDropdownMenu(Value: TPopupMenu);
    procedure SetFlat(Value: Boolean);
    procedure SetGrayNewStyle(const Value: Boolean);
    procedure SetGroupIndex(Value: Integer);
    procedure SetInactiveGrayed(Value: Boolean);
    procedure SetLayout(Value: TButtonLayout);
    procedure SetMargin(Value: Integer);
    procedure SetMarkDropDown(Value: Boolean);
    procedure SetSpacing(Value: Integer);
    procedure SetStyle(Value: TButtonStyle);
    procedure SetTransparent(Value: Boolean);
    procedure SetWordWrap(Value: Boolean);

    {IJvHotTrack}   //added by dejoy 2005-04-20
    function GetHotTrack:Boolean;
    function GetHotTrackFont:TFont;
    function GetHotTrackFontOptions:TJvTrackFontOptions;
    function GetHotTrackOptions:TJvHotTrackOptions;
    procedure SetHotTrack(Value: Boolean);
    procedure SetHotTrackFont(Value: TFont);
    procedure SetHotTrackFontOptions(Value: TJvTrackFontOptions);
    procedure SetHotTrackOptions(Value: TJvHotTrackOptions);

    function CheckMenuDropDown(const Pos: TSmallPoint; Manual: Boolean): Boolean;
    procedure DoMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure TimerExpired(Sender: TObject);
    procedure UpdateExclusive;
    procedure CMButtonPressed(var Msg: TCMButtonPressed); message CM_JVBUTTONPRESSED;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    {$IFDEF VCL}
    procedure CMSysColorChange(var Msg: TMessage); message CM_SYSCOLORCHANGE;
    procedure WMLButtonDblClk(var Msg: TWMLButtonDown); message WM_LBUTTONDBLCLK;
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure WMRButtonDown(var Msg: TWMRButtonDown); message WM_RBUTTONDOWN;
    procedure WMRButtonUp(var Msg: TWMRButtonUp); message WM_RBUTTONUP;
    {$ENDIF VCL}
  protected
    FState: TJvButtonState;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    function WantKey(Key: Integer; Shift: TShiftState;
      const KeyText: WideString): Boolean; override;
    procedure EnabledChanged; override;
    procedure FontChanged; override;
    procedure TextChanged; override;
    procedure VisibleChanged; override;
    {$IFDEF VisualCLX}
    procedure DblClick; override;
    {$ENDIF VisualCLX}
    function GetDropDownMenuPos: TPoint;
    procedure Loaded; override;
    procedure Paint; override;
    procedure MouseEnter(Control: TControl); override;
    procedure MouseLeave(Control: TControl); 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 PaintImage(Canvas: TCanvas; ARect: TRect; const Offset: TPoint;
      AState: TJvButtonState; DrawMark: Boolean); virtual; abstract;
    property ButtonGlyph: TTntJvxButtonGlyph read FGlyph;
    property IsDragging: Boolean read FDragging;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ButtonClick;
    function CheckBtnMenuDropDown: Boolean;
    procedure Click; override;
    procedure UpdateTracking;
  protected
    property Alignment: TAlignment read GetAlignment write SetAlignment default taCenter;
    property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
    property AllowTimer: Boolean read FAllowTimer write SetAllowTimer default False;
    property DoubleBuffered: Boolean read FDoubleBuffered write FDoubleBuffered default True;
    property Down: Boolean read FDown write SetDown default False;
    property DropDownMenu: TPopupMenu read FDropDownMenu write SetDropdownMenu;
    property Flat: Boolean read FFlat write SetFlat default False;
    { If True, Image is grayed when not mouse is in control (Only for flat buttons) }
    property GrayedInactive: Boolean read FInactiveGrayed write SetInactiveGrayed default True;
    { If True, Image is grayed (when enables=False) like the imagelist does, otherwise like the speedbutton does }
    property GrayNewStyle: Boolean read GetGrayNewStyle write SetGrayNewStyle default True;
    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
    property HotTrack: Boolean read GetHotTrack write SetHotTrack default False;
    property HotTrackFont: TFont read GetHotTrackFont write SetHotTrackFont;
    property HotTrackFontOptions: TJvTrackFontOptions read GetHotTrackFontOptions write SetHotTrackFontOptions default
      DefaultTrackFontOptions;
    property HotTrackOptions: TJvHotTrackOptions read GetHotTrackOptions write SetHotTrackOptions;
    property InitPause: Word read FInitRepeatPause write FInitRepeatPause default 500;
    { (rb) Weird default }
    property Layout: TButtonLayout read FLayout write SetLayout default blGlyphTop;
    property Margin: Integer read FMargin write SetMargin default -1;
    property MarkDropDown: Boolean read FMarkDropDown write SetMarkDropDown default True;
    property MenuPosition: TJvDropDownMenuPos read FMenuPosition write FMenuPosition default dmpBottom;
    property ModalResult: TModalResult read FModalResult write FModalResult default 0;
    property RepeatInterval: Word read FRepeatPause write FRepeatPause default 100;
    { (rb) Weird default }
    property Spacing: Integer read FSpacing write SetSpacing default 1;
    property Style: TButtonStyle read FStyle write SetStyle default bsAutoDetect;
    property Transparent: Boolean read FTransparent write SetTransparent default False;
    property WordWrap: Boolean read GetWordWrap write SetWordWrap default False;
    property ParentColor default False;
    property Color default clBtnFace;

    property OnMouseEnter;
    property OnMouseLeave;
  end;

  TTntJvCustomSpeedButton = class(TTntJvCustomSpeedButton0)
  private
    FCaptionEditor: TUnicodeLinesEditor;
    function GetCaptionEditor: TUnicodeLinesEditor;
    procedure SetCaptionEditor(const Value: TUnicodeLinesEditor);
  protected
    property CaptionEditor: TUnicodeLinesEditor read GetCaptionEditor write SetCaptionEditor stored False;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TTntJvImageSpeedButton = class;
  TTntJvSpeedButton = class;

  TTntJvImageSpeedButtonActionLink = class(TControlActionLink)
  protected
    FClient: TTntJvImageSpeedButton;
    procedure AssignClient(AClient: TObject); override;
    function IsCheckedLinked: Boolean; override;
    {$IFDEF COMPILER6_UP}
    {$IFDEF VCL}
    function IsGroupIndexLinked: Boolean; override;
    procedure SetGroupIndex(Value: Integer); override;
    {$ENDIF VCL}
    {$ENDIF COMPILER6_UP}
    function IsImageIndexLinked: Boolean; override;
    procedure SetChecked(Value: Boolean); override;
    procedure SetImageIndex(Value: Integer); override;
  end;

  TTntJvSpeedButtonActionLink = class(TControlActionLink)
  protected
    FClient: TTntJvSpeedButton;
    procedure AssignClient(AClient: TObject); override;
    function IsCheckedLinked: Boolean; override;
    {$IFDEF COMPILER6_UP}
    {$IFDEF VCL}
    function IsGroupIndexLinked: Boolean; override;
    procedure SetGroupIndex(Value: Integer); override;
    {$ENDIF VCL}
    {$ENDIF COMPILER6_UP}
    procedure SetChecked(Value: Boolean); override;
  end;

  TTntJvImageSpeedButton = class(TTntJvCustomSpeedButton)
  private
    FImageChangeLink: TChangeLink;
    FImageIndex: TImageIndex;
    FImages: TCustomImageList;
    FHotTrackImageIndex: TImageIndex;
    procedure ImageListChange(Sender: TObject);
    procedure SetImageIndex(const Value: TImageIndex);
    procedure SetImages(const Value: TCustomImageList);
    procedure SetHotTrackImageIndex(const Value: TImageIndex);
  protected
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    function GetActionLinkClass: TControlActionLinkClass; override;
    procedure InvalidateImage;
    procedure PaintImage(Canvas: TCanvas; ARect: TRect; const Offset: TPoint;
      AState: TJvButtonState; DrawMark: Boolean); override;
    function IsImageVisible: Boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Action;
    property Align;
    property Alignment;
    property AllowAllUp;
    property AllowTimer;
    property Anchors;
    {$IFDEF VCL}
    property BiDiMode;
    property DragCursor;
    property DragKind;
    property ParentBiDiMode;
    {$ENDIF VCL}
    property Caption;
    property CaptionEditor;
    property Constraints;
    property Color;
    property ParentColor;
    { Ensure group index is declared before Down }
    property GroupIndex;
    property DoubleBuffered;
    property Down;
    property DragMode;
    property DropDownMenu;
    property Enabled;
    property Flat;
    property Font;
    property GrayedInactive;
    property GrayNewStyle;
    property HintColor;
    property HotTrack;
    property HotTrackFont;
    property HotTrackFontOptions;
    property HotTrackImageIndex: TImageIndex read FHotTrackImageIndex write SetHotTrackImageIndex;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
    property Images: TCustomImageList read FImages write SetImages;
    property InitPause;
    property Layout;
    property Margin;
    property MarkDropDown;
    property MenuPosition;
    property ModalResult;
    property ParentFont;
    property ParentShowHint default False;
    property RepeatInterval;
    property ShowHint default True;
    property Spacing;
    property Style;
    property Transparent;
    property Visible;
    property WordWrap;

    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    {$IFDEF VCL}
    property OnEndDock;
    property OnStartDock;
    {$ENDIF VCL}
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnParentColorChange;
    property OnStartDrag;
  end;

  TTntJvSpeedButton = class(TTntJvCustomSpeedButton)
  private
    FHotTrackGlyph: TTntJvxButtonGlyph;
    function GetGlyph: TBitmap;
    function GetHotTrackGlyph: TBitmap;
    function GetNumGlyphs: TJvNumGlyphs;
    procedure GlyphChanged(Sender: TObject);
    procedure HotTrackGlyphChanged(Sender: TObject);
    procedure SetGlyph(Value: TBitmap);
    procedure SetHotTrackGlyph(const Value: TBitmap);
    procedure SetNumGlyphs(Value: TJvNumGlyphs);
  protected
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;

    function GetActionLinkClass: TControlActionLinkClass; override;
    {$IFDEF VCL}
    function GetPalette: HPALETTE; override;
    {$ENDIF VCL}
    procedure PaintImage(Canvas: TCanvas; ARect: TRect; const Offset: TPoint;
      AState: TJvButtonState; DrawMark: Boolean); override;
    procedure SyncHotGlyph;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Action;
    property Align;
    property Alignment;
    property AllowAllUp;
    property AllowTimer;
    property Anchors;
    {$IFDEF VCL}
    property BiDiMode;
    property DragCursor;
    property DragKind;
    property ParentBiDiMode;
    {$ENDIF VCL}
    property Caption;
    property CaptionEditor;
    property Constraints;
    property Color;
    property ParentColor;
    { Ensure group index is declared before Down }
    property GroupIndex;
    property DoubleBuffered;
    property Down;
    property DragMode;
    property DropDownMenu;
    property Enabled;
    property Flat;
    property Font;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property GrayedInactive;
    property GrayNewStyle;
    property HintColor;
    property HotTrack;
    property HotTrackFont;
    property HotTrackFontOptions;
    {Inserted by (ag) 2004-09-04}
    property HotTrackOptions;
    {Insert End}
    property HotTrackGlyph: TBitmap read GetHotTrackGlyph write SetHotTrackGlyph;
    property InitPause;
    property Layout;
    property Margin;
    property MarkDropDown;
    property MenuPosition;
    property ModalResult;
    property NumGlyphs: TJvNumGlyphs read GetNumGlyphs write SetNumGlyphs default 1;
    property ParentFont;
    property ParentShowHint default False;
    property RepeatInterval;
    property ShowHint default True;
    property Spacing;
    property Style;
    property Transparent;
    property Visible;
    property WordWrap;

    property OnMouseEnter;
    property OnMouseLeave;
    property OnParentColorChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    {$IFDEF VCL}
    property OnEndDock;
    property OnStartDock;
    {$ENDIF VCL}
  end;

  TTntJvButtonImage = class(TObject)