unit myPanel;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Graphics;
type
TbdStyle = (bdNone, bdSolid, bdDashed, bdClear, bdDotted);
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
FBgColorFrom : TColor;
FBgColorTo : TColor;
FPaintGradient : Boolean;
FGradientDirection : TGradientOrientation;
FBorderColor:TColor;
FBorderStyle:TPenStyle;
FBorderWidth:integer;
FRoundEdges:boolean;
FCornerWidth:integer;
FText:
String;
FTextAlign:Cardinal;
FPicture:TGraphic;
procedure SetBgColorFrom(Value : TColor);
procedure SetBgColorTo(Value : TColor);
procedure SetGradientStatus(Value: Boolean);
procedure SetBorderWidth(Value: integer);
procedure SetBorderColor(Value : TColor);
procedure SetPicture(Pic : TGraphic);
procedure SetText(Content :
String);
procedure SetTextAlign(Alignment : Cardinal);
procedure SetGradientDirection(Direction:TGradientOrientation);
{ 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 : TGradientOrientation
read FGradientDirection
write SetGradientDirection;
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;
property Picture : TGraphic
read FPicture
write SetPicture;
property Text :
String read FText
write SetText;
property TextAlign : Cardinal
read FTextAlign
write SetTextAlign;
{ 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.SetPicture(Pic : TGraphic);
begin
If Pic = FPicture
then Exit;
// wenn gleicher Status nichts tun
FPicture := Pic;
// Status abspeichern
Invalidate;
// Control neu zeichnen
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.SetGradientDirection(Direction:TGradientOrientation);
begin
If Direction = FGradientDirection
then Exit;
// wenn gleicher Status nichts tun
FGradientDirection := Direction;
// 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 TmyPanel.SetText(Content :
String);
// Settermethode
begin
If Content = FText
then Exit;
// wenn gleicher Inhalt nichts tun
FText := Content;
// Inhalt abspeichern
Invalidate;
// Control neu zeichnen
end;
procedure TmyPanel.SetTextAlign(Alignment : Cardinal);
// Settermethode
begin
If Alignment = FTextAlign
then Exit;
// wenn gleicher Inhalt nichts tun
FTextAlign := Alignment;
// Inhalt abspeichern
Invalidate;
// Control neu zeichnen
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
myRect,TextRect : TRect;
begin
myRect := GetClientRect;
Canvas.FillRect(myRect);
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := FBgColorFrom;
Canvas.Pen.Mode := pmCopy;
Canvas.Pen.Style := BorderStyle;
Canvas.Pen.Width := BorderWidth;
Canvas.Pen.Color := BorderColor;
//zeichnen des gradients
if PaintGradient
then
DrawGradient(Canvas, BgColorFrom, BgColorTo, myRect, GradientDirection);
//zeichnen des rahmens
Canvas.MoveTo(0,0);
Canvas.LineTo(myRect.Left,myRect.Bottom);
Canvas.MoveTo(0,0);
Canvas.LineTo(myRect.Right,myRect.Top);
Canvas.MoveTo(self.Width,0);
Canvas.LineTo(myRect.Right,myRect.Bottom);
Canvas.MoveTo(0,self.Height);
//links unten
Canvas.LineTo(myRect.Right,myRect.Bottom);
//zeichnen des bildes, wenn vorhanden
if Picture <>
nil then
Canvas.StretchDraw(myRect,Picture);
//schreiben des textes
TextRect := Rect(BorderWidth, BorderWidth, self.Width-BorderWidth, self.Height-BorderWidth);
SetBkMode(Canvas.Handle, TRANSPARENT);
DrawText(self.Canvas.Handle, PChar(FText), -1, TextRect,
DT_VCENTER
or DT_VCENTER
or DT_WORDBREAK);
end;
end.