unit OpenGLTemplateForm;

 

interface

 

uses

 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  StdCtrls, ExtCtrls, ComCtrls, DglOpenGL;

 

type

  TDGLForm = class(TForm)

    procedure FormKeyPress(Sender: TObject; var Key: Char);

    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

  TOpenGLRender = class(TThread)

  private

    DC:HDC;

    RC:HGLRC;

    angle: integer;

    fHandle: cardinal;

    fOptions: TRCOptions;

    fPixelDepth: byte;

    fDepthBuffer: byte;

  public

    destructor Destroy; override;

    procedure Init;

    procedure Draw;

    procedure Stop;

    procedure Execute; override;

    property Handle: cardinal read fHandle write fHandle;

    property Options: TRCOptions read fOptions write fOptions;

    property PixelDepth: byte read fPixelDepth write fPixelDepth;

    property DepthBuffer: byte read fDepthBuffer write fDepthBuffer;

  end;

 

var

  DGLForm: TDGLForm;

  OpenGLRender: TOpenGLRender;

 

implementation

 

{$R *.DFM}

 

type

     PGLarrayd3 = ^TGLArrayd3;

     TGLArrayd4 = array[0..3] of GLDouble;

     PGLArrayd4 = ^TGLArrayd4;

     TGLArrayd6 = array[0..5] of GLDouble;

     PGLArrayd6 = ^TGLArrayd6;

     TGLArrayvertex4 = array[0..3] of TGLArrayd6;

     PGLArrayvertex4 = ^TGLArrayvertex4;

 

function getNormal(p1,p2,p3:TGLArrayf3):TGLArrayf3;

var a,b:TGLArrayf3;

begin

 a[0]:=p2[0]-p1[0]; a[1]:=p2[1]-p1[1]; a[2]:=p2[2]-p1[2];

 b[0]:=p3[0]-p1[0]; b[1]:=p3[1]-p1[1]; b[2]:=p3[2]-p1[2];

 result[0]:=a[1]*b[2]-a[2]*b[1];

 result[1]:=a[2]*b[0]-a[0]*b[2];

 result[2]:=a[0]*b[1]-a[1]*b[0];

end;

 

//TOpenGLRender

 

destructor TOpenGLRender.Destroy;

begin

  inherited;

end;

 

procedure TOpenGLRender.Execute;

begin

  Init;

  while not terminated do

  begin

    Draw;

    sleep(1);

  end;

  Stop;

end;

 

procedure TOpenGLRender.Init;

const

  light0_position:TGLArrayf4=( -8.0, 8.0, -16.0, 0.0);

  ambient:  TGLArrayf4=( 0.3, 0.3, 0.3, 0.3);

begin

 

  InitOpenGL;

 

  DC := GetDC(fHandle);

  // Create RenderContext (32 Bit PixelDepth, 24 Bit DepthBuffer, Doublebuffering)

  RC := CreateRenderingContext(DC, fOptions, fPixelDepth, fDepthBuffer, 0, 0, 0, 0);

  // Activate RenderContext

  ActivateRenderingContext(DC, RC);

 

  // set viewing projection

  glMatrixMode(GL_PROJECTION);

  glFrustum(-0.1, 0.1, -0.1, 0.1, 0.3, 25.0);

 

  // position viewer

  glMatrixMode(GL_MODELVIEW);

 

  // Active DepthBuffer

  glEnable(GL_DEPTH_TEST);

  glDepthFunc(GL_LESS);

 

  glShadeModel(GL_SMOOTH);                    // shading mathod: GL_SMOOTH or GL_FLAT

 

  // track material ambient and diffuse from surface color, call it before glEnable(GL_COLOR_MATERIAL)

  glColorMaterial(GL_FRONT_AND_BACK, GL_AMBIENT_AND_DIFFUSE);

  glEnable(GL_COLOR_MATERIAL);

 

  // Set lighting

  glEnable(GL_LIGHTING);

  glLightfv(GL_LIGHT0, GL_POSITION, @light0_position);

  glLightfv(GL_LIGHT0, GL_AMBIENT, @ambient);

  glEnable(GL_LIGHT0);

 

  // Set clear background color

  glClearColor(0,0,0,0);

