unit StatusScroll;
interface
uses
SysUtils, Classes, Controls, Graphics;
type
TStatusScroll =
class(TGraphicControl)
private
FLines: TStringList;
FFont: TFont;
FRowCount: Integer;
FAlignment: TAlignment;
procedure SetLines(
const Value: TStringList);
procedure SetFont(
const Value: TFont);
procedure SetAlignment(
const Value: TAlignment);
{ Private-Deklarationen }
protected
procedure Paint;
override;
{ Protected-Deklarationen }
public
constructor Create(AOwner : TComponent);
override;
destructor destroy;
override;
{ Public-Deklarationen }
published
property Lines : TStringList
read FLines
write SetLines;
property Font : TFont
read FFont
write SetFont;
property RowCount : Integer
read FRowCount;
property Alignment : TAlignment
read FAlignment
write SetAlignment;
{ Published-Deklarationen }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('
Beispiele', [TStatusScroll]);
end;
{ TStatusScroll }
constructor TStatusScroll.Create(AOwner: TComponent);
begin
inherited;
FFont := TFont.Create;
FLines := TStringList.Create;
end;
destructor TStatusScroll.destroy;
begin
FreeAndNil(FFont);
FreeAndNIL(FLines);
inherited;
end;
procedure TStatusScroll.Paint;
var FTextHeight, FTextWidth, t : integer;
bmp : TBitmap;
begin
inherited;
with canvas
do begin
Brush.Style:=BSClear;
Font.Assign(FFont);
Pen.Color:=Font.Color;
FTextHeight := TextHeight('
Ü,');
FRowCount := trunc( height / ( FTextHeight + 4) );
For t:= 0
to FRowCount-1
do begin
if ( t <= Flines.Count -1 )
then begin
FTextwidth := TextWidth(Flines.strings[t]);
case FAlignment
of
taLeftJustify: TextOut(2,( t * ( FTextHeight + 4 ) + 2 ),Flines.Strings[t]);
taRightJustify: TextOut(width - FTextwidth -2,( t * ( FTextHeight + 4 ) + 2 ),Flines.Strings[t]);
taCenter: TextOut(trunc ( (width - FTextwidth -4) /2 ),( t * ( FTextHeight + 4 ) + 2 ),Flines.Strings[t]);
end;
end;
end;
end;
end;
procedure TStatusScroll.SetAlignment(
const Value: TAlignment);
begin
FAlignment := Value;
Paint;
end;
procedure TStatusScroll.SetFont(
const Value: TFont);
begin
FFont.Assign(Value);
Paint;
end;
procedure TStatusScroll.SetLines(
const Value: TStringList);
begin
FLines.Assign(Value);
Paint;
end;
end.