uses Graph,crt;

var
  i,j,Gd,Gm: Integer;
  Pt: FillPatternType;
  Mode: Integer;tx:string;
begin
  Gd := Detect;
  InitGraph(Gd, Gm, 'd:\pas\bp\bgi');
  if GraphResult <> grOk then
    Halt(1);
  RestoreCrtMode;
  Writeln('Enter any text');
  Readln(tx);
  SetGraphMode(GetGraphMode);
  getfillpattern(pt);
for j:=1 to getmaxy do begin
for i:=0 to length(tx) do begin
  Setcolor(3);
  OutTextXY((GETMAXX) div length(tx)*i,((getmaxY-2*j) div length(tx))*i+j,tx[i]);
  end;delay(800);
for i:=0 to length(tx) do begin
  SetColor(0);
  OutTextXY((GETMAXX) div length(tx)*i,((getmaxY-2*j) div length(tx))*i+j,#219);
  end;end;
  CloseGraph;
end.