Работа с OpenGL в Delphi

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, OpenGL15, StdCtrls, glut, sMemo, sEdit, sButton,
  sGroupBox, sLabel, sPanel, sSkinManager;
 
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    sPanel1: TsPanel;
    sLabel1: TsLabel;
    sLabel2: TsLabel;
    sLabel3: TsLabel;
    sRadioGroup1: TsRadioGroup;
    sButton2: TsButton;
    sEdit1: TsEdit;
    sEdit2: TsEdit;
    sEdit3: TsEdit;
    sEdit4: TsEdit;
    sMemo1: TsMemo;
    sButton3: TsButton;
    sButton1: TsButton;
    sSkinManager1: TsSkinManager;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure sRadioGroup1Click(Sender: TObject);
    procedure sButton3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
type
  TVector = record
     X, Y, Z: Single;
  end;
 
var
  Form1: TForm1;
  DC: HDC;
  RC: HGLRC;
  Graph: Integer;
  GraphColor: array[0..3] of Single;
  Mode: Word;
  a: Single;
  mas_1: array [0..2,0..500] of extended;
  n_1 :integer;
  raschet: boolean;
  type
mas=array[1..20] of real;
 
function f1(a1,a2:real):real;
 
implementation
{$R *.dfm}
function f1(a1,a2:real):real;
begin
 
case Graph of
1: Result := ( (sqr(a1) / 20) + (sqr(a2) / 20) ) / 2;
2: Result := sqrt(sqr(a1)+sqr(a2))-5;
3: Result := 0.01*sqr(a2-sqr(a1))+0.0001*sqr(1-a1)-5 ;
4: Result := Cos(a1 / 1.5) * Cos(a2 / 1.5) * 2;
 
end;
end;
 
procedure pmmks();
label 2;
var ma:mas; y,h,e,l,b,c:real; i,n:integer;
begin
n:=2;
h:=strtofloat(form1.sedit1.text);
e:=strtofloat(form1.sEdit2.Text);
ma[1]:=strtofloat(form1.sEdit3.text);
ma[2]:=strtofloat(form1.sEdit4.text);
l:=h;
repeat
for i:=1 to n do begin
b:=0.9E38;
2:ma[i]:=ma[i]+h;
y:=f1(ma[1],ma[2]);
c:=b;
b:=y;
if y-c<0 then goto 2;
h:=-h/3;
mas_1[0,n_1]:=ma[1];
mas_1[1,n_1]:=ma[2];
mas_1[2,n_1]:=y;
n_1:=n_1+1;
if abs(h)>=abs(l/3) then goto 2;
h:=l; end;
l:=l/9; h:=l;
until (e/9>l);
form1.sMemo1.Lines.Add('fmin='+floattostr(y));
for i:=1 to n do
form1.sMemo1.Lines.Add('x '+inttostr(i)+' min='+floattostr(ma[i])); end;
//---------------------------- Degree To Radial --------------------------------
 
function Rad(Deg: Extended): Extended;
begin
   Result := Deg * pi / 180;
end;
 
//-------------------------------- Vectors -------------------------------------
 
function GetVector(X, Y, Z: Single): TVector;
begin
   Result.X := X;
   Result.Y := Y;
   Result.Z := Z;
end;
 
function MagnitudeVector(Normal: TVector): Single;
begin
   Result := Sqrt((Normal.X * Normal.X) + (Normal.Y * Normal.Y) + (Normal.Z * Normal.Z));
end;
 
function NormalizeVector(Normal: TVector): TVector;
var
   Magnitude: Single;
begin
   Magnitude := MagnitudeVector(Normal);
   Result.X := Normal.X / Magnitude;
   Result.Y := Normal.Y / Magnitude;
   Result.Z := Normal.Z / Magnitude;
end;
 
function SubVector(Vector1, Vector2: TVector): TVector;
begin
   Result.X := Vector1.X - Vector2.X;
   Result.Y := Vector1.Y - Vector2.Y;
   Result.Z := Vector1.Z - Vector2.Z;
end;
 
function CrossVector(Vector1, Vector2: TVector): TVector;
begin
   Result.X := (Vector1.Y * Vector2.Z) - (Vector1.Z * Vector2.Y);
   Result.Y := (Vector1.Z * Vector2.X) - (Vector1.X * Vector2.Z);
   Result.Z := (Vector1.X * Vector2.Y) - (Vector1.Y * Vector2.X);