end;

 

procedure tessBeginCB(which: GLenum); stdcall;

begin

    glBegin(which);

end;

 

procedure tessEndCB(); stdcall;

begin

    glEnd();

end;

 

procedure tessErrorCB(errorCode: GLenum); stdcall;

var

  errorStr: string;

begin

    errorStr := gluErrorString(errorCode);

end;

 

procedure tessVertexCB(data: PGLArrayd6); stdcall;

begin

    glColor3d(data[3], data[4], data[5]);

    glVertex3d( data[0], data[1], data[2] );

end;

 

var

vertices: array[0..64] of TGLArrayd6;

vertexIndex: integer = 0;

 

procedure tessCombineCB(newVertex : PGLArrayd6; neighborVertex : Pointer;

                      neighborWeight : PGLArrayd4; var outData : Pointer); stdcall;

type

  PGLArrayd3= ^TGLArrayd3;

var

  vertice: PGLarrayd3;

  test: pointer;

begin

 

    vertices[vertexIndex][0] := newVertex[0];

    vertices[vertexIndex][1] := newVertex[1];

    vertices[vertexIndex][2] := newVertex[2];

 

    vertices[vertexIndex][3] := neighborWeight[0] * PGLArrayvertex4(neighborVertex)[0][3] +   // red

                                neighborWeight[1] * PGLArrayvertex4(neighborVertex)[1][3] +

                                neighborWeight[2] * PGLArrayvertex4(neighborVertex)[2][3] +

                                neighborWeight[3] * PGLArrayvertex4(neighborVertex)[3][3];

    vertices[vertexIndex][4] := neighborWeight[0] * PGLArrayvertex4(neighborVertex)[0][4] +   // green

                                neighborWeight[1] * PGLArrayvertex4(neighborVertex)[1][4] +

                                neighborWeight[2] * PGLArrayvertex4(neighborVertex)[2][4] +

                                neighborWeight[3] * PGLArrayvertex4(neighborVertex)[3][4];

    vertices[vertexIndex][5] := neighborWeight[0] * PGLArrayvertex4(neighborVertex)[0][5] +   // blue

                                neighborWeight[1] * PGLArrayvertex4(neighborVertex)[1][5] +

                                neighborWeight[2] * PGLArrayvertex4(neighborVertex)[2][5] +

                                neighborWeight[3] * PGLArrayvertex4(neighborVertex)[3][5];

 

    // return output data (vertex coords and others)

    outData := @vertices[vertexindex];

 

    vertexIndex := vertexIndex + 1;  // increase index for next vertex

end;

 

procedure TOpenGLRender.Draw;

var

  test: TGLArrayd3;

  star: array[0..4] of TGLArrayd6;

  tess: pointer;

 

