se_controls.pas

来自「小区水费管理系统源代码水费收费管理系统 水费收费管理系统」· PAS 代码 · 共 1,763 行 · 第 1/5 页

    property OwnsObjects: Boolean read FOwnsObjects write FOwnsObjects;
    property Items[Index: Integer]: TObject read GetItem write SetItem; default;
  end;

{ TComponentList class }

  TComponentList = class(TObjectList)
  private
    FNexus: TComponent;
  protected
    function GetItems(Index: Integer): TComponent;
    procedure SetItems(Index: Integer; AComponent: TComponent);
  public
    destructor Destroy; override;

    function Add(AComponent: TComponent): Integer;
    function Remove(AComponent: TComponent): Integer;
    function IndexOf(AComponent: TComponent): Integer;
    procedure Insert(Index: Integer; AComponent: TComponent);
    property Items[Index: Integer]: TComponent read GetItems write SetItems; default;
  end;

{ TClassList class }

  TClassList = class(TList)
  protected
    function GetItems(Index: Integer): TClass;
    procedure SetItems(Index: Integer; AClass: TClass);
  public
    function Add(aClass: TClass): Integer;
    function Remove(aClass: TClass): Integer;
    function IndexOf(aClass: TClass): Integer;
    procedure Insert(Index: Integer; aClass: TClass);
    property Items[Index: Integer]: TClass read GetItems write SetItems; default;
  end;

{ TOrdered class }

  TOrderedList = class(TObject)
  private
    FList: TList;
  protected
    procedure PushItem(AItem: Pointer); virtual; abstract;
    function PopItem: Pointer; virtual;
    function PeekItem: Pointer; virtual;
    property List: TList read FList;
  public
    constructor Create;
    destructor Destroy; override;

    function Count: Integer;
    function AtLeast(ACount: Integer): Boolean;
    procedure Push(AItem: Pointer);
    function Pop: Pointer;
    function Peek: Pointer;
  end;

{ TStack class }

  TStack = class(TOrderedList)
  protected
    procedure PushItem(AItem: Pointer); override;
  end;

{ TObjectStack class }

  TObjectStack = class(TStack)
  public
    procedure Push(AObject: TObject);
    function Pop: TObject;
    function Peek: TObject;
  end;

{ TQueue class }

  TQueue = class(TOrderedList)
  protected
    procedure PushItem(AItem: Pointer); override;
  end;

{ TObjectQueue class }

  TObjectQueue = class(TQueue)
  public
    procedure Push(AObject: TObject);
    function Pop: TObject;
    function Peek: TObject;
  end;


procedure ExecuteAnimation(Canvas: TCanvas; X, Y: integer; ASourceImage, ADestImage: TSeBitmap; Animation: TSeAnimation);


type

  { TSePerfomance set a buffer kind of a form. The following table lists the possible values:
    <TABLE>
    Value                       Meaning
    -----                       -------
    kspSharedBuffer             High speed - middle of memory. Shared buffer.
    kspDoubleBuffer             Slow speed - middle of memory.
    kspNoBuffer                 Max speed - min of memory. But flickers.
    </TABLE>
  }
  TSePerformance = (kspNoBuffer, kspSharedBuffer, kspDoubleBuffer);

  TSeBarOrientation = (kboHorizontal, kboVertical);

  TSeScrollCode = (kscLineUp, kscLineDown, kscPageUp, kscPageDown, kscPosition, kscTrack,
    kscTop, kscBottom, kscEndScroll);
  TSeScrollEvent = procedure (Sender: TObject; ScrollCode: TSeScrollCode; var ScrollPos: Integer) of object;

