rm_tb97ctls.pas

中小企业管理系统------ ERP系统原代码

unit RM_TB97Ctls;

{
  Toolbar97
  Copyright (C) 1998-2001 by Jordan Russell
  For conditions of distribution and use, see LICENSE.TXT.

  TToolbarButton97 & TEdit97

  $Id: TB97Ctls.pas,v 1.8 2001/05/01 17:00:49 jr Exp $
}

{$I RM.INC}
interface

{$IFDEF USE_INTERNALTB97}
{$I RM_TB97Ver.inc}

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

const
  DefaultDropdownArrowWidth = 9;
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;
    FDropdownArrowWidth: Integer;
    FDropdownCombo: Boolean;
    FDropdownMenu: TPopupMenu;
    FFlat: Boolean;
    FGlyph: Pointer;
    FGroupIndex: Integer;
    FHelpContext: THelpContext;
    FHighlightWhenDown: Boolean;
    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 SetDropdownArrowWidth (Value: Integer);
    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);
    procedure SetHighlightWhenDown (Value: Boolean);
    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);
    function GetVersion: TToolbar97Version;
    procedure SetVersion (const Value: TToolbar97Version);
    procedure SetWordWrap (Value: Boolean);
    procedure RemoveButtonMouseTimer;
    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 Canvas;
    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 DropdownArrowWidth: Integer read FDropdownArrowWidth write SetDropdownArrowWidth default DefaultDropdownArrowWidth;
    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 HighlightWhenDown: Boolean read FHighlightWhenDown write SetHighlightWhenDown default True;
    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 Version: TToolbar97Version read GetVersion write SetVersion stored False;
    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;
    function GetVersion: TToolbar97Version;
    procedure SetVersion (const Value: TToolbar97Version);
    procedure DrawNCArea (const DrawToDC: Boolean; const ADC: HDC;
      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 WMKillFocus (var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
    procedure WMPrint (var Message: TMessage); message WM_PRINT;
    procedure WMPrintClient (var Message: TMessage); message WM_PRINTCLIENT;
    procedure WMSetFocus (var Message: TWMSetFocus); message WM_SETFOCUS;
  protected
    procedure Loaded; override;
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; 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 Version: TToolbar97Version read GetVersion write SetVersion stored False;
    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;

function ControlIs97Control (AControl: TControl): Boolean;
procedure Register97ControlClass (AClass: TClass);
procedure Unregister97ControlClass (AClass: TClass);

{$ENDIF}
implementation

{$IFDEF USE_INTERNALTB97}
uses
  SysUtils, Consts, CommCtrl, RM_TB97Cmn;

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

  Control97List: TList = nil;

  Edit97Count: Integer = 0;

const
  DropdownComboSpace = 2;

function ControlIs97Control (AControl: TControl): Boolean;
var
  I: Integer;
begin
  Result := False;
  if Assigned(AControl) and Assigned(Control97List) then
    for I := 0 to Control97List.Count-1 do
      if AControl is TClass(Control97List[I]) then begin
        Result := True;
        Break;
      end;
end;

procedure Register97ControlClass (AClass: TClass);
begin
  if Control97List = nil then Control97List := TList.Create;
  Control97List.Add (AClass);
end;

procedure Unregister97ControlClass (AClass: TClass);
begin
  if Assigned(Control97List) then begin
    Control97List.Remove (AClass);
    if Control97List.Count = 0 then begin
      Control97List.Free;
      Control97List := nil;
    end;
  end;
end;