Wednesday, March 28, 2012

Scrolling Window Caption Bar Title

// Scrolling Window Caption Bar Title

// Screen shot of running application

// dfm
object Form1: TForm1
  Caption = 'Scrolling Window Caption Bar Title'
  Position = poScreenCenter
  object Button1: TButton
    Caption = 'Start Animation'
    Default = True
    OnClick = Button1Click
  end
  object Edit1: TEdit
    Text = 'Scrolling Window Caption Bar Title'
  end
  object Timer1: TTimer
    Enabled = False
    Interval = 100
    OnTimer = Timer1Timer
  end
end

// unit1
type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);

const
   {$J+}       // using assignable typed constant
   scrollingCaption : string = 'Scrolling Window Caption Bar Title...';
   {$J-}
var
  Form1: TForm1;

implementation

{$R *.dfm}
// ********************************************************** //
procedure TForm1.Button1Click(Sender: TObject);
// ********************************************************** //
begin
   if TButton(Sender).Caption='Start Animation' then
   begin
      scrollingCaption:=' >> '+Edit1.Text+' <<  ';
      Timer1.Enabled:=true;
      TButton(Sender).Caption:='Stop Animation';
   end
   else
   begin
      Timer1.Enabled:=false;
      TButton(Sender).Caption:='Start Animation';
   end;
end;

// ********************************************************** //
procedure TForm1.Timer1Timer(Sender: TObject);
// ********************************************************** //
var
   n: Integer;
begin
  Form1.Caption := scrollingCaption;
  for n := 1 to (Length(scrollingCaption) - 1) do
    scrollingCaption[n] := Form1.Caption[n + 1];

  scrollingCaption[Length(scrollingCaption)] := Form1.Caption[1];
end;