unit Gubka;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,
  OpenGL, Menus, StdCtrls, FileCtrl;

type
  TFrmGL = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    OpenDialog1: TOpenDialog;
    FileListBox1: TFileListBox;
    ColorDialog1: TColorDialog;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    Gubka1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormResize(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure Gubka1Click(Sender: TObject);
  private
    DC : HDC;
    hrc: HGLRC;
    Angle : GLfloat;
    wrkX, wrkY, wrkZ : Array [0..1000000] of GLfloat;
    R, G, B,
    Rf, Gf, Bf : GLFloat;
    quadObj : GLUquadricObj;
    { Private declarations }
  protected
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
  public
    { Public declarations }
  end;



var
  FrmGL: TFrmGL;
  mash:extended =1.0;
  fl_vyd:boolean =true;
implementation
uses DGLUT,Unit2;

{$R *.dfm}
Const  NAM=200; nmax=1000000;
type
coordp=array [1..nmax,1..3] of SINGLE ;

MAT=Array[1..3,1..3] of Extended;
COORD=Array[1..3,1..NAM] of SINGLE;
COOR=array[1..nam] of SINGLE;
TYP=Array[1..nam] of Integer;

Var
f:text;
xat,
X:COORD;         {Ёбе®¤­лҐ Є®®а¤Ё­ вл}
np2,
N,
NSVAZ,
NA:Integer;      {—Ёб«®  в®¬®ў ў ¬®«ҐЄг«Ґ}
IND:Array[1..NAM] of String[4]; {­ §ў ­Ёп  в®¬®ў}
T:TYP;                          {вЁЇл  в®¬®ў}
SH:extended;
rv:array[1..nam] of Single;
xpol,xp2,
xp:coordp;

  wrk_X, wrk_Y : Integer;
  mode : Boolean = False;
  solid : Boolean = True;
  down : Boolean = False;

NS:Array[1..NAM] of Integer;   {зЁб«® бўп§Ґ© г  в®¬ }
SV:Array[1..NAM,1..10] of Integer;  {б Є ЄЁ¬Ё  в®¬ ¬Ё бўп§ ­}
XBE:Array[1..2,1..nam] of Integer; {­®¬Ґа   в®¬®ў бўп§Ё}



{=======================================================================
Перерисовка окна}
procedure TfrmGL.WMPaint(var Msg: TWMPaint);
var
 ps : TPaintStruct;
 i : LongInt;
begin
 For i:=1 to n do
   begin
   wrkX[i]:=xpol[i,1]; wrkY[i]:=xpol[i,2]; wrkZ[i]:=xpol[i,3];
   end;

 BeginPaint(Handle, ps);
  glClearColor (Rf, Gf, Bf, 1.0);        // цвет фона

 // очистка буфера цвета и буфера глубины
 glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glScalef(mash,mash,mash); mash:=1;
// glRotatef(Angle, 0.0, 0.0, 1.0);  // поворот на угол
 glPushMatrix;
 {Цикл рисования поликуба}
 For i := 1 to n do begin
  glPushMatrix;                    // запомнили точку
  glTranslatef(wrkX [i], wrkY [i], wrkZ [i]);

   glColor3f (R, G, B);
     glPolygonMode (GL_FRONT_AND_BACK, GL_FILL);
     glutSolidCube (sh);
(*
   glColor3f (0.0, 0.0, 0.0);
   glPolygonMode (GL_FRONT_AND_BACK, GL_LINE);
   glLineWidth(1.5);
   glutSolidCube (0.125);
 *)
  glPopMatrix;                     // вернулись в точку
 End;
 SwapBuffers(DC);

 EndPaint(Handle, ps);
end;




{=======================================================================
Формат пикселя}
procedure SetDCPixelFormat (hdc : HDC);
var
 pfd : TPixelFormatDescriptor;
 nPixelFormat : Integer;
begin
 FillChar (pfd, SizeOf (pfd), 0);
 pfd.dwFlags  := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
 nPixelFormat := ChoosePixelFormat (hdc, @pfd);
 SetPixelFormat (hdc, nPixelFormat, @pfd);
end;


{=======================================================================
Создание формы}
procedure TfrmGL.FormCreate(Sender: TObject);
var
 i : 0..5;
begin
 DC := GetDC (Handle);
 SetDCPixelFormat(DC);
 hrc := wglCreateContext(DC);
 wglMakeCurrent(DC, hrc);
(*
 For i := 0 to 5 do begin
      wrkX [i] := sin (Pi / 3 * i);
      wrkY [i] := cos (Pi / 3 * i);

 end; *)
 glClearColor (1.0, 1.0, 1.0, 1.0);
 Rf:=0.4;Gf:=0.7;Bf:=0.9;
 R:=1;G:=0;B:=0;

 glEnable(GL_DEPTH_TEST);// разрешаем тест глубины
 // Добавляем источник света 0
 glEnable(GL_LIGHTING); // разрешаем работу с освещенностью
 glEnable(GL_LIGHT0);   // включаем источник света 0
 glEnable (GL_COLOR_MATERIAL);

 quadObj := gluNewQuadric;

 Angle := 70;
end;

{=======================================================================
Конец работы приложения}
procedure TfrmGL.FormDestroy(Sender: TObject);
begin
 wglMakeCurrent(0, 0);
 wglDeleteContext(hrc);
 ReleaseDC (Handle, DC);
 DeleteDC (DC);
end;


procedure TfrmGL.FormResize(Sender: TObject);
begin
 glViewPort (0, 0, ClientWidth, ClientHeight);
 glMatrixMode(GL_PROJECTION);
 glLoadIdentity;
 gluPerspective(18.0, ClientWidth / ClientHeight, 7.0, 10.0);
 glMatrixMode(GL_MODELVIEW);
 glLoadIdentity;
 glTranslatef(0.0, 0.0, -9.0);
 glRotatef(Angle, 1.0, 0.0, 1.0);
 InvalidateRect(Handle, nil, False);
end;

{=======================================================================
Перевод цвета из TColor в OpenGL}
procedure ColorToGL (c : TColor; var R, G, B : GLFloat);
begin
 R := (c mod $100) / 255;
 G := ((c div $100) mod $100) / 255;
 B := (c div $10000) / 255;
end;


procedure TfrmGL.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);

