unit myPanel;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Graphics;
type
TbdStyle = (bdNone, bdSolid, bdDashed, bdClear, bdDotted);
TGdDirection = (gdHorizontal, gdVertical, gdDiagonal);
TGradientOrientation = (goVertical, goHorizontal);
type
TPixelRec =
packed record
case Boolean
of
true: (Color: TColor);
false: (r, g, b, Reserved: Byte);
end;
type
TmyPanel =
class(TCustomControl)
private
FAlign : TAlign;
FBgColorFrom : TColor;
FBgColorTo : TColor;
FPaintGradient : Boolean;
FGradientDirection : TGdDirection;
FBorderColor:TColor;
FBorderStyle:TPenStyle;
FBorderWidth:integer;
FRoundEdges:boolean;
FCornerWidth:integer;
procedure SetBgColorFrom(Value : TColor);
procedure SetBgColorTo(Value : TColor);
procedure SetGradientStatus(Value: Boolean);
procedure SetBorderWidth(Value: integer);
procedure SetBorderColor(Value : TColor);
{ Private-Deklarationen }
protected
{ Protected-Deklarationen }
procedure Paint;
override;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
{ Public-Deklarationen }
published
//property Align : TAlign read FAlign write FAlign;
property Align;
property BgColorFrom : TColor
read FBgColorFrom
write SetBgColorFrom;
property BgColorTo : TColor
read FBgColorTo
write SetBgColorTo;
property PaintGradient : boolean
read FPaintGradient
write SetGradientStatus;
property GradientDirection : TGdDirection
read FGradientDirection
write FGradientDirection;
property BorderColor : TColor
read FBorderColor
write SetBorderColor;
property BorderStyle : TPenStyle
read FBorderStyle
write FBorderStyle;
property BorderWidth : integer
read FBorderWidth
write SetBorderWidth;
property RoundEdges : boolean
read FRoundEdges
write FRoundEdges;
property CornerWidth : integer
read FCornerWidth
write FCornerWidth;
{ Published-Deklarationen }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('
Standard', [TmyPanel]);
end;
constructor TmyPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Align := alNone;
BgColorFrom := clWhite;
BgColorTo := clSilver;
BorderColor := clGray;
BorderStyle := psSolid;
BorderWidth := 2;
end;
destructor TmyPanel.Destroy;
begin
inherited;
end;
procedure TmyPanel.SetGradientStatus(Value:Boolean);
begin
If Value = FPaintGradient
then Exit;
// wenn gleicher Status nichts tun
FPaintGradient := Value;
// Status abspeichern
Invalidate;
// Control neu zeichnen
end;
procedure TmyPanel.SetBorderWidth(Value:integer);
begin
If Value = FBorderWidth
then Exit;
// wenn gleicher Status nichts tun
FBorderWidth := Value;
// Status abspeichern
Invalidate;
// Control neu zeichnen
end;
procedure TmyPanel.SetBorderColor(Value : TColor);
// Settermethode
begin
If Value = FBorderColor
then Exit;
// wenn gleiche Farbe nichts tun
FBorderColor := Value;
// Farbe abspeichern
Invalidate;
// Control neu zeichnen
end;
procedure TmyPanel.SetBgColorFrom(Value : TColor);
// Settermethode
begin
If Value = FBgColorFrom
then Exit;
// wenn gleiche Farbe nichts tun
FBgColorFrom := Value;
// Farbe abspeichern
Invalidate;
// Control neu zeichnen
end;
procedure TmyPanel.SetBgColorTo(Value : TColor);
begin
If Value = FBgColorTo
then Exit;
FBgColorTo := Value;
Invalidate;
end;
procedure DrawGradient(
const Canvas: TCanvas; Color1, Color2: TColor;
ARect: TRect; GradientOrientation: TGradientOrientation);
var
c1, c2, c: TPixelRec;
//for easy access to RGB values as well as TColor value
x, y: Integer;
//current pixel position to be set
OldPenWidth: Integer;
//Save old settings to restore them properly
OldPenStyle: TPenStyle;
//see above
begin
c1.Color := ColorToRGB(Color1);
//convert system colors to RGB values
c2.Color := ColorToRGB(Color2);
//if neccessary
OldPenWidth := Canvas.Pen.Width;
//get old settings
OldPenStyle := Canvas.Pen.Style;
Canvas.Pen.Width:=1;
//ensure correct pen settings
Canvas.Pen.Style:=psInsideFrame;
case GradientOrientation
of
goVertical:
begin
for y := 0
to ARect.Bottom - ARect.Top
do
begin
c.r := Round(c1.r + (c2.r - c1.r) * y / (ARect.Bottom - ARect.Top));
c.g := Round(c1.g + (c2.g - c1.g) * y / (ARect.Bottom - ARect.Top));
c.b := Round(c1.b + (c2.b - c1.b) * y / (ARect.Bottom - ARect.Top));
Canvas.Brush.Color := c.Color;
Canvas.FillRect(Classes.Rect(ARect.Left, ARect.Top + y,
ARect.Right, ARect.Top + y + 1));
end;
end;
goHorizontal:
begin
for x := 0
to ARect.Right - ARect.Left
do
begin
c.r := Round(c1.r + (c2.r - c1.r) * x / (ARect.Right - ARect.Left));
c.g := Round(c1.g + (c2.g - c1.g) * x / (ARect.Right - ARect.Left));
c.b := Round(c1.b + (c2.b - c1.b) * x / (ARect.Right - ARect.Left));
Canvas.Brush.Color := c.Color;
Canvas.FillRect(Rect(ARect.Left + x, ARect.Top,
ARect.Left + x + 1, ARect.Bottom));
end;
end;
end;
Canvas.Pen.Width := OldPenWidth;
//restore old settings
Canvas.Pen.Style := OldPenStyle;
end;
procedure TmyPanel.Paint;
var
Rect,TextRect : TRect;
begin
Rect := GetClientRect;
Canvas.FillRect(Rect);
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := FBgColorFrom;
Canvas.Pen.Mode := pmCopy;
Canvas.Pen.Style := BorderStyle;
Canvas.Pen.Width := BorderWidth;
Canvas.Pen.Color := BorderColor;
if PaintGradient
then
DrawGradient(Canvas, BgColorFrom, BgColorTo, Rect, goVertical);
Canvas.MoveTo(0,0);
Canvas.LineTo(Rect.Left,Rect.Bottom);
Canvas.MoveTo(0,0);
Canvas.LineTo(Rect.Right,Rect.Top);
Canvas.MoveTo(self.Width,0);
Canvas.LineTo(Rect.Right,Rect.Bottom);
Canvas.MoveTo(0,self.Height);
//links unten
Canvas.LineTo(Rect.Right,Rect.Bottom);
//Canvas.MoveTo(Rect.Right,0);
//Canvas.LineTo(Rect.Right,Rect.Bottom);
//TextRect := Rect(2, 2, self.Width-2, TitleHeight-2);
//SetBkMode(Canvas.Handle, TRANSPARENT);
//DrawText(self.Canvas.Handle, PChar(FCaption), -1, TextRect,
// DT_CENTER or DT_VCENTER or DT_SINGLELINE);
//Canvas.TextOut(1,1,'Test');
end;
end.