terollform.pas

这个东西的功能很强大

    property Position: integer read FPosition write SetPosition default 0;
    property ShowHint;
    property SmallChange: TScrollBarInc read FSmallChange write FSmallChange default 1;
    property ThemeObject: TTeThemeObject read FThemeObject write SetThemeObject;
    property Visible;

    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnScroll: TTeScrollEvent read FOnScroll write FOnScroll;
    property OnStartDock;
    property OnStartDrag;
  end;


const
  DefaultFontColorHeight  = 18;
  ColorRectWidth          = 20;

var
  IsWinNT, IsWin98: boolean;
  VerInfo: TOsVersionInfo;
  TrueTypeBmp: TTeBitmap;


const

  CM_RECREATEWINDOW  = CM_BASE + 222;
  CM_DESTROYHOOK     = CM_BASE + 223;

type
  THookMessageEvent = procedure (Sender: TObject; var Msg: TMessage;
    var Handled: Boolean) of object;

{ TTeHook component }

  TTeHook = class(TComponent)
  private
    FActive: Boolean;
    FControl: TWinControl;
    FControlHook: TObject;
    function GetForm: TCustomForm;
    function GetWinControl: TWinControl;
    function GetHandle: HWnd;
    function GetHookHandle: HWnd;
    procedure SetWinControl(Value: TWinControl);

    function DoUnhookControl: Pointer;
  protected
    FHandled: boolean;
    procedure SetActive(Value: Boolean); virtual;
    procedure DoAfterMessage(var Msg: TMessage; var Handled: Boolean); virtual;
    procedure DoBeforeMessage(var Msg: TMessage; var Handled: Boolean); virtual;
    procedure DoBeforeDestruction; virtual;
    procedure MessageHandled;
    property HookHandle: HWnd read GetHookHandle;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure HookControl;
    procedure UnhookControl;

    property Active: Boolean read FActive write SetActive default True;
    property Form: TCustomForm read GetForm;
    property Handle: HWnd read GetHandle;
    property WinControl: TWinControl read GetWinControl write SetWinControl;
  end;


const

  CStdThumbRatio = 2.2;

type

  { The following table lists the possible values:
    <TABLE>
    Value                       Meaning
    -----                       -------
    htLowInterval               The highlight drawing between Min and Position
    htHighInterval              The highlight drawing between Position and Max
    htNone                      The highlight no drawing
    </TABLE>
  }
  TIntervalHighlightType = (htLowInterval, htHighInterval, htNone);

const

  GripperSize = 25;

type

{ TTeInplaceScrollBar class }

  TCreateScrollBarEvent = procedure (var AScrollBar: TTeScrollBar; AOwner: TComponent) of object;

  TTeInplaceScrollBar = class(TWinControl)
  private
    FDestroyed: boolean;
    FScrollBar: TTeScrollBar;
    FControl: TWinControl;
    FOnCreateScrollBar: TCreateScrollBarEvent;
    FNeedChangePos: boolean;
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;

    function GetOrientation: TTeScrollOrientation;
    procedure SetOrientation(const Value: TTeScrollOrientation);
    procedure SetControl(const Value: TWinControl);
  protected
    procedure DoScroll(Sender: TObject; ScrollCode: TTeScrollCode; var ScrollPos: Integer); virtual;
  public
    constructor Create(AOwner: TComponent; AOnCreateScrollBar: TCreateScrollBarEvent); virtual;
    destructor Destroy; override;

    procedure ScrollBarWndProc(var Message: TMessage);
    procedure ScrollBarUpdate;

    property Control: TWinControl read FControl write SetControl;
    property Orientation: TTeScrollOrientation read GetOrientation write SetOrientation;
    property ScrollBar: TTeScrollBar read FScrollBar;
    property OnCreateScrollBar: TCreateScrollBarEvent read FOnCreateScrollBar
      write FOnCreateScrollBar;
  end;

{ TTeSubScrollBar class }

  TTeSubScrollBar = class(TComponent)
  private
    FControl: TWinControl;
    FVScrollBar, FHScrollBar: TTeInplaceScrollBar;
    procedure SetControl(const Value: TWinControl);
  public
    constructor Create(AControl: TWinControl; AOnCreateScrollBar: TCreateScrollBarEvent); virtual;
    destructor Destroy; override;

    procedure SubWndProc(var Message: TMessage);
    procedure SetParent(AParent: TWinControl);

    property Control: TWinControl read FControl write SetControl;
    property VScrollBar: TTeInplaceScrollBar read FVScrollBar;
    property HScrollBar: TTeInplaceScrollBar read FHScrollBar;
  end;

const
  InitRepeatPause = 400;  { pause before repeat timer (ms) }
  RepeatPause     = 100;  { pause before hint window displays (ms)}


type

  TTeInternalButtonState = (kibsNormal, kibsPressed);