end;
 
function NormalVector(Vector1, Vector2, Vector3: TVector): TVector;
var
   V1, V2: TVector;
begin
   V1 := SubVector(Vector1, Vector2);
   V2 := SubVector(Vector2, Vector3);
   Result := NormalizeVector(CrossVector(V1, V2));
end;
 
//---------------------------------- Camera ------------------------------------
 
function GetLookVector(AngleV, AngleH: Single): TVector;
begin
   Result := GetVector(Cos(rad(AngleV)) * Sin(rad(AngleH)),
                       Cos(rad(AngleV)) * Cos(rad(AngleH)),
                       Sin(rad(AngleV)));
   NormalizeVector(Result);
end;
 
procedure SetCamera;
var
   Look, Up: TVector;
   X, Y: Single;
begin
   X := 30 * Sin(Rad(a));
   Y := 30 * Cos(Rad(a));
   glLoadIdentity;
   Look := GetLookVector(-15, a - 180);
   Up := GetVector(0, 0, 1);
   gluLookAt(X, Y, 10, Look.X + X, Look.Y + Y, Look.Z + 10, Up.X, Up.Y, Up.Z);
   a := a + 0.25;
   if a >= 360 then a := 0;
end;
 
//------------------------------------------------------------------------------
 
function Formula(X, Y: Single; var Err: Boolean): Single;
var
   temp: Single;
begin
   if Err then begin
      Result := 0;
      Exit;
   end;
   Err := false;
   case Graph of
      1 :
         begin
             Result := ( (sqr(X) / 20) + (sqr(Y) / 20) ) / 2;
         end;
      2 :
         begin
              Result := sqrt(sqr(X)+sqr(y))-5;
         end;
      3 :
         begin
             Result := 0.01*sqr(y-sqr(x))+0.0001*sqr(1-x)-5 ;
         end;
      4 :
         begin
            Result := Cos(X / 1.5) * Cos(Y / 1.5) * 2;
         end;
      else Result := 0;
   end;
end;
 
procedure DrawGraph(minX, minY, maxX, maxY, d: Single);
var
ji: integer;
   i, j: Single;
   P1, P2, P3, P4, Norm: TVector;
   Err: Boolean;
   pMode: Word;
begin
/// ðèñîâàíèÿ õîäà ïðîöåäóðû
glColor3f(1,0,0);
if raschet=true then
  begin
    for ji:=0 to n_1-1 do
      begin
        glPushMatrix;
        glTranslatef(mas_1[0,ji],mas_1[1,ji],mas_1[2,ji]);
        glutSolidSphere(0.1,12,12);
        glPopMatrix;
      end;
 
if raschet=true then
  begin
   glBegin(GL_LINE_STRIP);
    for ji:=0 to n_1-1 do
      begin
      glVertex3f(mas_1[0,ji],mas_1[1,ji],mas_1[2,ji]);
      end;
      glEnd;
 
 end;   end;
/// ðèñîâàíèÿ õîäà ïðîöåäóðû
 
   glPushAttrib(GL_ALL_ATTRIB_BITS);
   glColor3fv(@GraphColor);
   pMode := MakeWord(Mode, $1B);
   glPolygonMode(GL_FRONT_AND_BACK, pMode);
   i := minX;
   j := minY;
   while i < maxX - d do begin
      while j < maxY - d do begin
         Err := false;
         P1 := GetVector(i, j, Formula(i, j, Err));
         P2 := GetVector(i + d, j, Formula(i + d, j, Err));
         P3 := GetVector(i + d, j + d, Formula(i + d, j + d, Err));
         P4 := GetVector(i, j + d, Formula(i, j + d, Err));
         if not Err then begin
            glBegin(GL_TRIANGLES);
               Norm := NormalVector(P1, P2, P3);
               glNormal3fv(@Norm);
               glVertex3fv(@P1);
               glVertex3fv(@P2);
               glVertex3fv(@P3);
               Norm := NormalVector(P1, P3, P4);
               glNormal3fv(@Norm);
               glVertex3fv(@P1);
               glVertex3fv(@P3);
               glVertex3fv(@P4);
            glEnd;;
         end;
         j := j + d;
      end;
      j := minY;
      i := i + d;
   end;
   glPopAttrib;
