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:TAlignment;
FPicture:TPicture;
FTextWordwrap:Boolean;
FTextVCenter:Boolean;
procedure SetBgColorFrom(Value : TColor);
procedure SetBgColorTo(Value : TColor);
procedure SetGradientStatus(Value: Boolean);
procedure SetBorderWidth(Value: integer);
procedure SetBorderColor(Value : TColor);
//procedure SetPicture(Pic : TPicture);
procedure PictureChanged (Sender: TObject);
procedure SetPicture (aValue: TPicture);
procedure SetText(Content :
String);
procedure SetTextAlign(Alignment : TAlignment);
procedure SetGradientDirection(Direction:TGradientOrientation);
procedure SetTextWordwrap(WrapIt:Boolean);
procedure SetTextVCenter(VCenter:Boolean);
{ Private-Deklarationen }
protected
{ Protected-Deklarationen }
procedure Paint;
override;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
{ Public-Deklarationen }
published
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 : TAlignment
read FTextAlign
write SetTextAlign;
property TextWordwrap : Boolean
read FTextWordwrap
write SetTextWordwrap;
property TextVCenter : Boolean
read FTextVCenter
write SetTextVCenter;
property Picture: TPicture
read FPicture
write SetPicture;
{ Published-Deklarationen }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('
Standard', [TmyPanel]);
end;
constructor TmyPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPicture := TPicture.Create;
FPicture.OnChange := PictureChanged;
Align := alNone;
BgColorFrom := clWhite;
BgColorTo := clSilver;
BorderColor := clGray;
BorderStyle := psSolid;
BorderWidth := 2;
end;
destructor TmyPanel.Destroy;
begin
FPicture.Free;
inherited;
end;
procedure TmyPanel.PictureChanged (Sender: TObject);
begin
Invalidate;
end;
procedure TmyPanel.SetPicture (aValue: TPicture);
begin
FPicture.Assign (aValue);
// KEINE Zuweisung, sondern Assign!
end;
procedure TmyPanel.SetTextWordwrap(WrapIt:Boolean);
begin
If WrapIt = FTextWordwrap
then Exit;
// wenn gleicher Status nichts tun
FTextWordwrap := WrapIt;
// Status abspeichern
Invalidate;
// Control neu zeichnen
end;
procedure TmyPanel.SetTextVCenter(VCenter:Boolean);
begin
If VCenter = FTextVCenter
then Exit;
// wenn gleicher Status nichts tun
FTextVCenter := VCenter;
// Status abspeichern
Invalidate;
// Control neu zeichnen
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 : TAlignment);
// 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 bildes, wenn vorhanden
if Picture <>
nil then
Canvas.StretchDraw(myRect,Picture.Graphic);
//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);
//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.