{ TSeCustomControl class }

  TSeCustomControl = class(TCustomControl)
  private
    FPerformance: TSePerformance;
    FBack: TSeBitmap;
    FFocused: boolean;
    FTransparent: boolean;
    FMouseInControl: Boolean;
    FHScrollBar, FVScrollBar: TControl;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FScrollBars: TScrollStyle;
    FDisableScrollBarUpdate: boolean;
    FFont: TFont;
    FBorderWidth: integer;
    FBevelInner: TSeBevelCut;
    FBevelOuter: TSeBevelCut;
    FBevelSides: TSeBevelSides;
    FBevelKind: TSeBevelKind;
    FBevelWidth: integer;
    FBlending: TSeBlending;
    FDrawXPBorder: boolean;
    { Windows }
    procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure WMEraseBkgnd(var Msg: TWmEraseBkgnd); message WM_ERASEBKGND;
    procedure WMWindowPosChanging(var Msg: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    { XP }
    procedure WMThemeChanged(var Msg: TMessage); message WM_THEMECHANGED;
    { Props }
    procedure DoBlendingChanged(Sender: TObject);
    { Properties }
    procedure SetTransparent(const Value: boolean);
    procedure SetScrollBars(const Value: TScrollStyle);
    procedure SetFont(const Value: TFont);
    procedure SetBorderWidth(const Value: integer);
    procedure SetBevelSides(const Value: TSeBevelSides);
    procedure SetBevelKind(const Value: TSeBevelKind);
    procedure SetBevelWidth(const Value: integer);
    procedure SetBevelInner(const Value: TSeBevelCut);
    procedure SetBevelOuter(const Value: TSeBevelCut);
    procedure SetBlending(const Value: TSeBlending);
    procedure SetPerformance(const Value: TSePerformance);
  protected
    FWidth, FHeight: integer;
    { VCL }
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure Paint; override;
    { Painting }
    procedure PaintBuffer; virtual;
    procedure PaintBorder; virtual;
    function GetBorderRect: TRect; virtual;
    { ScrollBars }
    procedure InitScrollBars;
    function CreateScrollBar: TControl; virtual;
    function GetScrollBarHeight: integer; virtual;
    procedure UpdateScrollBars;
    procedure DoHScroll(Sender: TObject; ScrollCode: TSeScrollCode; var ScrollPos: Integer);
    procedure DoVScroll(Sender: TObject; ScrollCode: TSeScrollCode; var ScrollPos: Integer);
    { Event }
    procedure MouseEnter; dynamic;
    procedure MouseLeave; dynamic;
    procedure HasFocus; dynamic;
    procedure KillFocus; dynamic;
    { Protected }
    procedure PaintOwnerBackground(DC: HDC);
    procedure BorderChanged; virtual;
    { Protected Propperty }
    property ControlFont: TFont read FFont write SetFont;
    property DrawXPBorder: boolean read FDrawXPBorder write FDrawXPBorder;
    { Bevel styles }
    property BevelSides: TSeBevelSides read FBevelSides write SetBevelSides;
    property BevelInner: TSeBevelCut read FBevelInner write SetBevelInner;
    property BevelOuter: TSeBevelCut read FBevelOuter write SetBevelOuter;
    property BevelKind: TSeBevelKind read FBevelKind write SetBevelKind;
    property BevelWidth: integer read FBevelWidth write SetBevelWidth;
    property BorderWidth: integer read FBorderWidth write SetBorderWidth;
    property Focused: boolean read FFocused;
    property MouseInControl: boolean read FMouseInControl;
    property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars;
    property HScrollBar: TControl read FHScrollBar;
    property VScrollBar: TControl read FVScrollBar;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;

    procedure InvalidateBorder;
    procedure InvalidateRect(ARect: TRect);

    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    function GetClientRect: TRect; override;

    function GetScrollPos(ScrollBar: integer): integer;
    function GetScrollInfo(ScrollBar: integer; var AInfo: TScrollInfo): boolean;
    procedure GetScrollRange(ScrollBar: integer; var Min, Max: integer);
    procedure SetScrollInfo(ScrollBar: integer; AInfo: TScrollInfo; Redraw: boolean);
    procedure SetScrollPos(ScrollBar, Pos: integer; Redraw: boolean);
    procedure SetScrollRange(ScrollBar, Min, Max: integer; Redraw: boolean);
  published
    property Blending: TSeBlending read FBlending write SetBlending;
    property Constraints;
    property BiDiMode;
    property DragCursor;
    property DragKind;
    property DragMode;
    property ParentBiDiMode;
    property Performance: TSePerformance read FPerformance write SetPerformance;
    property ShowHint;
    property Transparent: boolean read FTransparent write SetTransparent;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnEnter;
    property OnExit;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property OnKeyDown;
    property OnKeyUp;
    property OnKeyPress;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDrag;
  end;

{ TSeCustomControl class }

  TSeGraphicControl = class(TGraphicControl)
  private
    FBack: TSeBitmap;
    FFocused: boolean;
    FTransparent: boolean;
    FMouseInControl: Boolean;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FFont: TFont;
    FPerformance: TSePerformance;
    FBlending: TSeBlending;
    procedure SetTransparent(const Value: boolean);
    procedure SetFont(const Value: TFont);
    procedure SetPerformance(const Value: TSePerformance);
    procedure SetBlending(const Value: TSeBlending);
  protected
    { Windows }
    procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    { For next }
    procedure PaintOwnerBackground(DC: HDC);
    procedure PaintBuffer; virtual;
    { Event }
    procedure MouseEnter; dynamic;
    procedure MouseLeave; dynamic;
    { Protected Propperty }
    property ControlFont: TFont read FFont write SetFont;
    property MouseInControl: boolean read FMouseInControl;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure Paint; override;
  published
    property BiDiMode;
    property Blending: TSeBlending read FBlending write SetBlending;
    property ParentBiDiMode;
    property Performance: TSePerformance read FPerformance write SetPerformance;
    property ShowHint;
    property Transparent: boolean read FTransparent write SetTransparent;
    property Visible;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  end;

const

{ Bevel styles and colors }

  OuterBevelKind: array [TSeBevelKind] of TSeBevelCut =
    (kbvNone, kbvLowered, kbvLowered, kbvLowered, kbvBorder, kbvFlatBorder);
  InnerBevelKind: array [TSeBevelKind] of TSeBevelCut =
    (kbvNone, kbvLowered, kbvLowered, kbvLowered, kbvBorder, kbvFlatBorder);

  OuterBevelRaisedColor: array [TSeBevelCut] of TColor =
    (clNone, clBtnShadow, clBtnHighlight, clBtnFace, cl3DDkShadow, clBtnShadow);
  OuterBevelSunkenColor: array [TSeBevelCut] of TColor =
    (clNone, clBtnHighlight, cl3DDkShadow, clBtnFace, cl3DDkShadow, clBtnShadow);

  InnerBevelRaisedColor: array [TSeBevelCut] of TColor =
    (clNone, cl3DDkShadow, clBtnShadow, clBtnFace, clWindow, clBtnFace);
  InnerBevelSunkenColor: array [TSeBevelCut] of TColor =
    (clNone, clBtnFace, clBtnShadow, clBtnFace, clWindow, clBtnFace);

{ Shared Buffer }

  SharedBuffer: TSeBitmap    = nil; { Shared buffer }

procedure InitSharedBuffer;


const
  ItemStep              = 20;
  GlyphWidth            = 22;
  SubMenuWidth          = 22;
  SepHeight             = 15;

  ScrollButtonSize      = 10;
  ScrollTimerInterval   = 100;

  WM_CLICKEVENT = WM_USER + 1210; { Need for handle OnClick event }

type

  TSeMenuScrollButton = (ksbNone, ksbUp, ksbDown);

  TSeCustomItem = class;

  TSeCustomItemActionLink = class(TActionLink)
  protected
    FClient: TSeCustomItem;
    procedure AssignClient (AClient: TObject); override;
    function IsCaptionLinked: Boolean; override;
    function IsCheckedLinked: Boolean; override;
    function IsEnabledLinked: Boolean; override;
    function IsHelpContextLinked: Boolean; override;
    function IsHintLinked: Boolean; override;
    function IsImageIndexLinked: Boolean; override;
    function IsShortCutLinked: Boolean; override;
    function IsVisibleLinked: Boolean; override;
    function IsOnExecuteLinked: Boolean; override;
    procedure SetCaption (const Value: String); override;
    procedure SetChecked (Value: Boolean); override;
    procedure SetEnabled (Value: Boolean); override;
    procedure SetHelpContext (Value: THelpContext); override;