begin

  vertexindex:=0;

  angle:=180;//angle+1;

 

  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  glLoadIdentity;

  glTranslatef(0.0, 0.0, -12.0);

  glRotatef(angle, 0.0, 1.0, 0.0);

 

  star[0][0] := 0.0;

  star[0][1] := 3.0;

  star[0][2] := 0.0;

 

  star[0][3] := 1;

  star[0][4] := 0;

  star[0][5] := 0;

 

  star[1][0] := -1.0;

  star[1][1] := 0.0;

  star[1][2] := 0.0;

 

  star[1][3] := 0;

  star[1][4] := 1;

  star[1][5] := 0;

 

  star[2][0] := 1.6;

  star[2][1] := 1.9;

  star[2][2] := 0.0;

 

  star[2][3] := 1;

  star[2][4] := 0;

  star[2][5] := 1;

 

  star[3][0] := -1.6;

  star[3][1] := 1.9;

  star[3][2] := 0.0;

 

  star[3][3] := 1;

  star[3][4] := 1;

  star[3][5] := 0;

 

  star[4][0] := 1.0;

  star[4][1] := 0.0;

  star[4][2] := 0.0;

 

  star[4][3] := 0;

  star[4][4] := 0;

  star[4][5] := 1;

 

  tess := gluNewTess();

 

  gluTessCallback(tess, GLU_TESS_BEGIN, @tessBeginCB);

  gluTessCallback(tess, GLU_TESS_END, @tessEndCB);

  gluTessCallback(tess, GLU_TESS_ERROR, @tessErrorCB);

  gluTessCallback(tess, GLU_TESS_VERTEX, @tessVertexCB);

  gluTessCallback(tess, GLU_TESS_COMBINE, @tessCombineCB);

 

 

  gluTessProperty(tess, GLU_TESS_WINDING_RULE, GLU_TESS_WINDING_NONZERO);

 

  gluTessBeginPolygon(tess, 0);                   // with NULL data

    gluTessBeginContour(tess);

 

      test[0] := star[0][0];

      test[1] := star[0][1];

      test[2] := star[0][2];

 

      gluTessVertex(tess, test, @star[0]);

 

      test[0] := star[1][0];

      test[1] := star[1][1];

      test[2] := star[1][2];

 

      gluTessVertex(tess, test, @star[1]);

 

      test[0] := star[2][0];

      test[1] := star[2][1];

      test[2] := star[2][2];

 

      gluTessVertex(tess, test, @star[2]);

 

      test[0] := star[3][0];

      test[1] := star[3][1];

      test[2] := star[3][2];

 

      gluTessVertex(tess, test, @star[3]);

 

      test[0] := star[4][0];

      test[1] := star[4][1];

      test[2] := star[4][2];

 

      gluTessVertex(tess, test, @star[4]);

 

    gluTessEndContour(tess);

  gluTessEndPolygon(tess);

 

  gluDeleteTess(tess);        // delete after tessellation

 

  SwapBuffers(DC);

end;

 

procedure TOpenGLRender.Stop;

begin

  DeactivateRenderingContext; // Deactivate RenderContext

  wglDeleteContext(RC); //Delete RenderContext

  ReleaseDC(Handle, DC);

end;

 

//TDGLForm

 

procedure TDGLForm.FormCreate(Sender: TObject);

begin

  DecimalSeparator:='.'; //always use . as decimal seperator

  OpenGLRender := TOpenGLRender.Create(true);

  OpenGLRender.Handle := Handle;

  OpenGLRender.Options := [opDoubleBuffered];

  OpenGLRender.PixelDepth := 32;

  OpenGLRender.DepthBuffer := 24;

  OpenGLRender.Resume;

end;

 

procedure TDGLForm.FormDestroy(Sender: TObject);

begin

  OpenGLRender.Suspend;

  OpenGLRender.Free;

end;

 

procedure TDGLForm.FormKeyPress(Sender: TObject; var Key: Char);

begin

  case Key of

    #27 : Close;

  end;

end;

 

end.

 

 

type

     TGLArrayd6 = array[0..5] of GLDouble;

     PGLArrayd6 = ^TGLArrayd6;

     TGLArrayvertex4 = array[0..3] of PGLArrayd6;

     PGLArrayvertex4 = ^TGLArrayvertex4;

     PGLArrayf4 = ^TGLArrayf4;

 

procedure tessCombineCB(newVertex : PGLArrayd6; neighborVertex : Pointer;

                      neighborWeight : Pointer; var outData : Pointer); stdcall;

