Листинг 6

procedure TForm1.FormPaint(Sender: TObject); 
var 
  X: Integer; 
  LF: TLogFont; 
  Fnt: HFont; 
const 
  Text = 'Лучшая в мире система программирования'; 
begin 
  // Определяем параметры нового шрифта 
  FillChar(LF, SizeOf(LF), 0); 
  with LF do 
  begin 
    lfHeight := 20; 
    lfWeight := fw_Normal; 
    lfUnderline := 1; 
    lfEscapement := 450; 
    StrPCopy(lfFaceName, 'Courier New Cyr'); 
  end; 
  with Form1.Canvas do 
  begin 
    // Создаем шрифт 
    Fnt := CreateFontIndirect(LF); 
    // Присваиваем его дескриптор шрифту канвы 
    Font.Handle := Fnt; 
    // Выводим текст под углом +45 градусов 
    TextOut(0, 300, Text); 
    X := TextWidth(Text); 
    DeleteObject(Fnt);  // Удаляем ненужный шрифт    
    // Изменяем параметры шрифта 
    with LF do 
    begin 
      lfHeight := 90; 
      lfEscapement := -900; 
      lfWeight := fw_Heavy; 
      StrPCopy(LF.lfFaceName, 'Arial Cyr'); 
    end; 
    Fnt := CreateFontIndirect(LF); // Создаем новый    шрифт 
    Font.Handle := Fnt; 
    Font.Color := clRed; 
    // Выводим с наклоном -90 градусов 
    TextOut(X-10, 10, 'Delphi 5'); 
    DeleteObject(Fnt); // Удаляем ненужный    шрифт 
  end; 
end;