[Asinkrit]

Интересная задачка, решил ее очень хитропопым способом) рисуем в буфере символ, и используем его как маску для рисования, шрифт для удобства подобран с постоянной длиной и шириной символов, написано под консольное приложения, для облегчения переноса кода. Так же, использовал вспомогательную функцию GotoXY.

Код:

{$APPTYPE CONSOLE}

uses
  Windows, SysUtils, Graphics;

const
  CWidth = 8;
  CHeight = 16;
  CWord = 'DELPHI6';  //слово которое выведем на экран.

var
  Buffer:TBitmap;  //буфер
  hCon: integer;    //хэндл консоли

procedure GotoXY(X, Y : Word);
//перемещаем курсор по XY
var
  Coord: TCoord;
begin
  Coord.X := X;
  Coord.Y := Y;
  SetConsoleCursorPosition(hCon, Coord);
end;

procedure DrawMask(aSymbol:char; const aX, aY:integer);
//основная процедура, рисует символ по координатам XY
var
  x,y:byte;
begin
  with Buffer.Canvas do
    begin
    TextOut(0,0,aSymbol);
    for x:=0 to CWidth-1 do
      for y:=0 to CHeight-1 do
        if (Pixels[x,y] <> clWhite) then
          begin
          GotoXY(aX+(x*1), aY+Y);
          Write(aSymbol);
          end
    end;
end;

procedure DrawString(const aString:String; const aX, aY:Byte);
//выводим слово по буквам
var
  i:byte;
begin
  if Length(aString) > 0 then
    for i:=1 to Length(aString) do
      DrawMask(aString[i],aX+((i-1)*CWidth), aY);
end;

begin
  hCon := GetStdHandle(STD_OUTPUT_HANDLE);
  //подготавливаем буфер 
  Buffer:=TBitmap.Create;
  with Buffer do
    begin
    Height:=CHeight;
    Width:=CWidth;
    with Canvas do
      begin
      with Font do
        begin
        Name:='Courier New';
        Color:=clBlack;
        Pitch:=fpFixed;
        Size:=10;
        end;
      with Brush do
        begin
        Color:=clWhite;
        Style:=bsSolid;
        end;
      end;
    end;
  //выводим слово
  DrawString(CWord, 2,2);
  //уничтожаем буфер
  Buffer.Destroy;
  Writeln;
  Readln;
end.