begin

 

    vertices[vertexIndex][0] := newVertex^[0];

    vertices[vertexIndex][1] := newVertex^[1];

    vertices[vertexIndex][2] := newVertex^[2];

 

    vertices[vertexIndex][3] := PGLArrayf4(neighborWeight)^[0] *

                                PGLArrayvertex4(neighborVertex)^[0][3] +   // red

                                PGLArrayf4(neighborWeight)^[1] *

                                PGLArrayvertex4(neighborVertex)^[1][3] +

                                PGLArrayf4(neighborWeight)^[2] *

                                PGLArrayvertex4(neighborVertex)^[2][3] +

                                PGLArrayf4(neighborWeight)^[3] *

                                PGLArrayvertex4(neighborVertex)^[3][3];

    vertices[vertexIndex][4] := PGLArrayf4(neighborWeight)^[0] *

                                PGLArrayvertex4(neighborVertex)^[0][4] +   // green

                                PGLArrayf4(neighborWeight)^[1] *

                                PGLArrayvertex4(neighborVertex)^[1][4] +

                                PGLArrayf4(neighborWeight)^[2] *

                                PGLArrayvertex4(neighborVertex)^[2][4] +

                                PGLArrayf4(neighborWeight)^[3] *

                                PGLArrayvertex4(neighborVertex)^[3][4];

    vertices[vertexIndex][5] := PGLArrayf4(neighborWeight)^[0] *

                                PGLArrayvertex4(neighborVertex)^[0][5] +   // blue

                                PGLArrayf4(neighborWeight)^[1] *

                                PGLArrayvertex4(neighborVertex)^[1][5] +

                                PGLArrayf4(neighborWeight)^[2] *

                                PGLArrayvertex4(neighborVertex)^[2][5] +

                                PGLArrayf4(neighborWeight)^[3] *

                                PGLArrayvertex4(neighborVertex)^[3][5];

    //vertices[vertexIndex][5] := vertexIndex;

 

 

    // return output data (vertex coords and others)

    outData:= @vertices[vertexindex];

 

    vertexIndex := vertexIndex + 1;  // increase index for next vertex

end;

 

 

unit Polygon;

 

interface

 

uses DGLOpenGL;

 

type

TPoint = packed record

  x: single;

  y: single;

  z: single;

  r: single;

  g: single;

  b: single;

  a: single;

end;

 

TPolygon = class

private

  FPoints: array of TPoint; //polygon point

  FVertex: array of TPoint; //triangulated data

  FColor: TPoint;

  FCount: integer;

  FVertexCount: integer;

  FTesselated: boolean;

  procedure SetPoint(I: integer; Value: TPoint);

  procedure AddVertex(x: single; y: single; z: single; r: single; g: single; b: single; a:single);

  function GetPoint(I: integer): TPoint;

  function GetCount(): integer;

  procedure tessBegin(which: GLenum);

  procedure tessEnd();

  procedure tessVertex(x: single; y: single; z: single; r: single; g: single; b: single; a:single);

public

  constructor Create();

  destructor Destroy();

  procedure SetColor(R: single; G: single; B: single;A: single);

  procedure Add(X: single; Y: single); overload;

  procedure Add(X: single; Y: single; Z: single); overload;

  procedure Add(X: single; Y: single; Z: single; R: single; G: single; B: single; A: single); overload;

  procedure Render();

  procedure Tesselate();

  property Points[I: integer]: TPoint read GetPoint write SetPoint;

  property Count: integer read GetCount;

end;

 

implementation

 

type

     TGLArrayd6 = array[0..5] of GLDouble;

     PGLArrayd6 = ^TGLArrayd6;

     TGLArrayvertex4 = array[0..3] of PGLArrayd6;

     PGLArrayvertex4 = ^TGLArrayvertex4;

     PGLArrayf4 = ^TGLArrayf4;

 

threadvar

  PolygonClass: TPolygon;

 

procedure TPolygon.SetColor(R: single; G: single; B: single;A: single);

begin

  FColor.r := R;

  FColor.g := G;

  FColor.b := B;

  FColor.a := A;

