Вот, на скорую руку:
program Hello;
uses Windows;
const
PHS = 'Hello, world!';
FNS = 'Verdana';
var
DC, WW, WH, TL, MF, TF: DWORD;
function BuildFont(FName:PChar; FSize:word; Width:LongInt; i, u:boolean; Angle:Integer):HFONT;
var
LF: LOGFONT;
begin
FillChar(LF, SIZEOF(LOGFONT), 0);
with LF do begin
lfHeight := -FSize;
lfWeight := Width;
lfItalic := abs(longInt(i));
lfUnderline := abs(longInt(u));
lfCharSet := DEFAULT_CHARSET;
lfOutPrecision := OUT_DEFAULT_PRECIS;
lfClipPrecision := CLIP_DEFAULT_PRECIS;
lfQuality := DEFAULT_QUALITY;
lfPitchAndFamily := FF_DONTCARE or DEFAULT_PITCH;
lfEscapement := Angle;
lfOrientation := Angle;
end;
lstrcpy(LF.lfFaceName, FName);
Result:=CreateFontIndirect(LF);
end;
begin
Randomize;
DC:=GetDC(0);
WW:=GetSystemMetrics(SM_CXSCREEN);
WH:=GetSystemMetrics(SM_CYSCREEN);
TL:=Length(PHS);
MF:=BuildFont(FNS, 17, FW_NORMAL, False, False, Random(45)*10);
TF:=SelectObject(DC, MF);
repeat
if GetAsyncKeyState(VK_ESCAPE)<0 then break;
SetBkMode(DC, TRANSPARENT);
SetTextColor(DC, RGB(Random(256), Random(256), Random(256)));
TextOut(DC, Random(WW), Random(WH), PHS, TL);
Sleep(10);
until 1=0;
SelectObject(DC, TF);
InvalidateRect(0, nil, True);
ReleaseDC(0, DC);
DeleteDC(DC);
DeleteObject(MF);
end.
Должно сработать.
зы. Опять же, извиняюсь за выкладывание длинных листингов...