end;
 
 
procedure TForm1.FormCreate(Sender: TObject);
var
   LightPos: array[0..3] of Single;
begin  raschet:=false;
   Randomize;
   GraphColor[0] := 0.0;
   GraphColor[1] := 0.8;
   GraphColor[2] := 0.0;
   GraphColor[3] := 0.0;
   Graph := 1;
   a := 0;
   Mode := 0;
   DC := GetDC(Handle);
   InitOpenGL;
   RC := CreateRenderingContext(DC,[opDoubleBuffered],24, 24, 8, 64, 0,0);
   ActivateRenderingContext(DC, RC);
   glClearColor(0.5, 0.5, 0.5, 0.5);
   glEnable(GL_DEPTH_TEST);
   glEnable(GL_COLOR_MATERIAL);
   glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
   glEnable(GL_LIGHTING);
   glEnable(GL_LIGHT0);
   LightPos[0] := 0;
   LightPos[1] := 0;
   LightPos[2] := 10;
   LightPos[3] := 0;
   glLightfv(GL_LIGHT0, GL_POSITION, @LightPos);
   glMatrixMode(GL_PROJECTION);
   glLoadIdentity;
   gluPerspective(60, ClientWidth/ClientHeight, 0.1, 1000);
   glMatrixMode(GL_MODELVIEW);
   glLoadIdentity;
   Timer1.Enabled := true;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
   if GetForegroundWindow = Handle then begin
      SetCamera;
      glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
      //-------------- Draw graph --------------
      glPushAttrib(GL_ALL_ATTRIB_BITS);
      glDisable(GL_LIGHTING);
      glBegin(GL_LINES);
         glColor3f(1.0, 1.0, 1.0);
         glVertex3f(0, 0, 0);
         glVertex3f(100, 0, 0);
         glVertex3f(0, 0, 0);
         glVertex3f(0, 100, 0);
         glVertex3f(0, 0, 0);
         glVertex3f(0, 0, 100);
         glColor3f(0.25, 0.25, 0.25);
         glVertex3f(-100, 0, 0);
         glVertex3f(0, 0, 0);
         glVertex3f(0, -100, 0);
         glVertex3f(0, 0, 0);
         glVertex3f(0, 0, -100);
         glVertex3f(0, 0, 0);
      glEnd;
      glPopAttrib;
      DrawGraph(-15, -15, 15, 15, 0.4);
      //-------------- Draw graph --------------
      SwapBuffers(DC);
   end;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
   Timer1.Enabled := false;
   wglMakeCurrent(DC, RC);
   wglDeleteContext(RC);
   ReleaseDC(Handle, DC);
   DeleteDC(DC);
end;
 
procedure TForm1.FormResize(Sender: TObject);
begin
   glViewport(0, 0, ClientWidth, ClientHeight);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
n_1:=0;
form1.sMemo1.Clear;
raschet:=false;
pmmks();
raschet:=true;   // ðàçðåøåíèå âûâîäèòü
end;
 
procedure TForm1.Button2Click(Sender: TObject);
 begin
      GraphColor[0] := Random(256) * 1 / 256;
      GraphColor[1] := Random(256) * 1 / 256;
      GraphColor[2] := Random(256) * 1 / 256;
   end;
 
procedure TForm1.Button3Click(Sender: TObject);
begin
    Inc(Mode);
      if Mode > 2 then Mode := 0;
end;
 
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
raschet:=false;
Graph:=form1.sRadioGroup1.ItemIndex+1;
end;
 
procedure TForm1.sButton1Click(Sender: TObject);
begin
GraphColor[0] := Random(256) * 1 / 256;
      GraphColor[1] := Random(256) * 1 / 256;
      GraphColor[2] := Random(256) * 1 / 256;
end;
 
procedure TForm1.sButton2Click(Sender: TObject);
begin
  Inc(Mode);
      if Mode > 2 then Mode := 0;
end;
 
procedure TForm1.sRadioGroup1Click(Sender: TObject);
begin
raschet:=false;
Graph:=form1.sRadioGroup1.ItemIndex+1;
end;
 
procedure TForm1.sButton3Click(Sender: TObject);
begin
n_1:=0;
form1.sMemo1.Clear;
raschet:=false;
pmmks();
raschet:=true;   // ðàçðåøåíèå âûâîäèòü
end;
 
end.