{ TTeButton }

  TTeButton = class(TTeControl)
  private
    FActiveDefault: boolean;
    FDefault: boolean;
    FDragging: Boolean;
    FGlyph, FCopyGlyph: TBitmap;
    FLayout: TButtonLayout;
    FKind: TBitBtnKind;
    FNumGlyphs: TNumGlyphs;
    FModifiedGlyph: boolean;
    FSpacing: Integer;
    FState: TTeInternalButtonState;
    FModalResult: TModalResult;
    FBlackAndWhiteGlyph: boolean;
    FCancel: Boolean;
    FWordWrap: boolean;
    FCaption: WideString;
    FThemeObject: TTeThemeObject;
    FTransparent: boolean;
    FGroupIndex: Integer;
    FImages: TCustomImageList;
    FImageIndex: TImageIndex;
    { Properties }
    procedure SetDefault(const Value: boolean);
    procedure SetGlyph(const Value: TBitmap);
    procedure SetKind(const Value: TBitBtnKind);
    procedure SetLayout(const Value: TButtonLayout);
    procedure SetNumGlyphs(const Value: TNumGlyphs);
    procedure SetSpacing(const Value: Integer);
    procedure SetBlackAndWhiteGlyph(const Value: boolean);
    { Internal Event Handlers }
    procedure GlyphChangedHandler(Sender: TObject);
    procedure SetWordWrap(const Value: boolean);
    procedure SetCaption(const Value: WideString);
    function IsGlyphStored: Boolean;
    procedure SetThemeObject(const Value: TTeThemeObject);
    procedure SetTransparent(const Value: boolean);
    procedure SetGroupIndex(const Value: Integer);
    function IsImageIndexStored: Boolean;
    procedure SetImageIndex(const Value: TImageIndex);
    procedure SetImages(const Value: TCustomImageList);
  protected
    { Theme Routines }
    procedure WriteState(Writer: TWriter); override;
    procedure SNMThemeMessage(var Msg: TMessage); message SNM_THEMEMESSAGE;
    { Message Handling }
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
    procedure CMDialogKey( var Msg: TCMDialogKey ); message CM_DIALOGKEY;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMFocusChanged(var Msg: TCMFocusChanged); message CM_FOCUSCHANGED;
    procedure CMTextChanged(var Msg: TMessage); message CM_TEXTCHANGED;
    { VCL Inherited }
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    { Inherited }
    procedure PaintBuffer; override;
    { Button }
    procedure NeedCopyGlyph;
    function GetLayoutRect: TRect; virtual;
    function GetCaptionRect: TRect; virtual;
    function GetGlyphRect: TRect; virtual;
    function GetGlyphSize: TPoint;
    procedure PaintFace; virtual;
    procedure PaintGlyph; virtual;
    procedure PaintText; virtual;
    { Mouse Handlers }
    procedure MouseEnter; override;
    procedure MouseLeave; override;
    procedure HasFocus; override;
    procedure KillFocus; override;
    { VCL }
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(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;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    { Event Dispatch Methods }
    procedure Click; override;
  published
    property Align;
    property Action;
    property Anchors;
    property ActiveDefault: boolean read FActiveDefault;
    property BlackAndWhiteGlyph: boolean read FBlackAndWhiteGlyph write SetBlackAndWhiteGlyph;
    property Cancel: Boolean read FCancel write FCancel default false;
    property Caption: WideString read FCaption write SetCaption;
    property Default: boolean read FDefault write SetDefault default false;
    property Enabled;
    property Font;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex stored IsImageIndexStored default -1;
    property Images: TCustomImageList read FImages write SetImages;
    property Kind: TBitBtnKind read FKind write SetKind default bkCustom;
    property ModalResult: TModalResult read FModalResult write FModalResult default mrNone;
    property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs default 1;
    property Spacing: Integer read FSpacing write SetSpacing default 4;
    property Glyph: TBitmap read FGlyph write SetGlyph stored IsGlyphStored;
    property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
    property ThemeObject: TTeThemeObject read FThemeObject write SetThemeObject;
    property ParentFont;
    property ParentShowHint;
    property TabOrder;
    property TabStop default true;
    property Transparent: boolean read FTransparent write SetTransparent default false;
    property WordWrap: boolean read FWordWrap write SetWordWrap;
    property OnClick;
  end;


type

  TTeLeftRight = (
    kalLeftJustify,
    kalRightJustify
  );



const

  WM_TRAYICONMESSAGE    = WM_USER + 364;
  WM_UPDATENCAREA       = WM_USER + 365;
  WM_MAXIMIZE           = WM_USER + 366;

  WM_STARTACTION        = WM_USER + 367;

  SMDIItemName          = 'ksmdiwi_rty';

type

  { Form's BorderIcons }

  TTeBorderIcon = (
    kbiSystemMenu,
    kbiTop,
    kbiHelp,
    kbiRollup,
    kbiTray,
    kbiMinimize,
    kbiMaximize,
    kbiClose,
    kbiCustom
  );

  { Form's BorderStyle }

  TTeBorderStyle = (
    kbsNone,
    kbsStandard,
    kbsToolWindow
  );

  { Form's states }

  TTeWindowState = (
    kwsNormal,
    kwsMaximized,
    kwsMinimized,
    kwsRollup,
    kwsTray
  );

  TTeBorderIcons = set of TTeBorderIcon;

  TTeFormActionEvent = procedure (Sender: TObject; var CallDefault: boolean) of object;

{ TTeDefaultForm class }

  TTeDefaultForm = class(TTeHook)
  private
    FCanvas: TCanvas;
    FPersistentBuffer: TTeBitmap;
    FPerformance: TTeFormPerformance;
    FBorderStyle: TTeBorderStyle;
    FBorderIcons: TTeBorderIcons;
    FConstraints: TSizeConstraints;
    FWindowState: TTeWindowState;
    FLoadedState: TTeWindowState;
    FSysMenu: TTeItem;
    FSysMenuPoint: TPoint;
    FMinimizeApplication: boolean;
    FStayOnTop: boolean;
    FAnimation: TTeAnimation;
    FSystemMenuOptions: TTePopupMenuOptions;
    FTrayMenuOptions: TTePopupMenuOptions;
    { Internal - temporary }
    FScreen: TTeBitmap;
    FAnimating: boolean;
    FDownPoint: TPoint;
    FMovePoint: TPoint;
    FRestoreRect: TRect;
    FOldState: TTeWindowState;
    FIconData: TNotifyIconData;
    FOldPlacment: HWnd;