Mega Code Archive
A ScrollText Component
<![CDATA[
Title: A ScrollText Component
Question: If you need to Scroll Text like those led advertising things you can use this component.
Answer:
//MWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
// Scroll Text Component
// Author: Jorge Abel Ayala Marentes
// Created: 25/01/2001
//MWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
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
//MWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
procedure TScrollText.CustomOnTimer(Sender: TObject);
begin
ScrollText;
//Move text
Inc(vi_Mv, vi_St);
end;//end of TScrollText.CustomOnTimer
//MWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
destructor TScrollText.Destroy;
begin
FTimer.Free;
inherited;
end;//end of TScrollText.Destroy
//MWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
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 Bitmaps Height to equal the Messages 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 vi_St:=1;
//Set Bitmaps 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
//MWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
procedure TScrollText.SetText(const Value: String);
begin
if Value FText then
FText := Value;
ScrollText;
end;//end of TScrollText.SetText
//MWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
procedure TScrollText.SetTextColor(const Value: TColorType);
begin
if FTextColor Value then
FTextColor := Value;
end;//end of TScrollText.SetTextColor
//MWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
end.
]]>