end;

 

procedure TPolygon.tessBegin(which: GLenum);

begin

    glBegin(which);

end;

 

procedure TPolygon.tessEnd();

begin

    glEnd();

end;

 

procedure TPolygon.tessVertex(x: single; y: single; z: single; r: single; g: single; b: single; a:single);

begin

    glcolor3f(r,g,b);

    glVertex3f(x,y,z);

end;

 

procedure TPolygon.AddVertex(x: single; y: single; z: single; r: single; g: single; b: single; a:single);

begin

    FVertexCount := FVertexCount + 1;

    SetLength(FVertex, FVertexCount);

 

    FVertex[FVertexCount-1].R := R;

    FVertex[FVertexCount-1].G := G;

    FVertex[FVertexCount-1].B := B;

 

    FVertex[FVertexCount-1].X := X;

    FVertex[FVertexCount-1].Y := Y;

    FVertex[FVertexCount-1].Z := Z;

end;

 

constructor TPolygon.Create();

begin

  inherited Create();

  FCount := 0;

  FVertexCount := 0;

  FTesselated := false;

  FColor.R := 0.0;

  FColor.G := 0.0;

  FColor.B := 0.0;

  FColor.A := 0.0;

end;

 

destructor TPolygon.Destroy();

begin

  FTesselated := false;

  FCount := 0;

  FVertexCount := 0;

  SetLength(FPoints, FCount);

  SetLength(FVertex, FVertexCount);

  inherited Destroy;

end;

 

procedure TPolygon.SetPoint(I: integer; Value: TPoint);

begin

  FTesselated := false; //check first on changed values

  FPoints[I] := Value;

end;

 

function TPolygon.GetPoint(I: integer): TPoint;

begin

  result := FPoints[I];

end;

 

function TPolygon.GetCount(): integer;

begin

  result := FCount;

end;

 

procedure TPolygon.Add(X: single; Y: single);

begin

  FTesselated := false;

  FCount := FCount + 1;

  SetLength(FPoints, FCount);

  FPoints[FCount-1].X := X;

  FPoints[FCount-1].Y := Y;

  FPoints[FCount-1].Z := 0.0;

  FPoints[FCount-1].R := FColor.R;

  FPoints[FCount-1].G := FColor.G;

  FPoints[FCount-1].B := FColor.B;

  FPoints[FCount-1].A := FColor.A;

end;

 

procedure TPolygon.Add(X: single; Y: single; Z: single);

begin

  FTesselated := false;

  FCount := FCount + 1;

  SetLength(FPoints, FCount);

  FPoints[FCount-1].X := X;

  FPoints[FCount-1].Y := Y;

  FPoints[FCount-1].Z := Z;

  FPoints[FCount-1].R := FColor.R;

  FPoints[FCount-1].G := FColor.G;

  FPoints[FCount-1].B := FColor.B;

  FPoints[FCount-1].A := FColor.A;

end;

 

procedure TPolygon.Add(X: single; Y: single; Z: single; R: single; G: single; B: single; A: single);

begin

  FTesselated := false;

  FCount := FCount + 1;

  SetLength(FPoints, FCount);

  FPoints[FCount-1].X := X;

  FPoints[FCount-1].Y := Y;

  FPoints[FCount-1].Z := Z;

  FPoints[FCount-1].R := R;

  FPoints[FCount-1].G := G;

  FPoints[FCount-1].B := B;

  FPoints[FCount-1].A := A;

end;

 

Procedure TPolygon.Render();

var

  loop: integer;

begin

  if FTesselated = false then Tesselate;

 

  glbegin(GL_TRIANGLES);

  for loop:=0 to FVertexCount-1 do

  begin

    glcolor3f(FVertex[loop].R,FVertex[loop].G,FVertex[loop].B);

    glvertex3f(FVertex[loop].X,FVertex[loop].Y,FVertex[loop].Z);

  end;

  glend;

