Mega Code Archive
A frame component
<![CDATA[
Title: A frame component
Question: How can I add a frame to a component?
Answer:
Bellow you have a component that draw a frame arround of a component.
Copy and paste the code and you will obtain the RbsFrame Component.
unit RbsFrame;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,extctrls;
type
TRbsButton=class(TGraphicControl)
private
fhighlightcolor:TColor;
fshadowcolor:Tcolor;
fstate:Boolean;
fframewidth:integer;
procedure SetHighLightColor(value:TColor);
procedure SetShadowColor(value:TColor);
procedure paint; override;
procedure SetFrameWidth(value:integer);
protected
public
constructor Create(AOwner:TComponent);override;
published
property HightLightColor:Tcolor read fHighLightcolor write SetHighLightColor;
property ShadowColor:Tcolor read fShadowcolor write SetShadowColor;
property FrameWidth:integer read fframewidth write SetFrameWidth;
property OnMouseMove;
property OnClick;
end;
type
TRbsFrame = class(TGraphicControl)
private
{ Private declarations }
FControl:TControl;
FBevelWidth:integer;
FHighlightColor:TColor;
FShadowColor:TColor;
procedure SetHighlightColor(value:TColor);
procedure SetShadowColor(value:TColor);
procedure SeTControl(Value:TControl);
function GetControl:TControl;
procedure SetBevelWidth(Value:integer);
procedure drawframe(iwidth,iheight:Integer);
protected
{ Protected declarations }
procedure paint;override;
procedure Notification(AComponent:TComponent; Operation:TOperation);override;
public
{ Public declarations }
constructor create(AOwner:TComponent);override;
destructor destroy; override;
published
{ Published declarations }
property AttachToControl:TControl read Getcontrol write SeTControl;
property BevelWidth:integer read FBevelWidth write SetBevelWidth;
property ShadowColor:TColor read fShadowColor write SetShadowColor;
property HighlightColor:TColor read fHighlightColor write SetHighlightColor;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Rombest', [TRbsFrame,TRbsButton]);
end;
constructor TRBSFrame.Create(AOwner:TComponent);
begin
inherited create(AOwner);
ControlStyle := ControlStyle-[csopaque];
width:=75;
height:=25;
fbevelwidth:=1;
fshadowColor:=clBtnShadow;
fHighlightColor:=clbtnHighlight;
end;
function TRbsFrame.GetControl:TControl;
begin
if fcontrol is TRbsFrame then result:=nil
else result:=fcontrol;
end;
procedure TRbsFrame.SeTControl(Value:TControl);
begin
if (valuefcontrol) then
fcontrol:=value;
invalidate;
end;
procedure TRbsFrame.SetBevelWidth(Value:integer);
begin
if valuefbevelwidth then fbevelwidth:=value;
invalidate;
end;
procedure TRBSFrame.drawframe(iwidth,iheight:Integer);
var r:TRect;
begin
r:=Rect(0,0,iwidth,iheight);
frame3d(canvas,r,fhighlightColor,fshadowColor,fbevelwidth);
r:=Rect(fbevelwidth,fbevelwidth,iwidth-fbevelwidth,iheight-fbevelwidth);
frame3d(canvas,r,fshadowColor,fhighlightColor,fbevelwidth);
end;
procedure TRbsFrame.paint;
begin
if (fcontrol=nil) then
begin
drawframe(width,height);
exit;
end;
sendtoback;
width:=fcontrol.Width+4*fbevelwidth;
height:=fcontrol.Height+4*fbevelwidth;
top:=fcontrol.Top-2*fbevelwidth;
left:=fcontrol.Left-2*fbevelwidth;
drawframe(width,height);
end;
procedure TRbsFrame.Notification(AComponent:TComponent; Operation:TOperation);
begin
inherited notification(AComponent,Operation);
if (operation=opremove) and (acomponent=fcontrol) then
fcontrol:=nil;
end;
procedure TRbsFrame.SetHighlightColor(Value:TColor);
begin
if value=fHighlightColor Then exit;
fhighlightColor:=value;
invalidate;
end;
procedure TRbsFrame.SetShadowColor(value:TColor);
begin
if value=fshadowcolor then exit;
fshadowcolor:=value;
invalidate;
end;
destructor TRbsFrame.destroy;
begin
SetControl(nil);
inherited;
end;
//TRbsButton
constructor TRbsButton.Create(AOwner:TComponent);
begin
inherited create(aowner);
controlstyle:=controlstyle-[csopaque];
width:=75;
height:=25;
fShadowcolor:=clbtnShadow;
fHighLightColor:=clBtnHighLight;
fstate:=false;
fframewidth:=1;
end;
procedure TRbsButton.SetHighLightColor(value:TColor);
begin
if value=fHighLightcolor then exit;
fHighLightcolor:=value;
invalidate;
end;
procedure TRbsButton.CMMouseEnter(var msg:TMessage);
begin
inherited;
fstate:=true;
invalidate;
end;
procedure TRbsButton.CMMouseLeave(var msg:TMessage);
begin
inherited;
fstate:=false;
invalidate;
end;
procedure TRbsButton.paint;
var r:TRect;
x,y:integer;
begin
inherited paint;
canvas.brush.Style:=bsclear;
if fstate then
begin
//paint up
r:=rect(0,0,width,height);
frame3d(canvas,r,fhighlightcolor,fshadowcolor,fframewidth);
end
else
begin
canvas.pen.Width:=fframewidth;
canvas.Pen.Color:=fHighLightColor;
canvas.Rectangle(0,0,width,height);
end;
end;
procedure TRbsButton.SetShadowColor(value:TColor);
begin
if value=fShadowcolor then exit;
fShadowColor:=value;
invalidate;
end;
procedure TRbsButton.SetFrameWidth(value:integer);
begin
if value=fframewidth then exit;
fframewidth:=value;
invalidate;
end;
end.
]]>