uses Crt, Gr, Objects, Memory, Graph, Bgi, VgaMem, WinRes,
  Bitmap, ttf, ttfilter, ttcolor, Vesa;

procedure ShowFilter(Filter: PFilter);
var
  x, y: Integer;
begin
  with Filter^ do
  For x := 0 to Size - 1 do
    For y := 0 to Size - 1 do
      PutPixel(x, y, Byte(PChar(@Data)[y * Size + x]));
end;

procedure InsertShadedColors(A, B: TColor; Steps: Integer);
var
  i: Integer;
const
  Cur: Integer = 0;

	function Between(A, B: Integer): Integer;
	begin
	  Between := Round((A*i + B*(Steps-i+1)) / (Steps + 1));
	end;

begin
  For i := 1 to Steps do
  begin
    SetRGBPalette(Cur, Between(A.R, B.R) and $FC,
      Between(A.G, B.G) and $FC, Between(A.B, B.B) and $FC);
    Inc(Cur)
  end;
end;


{ 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴
}

var
  i: Integer;
  tt: PTTFont;
  B: PBitmap;
  Im: pointer;
  r: real;
  AFilter: PFilter;
  Pal: pointer;
  Back, Fore: TColor;
  Extent: TPoint;
  X, Y: Integer;

begin
  If DetectVesa
  then SetGrMode(gr800x600x256)
  else SetGrMode(gr320x200x256);
  InitMemory;
  InitGraphics;
  InitVgaMem;
  Randomize;
  {For i := 0 to 255 do
  begin
    SetRGBPalette(i, i shr 2, i shr 2, i shr 2);
    PutPixel(i, 0, i)
  end;}
    For i := 0 to 255 do
      SetRGBPalette(i, Random(64) shl 2, Random(64) shl 2, Random(64) shl 2);
    {SetRGBPalette(255, $FC, $FC, $FC);}
    UserParams(3); GrNotifyProc(gnpPalette, 0);
  tt := New(PTTFont, InitByFile('c:\windows\system\times.ttf'));
  {ConeFilter radius}
  r := 2.0;
  AFilter := CreateFilter(4, 7, {BoxFilter} ConeFilter, true, true, @r);
  ShowFilter(AFilter);

  with tt^ do
  begin
    SetOutMethod(2);
    {SetPostScaling(4);} {now done by SetFilter}
    X := Random(200) + 50;
    SetPointSize(X, X);
    SetFilter(AFilter);
    SetResolution(GetResX, GetResY);
  end;

  X := 10; Y := 50;
  {MakeColor(Random(256), Random(256), Random(256), Back);
  MakeColor(Random(256), Random(256), Random(256), Fore);}
  Repeat
    with tt^ do
      GetBitmap(GetIndexOf(Chr(Random(95) + 32)), pointer(B));
    ColorByIndex(Random(256), Back);
    ColorByIndex(Random(256), Fore);
    {MakeColor(255, 0, 0, Back);
    MakeColor(255, 255, 0, Fore);}
    {InsertShadedColors(Back, Fore, 16);
    UserParams(3); GrNotifyProc(gnpPalette, 0);}
    Pal := Interpolation(Back, Fore);
    Im := BitmapToImageWithUserPalette(B, Pal);
    DisposeCache(B);
    i := Ord(PChar(Pal)[0]);
    Gr.SetBkColor(i);
    SetFillStyle(SolidFill, i);
    GetImageExtent(Im, Extent);
    If X + Extent.X > GetMaxX then begin
      X := 10;
      Inc(Y, Extent.Y)
    end;
    If Y + Extent.Y > GetMaxY then Y := 10;
    Bar(X, Y, X + Extent.X, Y + Extent.Y);

    FreeMem(Pal, 256);
    PasteImage(X, Y, Im, NormalPut + BackPut);
    FreeImage(Im);
    Inc(X, Extent.X + 10);
  Until keypressed;
  Dispose(tt, Done);
  ReadKey;
  CloseGraphics;
  DoneVgaMem;
  DoneMemory;
end.
