Для того чтобы вывести текст под углом, вытянуть или сжать его нужно воспользоваться структурой LOGFONT. Здесь показаны не все ее возможности, но, на мой взгляд, самые интересные.

procedure TForm1.FormPaint(Sender: TObject);
var
lf: TLogFont;
begin
FillChar(lf, SizeOf(lf), 0);
with lf do
begin
// Высота буквы
lfHeight := 15;

// Ширина буквы
lfWidth := 20;

// Угол наклона в десятых градуса
lfEscapement := 100;

// Жирность 0..1000, 0 - по умолчанию
lfWeight := 1000;

// Курсив
lfItalic := 0;

// Подчеркнут
lfUnderline := 1;

// Зачеркнут
lfStrikeOut := 1;

// CharSet
lfCharSet := RUSSIAN_CharSet;

// Название шрифта
StrCopy(lfFaceName, ‘Arial’);
end;
with Form1.Canvas do
begin
FillRect(ClipRect);
Font.Handle := CreateFontIndirect(lf);
TextOut(0, 100, ‘It is a text string’);
end;
end;

При рисовании линии, особенно под маленьким углом, хорошо различимы отдельные точки. Для устранения этого недостатка я использую уменьшение изображения, как в предыдущем совете.

procedure TForm1.Button1Click(Sender: TObject);
var
x, y: integer;
i, j: integer;
r, g, b: integer;
begin
Form1.Canvas.Pen.Width := 10;
Form1.Canvas.MoveTo(10, 10);
Form1.Canvas.LineTo(90, 20);
for y := 0 to 10 do
begin
for x := 0 to 25 do
begin
r := 0;
for i := 0 to 3 do
for j := 0 to 3 do
r := r + GetRValue(Form1.Canvas.Pixels[4*x+i, 4*y+j]);
r := round(r / 16);
g := 0;
for i := 0 to 3 do
for j := 0 to 3 do
g := g + GetGValue(Form1.Canvas.Pixels[4*x+i, 4*y+j]);
g := round(g / 16);
b := 0;
for i := 0 to 3 do
for j := 0 to 3 do
b := b + GetBValue(Form1.Canvas.Pixels[4*x+i, 4*y+j]);
b := round(b / 16);
Form1.Canvas.Pixels[x,y+50] := RGB(r, g, b)
end;
Application.ProcessMessages;
end;
end;

При попытке изобразить некую анимацию использую только средства TCanvas, на экране получается черте-чего. Все мельтешит, дергается, одним словом - не годится.

Для получения ” гладкой” ( не мельтешащей ) анимация в программах не использующих DirectX, я обычно использую следующую технику.

Узким местом в процессе является момент изменения картинки на экране, поэтому рисование нужно проводить на невидимом для пользователя канвасе, и только подготовив там обновляемые участки выводить их на видимый экран.

Для того, чтобы стереть кртинку в том месте где ее уже нет, нужно помнить позицию в которой она была выведена в прошлый раз. Обзовем эту позицию Old: TRect, текущую позицию запомним в New: TRect.

TRect я использую, на сучай если размер отображаемой картинки может изменяться.

Стандартным подходом является написание двух процедур - Hide и Show, одна из которых прячет картинку в старой позиции, выводя участок фона поверх нее, а вторая выводит в новой позиции.
Read more »

{
This code draws an anti-aliased line on a bitmap
This means that the line is not jagged like the
lines drawn using the LineTo() function
}

uses
Graphics, Windows;

type
TRGBTripleArray = array[0..1000] of TRGBTriple;
PRGBTripleArray = ^TRGBTripleArray;

// anti-aliased line
procedure WuLine(ABitmap : TBitmap ; Point1, Point2 : TPoint ; AColor : TColor);
var
deltax, deltay, loop, start, finish : integer;
dx, dy, dydx : single; // fractional parts
LR, LG, LB : byte;
x1, x2, y1, y2 : integer;
begin Read more »

{
The following code allows you to draw a gradient on a canvas with
an arbitrary number of colors (minimum 2).
To draw a gradient on a form’s canvas,
call the DrawGradient() in the OnPaint and OnResize-event handlers.
}

{
Mit dieser Prozedur kann man auf einen Canvas einen Farbverlauf mit
beliebig vielen Farben (min. 2) zeichnen.
Z.B. wenn auf eine Form ein Farbverlauf gezeichnet werden soll,
rufe die DrawGradient() Funktion im OnPaint-Ereignis und
im OnResize-Ereignis der Form auf.
}

procedure DrawGradient(ACanvas: TCanvas; Rect: TRect;
Horicontal: Boolean; Colors: array of TColor);
type
RGBArray = array[0..2] of Byte;
var
x, y, z, stelle, mx, bis, faColorsh, mass: Integer;
Faktor: double;
A: RGBArray;
B: array of RGBArray;
merkw: integer;
merks: TPenStyle;
merkp: TColor;
begin Read more »