begin
  If Key = VK_ESCAPE then Close;

  Case Key of
   68: begin mash:=mash/1.01; InvalidateRect(Handle,nil,False);end;
   85: begin mash:=mash*1.01; InvalidateRect(Handle,nil,False);end;
   end;

end;

 Procedure SVAZ;
 Var
 I,J,K:Integer;
 R:Extended;

 Begin
 NSVAZ:=0;
 For I:=1 to NA-1 do
   begin
   NS[I]:=0;
   For J:=I+1 to NA do
     begin
     R:=Sqrt(Sqr(X[1,I]-X[1,J])+Sqr(X[2,I]-X[2,J])+Sqr(X[3,I]-X[3,J]));
     If R<rv[t[i]]+rv[t[j]] then
       begin
       NS[I]:=NS[I]+1;
       SV[I,NS[I]]:=J;
       NSVAZ:=NSVAZ+1;
       XBE[1,NSVAZ]:=I;XBE[2,NSVAZ]:=J;
       end;
     end;
   end;
 End;


procedure TFrmGL.N1Click(Sender: TObject);
 Var
 i:integer;

begin
n:=1; i:=1;
  Xpol[i,1]:=0;
  xpol[i,2]:=0;
  xpol[i,3]:=0;
  sh:=1.8;
InvalidateRect(Handle,nil,False);

end;

procedure TFrmGL.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Down := True;
  wrk_X := X;
  wrk_Y := Y;
end;

procedure TFrmGL.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Down := False;
end;

procedure TFrmGL.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  If Down then begin
     glRotatef (X - wrk_X, 0.0, 1.0, 0.0);
     glRotatef (Y - wrk_Y, 1.0, 0.0, 0.0);
     InvalidateRect(Handle, nil, False);
     wrk_X := X;
     wrk_Y := Y;
  end;
end;


procedure TFrmGL.N3Click(Sender: TObject);
begin
If ColorDialog1.Execute then begin
         ColorToGL (ColorDialog1.Color, Rf, Gf, Bf);
         InvalidateRect(Handle,nil,False);
         end;
end;

procedure TFrmGL.N4Click(Sender: TObject);
begin
If ColorDialog1.Execute then begin
         ColorToGL (ColorDialog1.Color, R, G, B);
         InvalidateRect(Handle,nil,False);
         end;

