vrdesign.pas

作工控的好控件

{*****************************************************}
{                                                     }
{     Varian Component Workshop                       }
{                                                     }
{     Varian Software NL (c) 1996-2000                }
{     All Rights Reserved                             }
{                                                     }
{*****************************************************}

unit VrDesign;

{$I VRLIB.INC}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  VrTypes, VrClasses, VrControls, VrSystem, VrSysUtils;


type
  TVrBitmapButton = class(TVrGraphicImageControl)
  private
    FAutoSize: Boolean;
    FGlyph: TBitmap;
    FMask: TBitmap;
    FNumGlyphs: TVrNumGlyphs;
    FImageWidth: Integer;
    FImageHeight: Integer;
    FVIndent: Integer;
    FHIndent: Integer;
    FHasMouse: Boolean;
    FTransparentMode: TVrTransparentMode;
    Down: Boolean;
    Pressed: Boolean;
    function InControl(X, Y: Integer): Boolean;
    procedure SetGlyph(Value: TBitmap);
    procedure SetNumGlyphs(Value: TVrNumGlyphs);
    procedure SetVIndent(Value: Integer);
    procedure SetHIndent(Value: Integer);
    procedure SetAutoSize(Value: Boolean);
    procedure SetTransparentMode(Value: TVrTransparentMode);
    procedure GlyphChanged(Sender: TObject);
    procedure DoMouseDown(XPos, YPos: Integer);
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LButtonDown;
    procedure WMMouseMove(var Message: TWMMouseMove); message WM_MouseMove;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LButtonUp;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  protected
    function GetPalette: HPalette; override;
    procedure Loaded; override;
    procedure Paint; override;
    procedure AdjustBounds;
    procedure AdjustImageSize;
    function DestRect: TRect;
    function GetImageRect(Index: Integer): TRect;
    function GetTransparentColor: TColor;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Glyph: TBitmap read FGlyph write SetGlyph;
    property NumGlyphs: TVrNumGlyphs read FNumGlyphs write SetNumGlyphs default 1;
    property VIndent: Integer read FVIndent write SetVIndent default 2;
    property HIndent: Integer read FHIndent write SetHIndent default 2;
    property AutoSize: Boolean read FAutoSize write SetAutoSize default false;
    property TransparentMode: TVrTransparentMode read FTransparentMode write SetTransparentMode default tmColor;
    property Transparent default false;
    property Align;
{$IFDEF VER110}
    property Anchors;
    property Constraints;
{$ENDIF}
    property Color default clBtnFace;
    property DragCursor;
{$IFDEF VER110}
    property DragKind;
{$ENDIF}
    property DragMode;
    property Enabled;
    property Hint;
    property ParentColor default false;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
{$IFDEF VER130}
    property OnContextPopup;
{$ENDIF}
    property OnDragDrop;
    property OnDragOver;
{$IFDEF VER110}
    property OnEndDock;
{$ENDIF}
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
{$IFDEF VER110}
    property OnStartDock;
{$ENDIF}
    property OnStartDrag;
  end;

  TVrBitmapImage = class(TVrGraphicImageControl)
  private
    FAutoSize: Boolean;
    FCenter: Boolean;
    FStretch: Boolean;
    FBitmapIndex: Integer;
    FBitmap: TBitmap;
    FBitmapList: TVrBitmapList;
    FBitmapListLink: TVrChangeLink;
    function GetBitmap: TBitmap;
    procedure SetAutoSize(Value: Boolean);
    procedure SetCenter(Value: Boolean);
    procedure SetStretch(Value: Boolean);
    procedure SetBitmapIndex(Value: Integer);
    procedure SetBitmapList(Value: TVrBitmapList);
    procedure BitmapListChanged(Sender: TObject);
  protected
    function GetPalette: HPALETTE; override;
    function DestRect: TRect;
    procedure AdjustBounds;
    procedure Paint; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AutoSize: Boolean read FAutoSize write SetAutoSize default false;
    property Center: Boolean read FCenter write SetCenter default True;
    property Stretch: Boolean read FStretch write SetStretch default false;
    property BitmapIndex: Integer read FBitmapIndex write SetBitmapIndex default -1;
    property BitmapList: TVrBitmapList read FBitmapList write SetBitmapList;
    property Transparent default false;
    property Align;
{$IFDEF VER110}
    property Anchors;
    property Constraints;
{$ENDIF}
    property Color default clBlack;
    property DragCursor;
{$IFDEF VER110}
    property DragKind;
{$ENDIF}
    property DragMode;
    property Hint;
    property ParentColor default false;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
{$IFDEF VER130}
    property OnContextPopup;
{$ENDIF}    
    property OnDblClick;    
    property OnDragDrop;
    property OnDragOver;
{$IFDEF VER110}
    property OnEndDock;
{$ENDIF}
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
{$IFDEF VER110}
    property OnStartDock;
{$ENDIF}
    property OnStartDrag;
  end;

  TVrCounterDigits = 1..10;
  TVrCounterValue = 0..MaxInt;
  TVrCounter = class(TVrGraphicImageControl)
  private
    FValue: TVrCounterValue;
    FDigits: TVrCounterDigits;
    FAutoSize: Boolean;
    FBitmap: TBitmap;
    FSpacing: Integer;
    FDigitSize: TPoint;
    FStretch: Boolean;
    FOnChange: TNotifyEvent;
    FImage: TBitmap;
    procedure SetValue(Value: TVrCounterValue);
    procedure SetDigits(Value: TVrCounterDigits);
    procedure SetAutoSize(Value: Boolean);
    procedure SetBitmap(Value: TBitmap);
    procedure SetSpacing(Value: Integer);
    procedure SetStretch(Value: Boolean);
    procedure BitmapChanged(Sender: TObject);
  protected
    function GetPalette: HPalette; override;
    procedure CalcPaintParams;
    procedure Paint; override;
    procedure Changed; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Value: TVrCounterValue read FValue write SetValue default 0;
    property Digits: TVrCounterDigits read FDigits write SetDigits default 8;
    property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
    property Bitmap: TBitmap read FBitmap write SetBitmap;
    property Spacing: Integer read FSpacing write SetSpacing default 0;
    property Stretch: Boolean read FStretch write SetStretch default false;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property Transparent default false;
{$IFDEF VER110}
    property Anchors;
    property Constraints;
{$ENDIF}
    property Color default clBlack;
    property DragCursor;
{$IFDEF VER110}
    property DragKind;
{$ENDIF}
    property DragMode;
    property Hint;
    property ParentColor default false;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
{$IFDEF VER130}
    property OnContextPopup;
{$ENDIF}
    property OnDblClick;    
    property OnDragDrop;
    property OnDragOver;
{$IFDEF VER110}
    property OnEndDock;
{$ENDIF}
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
{$IFDEF VER110}
    property OnStartDock;
{$ENDIF}
    property OnStartDrag;
  end;

  TVrCheckBoxState = (vcbUnchecked, vcbChecked, vcbGrayed);
  TVrCheckBoxGlyphs = 1..3;
  TVrCheckBoxTexture = (cbtTile, cbtStretch);
  TVrBitmapCheckBox = class(TVrCustomImageControl)
  private
    FSpacing: Integer;
    FMargin: Integer;
    FLayout: TVrImageTextLayout;
    FState: TVrCheckBoxState;
    FNumGlyphs: TVrCheckBoxGlyphs;
    FEnabledGlyphs: TBitmap;
    FEnabledGlyphIndex: Integer;
    FDisabledGlyphs: TBitmap;
    FDisabledGlyphIndex: Integer;
    FTransparentColor: TColor;
    FTextureIndex: Integer;
    FTextureStyle: TVrCheckBoxTexture;
    FAllowGrayed: Boolean;
    FFont3D: TVrFont3D;
    FFocusColor: TColor;
    FFocusOffset: Integer;
    FFocused: Boolean;
    FSize: TPoint;
    FImageRect: TRect;
    FTextBounds: TRect;
    FBitmapList: TVrBitmapList;
    FBitmapListLink: TVrChangeLink;
    FButtonDown: Boolean;
    FOnChange: TNotifyEvent;
    function GetChecked: Boolean;
    function GetBitmap(Index: Integer): TBitmap;
    procedure SetLayout(Value: TVrImageTextLayout);
    procedure SetMargin(Value: Integer);
    procedure SetSpacing(Value: Integer);
    procedure SetState(Value: TVrCheckBoxState);
    procedure SetEnabledGlyphIndex(Value: Integer);
    procedure SetDisabledGlyphIndex(Value: Integer);
    procedure SetNumGlyphs(Value: TVrCheckBoxGlyphs);
    procedure SetTransparentColor(Value: TColor);
    procedure SetTextureIndex(Value: Integer);
    procedure SetTextureStyle(Value: TVrCheckBoxTexture);
    procedure SetFont3D(Value: TVrFont3D);
    procedure SetBitmapList(Value: TVrBitmapList);
    procedure SetChecked(Value: Boolean);
    procedure SetFocusColor(Value: TColor);
    procedure SetFocusOffset(Value: Integer);
    procedure Font3DChanged(Sender: TObject);
    procedure BitmapListChanged(Sender: TObject);
    procedure WMSize(var Message: TMessage); message WM_SIZE;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure UpdateGlyphs;
    procedure CalcPaintParams(Repaint: Boolean);
    procedure Paint; override;
    procedure Changed; dynamic;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Keypress(var Key: Char); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Toggle;
  published
    property Layout: TVrImageTextLayout read FLayout write SetLayout default ImageLeft;
    property Margin: Integer read FMargin write SetMargin default -1;
    property Spacing: Integer read FSpacing write SetSpacing default 5;
    property State: TVrCheckBoxState read FState write SetState default vcbUnchecked;
    property EnabledGlyphIndex: Integer read FEnabledGlyphIndex write SetEnabledGlyphIndex default -1;
    property DisabledGlyphIndex: Integer read FDisabledGlyphIndex write SetDisabledGlyphIndex default -1;
    property NumGlyphs: TVrCheckBoxGlyphs read FNumGlyphs write SetNumGlyphs default 3;
    property TransparentColor: TColor read FTransparentColor write SetTransparentColor default clOlive;
    property Font3D: TVrFont3D read FFont3D write SetFont3D;
    property BitmapList: TVrBitmapList read FBitmapList write SetBitmapList;
    property TextureIndex: Integer read FTextureIndex write SetTextureIndex default -1;
    property TextureStyle: TVrCheckBoxTexture read FTextureStyle write SetTextureStyle default cbtTile;
    property Checked: Boolean read GetChecked write SetChecked;
    property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed default false;
    property FocusColor: TColor read FFocusColor write SetFocusColor default clBlue;
    property FocusOffset: Integer read FFocusOffset write SetFocusOffset default 0;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
{$IFDEF VER110}
    property Anchors;
    property Constraints;
{$ENDIF}
    property Caption;
    property Color;
    property DragCursor;
{$IFDEF VER110}
    property DragKind;
{$ENDIF}
    property DragMode;
    property Enabled;
    property Font;
    property ParentFont;
    property ParentColor;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop default false;
    property Visible;
    property OnClick;
{$IFDEF VER130}
    property OnContextPopup;
{$ENDIF}
    property OnDragDrop;
    property OnDragOver;
{$IFDEF VER110}
    property OnEndDock;
{$ENDIF}
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
{$IFDEF VER110}
    property OnStartDock;
{$ENDIF}
    property OnStartDrag;
  end;

  TVrRadioButtonState = (vrbUnchecked, vrbChecked);
  TVrRadioButtonGlyphs = 1..2;
  TVrRadioButtonTexture = (rbtTile, rbtStretch);
  TVrBitmapRadioButton = class(TVrCustomImageControl)
  private
    FChecked: Boolean;
    FSpacing: Integer;
    FMargin: Integer;
    FLayout: TVrImageTextLayout;
    FNumGlyphs: TVrRadioButtonGlyphs;
    FEnabledGlyphs: TBitmap;
    FEnabledGlyphIndex: Integer;
    FDisabledGlyphs: TBitmap;
    FDisabledGlyphIndex: Integer;
    FTransparentColor: TColor;
    FTextureIndex: Integer;
    FTextureStyle: TVrRadioButtonTexture;
    FFont3D: TVrFont3D;
    FFocusColor: TColor;
    FFocusOffset: Integer;
    FFocused: Boolean;
    FSize: TPoint;
    FImageRect: TRect;
    FTextBounds: TRect;
    FBitmapList: TVrBitmapList;
    FBitmapListLink: TVrChangeLink;
    FButtonDown: Boolean;
    FOnChange: TNotifyEvent;
    function GetBitmap(Index: Integer): TBitmap;
    procedure SetLayout(Value: TVrImageTextLayout);
    procedure SetMargin(Value: Integer);
    procedure SetSpacing(Value: Integer);
    procedure SetEnabledGlyphIndex(Value: Integer);
    procedure SetDisabledGlyphIndex(Value: Integer);
    procedure SetNumGlyphs(Value: TVrRadioButtonGlyphs);
    procedure SetTransparentColor(Value: TColor);
    procedure SetTextureIndex(Value: Integer);
    procedure SetTextureStyle(Value: TVrRadioButtonTexture);
    procedure SetFont3D(Value: TVrFont3D);
    procedure SetBitmapList(Value: TVrBitmapList);
    procedure SetChecked(Value: Boolean);
    procedure SetFocusColor(Value: TColor);
    procedure SetFocusOffset(Value: Integer);
    procedure Font3DChanged(Sender: TObject);
    procedure BitmapListChanged(Sender: TObject);
    procedure WMSize(var Message: TMessage); message WM_SIZE;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure UpdateGlyphs;
    procedure CalcPaintParams(Repaint: Boolean);
    procedure Paint; override;
    procedure Changed; dynamic;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Keypress(var Key: Char); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Layout: TVrImageTextLayout read FLayout write SetLayout default ImageLeft;
    property Margin: Integer read FMargin write SetMargin default -1;
    property Spacing: Integer read FSpacing write SetSpacing default 5;
    property EnabledGlyphIndex: Integer read FEnabledGlyphIndex write SetEnabledGlyphIndex default -1;
    property DisabledGlyphIndex: Integer read FDisabledGlyphIndex write SetDisabledGlyphIndex default -1;
    property NumGlyphs: TVrRadioButtonGlyphs read FNumGlyphs write SetNumGlyphs default 2;
    property TransparentColor: TColor read FTransparentColor write SetTransparentColor default clOlive;