Приведенное выше решение (1) очень медленно, так как требует рисования текста и содержит, на мой взгляд, неэффективный метод вращения. Попробуйте взамен это:

procedure TForm1.TextUp(aRect:tRect;aTxt:String);
var
LFont: TLogFont;
hOldFont, hNewFont: HFont;
begin
GetObject(Canvas.Font.Handle,SizeOf(LFont),Addr(LFont));
LFont.lfEscapement := 900;
hNewFont := CreateFontIndirect(LFont);
hOldFont := SelectObject(Canvas.Handle,hNewFont);
Canvas.TextOut(aRect.Left+2,aRect.Top,aTxt);
hNewFont := SelectObject(Canvas.Handle,hOldFont);
DeleteObject(hNewFont);
end;

const
PIDiv180 = 0.017453292519943295769236907684886;

procedure Rotate(RotAng: Double; x, y: Double; var Nx, Ny: Double);
var
SinVal: Double;
CosVal: Double;
begin
RotAng := RotAng * PIDiv180;
SinVal := Sin(RotAng);
CosVal := Cos(RotAng);
Nx := x * CosVal - y * SinVal;
Ny := y * CosVal + x * SinVal;
end;
(* End Of Rotate Cartesian Point*)

Здесь я бы хотел рассказать не о том, как работать с DelphiX, OpenGL или Direct, а о том, как можно вращать многогранники с помощью простых действий: moveto и lineto.

Здесь рассмотрим пример вращения куба. Будем рисовать на Canvase (например Listbox). Сначала нарисуем врашающийся квадрат (точнее 2 квадрата и соединим их). Пусть q - угол поворота квадрата, который мы рисуем. Очевидно, что нам надо задать координаты вершин квадрата - a:array [1..5,1..2] of integer. 1..4+1 - количество вершин квадрата (почему +1 будет объяснено позже). 1..2 - координата по X и Y. Кто учился в школе, наверное помнит, что уравнение окружности: X^2+Y^2=R^2, кто хорошо учился в школе, возможно вспомнит уравнение эллипса: (X^2)/(a^2)+ (Y^2)/(b^2)=1. Но это нам не надо. Нам понадобится уравнение эллипса в полярных координатах: x=a*sin(t); y=a*cos(t);t=0..2*PI; (учащиеся университетов и институтов ликуют).

С помощью данного уравнения мы заполняем массив с координатами.

for i:=1 to 5 do
begin
// координата по Х; q+i*pi/2 - угол поворота
// i-той вершины квадрата.
a[i,1]:=trunc(80*sin(q+i*pi/2));
// координата по Y; знак минус - потому что координаты
// считаются с верхнего левого угла
a[i,1]:=trunc(-30*cos(q+i*pi/2));
end;

Сейчас будем рисовать квадрат:

for i:=1 to 4 do
begin
moveto(100+a[i,1],50+a[i,2]); //Встаем на i-ую точку квадрата.
lineto(100+a[i+1,1],50+a[i+1,2]); //Рисуем линию к i+1-ой точке.

Вот почему array[1..5,1..2], иначе - выход за границы. end;

Затем рисуем второй такой же квадрат, но пониже (или повыше). Соединяем линиями первый со вторым:

for i:=1 to 4 do
begin
moveto(100+a[i,1],50+a[i,2]);
lineto(100+a[i,1],130+a[i,2]);
end;

Осталось очистить Listbox, увеличить q и сделать сначала. Все!!!

procedure TextOutAngle(x,y,aAngle,aSize: integer; txt: string);
var
hFont, Fontold: integer;
DC: hdc;
Fontname: string;
begin
if length(txt) = 0 then
Exit;
DC:= Screen.ActiveForm.Canvas.handle;
SetBkMode(DC, transparent);
Fontname:= Screen.ActiveForm.Canvas.Font.name;
hFont:= CreateFont(-aSize,0, aAngle*10,0, fw_normal,0, 0,
0,1,4,$10,2,4,PChar(Fontname));
Fontold:= SelectObject(DC, hFont);
TextOut(DC,x,y,PChar(txt), length(txt));
SelectObject(DC, Fontold);
DeleteObject(hFont);
end;

{ Эта процедура устанавливает угол вывода текста
для указанного Canvas, угол в градусах
Шрифт должен быть TrueType }
procedure CanvasSetTextAngle(c: TCanvas; d: single);
var
LogRec: TLOGFONT; { Информация о шрифте }
begin
{Читаем текущюю инф. о шрифте }
GetObject(c.Font.Handle,SizeOf(LogRec) ,Addr(LogRec) );
{ Изменяем угол }
LogRec.lfEscapement := round(d*10);
{ Устанавливаем новые параметры }
c.Font.Handle := CreateFontIndirect(LogRec);
end;