end;

 

procedure TPolygon.Tesselate();

var

  loop: integer;

  tess: pointer;

  test: TGLArrayd3;

  pol: PGLArrayd6;

 

  MyTest: string;

 

procedure iTessBeginCB(which: GLenum); {$IFDEF Win32}stdcall; {$ELSE}cdecl; {$ENDIF}

begin

  //PolygonClass.tessBegin(which);

end;

 

procedure iTessEndCB(); {$IFDEF Win32}stdcall; {$ELSE}cdecl; {$ENDIF}

begin

  //PolygonClass.tessEnd();

end;

 

procedure iTessEdgeCB(flag: GLboolean; lpContext: pointer); {$IFDEF Win32}stdcall; {$ELSE}cdecl; {$ENDIF}

begin

      //just do nothing to force GL_TRIANGLES !!!

end;

 

procedure iTessVertexCB(data: PGLArrayd6); {$IFDEF Win32}stdcall; {$ELSE}cdecl; {$ENDIF}

begin

  //PolygonClass.tessVertex(data[0], data[1], data[2], data[3], data[4], data[5],0);

  PolygonClass.AddVertex(data[0], data[1], data[2], data[3], data[4], data[5],0);

end;

 

 

procedure iTessCombineCB(newVertex : PGLArrayd6; neighborVertex : Pointer;

                      neighborWeight : Pointer; var outData : Pointer); {$IFDEF Win32}stdcall; {$ELSE}cdecl; {$ENDIF}

var

  vertex: PGLArrayd6;

  loop: integer;

  colorloop: integer;

  color: double;

begin

  new(vertex);

 

  vertex[0] := newVertex^[0];

  vertex[1] := newVertex^[1];

  vertex[2] := newVertex^[2];

 

  for colorloop := 3 to 5 do

  begin

    vertex[colorloop] := 0.0;

    for loop:=0 to 3 do

    begin

      if PGLArrayf4(neighborWeight)^[loop] <> 0 then

      begin

        vertex[colorloop] := vertex[colorloop] +

             PGLArrayf4(neighborWeight)^[loop] *

             PGLArrayvertex4(neighborVertex)^[loop][colorloop]

      end;

    end;

  end;

 

  // return output data (vertex coords and others)

  outData:= vertex;

end;

 

begin

  PolygonClass := Self;

 

  tess := gluNewTess();

 

  gluTessCallback(tess, GLU_TESS_BEGIN, @iTessBeginCB );

  gluTessCallback(tess, GLU_TESS_END, @iTessEndCB);

  gluTessCallback(tess, GLU_TESS_VERTEX, @iTessVertexCB);

  gluTessCallback(tess, GLU_TESS_COMBINE, @iTessCombineCB);  //does not work for font?

  gluTessCallback(tess, GLU_TESS_EDGE_FLAG_DATA, @iTessEdgeCB); //force triangles

 

  gluTessProperty(tess, GLU_TESS_WINDING_RULE, GLU_TESS_WINDING_NONZERO );

 

  gluTessBeginPolygon(tess, nil);                   // with NULL data

  gluTessBeginContour(tess);

 

  for loop := 0 to FCount-1 do

  begin

      new(pol);

      pol[3]:=FPoints[loop].R; //color

      pol[4]:=FPoints[loop].G;

      pol[5]:=FPoints[loop].B;

 

      pol[0]:=FPoints[loop].X;

      pol[1]:=FPoints[loop].Y;

      pol[2]:=0;

 

      test[0] := pol[0];

      test[1] := pol[1];

      test[2] := pol[2];

      gluTessVertex(tess, test, pol);

  end;

 

  gluTessEndContour(tess);

  gluTessEndPolygon(tess);

  gluDeleteTess(tess);        // delete after tessellation

 

  PolygonClass := nil;

  FTesselated := true;

end;

 

end.