Code:
Const
{ ------------------------------------ }
W = 140; //Width - The bigger the slower.
H = 140; //Height - The bigger the slower.
Text = 'GrEeN DaY SuCkS'; //Text.
Textmcolor = 'green'; //Text color.
Size = 10; //Text size.
Delay = 1; //Waits per frame.
Bold = true; //Bold text.
Italic = false; //Italic text.
Strikeout = false; //Strikeout text.
Underline = true; //Underline text.
Backgcolor = 'black'; //Background color.
RandomPos = true; //Random positions.
Statusf = true; //Display status. (Frames)..
{ ------------------------------------ }
var
ksW, ksH: integer;
c: tcanvas;
function correctcolor(back: boolean): integer;
var
s: string;
begin
if(back)then
s:= lowercase(backgcolor)
else
s:= lowercase(textmcolor);
result:= -1;
case copy(lowercase(s), 1, 3) of
'red': result:= clred;
'blu': result:= clblue;
'pur': result:= clpurple;
'bla': result:= clblack;
'whi': result:= clwhite;
'yel': result:= clyellow;
'gre': result:= clgreen;
end;
if(result = -1)then
result:= clblack;
end;
procedure SetCanvasDimensions(var a, b: integer; w, h: integer);
begin
a:= w;
b:= h;
end;
procedure SetCanvasDebug;
begin
Displaydebugimgwindow(ksW, ksH);
c:= getdebugcanvas;
end;
procedure maketext(x, y: integer; text: string);
begin
c.textout(x, y, text);
end;
procedure setbrushcolor(scolor: integer);
begin
c.brush.color:= scolor;
end;
procedure backcolor(scolor: integer);
begin
setbrushcolor(scolor);
c.rectangle(-1, -1, ksW + 1, ksH + 1);
end;
procedure textcolor(scolor: integer);
begin
c.font.color:= scolor;
end;
procedure setstyle(s: tfontstyles);
begin
c.font.style:= s;
end;
procedure setsize(size: integer);
begin
c.font.size := size;
end;
procedure canvastofront;
begin
if(findwindow('Debug Image'))then
activateclient;
end;
procedure setcertain(var rset: string; b: boolean; s, es: string);
begin
if(b)then
rset:= rset+s
else
rset:= rset+es;
end;
function correctstyle: string;
begin
setcertain(result, bold, '1', '0');
setcertain(result, italic, '1', '0');
setcertain(result, strikeout, '1', '0');
setcertain(result, underline, '1', '0');
end;
function find(s, f: string): integer;
var
i: integer;
begin
for i:= 1 to length(s) do
if(copy(s, i, 1)=f)then
result:= result+1;
end;
function posnumb(s, f: string): integer;
var
i: integer;
begin
if(find(s, f)>1)then
exit;
for i:= 1 to length(s) do
if(copy(s, i, 1)=f)then
begin
result:= i;
exit;
end;
end;
procedure setupcanvas;
var
style: string;
i: integer;
begin
ClearDebug;
i:= min(w, h);
SetCanvasDimensions(ksW, ksH, i, i);
SetCanvasDebug;
if(size < 1)then
setsize(1)
else
setsize(size);
textcolor(correctcolor(false));
style:= correctstyle;
c.font.name:= 'verdana';
setstyle([]);
if(find(style, '1')=1)then
begin
case posnumb(style, '1') of
1: setstyle([fsbold]);
2: setstyle([fsitalic]);
3: setstyle([fsstrikeout]);
4: setstyle([fsunderline]);
end;
end else
begin
case style of
'1100': setstyle([fsbold, fsitalic]);
'1110': setstyle([fsbold, fsitalic, fsstrikeout]);
'1111': setstyle([fsbold, fsitalic, fsstrikeout, fsunderline]);
'0011': setstyle([fsstrikeout, fsunderline]);
'0111': setstyle([fsitalic, fsstrikeout, fsunderline]);
{}
'1010': setstyle([fsbold, fsstrikeout]);
'0101': setstyle([fsitalic, fsunderline]);
{}
'1001': setstyle([fsbold, fsunderline]);
'0110': setstyle([fsitalic, fsstrikeout]);
{}
'1011': setstyle([fsbold, fsstrikeout, fsunderline]);
'1101': setstyle([fsbold, fsitalic, fsunderline]);
end;
end;
CanvasToFront;
end;
var
pos: tpointarray;
Csize, countframes, frame, ending: integer;
begin
SetupCanvas;
Setarraylength(pos, 1);
ending:= -10 * (length(text) + (size-(size/2)))
repeat
frame:= 0;
pos[0].x:= ksW;
if(randompos)then
pos[0].y:= ksH-(random(ksH-(size*4))+(ksW/4))
else
pos[0].y:= ksW/2-(size)+(size/4);
repeat
ClearDebug;
if(statusf)then
begin
if(countframes > 0)then
begin
writeln('Total frames: '+inttostr(countframes));
writeln(' ');
writeln('Ending in: '+inttostr(countframes-frame)+' frames');
end;
writeln('Playing frame: '+inttostr(frame));
end;
BackColor(correctcolor(true));
MakeText(pos[0].x, pos[0].y, text);
pos[0].x:= pos[0].x - 1;
if(delay < 0)then
wait(1)
else
wait(delay);
frame:= frame+1;
until(pos[0].x <= ending) or
(ismousebuttondown(false));
if(countframes < 1)then
begin
CanvasToFront;
countframes:= frame;
end;
until(ismousebuttondown(false));
Hidedebugimgwindow;
end.
Just play it.. don't even worry about editting anything.