A ScrollText Component

Answer

//
// Scroll Text Component
// Author: Jorge Abel Ayala Marentes
// Created: 25/01/2001
//
unit ScrollText;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;

type
TColorType = (ctGreen, ctRed, ctBlue);

TScrollText = class(TComponent)
private
FText: string;
FTimer: TTimer;
FTextColor: TColorType;
vi_Mv, vi_St: Integer;
procedure SetText(const Value: string);
procedure CustomOnTimer(Sender: TObject);
procedure SetTextColor(const Value: TColorType);
protected
public
procedure ScrollText;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Text: string read FText write SetText;
property TextColor: TColorType read FTextColor write SetTextColor;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents(‘prueba’, [TScrollText]);
end;

{ TScrollText }

constructor TScrollText.Create(AOwner: TComponent);
begin
inherited;
vi_Mv := 0;
vi_St := 1;

FTimer := TTimer.Create(Self);
with FTimer do
begin
Enabled := True;
Interval := 5;
OnTimer := CustomOnTimer;
end;

if not (AOwner.InheritsFrom(TForm)) then
raise Exception.Create(‘This Component can only be dropped on Forms!’);

//Set the Forms Height
with (Owner as TForm) do
begin
Height := 90;
Color := clBlack;
BorderStyle := bsDialog;
Caption := ”;
end;

ScrollText;
end; //end of TScrollText.Create

procedure TScrollText.CustomOnTimer(Sender: TObject);
begin
ScrollText;

//Move text
Inc(vi_Mv, vi_St);
end; //end of TScrollText.CustomOnTimer

destructor TScrollText.Destroy;
begin
FTimer.Free;
inherited;
end; //end of TScrollText.Destroy

procedure TScrollText.ScrollText;
var
Bitmap: TBitmap;
Rect: TRect;
vi_Counter: Integer;
begin
if not (csDesigning in Self.ComponentState) then
begin
//Create a Bitmap to draw the text
Bitmap := TBitmap.Create;
try
//set Bitmap´s Height to equal the Message´s Height
Bitmap.Height := Bitmap.Canvas.TextHeight(Text);

//If the text has reaced the end then rewind
if vi_Mv >= Bitmap.Canvas.Textwidth(Text) then
vi_St := -16;

//if its at the beginning, go forward
if vi_Mv <= 0 then
vi_St := 1;

//Set Bitmap´s Width
Bitmap.Width := (Owner as TForm).Width div 4;

with Bitmap.Canvas do
begin
//We are Filling it with Solid Dark Green
Brush.Style := bssolid;
//The colour goes BBGGRR in hex – look up TColor
case TextColor of
ctGreen:
begin
Brush.Color := $005000;
Fillrect(ClipRect);
Font.Color := $00FF00;
end;
ctRed:
begin
Brush.Color := $000050;
Fillrect(ClipRect);
Font.color := $0000FF;
end;
ctBlue:
begin
Brush.Color := $500000;
Fillrect(ClipRect);
Font.color := $FF0000;
end;
end;
Textout(-vi_Mv, 0, Text);
Rect := Cliprect;
//Enlarge the image to twice its original size
Bitmap.Height := Bitmap.Height * 2;
Bitmap.Width := Bitmap.Width * 2;

CopyRect(ClipRect, Bitmap.canvas, Rect);
//Set up pen for solid black
Pen.Style := pssolid;
Pen.Color := clblack;

//Draw a grid of lines across the bitmap in X+Y
for vi_Counter := 0 to Bitmap.Height div 2 do
begin
MoveTo(0, vi_Counter * 2);
LineTo(Bitmap.width, vi_Counter * 2);
end;

for vi_Counter := 0 to Bitmap.width div 2 do
begin
MoveTo(vi_Counter * 2, 0);
LineTo(vi_counter * 2, Bitmap.height);
end;

//Stretch bitmap again and draw twice its size on the form
Rect := Bitmap.Canvas.ClipRect;
Rect.Bottom := Rect.Bottom * 2;
Rect.Right := Rect.Right * 2;
(Owner as TForm).Canvas.StretchDraw(Rect, Bitmap);

end;
finally
Bitmap.Free;
end;
end;
end; //end of TScrollText.ScrollText

procedure TScrollText.SetText(const Value: string);
begin
if Value <> FText then
FText := Value;

ScrollText;
end; //end of TScrollText.SetText

procedure TScrollText.SetTextColor(const Value: TColorType);
begin
if FTextColor <> Value then
FTextColor := Value;
end; //end of TScrollText.SetTextColor

end.