Mega Code Archive
Frame
<![CDATA[
Title: Frame
Question: How can I have a component with different form.
Answer:
unit RVFrame;
interface
uses
SysUtils, Classes, Controls, Graphics, Windows;
type
TRVFrameType = (rvfRectangle,rvfRoundRectangle,rvfEllipse,rvfWireStar,rvfStar,
rvfTriangle,rvfOctogon,rvfDiamond,rvfPostIt);
TRVFrame = class(TGraphicControl)
private
FFrameType : TRVFrameType;
FBrush : TBrush;
FPen : TPen;
FRndRectArcX: Integer;
FRndRectArcY: Integer;
procedure SetFrameType(Value: TRVFrameType);
procedure SetBrush(Value: TBrush);
procedure SetPen(Value: TPen);
procedure SetRndRectArcX(Value: Integer);
procedure SetRndRectArcY(Value: Integer);
protected
{ Protected declarations }
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Paint; override;
published
property Align;
property Anchors;
property FrameType: TRVFrameType read FFrameType write SetFrameType;
property Brush: TBrush read FBrush write SetBrush;
property Pen: TPen read FPen write SetPen;
property RndRectArcX: Integer read FRndRectArcX write SetRndRectArcX;
property RndRectArcY: Integer read FRndRectArcY write SetRndRectArcY;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Rendez-vous', [TRVFrame]);
end;
{ TRVFrame }
constructor TRVFrame.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Canvas.Brush.Style := bsClear;
FFrameType := rvfRectangle;
FBrush := TBrush.Create;
FBrush.Assign(Canvas.Brush);
FPen := TPen.Create;
FPen.Assign(Canvas.Pen);
FRndRectArcX := 25;
FRndRectArcY := 25;
end;
destructor TRVFrame.Destroy;
begin
FBrush.Free;
FPen.Free;
inherited Destroy;
end;
procedure TRVFrame.Paint;
var
Rct : TRect;
PtsWS: array[0..4] of TPoint;
PtsS : array[0..9] of TPoint;
PtsT : array[0..2] of TPoint;
PtsO : array[0..7] of TPoint;
PtsD : array[0..3] of TPoint;
PtsP1: array[0..4] of TPoint;
PtsP2: array[0..2] of TPoint;
GapX : Integer;
GapY : Integer;
begin
inherited Paint;
Rct := ClientRect;
Canvas.Pen.Assign(FPen);
Canvas.Brush.Assign(FBrush);
if FFrameType = rvfRectangle then
begin
Canvas.Rectangle(Rct);
end
else if FFrameType = rvfRoundRectangle then
begin
Canvas.RoundRect(Rct.Left,Rct.Top,Rct.Right,Rct.Bottom,FRndRectArcX,FRndRectArcY);
end
else if FFrameType = rvfEllipse then
begin
Canvas.Ellipse(Rct);
end
else if FFrameType = rvfStar then
begin
InflateRect(Rct,-1,-1);
Canvas.Polygon(PtsS);
end
else if FFrameType = rvfWireStar then
begin
InflateRect(Rct,-1,-1);
GapX := (Rct.Right - Rct.Left) div 6;
GapY := (Rct.Bottom - Rct.Top) div 6;
PtsWS[0].X := (Rct.Right - Rct.Left) div 2;
PtsWS[0].Y := Rct.Top;
PtsWS[1].X := Rct.Left + GapX;
PtsWS[1].Y := Rct.Bottom - GapY;
PtsWS[2].X := Rct.Right;
PtsWS[2].Y := ((Rct.Bottom - Rct.Top) div 2) - GapY;
PtsWS[3].X := Rct.Left;
PtsWS[3].Y := ((Rct.Bottom - Rct.Top) div 2) - GapY;
PtsWS[4].X := Rct.Right - GapX;
PtsWS[4].Y := Rct.Bottom - GapY;
Canvas.Polygon(PtsWS);
end
else if FFrameType = rvfTriangle then
begin
InflateRect(Rct,-1,-1);
PtsT[0].X := Rct.Left;
PtsT[0].Y := Rct.Bottom;
PtsT[1].X := (Rct.Right - Rct.Left) div 2;
PtsT[1].Y := Rct.Top;
PtsT[2].X := Rct.Right;
PtsT[2].Y := Rct.Bottom;
Canvas.Polygon(PtsT);
end
else if FFrameType = rvfOctogon then
begin
InflateRect(Rct,-1,-1);
GapX := (Rct.Right - Rct.Left) div 3;
GapY := (Rct.Bottom - Rct.Top) div 3;
PtsO[0].X := Rct.Left + GapX;
PtsO[0].Y := Rct.Top;
PtsO[1].X := Rct.Right - GapX;
PtsO[1].Y := Rct.Top;
PtsO[2].X := Rct.Right;
PtsO[2].Y := Rct.Top + GapY;
PtsO[3].X := Rct.Right;
PtsO[3].Y := Rct.Bottom - GapY;
PtsO[4].X := Rct.Right - GapX;
PtsO[4].Y := Rct.Bottom;
PtsO[5].X := Rct.Left + GapX;
PtsO[5].Y := Rct.Bottom;
PtsO[6].X := Rct.Left;
PtsO[6].Y := Rct.Bottom - GapY;
PtsO[7].X := Rct.Left;
PtsO[7].Y := Rct.Top + GapY;
Canvas.Polygon(PtsO);
end
else if FFrameType = rvfDiamond then
begin
InflateRect(Rct,-1,-1);
GapX := (Rct.Right - Rct.Left) div 2;
GapY := (Rct.Bottom - Rct.Top) div 2;
PtsD[0].X := Rct.Left + GapX;
PtsD[0].Y := Rct.Top;
PtsD[1].X := Rct.Right;
PtsD[1].Y := Rct.Top + GapY;
PtsD[2].X := Rct.Left + GapX;
PtsD[2].Y := Rct.Bottom;
PtsD[3].X := Rct.Left;
PtsD[3].Y := Rct.Top + GapY;
Canvas.Polygon(PtsD);
end
else if FFrameType = rvfPostIt then
begin
InflateRect(Rct,-1,-1);
if (Rct.Right - Rct.Left) (Rct.Bottom - Rct.Top) then
begin
GapX := (Rct.Bottom - Rct.Top) div 4;
GapY := (Rct.Bottom - Rct.Top) div 4;
end
else if (Rct.Right - Rct.Left) begin
GapX := (Rct.Right - Rct.Left) div 4;
GapY := (Rct.Right - Rct.Left) div 4;
end
else
begin
GapX := (Rct.Right - Rct.Left) div 4;
GapY := (Rct.Bottom - Rct.Top) div 4;
end;
PtsP1[0].X := Rct.Left;
PtsP1[0].Y := Rct.Top;
PtsP1[1].X := Rct.Right;
PtsP1[1].Y := Rct.Top;
PtsP1[2].X := Rct.Right;
PtsP1[2].Y := Rct.Bottom - GapY;
PtsP1[3].X := Rct.Right - GapX;
PtsP1[3].Y := Rct.Bottom;
PtsP1[4].X := Rct.Left;
PtsP1[4].Y := Rct.Bottom;
Canvas.Polygon(PtsP1);
PtsP2[0].X := Rct.Right - GapX;
PtsP2[0].Y := Rct.Bottom;
PtsP2[1].X := Rct.Right - GapX;
PtsP2[1].Y := Rct.Bottom - GapY;
PtsP2[2].X := Rct.Right;
PtsP2[2].Y := Rct.Bottom - GapY;
Canvas.Polygon(PtsP2);
end;
Canvas.FloodFill((Rct.Right - Rct.Left) div 2,(Rct.Bottom - Rct.Top) div 2,FBrush.Color,fsSurface);
if FFrameType = rvfPostIt then
begin
Canvas.Brush.Color := Canvas.Pen.Color;
Canvas.FloodFill(Rct.Right - GapX + 3,Rct.Bottom - GapY + 3,Canvas.Pen.Color,fsBorder);
end;
end;
procedure TRVFrame.SetBrush(Value: TBrush);
begin
if Value FBrush then
begin
FBrush.Assign(Value);
Invalidate;
end;
end;
procedure TRVFrame.SetFrameType(Value: TRVFrameType);
begin
if Value FFrameType then
begin
FFrameType := Value;
invalidate;
end;
end;
procedure TRVFrame.SetPen(Value: TPen);
begin
if Value FPen then
begin
FPen.Assign(Value);
Invalidate;
end;
end;
procedure TRVFrame.SetRndRectArcX(Value: Integer);
begin
if Value FRndRectArcX then
begin
FRndRectArcX := Value;
if FRndRectArcX FRndRectArcX := 1;
Invalidate;
end;
end;
procedure TRVFrame.SetRndRectArcY(Value: Integer);
begin
if Value FRndRectArcY then
begin
FRndRectArcY := Value;
if FRndRectArcY FRndRectArcY := 1;
Invalidate;
end;
end;
end.
]]>