?? abbevel.pas
字號(hào):
unit AbBevel;
{******************************************************************************}
{ Abakus VCL }
{ Component TAbBevel }
{ }
{******************************************************************************}
{ e-Mail: support@abaecker.de , 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.
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -