terollform.pas

这个东西的功能很强大

{==============================================================================

  Common Controls
  Copyright (C) 2000-2002 by Evgeny Kryukov
  All rights reserved

===============================================================================}

unit TeRollForm;

{$I TeDefine.inc}
{$T-,W-,X+,P+,O+}
{$WARNINGS OFF}
{$HINTS OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Buttons, Menus, 
  ImgList, Dialogs, StdCtrls, ActnList, ExtCtrls, ShellApi, Mask, Math, Clipbrd, 
  Consts, Printers, ComCtrls, CommCtrl, Imm, Grids, TeConst, TeCommon, TeWinAPI, 
  TeEffect, TeTheme, TeBitmap, TeUtils;

{!============================================================================!}

const
  sCommonVersion = '4.3.0';
  sCommonVersionPropText = 'LibGUI Version ' + sCommonVersion;

type
  TTeCommonVersion = type string;

var
  Sig: PChar = '- ' + sCommonVersionPropText +
    {$IFDEF KS_DELPHI4} ' - D4 - '+ {$ENDIF}
    {$IFDEF KS_CBUILDER4} ' - CB4 - ' + {$ENDIF}
    {$IFDEF KS_DELPHI5} ' - D5 - '+ {$ENDIF}
    {$IFDEF KS_CBUILDER5} ' - CB5 - '+ {$ENDIF}
    {$IFDEF KS_DELPHI6} ' - D6 - '+ {$ENDIF}
    {$IFDEF KS_CBUILDER6} ' - CB6 - '+ {$ENDIF}
    {$IFDEF KS_DELPHI7} ' - D7 - '+ {$ENDIF}
    'Copyright (C) 1998-2002 by Evgeny Kryukov -';


const
  WordWraps: array [boolean] of Word = (0, DT_WORDBREAK);

type

{ Kind of form's buffering }

  TTeFormPerformance = (ksfpNoBuffer, ksfpSharedBuffer, ksfpPersistentBuffer, ksfpDoubleBuffer);

{ Expanded blending property }

  TTeBlending = class(TPersistent)
  private
    FEnabled: boolean;
    FValue: integer;
    FOnChange: TNotifyEvent;
    FWin2KBlending: boolean;
    procedure SetEnabled(const AValue: boolean);
    procedure SetValue(const AValue: integer);
    procedure SetWin2KBlending(const AValue: boolean);
  protected
    property Win2KBlending: boolean read FWin2KBlending write SetWin2KBlending;
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    procedure Change;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property Enabled: boolean read FEnabled write SetEnabled default false;
    property Value: integer read FValue write SetValue default 150;
  end;

{ Expanded shadow property }

  TTeShadow = class(TPersistent)
  private
    FOnChange: TNotifyEvent;
    FEnabled: boolean;
    FSize: integer;
    procedure SetEnabled(const Value: boolean);
    procedure SetSize(const Value: integer);
  protected
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    procedure Change;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property Enabled: boolean read FEnabled write SetEnabled default false;
    property Size: integer read FSize write SetSize default 4;
  end;

{ Expanded gravitation property }

  TTeGravitationKind = (kgkDock, kgkSite);

  TTeGravitation = class(TPersistent)
  private
    FEnabled: boolean;
    FSize: integer;
    FKind: TTeGravitationKind;
    procedure SetEnabled(const Value: boolean);
    procedure SetKind(const Value: TTeGravitationKind);
    procedure SetSize(const Value: integer);
  protected
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    property Kind: TTeGravitationKind read FKind write SetKind default kgkDock;
  published
    property Enabled: boolean read FEnabled write SetEnabled default true;
    property Size: integer read FSize write SetSize default 20;
  end;

{ Expanded gragging property }

  TTeFormDragMode = (kfdmBorder, kfdmFullDrag);

  TTeDragging = class(TPersistent)
  private
    FSizeable: boolean;
    FMoveable: boolean;
    FDragMode: TTeFormDragMode;
  protected
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
  published
    property Moveable: boolean read FMoveable write FMoveable default true;
    property Sizeable: boolean read FSizeable write FSizeable default false;
    property DragMode: TTeFormDragMode read FDragMode write FDragMode default kfdmFullDrag;
  end;

{ Animation property }

  TTeDirection = (kdNone, kdNoRotate, kdRotate90, kdRotate180, kdRotate270);

  TTeAnimation = class(TPersistent)
  private
    FAnimationRec: TTeAnimationRec;
    procedure SetResolution(const Value: integer);
    procedure SetTileCount(const Value: integer);
    procedure SetTime(const Value: integer);
    function GetDirection: TTeDirection;
    function GetEffect: string;
    function GetEnabled: boolean;
    function GetResolution: integer;
    function GetTileCount: integer;
    function GetTime: integer;
    procedure SetDirection(const Value: TTeDirection);
    procedure SetEffect(const Value: string);
    procedure SetEnabled(const Value: boolean);
  protected
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property AnimationRec: TTeAnimationRec read FAnimationRec;
  published
    property Direction: TTeDirection read GetDirection write SetDirection default kdNone;
    property EffectKind: string read GetEffect write SetEffect;
    property Enabled: boolean read GetEnabled write SetEnabled default false;
    property Resolution: integer read GetResolution write SetResolution default 1;
    property TileCount: integer read GetTileCount write SetTileCount default 1;
    property Time: integer read GetTime write SetTime default 400;
  end;

{ Embeded form options }

  TTeFormOptions = class(TPersistent)
  private
    FOnChange: TNotifyEvent;
    FBlending: TTeBlending;
    FShadow: TTeShadow;
    FAnimation: TTeAnimation;
    procedure SetBlending(const Value: TTeBlending);
    procedure SetShadow(const Value: TTeShadow);
    procedure SetAnimation(const Value: TTeAnimation);
  protected
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure Change;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property Blending: TTeBlending read FBlending write SetBlending;
    property Shadow: TTeShadow read FShadow write SetShadow;
    property Animation: TTeAnimation read FAnimation write SetAnimation;
  end;

{ Embeded popupmenu options }

  TTePopupMenuOptions = class(TPersistent)
  private
    FOnChange: TNotifyEvent;
    FBlending: TTeBlending;
    FShadow: TTeShadow;
    FAnimation: TTeAnimation;
    procedure SetBlending(const Value: TTeBlending);
    procedure SetShadow(const Value: TTeShadow);
    procedure SetAnimation(const Value: TTeAnimation);
  protected
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure Change;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property Blending: TTeBlending read FBlending write SetBlending;
    property Shadow: TTeShadow read FShadow write SetShadow;
    property Animation: TTeAnimation read FAnimation write SetAnimation;
  end;

{ Extra WE_ERASEBKGND Params }

  TTeEraseBackgroundAction = (keaInvalidateRect, keaPaintBackground);

  PEraseBackgroundInfo = ^TEraseBackgroundInfo;
  TEraseBackgroundInfo = record
    Action: TTeEraseBackgroundAction;
    Rect: TRect;
    PaintChildren: boolean;
  end;

{ Extract TColor rec }

  PColorRec =^TColorRec;
  TColorRec = packed record
    case Cardinal of
      0: (Color: Cardinal);
      2: (HiWord, LoWord: Word);
      3: (R, G, B, A: Byte);
    end;


type

{ TObjectList class }

  TObjectList = class(TList)
  private
    FOwnsObjects: Boolean;
  protected
    function GetItem(Index: Integer): TObject;
    procedure SetItem(Index: Integer; AObject: TObject);
  public
    constructor Create; overload;
    constructor Create(AOwnsObjects: Boolean); overload;

    function Add(AObject: TObject): Integer;
    function Remove(AObject: TObject): Integer;
    function IndexOf(AObject: TObject): Integer;
    function FindInstanceOf(AClass: TClass; AExact: Boolean = True; AStartAt: Integer = 0): Integer;
    procedure Insert(Index: Integer; AObject: TObject);
    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;


type

{ Bevel Styles }

  TTeBevelCut = (kbvNone, kbvLowered, kbvRaised, kbvSpace, kbvBorder, kbvFlatBorder);
  TTeBevelSide = (kbsLeft, kbsTop, kbsRight, kbsBottom);