A ScrollText Component

Mirror

A ScrollText Component (Views: 5)

Problem/Question/Abstract:

If you need to Scroll Text like those led advertising things you can use this 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.

<< Back to main page