end;

procedure TFrmGL.N6Click(Sender: TObject);
begin
mash:=mash/1.01; InvalidateRect(Handle,nil,False);
end;

procedure TFrmGL.N7Click(Sender: TObject);
begin
mash:=mash*1.01; InvalidateRect(Handle,nil,False);
end;

procedure TFrmGL.N8Click(Sender: TObject);
begin
Form2.Show;
end;

procedure TFrmGL.Gubka1Click(Sender: TObject);
var
i,j:LongInt;

begin

sh:=sh/3;
j:=0;
For i:=1 to n do
 begin
 xp[j+1,1]:=xpol[i,1]-sh; xp[j+1,2]:=xpol[i,2]-sh; xp[j+1,3]:=xpol[i,3]-sh;
 xp[j+2,1]:=xpol[i,1]-sh; xp[j+2,2]:=xpol[i,2]-sh; xp[j+2,3]:=xpol[i,3];
 xp[j+3,1]:=xpol[i,1]-sh; xp[j+3,2]:=xpol[i,2]-sh; xp[j+3,3]:=xpol[i,3]+sh;
 xp[j+4,1]:=xpol[i,1]-sh; xp[j+4,2]:=xpol[i,2];    xp[j+4,3]:=xpol[i,3]-sh;
 xp[j+5,1]:=xpol[i,1]-sh; xp[j+5,2]:=xpol[i,2];    xp[j+5,3]:=xpol[i,3]+sh;
 xp[j+6,1]:=xpol[i,1]-sh; xp[j+6,2]:=xpol[i,2]+sh; xp[j+6,3]:=xpol[i,3]-sh;
 xp[j+7,1]:=xpol[i,1]-sh; xp[j+7,2]:=xpol[i,2]+sh; xp[j+7,3]:=xpol[i,3];
 xp[j+8,1]:=xpol[i,1]-sh; xp[j+8,2]:=xpol[i,2]+sh; xp[j+8,3]:=xpol[i,3]+sh;
 j:=j+8;
 xp[j+1,1]:=xpol[i,1]; xp[j+1,2]:=xpol[i,2]-sh; xp[j+1,3]:=xpol[i,3]-sh;
 xp[j+2,1]:=xpol[i,1]; xp[j+2,2]:=xpol[i,2]-sh; xp[j+2,3]:=xpol[i,3]+sh;
 xp[j+3,1]:=xpol[i,1]; xp[j+3,2]:=xpol[i,2]+sh; xp[j+3,3]:=xpol[i,3]-sh;
 xp[j+4,1]:=xpol[i,1]; xp[j+4,2]:=xpol[i,2]+sh; xp[j+4,3]:=xpol[i,3]+sh;
 j:=j+4;
 xp[j+1,1]:=xpol[i,1]+sh; xp[j+1,2]:=xpol[i,2]-sh; xp[j+1,3]:=xpol[i,3]-sh;
 xp[j+2,1]:=xpol[i,1]+sh; xp[j+2,2]:=xpol[i,2]-sh; xp[j+2,3]:=xpol[i,3];
 xp[j+3,1]:=xpol[i,1]+sh; xp[j+3,2]:=xpol[i,2]-sh; xp[j+3,3]:=xpol[i,3]+sh;
 xp[j+4,1]:=xpol[i,1]+sh; xp[j+4,2]:=xpol[i,2];    xp[j+4,3]:=xpol[i,3]-sh;
 xp[j+5,1]:=xpol[i,1]+sh; xp[j+5,2]:=xpol[i,2];    xp[j+5,3]:=xpol[i,3]+sh;
 xp[j+6,1]:=xpol[i,1]+sh; xp[j+6,2]:=xpol[i,2]+sh; xp[j+6,3]:=xpol[i,3]-sh;
 xp[j+7,1]:=xpol[i,1]+sh; xp[j+7,2]:=xpol[i,2]+sh; xp[j+7,3]:=xpol[i,3];
 xp[j+8,1]:=xpol[i,1]+sh; xp[j+8,2]:=xpol[i,2]+sh; xp[j+8,3]:=xpol[i,3]+sh;
 j:=j+8;
{} end;
xpol:=xp;
n:=j;
InvalidateRect(Handle,nil,False);
end;

end.
