tb97ctls.pas

企业智能(ERP)管理系统

unit TB97Ctls;

{
  Toolbar97
  Copyright (C) 1998 by Jordan Russell

  TToolbarButton97 & TEdit97
}

interface

{$I TB97Ver.inc}

uses
  Windows, Messages, Classes, Controls, Forms, Menus, Graphics, Buttons,
  {$IFDEF TB97D4} ImgList, ActnList, {$ENDIF} StdCtrls, ExtCtrls;

type
  { TToolbarButton97 }

  TButtonDisplayMode = (dmBoth, dmGlyphOnly, dmTextOnly);
  TButtonState97 = (bsUp, bsDisabled, bsDown, bsExclusive, bsMouseIn);
  TNumGlyphs97 = 1..5;
  TButtonDropdownEvent = procedure(Sender: TObject;
    var ShowMenu, RemoveClicks: Boolean) of object;

  TToolbarButton97 = class(TGraphicControl)
  private
    FAllowAllUp: Boolean;
    FAlignment: TAlignment;
    FCancel: Boolean;
    FDefault: Boolean;
    FDisplayMode: TButtonDisplayMode;
    FDown: Boolean;
    FDropdownAlways: Boolean;
    FDropdownArrow: Boolean;
    FDropdownCombo: Boolean;
    FDropdownMenu: TPopupMenu;
    FFlat: Boolean;
    FGlyph: Pointer;
    FGroupIndex: Integer;
    FHelpContext: THelpContext;
    FLayout: TButtonLayout;
    FMargin: Integer;
    FModalResult: TModalResult;
    FNoBorder: Boolean;
    FOldDisabledStyle: Boolean;
    FOpaque: Boolean;
    FRepeating: Boolean;
    FRepeatDelay, FRepeatInterval: Integer;
    FShowBorderWhenInactive: Boolean;
    FSpacing: Integer;
    FWordWrap: Boolean;
    FOnDropdown: TButtonDropdownEvent;
    FOnMouseEnter, FOnMouseExit: TNotifyEvent;
    { Internal }
    FInClick: Boolean;
    FMouseInControl: Boolean;
    FMouseIsDown: Boolean;
    FMenuIsDown: Boolean;
    FUsesDropdown: Boolean;
    FRepeatTimer: TTimer;
    procedure GlyphChanged(Sender: TObject);
    procedure UpdateExclusive;
    procedure SetAlignment (Value: TAlignment);
    procedure SetAllowAllUp (Value: Boolean);
    function GetCallDormant: Boolean;
    procedure SetCallDormant (Value: Boolean);
    procedure SetDown (Value: Boolean);
    procedure SetDisplayMode (Value: TButtonDisplayMode);
    procedure SetDropdownAlways (Value: Boolean);
    procedure SetDropdownArrow (Value: Boolean);
    procedure SetDropdownCombo (Value: Boolean);
    procedure SetDropdownMenu (Value: TPopupMenu);
    procedure SetFlat (Value: Boolean);
    function GetGlyph: TBitmap;
    procedure SetGlyph (Value: TBitmap);
    function GetGlyphMask: TBitmap;
    procedure SetGlyphMask (Value: TBitmap);
    procedure SetGroupIndex (Value: Integer);
    function GetImageIndex: Integer;
    procedure SetImageIndex (Value: Integer);
    function GetImages: TCustomImageList;
    procedure SetImages (Value: TCustomImageList);
    procedure SetLayout (Value: TButtonLayout);
    procedure SetMargin (Value: Integer);
    procedure SetNoBorder (Value: Boolean);
    function GetNumGlyphs: TNumGlyphs97;
    procedure SetNumGlyphs (Value: TNumGlyphs97);
    procedure SetOldDisabledStyle (Value: Boolean);
    procedure SetOpaque (Value: Boolean);
    procedure SetSpacing (Value: Integer);
    procedure SetWordWrap (Value: Boolean);
    procedure RemoveButtonMouseTimer;
    procedure UpdateTracking;
    procedure Redraw (const Erase: Boolean);
    function PointInButton (X, Y: Integer): Boolean;
    procedure ButtonMouseTimerHandler (Sender: TObject);
    procedure RepeatTimerHandler (Sender: TObject);
    {$IFDEF TB97D4}
    function IsCheckedStored: Boolean;
    function IsHelpContextStored: Boolean;
    function IsImageIndexStored: Boolean;
    {$ENDIF}
    procedure WMLButtonDblClk (var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMDialogChar (var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMDialogKey (var Message: TCMDialogKey); message CM_DIALOGKEY;
    procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED;
    procedure CMTextChanged (var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMSysColorChange (var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure WMCancelMode (var Message: TWMCancelMode); message WM_CANCELMODE;
  protected
    FState: TButtonState97;
    function GetPalette: HPALETTE; override;
    procedure Loaded; override;
    procedure Notification (AComponent: TComponent; Operation: TOperation); 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 Paint; override;
    {$IFDEF TB97D4}
    procedure ActionChange (Sender: TObject; CheckDefaults: Boolean); override;
    function GetActionLinkClass: TControlActionLinkClass; override;
    procedure AssignTo (Dest: TPersistent); override;
    {$ENDIF}
  public
    property CallDormant: Boolean read GetCallDormant write SetCallDormant;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Click; override;
    procedure MouseEntered;
    procedure MouseLeft;
  published
    {$IFDEF TB97D4}
    property Action;
    {$ENDIF}
    property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
    property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
    {$IFDEF TB97D4}
    property Anchors;
    {$ENDIF}
    property Cancel: Boolean read FCancel write FCancel default False;
    property Color default clBtnFace;
    {$IFDEF TB97D4}
    property Constraints;
    {$ENDIF}
    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
    property Default: Boolean read FDefault write FDefault default False;
    property DisplayMode: TButtonDisplayMode read FDisplayMode write SetDisplayMode default dmBoth;
    property Down: Boolean read FDown write SetDown {$IFDEF TB97D4} stored IsCheckedStored {$ENDIF} default False;
    property DragCursor;
    property DragMode;
    property DropdownAlways: Boolean read FDropdownAlways write SetDropdownAlways default False;
    property DropdownArrow: Boolean read FDropdownArrow write SetDropdownArrow default True;
    property DropdownCombo: Boolean read FDropdownCombo write SetDropdownCombo default False;
    property DropdownMenu: TPopupMenu read FDropdownMenu write SetDropdownMenu;
    property Caption;
    property Enabled;
    property Flat: Boolean read FFlat write SetFlat default True;
    property Font;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property GlyphMask: TBitmap read GetGlyphMask write SetGlyphMask;
    property HelpContext: THelpContext read FHelpContext write FHelpContext {$IFDEF TB97D4} stored IsHelpContextStored {$ENDIF} default 0;
    property ImageIndex: Integer read GetImageIndex write SetImageIndex {$IFDEF TB97D4} stored IsImageIndexStored {$ENDIF} default -1;
    property Images: TCustomImageList read GetImages write SetImages;
    property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
    property Margin: Integer read FMargin write SetMargin default -1;
    property ModalResult: TModalResult read FModalResult write FModalResult default 0;
    property NoBorder: Boolean read FNoBorder write SetNoBorder default False;
    property NumGlyphs: TNumGlyphs97 read GetNumGlyphs write SetNumGlyphs default 1;
    property OldDisabledStyle: Boolean read FOldDisabledStyle write SetOldDisabledStyle default False;
    property Opaque: Boolean read FOpaque write SetOpaque default True;
    property ParentFont;
    property ParentColor default False;
    property ParentShowHint;
    property Repeating: Boolean read FRepeating write FRepeating default False;
    property RepeatDelay: Integer read FRepeatDelay write FRepeatDelay default 400;
    property RepeatInterval: Integer read FRepeatInterval write FRepeatInterval default 100;
    property ShowBorderWhenInactive: Boolean read FShowBorderWhenInactive write FShowBorderWhenInactive default False;
    property ShowHint;
    property Spacing: Integer read FSpacing write SetSpacing default 4;
    property Visible;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default False;

    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDropdown: TButtonDropdownEvent read FOnDropdown write FOnDropdown;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseExit: TNotifyEvent read FOnMouseExit write FOnMouseExit;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

  { TToolButtonActionLink }

  {$IFDEF TB97D4}
  TToolbarButton97ActionLink = class(TControlActionLink)
  protected
    FClient: TToolbarButton97;
    procedure AssignClient (AClient: TObject); override;
    function IsCheckedLinked: Boolean; override;
    function IsHelpContextLinked: Boolean; override;
    function IsImageIndexLinked: Boolean; override;
    procedure SetChecked (Value: Boolean); override;
    procedure SetHelpContext (Value: THelpContext); override;
    procedure SetImageIndex (Value: Integer); override;
  end;

  TToolbarButton97ActionLinkClass = class of TToolbarButton97ActionLink;
  {$ENDIF}

  { TEdit97 }

  TEdit97 = class(TCustomEdit)
  private
    MouseInControl: Boolean;
    procedure RedrawBorder (const Clip: HRGN);
    procedure NewAdjustHeight;
    procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED;
    procedure CMMouseEnter (var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave (var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMSetFocus (var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus (var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
  protected
    procedure Loaded; override;
  public
    constructor Create (AOwner: TComponent); override;
  published
    property AutoSelect;
    {$IFDEF TB97D4}
    property Anchors;
    {$ENDIF}
    property Align;
    {$IFDEF TB97D4}
    property BiDiMode;
    {$ENDIF}
    property CharCase;
    {$IFDEF TB97D4}
    property Constraints;
    {$ENDIF}
    property DragCursor;
    {$IFDEF TB97D4}
    property DragKind;
    {$ENDIF}
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    {$IFDEF TB97D3}
    property ImeMode;
    property ImeName;
    {$ENDIF}
    property MaxLength;
    property OEMConvert;
    {$IFDEF TB97D4}
    property ParentBiDiMode;
    {$ENDIF}
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PasswordChar;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    {$IFDEF TB97D4}
    property OnEndDock;
    {$ENDIF}
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    {$IFDEF TB97D4}
    property OnStartDock;
    {$ENDIF}
    property OnStartDrag;
  end;

var
  ButtonsStayDown: Boolean = True;
  ButtonMouseInControl: TToolbarButton97 = nil;

implementation

uses
  SysUtils, Consts, CommCtrl, TB97Cmn, TB97;

type
  TCustomToolWindow97Access = class(TCustomToolWindow97);

var
  { See TToolbarButton97.ButtonMouseTimerHandler for info on this }
  ButtonMouseTimer: TTimer = nil;

const
  DropdownComboWidth = 11;

{ TToolbarButton97ActionLink - internal }

{$IFDEF TB97D4}
procedure TToolbarButton97ActionLink.AssignClient (AClient: TObject);
begin
  inherited AssignClient(AClient);
  FClient := AClient as TToolbarButton97;
end;

function TToolbarButton97ActionLink.IsCheckedLinked: Boolean;
begin
  Result := inherited IsCheckedLinked and
    (FClient.Down = (Action as TCustomAction).Checked);
end;

function TToolbarButton97ActionLink.IsHelpContextLinked: Boolean;
begin
  Result := inherited IsHelpContextLinked and
    (FClient.HelpContext = (Action as TCustomAction).HelpContext);
end;

function TToolbarButton97ActionLink.IsImageIndexLinked: Boolean;
begin
  Result := inherited IsImageIndexLinked and
    (FClient.ImageIndex = (Action as TCustomAction).ImageIndex);
end;

procedure TToolbarButton97ActionLink.SetChecked (Value: Boolean);
begin
  if IsCheckedLinked then FClient.Down := Value;
end;

procedure TToolbarButton97ActionLink.SetHelpContext (Value: THelpContext);
begin
  if IsHelpContextLinked then FClient.HelpContext := Value;
end;

procedure TToolbarButton97ActionLink.SetImageIndex (Value: Integer);
begin
  if IsImageIndexLinked then FClient.ImageIndex := Value;
end;
{$ENDIF}


{ TToolbarButton97 - internal }

type
  TGlyphList = class(TImageList)
  private
    Used: TBits;
    FCount: Integer;
    function AllocateIndex: Integer;
  public
    constructor CreateSize (AWidth, AHeight: Integer);
    destructor Destroy; override; 
    function Add (Image, Mask: TBitmap): Integer;
    function AddMasked (Image: TBitmap; MaskColor: TColor): Integer;
    procedure Delete (Index: Integer);
    property Count: Integer read FCount;
  end;

  TGlyphCache = class