unit frmMain;

interface

uses
 Windows, Messages, Classes, Graphics, Forms, ExtCtrls, Menus,
 Controls, Dialogs, SysUtils,
 OpenGL;

type
  TFBBuffer = Array [0..1023] of GLFloat;

type
  TfrmGL = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormPaint(Sender: TObject);

  private
    DC : HDC;
    hrc : HGLRC;

    fb: TFBBuffer;

    procedure PrintBuffer(b: TFBBuffer; n: Integer);

    procedure SetDCPixelFormat;
  end;

const
  GLF_START_LIST = 1000;

var
  frmGL: TfrmGL;

implementation

{$R *.DFM}

procedure OutText (Litera : PChar);
begin
  glListBase(GLF_START_LIST);
  glCallLists(Length (Litera), GL_UNSIGNED_BYTE, Litera);
end;

procedure TfrmGL.SetDCPixelFormat;
var
  nPixelFormat: Integer;
  pfd: TPixelFormatDescriptor;
begin
  FillChar(pfd, SizeOf(pfd), 0);

  with pfd do begin
    dwFlags   := PFD_DRAW_TO_WINDOW or
                 PFD_SUPPORT_OPENGL or
                 PFD_DOUBLEBUFFER;
    cDepthBits:= 32;
  end;

  nPixelFormat := ChoosePixelFormat(DC, @pfd);
  SetPixelFormat(DC, nPixelFormat, @pfd);
end;

procedure TfrmGL.FormCreate(Sender: TObject);
var
  n : integer;
begin
  DC := GetDC(Handle);
  SetDCPixelFormat;
  hrc := wglCreateContext(DC);
  wglMakeCurrent(DC, hrc);
  wglUseFontOutlines (Canvas.Handle, 0, 255, GLF_START_LIST, 50, 0,
                      WGL_FONT_POLYGONS, nil);
  glFeedbackBuffer(SizeOf (fb), GL_3D, @fb);
  glEnable(GL_DEPTH_TEST);

  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPerspective(14.0, 1, 15.0, 16.0);
  glViewport(0, 0, ClientWidth, ClientHeight);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
  glTranslatef(-1.0, 0.0, -15.0);

  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  glRenderMode(GL_FEEDBACK);
  glPassThrough(1);
  OutText ('A');
  n := glRenderMode(GL_RENDER);

  if n > 0 then PrintBuffer(fb, n);
end;

procedure TfrmGL.FormDestroy(Sender: TObject);
begin
  glDeleteLists (GLF_START_LIST, 256);
  wglMakeCurrent(0, 0);
  wglDeleteContext(hrc);
  ReleaseDC(Handle, DC);
  DeleteDC(DC);
end;

procedure TfrmGL.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  If Key = VK_ESCAPE then Close
end;

procedure TfrmGL.PrintBuffer(b: TFBBuffer; n: Integer);
var
  i, k, vcount : Integer;
  token : Single;
  vert, wrkS : String;
  t : textfile;
begin
  AssignFile (t, '1.txt');
  Rewrite (t);
  i := n;
  while i <> 0 do begin
    token := b[n-i];
    DEC(i);
    if token = GL_POLYGON_TOKEN then begin
      vcount := Round(b[n-i]);
      DEC(i);
      for k := 1 to vcount do begin
        vert := '  ';
        Str (b[n-i]:4:2, wrkS);
        vert := vert + wrkS + ' ';
        DEC(i);
        Str (b[n-i]:4:2, wrkS);
        vert := vert + wrkS + ' ';
        DEC(i);
        DEC(i);
        WriteLn (t, vert);
      end;
    end;
   end;
   CloseFile (t);
end;

procedure TfrmGL.FormPaint(Sender: TObject);
begin
  OutText ('A');
  SwapBuffers (DC);
end;

end.

