abbevel.pas

著名的虚拟仪表控件,包含全部源码, 可以在,delphi2007 下安装运行

unit AbBevel;

{******************************************************************************}
{ Abakus VCL                                                                   }
{                           Component TAbBevel                                 }
{                                                                              }
{******************************************************************************}
{        e-Mail: [e-mail] , Web: http://www.abaecker.com            }
{------------------------------------------------------------------------------}
{          (c) Copyright 1998..2000 A.Baecker, All rights Reserved             }
{******************************************************************************}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  extctrls, _GClass, _AbProc;

type
  TAbBevelOption = (opBevelInner, opBevelOuter, opTranparent);
  TAbBevelOptions = set of TAbBevelOption;

  TAbBevel = class(TAbGraphicControl)
  private
    { Private-Deklarationen }
    FBevelInner: TAbSBevel;
    FBevelOuter: TAbSBevel;
    FOptions: TAbBevelOptions;
  protected
    { Protected-Deklarationen }
    procedure Paint; override;
    procedure ParamChange(Sender: TObject); override;
    procedure SetOptions(Value: TAbBevelOptions);
  public
    { Public-Deklarationen }
    InnerRect: TRect;                   // BevelInnerRect
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
  published
    { Published-Deklarationen }
    property Align;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseUp;
    property OnStartDrag;
    property BevelInner: TAbSBevel read FBevelInner write FBevelInner;
    property BevelOuter: TAbSBevel read FBevelOuter write FBevelOuter;
    property Options: TAbBevelOptions read FOptions write SetOptions default
    [opBevelInner, opBevelOuter];

  end;

implementation

constructor TAbBevel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if (AOwner is TWinControl) then Parent := AOwner as TWinControl;

  BeginUpdate;
  SetBounds(Left, Top, 100, 100);

  FBevelInner := TAbSBevel.Create;
  FBevelInner.Style := bsLowered;
  FBevelInner.Spacing := 5;
  FBevelInner.Width := 2;
  FBevelInner.BevelLine := blInner;

  FBevelOuter := TAbSBevel.Create;
  FBevelOuter.Spacing := 5;
  FBevelOuter.BevelLine := blOuter;
  FBevelOuter.Width := 2;

  FOptions := [opBevelInner, opBevelOuter];

  if (csDesigning in Componentstate) then Loaded;

end;

procedure TAbBevel.Loaded;
begin
  inherited Loaded;
  FBevelOuter.OnChange := ParamChange;
  FBevelInner.OnChange := ParamChange;
  EndUpdate;
end;

destructor TAbBevel.Destroy;
begin
  FBevelInner.Free;
  FBevelOuter.Free;
  inherited;
end;

procedure TAbBevel.ParamChange(Sender: TObject);
begin
  inherited ParamChange(Sender);
  Invalidate;
end;

procedure TAbBevel.Paint;
var
  r                 : TRect;
begin
  if not Visible and not (csDesigning in Componentstate) then Exit;

  r := ClientRect;
  if opTranparent in FOptions then
  begin
    if opBevelOuter in FOptions then FBevelOuter.PaintBevel(Canvas, r);
    if opBevelInner in FOptions then FBevelInner.PaintBevel(Canvas, r);
  end
  else
  begin
    if opBevelOuter in FOptions then FBevelOuter.PaintFilledBevel(Canvas, r);
    if opBevelInner in FOptions then FBevelInner.PaintFilledBevel(Canvas, r);
  end;
  InnerRect := r;

end;

procedure TAbBevel.SetOptions(Value: TAbBevelOptions);
begin
  FOptions := Value;
  Change;
end;


end.