unit RundPanel; 
 
interface 
 
uses 
  Windows, Classes, Graphics, Controls, ExtCtrls; 
 
type 
  TRundPanel = class(TPanel) 
  private 
    rhell, rdunkel: TColor; 
    w, h: integer; 
    rct: TRect; 
    rgn: HRgn; 
  protected 
    procedure setdunkel(f: TColor); 
    procedure sethell(f: TColor); 
    procedure formen; 
  public 
    constructor Create(Owner: TComponent); override; 
    procedure Resize; override; 
    procedure Loaded; override; 
    procedure Paint; override; 
  published 
    property RandDunkel: TColor read rdunkel write setdunkel; 
    property RandHell: TColor read rhell write sethell; 
  end; 
 
procedure Register; 
 
implementation 
 
procedure Register; 
begin 
  RegisterComponents('DBR', [TRundPanel]); 
end; 
 
constructor TRundPanel.Create(Owner: TComponent); 
begin 
  inherited Create(Owner); 
  rhell := clBtnHighLight; 
  rdunkel := clBtnShadow; 
  height := 70; 
  width := 120; 
end; 
 
procedure TRundPanel.formen; 
begin 
  h := height * 2 div 3; 
  w := width * 4 div 3; 
  rgn := CreateEllipticRgn(0, 0, width, height); 
  setwindowRgn(handle, rgn, true); 
  rct := clientrect; 
  repaint; 
end; 
 
procedure TRundPanel.resize; 
begin 
  inherited; 
  formen; 
end; 
 
procedure TRundPanel.loaded; 
begin 
  inherited; 
  formen; 
end; 
 
procedure TRundPanel.sethell(f: TColor); 
begin 
  if f = rhell then exit; 
  rhell := f; 
  repaint; 
end; 
 
procedure TRundPanel.setdunkel(f: TColor); 
begin 
  if f = rdunkel then exit; 
  rdunkel := f; 
  repaint; 
end; 
 
procedure TRundPanel.paint; 
var br: integer; 
begin 
  Canvas.Font := Font; 
  with canvas do begin 
    brush.color := color; 
    fillrect(cliprect); 
    drawtext(canvas.handle, PChar(Caption), -1, rct, 
      DT_SINGLELINE or DT_CENTER or DT_VCENTER); 
    if bevelouter <> bvNone then begin 
      br := succ(bevelwidth); 
      pen.width := succ(br); 
      if bevelouter = bvLowered then 
        pen.color := rhell else 
        pen.color := rdunkel; 
      arc(0, 0, width - 1, height - 1, 0, h, w, 0); 
      if bevelouter = bvLowered then 
        pen.color := rdunkel else 
        pen.color := rhell; 
      arc(0, 0, width - 1, height - 1, w, 0, -bevelwidth, h); 
    end else br := 0; 
    if bevelinner <> bvNone then begin 
      pen.width := bevelwidth + ord(bevelouter = bvNone); 
      if bevelinner = bvLowered then 
        pen.color := rhell else 
        pen.color := rdunkel; 
      arc(br, br, width - 1 - br, height - 1 - br, 0, h - bevelwidth, w, 0); 
      if bevelinner = bvLowered then 
        pen.color := rdunkel else 
        pen.color := rhell; 
      arc(br, br, width - 1 - br, height - 1 - br, w, bevelwidth, 
        0, h - bevelwidth); 
    end; 
  end; 
end; 
 
end.