abpanel.pas

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

unit AbPanel;

{******************************************************************************}
{ Abakus VCL                                                                   }
{                            Component TAbPanel                                }
{                                                                              }
{******************************************************************************}
{        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
  TAbPanelOption = (opBevelInner, opBevelOuter);
  TAbPanelOptions = set of TAbPanelOption;

  TAbPanel = class(TAbCustomControl)
  private
    { Private-Deklarationen }
    FBevelInner: TAbSBevel;
    FBevelOuter: TAbSBevel;
    FOptions: TAbPanelOptions;
  protected
    { Protected-Deklarationen }
    function GetClientRect: TRect; override;
    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
    procedure Paint; override;
    procedure ParamChange(Sender: TObject); override;
    procedure SetOptions(Value: TAbPanelOptions);
  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 OnKeyDown;
    property OnKeyUp;
    property OnEnter;
    property OnExit;
    property OnMouseMove;
    property BevelInner: TAbSBevel read FBevelInner write FBevelInner;
    property BevelOuter: TAbSBevel read FBevelOuter write FBevelOuter;
    property Options: TAbPanelOptions read FOptions write SetOptions default
      [opBevelInner, opBevelOuter];
  end;

implementation

constructor TAbPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if (AOwner is TWinControl) then Parent := AOwner as TWinControl;
  BeginUpdate;
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
    csSetCaption, csOpaque, csDoubleClicks, csReplicatable];

  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 TAbPanel.Loaded;
begin
  inherited Loaded;
  FBevelOuter.OnChange := ParamChange;
  FBevelInner.OnChange := ParamChange;
  EndUpdate;
end;

procedure TAbPanel.AlignControls(AControl: TControl; var Rect: TRect);
var
  BevelSize         : Integer;
begin
  BevelSize := 0;
  if opBevelOuter in FOptions then
  begin
    BevelSize := BevelSize + FBevelOuter.TotalWidth;
    with FBevelOuter.Offset do
    begin
      AbMultiBorder(Rect, Left, Top, Right, Bottom);
    end;
  end;

  if opBevelInner in FOptions then
  begin
    BevelSize := BevelSize + FBevelInner.TotalWidth;
    with FBevelInner.Offset do
    begin
      AbMultiBorder(Rect, Left, Top, Right, Bottom);
    end;
  end;
  AbBorder(Rect, BevelSize);
  inherited AlignControls(AControl, Rect);
end;

function TAbPanel.GetClientRect;
begin
  Windows.GetClientRect(Handle, result);
end;

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

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

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

  r := Rect(0, 0, Width, Height);
  r := GetClientRect;

  if opBevelOuter in FOptions then FBevelOuter.PaintFilledBevel(Canvas, r);
  if opBevelInner in FOptions then FBevelInner.PaintFilledBevel(Canvas, r);

end;

procedure TAbPanel.SetOptions(Value: TAbPanelOptions);
begin
  FOptions := Value;
  Change;
end;


end.