unit uDings;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TDings =
class(TGraphicControl)
private
FInfoUnten:
string;
FInfoOben:
string;
procedure SetInfoOben(
const Value:
string);
procedure SetInfoUnten(
const Value:
string);
protected
procedure Paint;
override;
published
property InfoOben:
string read FInfoOben
write SetInfoOben;
property InfoUnten:
string read FInfoUnten
write SetInfoUnten;
end;
TFormTest =
class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private-Deklarationen }
FDings: TDings;
public
{ Public-Deklarationen }
end;
var
FormTest: TFormTest;
implementation
{$R *.dfm}
procedure TDings.Paint;
const
BEVELWIDTH = 20;
var
R: TRect;
begin
inherited;
Canvas.Brush.Style := bsClear;
Canvas.Pen.Width := 2;
Canvas.MoveTo(0, BEVELWIDTH);
Canvas.LineTo(0, 0);
Canvas.LineTo(BEVELWIDTH, 0);
Canvas.MoveTo(Width - BEVELWIDTH, 0);
Canvas.LineTo(Width, 0);
Canvas.LineTo(Width, BEVELWIDTH);
Canvas.MoveTo(Width, Height - BEVELWIDTH);
Canvas.LineTo(Width, Height);
Canvas.LineTo(Width - BEVELWIDTH, Height);
Canvas.MoveTo(BEVELWIDTH, Height);
Canvas.LineTo(0, Height);
Canvas.LineTo(0, Height - BEVELWIDTH);
R := Rect(0, 0, Width, Height);
InflateRect(R, -3, -2);
DrawText(Canvas.Handle, PChar(FInfoOben), -1, R, DT_SINGLELINE
or DT_TOP
or DT_LEFT);
DrawText(Canvas.Handle, PChar(FInfoUnten), -1, R, DT_SINGLELINE
or DT_BOTTOM
or DT_LEFT);
end;
procedure TFormTest.FormCreate(Sender: TObject);
begin
FDings := TDings.Create(self);
FDings.Left := 20;
FDings.Top := 20;
FDings.Width := 200;
FDings.Height := 100;
FDings.Parent := self;
FDings.InfoOben := '
Oberer Text';
FDings.InfoUnten := '
Unterer Text';
end;
procedure TDings.SetInfoOben(
const Value:
string);
begin
FInfoOben := Value;
Invalidate;
end;
procedure TDings.SetInfoUnten(
const Value:
string);
begin
FInfoUnten := Value;
Invalidate;
end;
end.