unit font1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  cOpenGL, OpenGL, MMSystem, light, Material, Transfrm;

type
  TForm1 = class(TForm)
    OpenGL1: TOpenGL;
    Light1: TLight;
    TransformLight: TTransform;
    TransformCyl: TTransform;
    MaterialCyl: TMaterial;
    TransformBitmap: TTransform;
    MaterialBitmap: TMaterial;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure TransformLightPaint(Sender: TObject);
    procedure TransformCylPaint(Sender: TObject);
    procedure TransformBitmapPaint(Sender: TObject);
  private
    start,
    elapsed,
    frames: integer;
    LastKey: char; 
    Times: pointer;
    bmWidth,
    bmHeight:GLsizei;
    procedure Idle(Sender:TObject;var Done:boolean);
    procedure ShowBitmap;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Shapes;

{$R *.DFM}

var
  tnrFont: HFont;
  tnrBase: GLuint;
  tnrHello: string;

procedure TForm1.FormCreate(Sender: TObject);
begin
  glPixelStorei(GL_UNPACK_ALIGNMENT,1);
  tnrFont := CreateFont(20,0,0,0,FW_NORMAL,0,0,0,ANSI_CHARSET,  
    OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,DRAFT_QUALITY,DEFAULT_PITCH,
    'Times New Roman');
  SelectObject(OpenGL1.glDC,tnrFont);
  tnrBase := glGenLists(94);
  wglUseFontBitmaps(OpenGL1.glDC,32,94,tnrBase);
  tnrHello := 'Hello, Times New Roman!';
  glListBase(tnrBase-32);
  glLightModeli(GL_LIGHT_MODEL_TWO_SIDE,GL_TRUE);
  CylinderBase;
  Application.OnIdle := Idle;
  start := TimeGetTime;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  TransformLight.Apply;
  TransformCyl.Apply;
  TransformBitmap.Apply;
  OpenGL1.Swap;
  OpenGL1.ErrorCheck('FormPaint');
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  if OpenGL1.Smaller then
    FormPaint(Sender);
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  LastKey := UpCase(Key);
  if Key=#27 then
    Close;
end;

procedure TForm1.TransformLightPaint(Sender: TObject);
begin
  Light1.Apply;
end;

procedure TForm1.TransformCylPaint(Sender: TObject);
begin
  MaterialCyl.Apply;
  Cylinder;
end;

procedure TForm1.Idle(Sender:TObject;var Done:boolean);
const
  rollover=1000;
  mspersec=1000.0;
begin
  Done := false;
  inc(frames);
  if frames>= rollover then
  begin
    elapsed := TimeGetTime;
    Caption := Format('fps=%0.1f',[rollover*mspersec/(elapsed-start)]);
    start := elapsed;
    frames := 0;
  end else
    FormPaint(nil);
end;

procedure TForm1.ShowBitmap;
begin
  glRasterPos3f(0.0,0.0,0.0);
  glCallLists(length(tnrHello),GL_UNSIGNED_BYTE,pointer(tnrHello));
end;

procedure TForm1.TransformBitmapPaint(Sender: TObject);
begin
  if LastKey<>'B' then
    exit;
  MaterialBitmap.Apply;
  ShowBitmap;
end;

end.
 