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;
    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);
  private
    DC : HDC;
    hrc: HGLRC;
    Angle : GLfloat;
    wrkX, wrkY, wrkZ : Array [0..10000] 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=10000;
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 : word;
begin
If fl_Vyd then
 Begin
 For i:=1 to n do
   begin
   wrkX[i]:=xpol[i,1]; wrkY[i]:=xpol[i,2]; wrkZ[i]:=xpol[i,3];
   end;
 end
          else
 Begin
 For i:=1 to na do
   begin
   wrkX[i]:=xat[1,i]; wrkY[i]:=xat[2,i]; wrkZ[i]:=xat[3,i];
   end;
 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;
If fl_Vyd then
 Begin
 {Цикл рисования поликуба}
 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 (0.122);

   glColor3f (0.0, 0.0, 0.0);
   glPolygonMode (GL_FRONT_AND_BACK, GL_LINE);
   glLineWidth(1.5);
   glutSolidCube (0.125);
  glPopMatrix;                     // вернулись в точку
 End;
 End
           else
 //Рисование молекуды
 begin
 glClearColor (0, 1, 1, 1.0);        // цвет фона
 glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

 For i := 1 to na do
  begin
  glPushMatrix;                    // запомнили точку
  glTranslatef(wrkX [i], wrkY [i], wrkZ [i]);
  Case t[i] of
   1:glColor3f (0.5, 0.5, 0.5);
   2:glColor3f (1, 1, 1);
   3:glColor3f (0, 1, 0);
   6:glColor3f (1, 0, 0);
            else
   glColor3f (1, 1, 1);
   end;
  Case t[i] of
    2: glutSolidSphere (0.03, 20, 20);
            else
    glutSolidSphere (0.05, 20, 20);
    end;
  glPopMatrix;                     // вернулись в точку
  end;

 glLineWidth(6);
 glColor3f (0.5, 0.5, 0.5);
 glEnable (GL_LINE_SMOOTH);
 glBegin(GL_LINES);
   For i:=1 to NSVAZ do
     begin
     glVertex3f(wrkX[XBE[1,i]],wrkY[XBE[1,i]],wrkZ[XBE[1,i]]);
     glVertex3f(wrkX[XBE[2,i]],wrkY[XBE[2,i]],wrkZ[XBE[2,i]]);
     end;
 glEnd;
 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:=1;Gf:=1;Bf:=1;
 R:=1;G:=1;B:=1;

 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
 NP,NS,
 i,j,jj:integer;
 xx:array[1..3] of extended;
 PX:coordp;
 nor:word;

begin
frmGL.OpenDialog1.InitialDir:=frmGL.FileListBox1.directory;
OpenDialog1.Filter := 'Polycube(*.po)|*.pol|All files (*.*)|*.*';
OpenDialog1.FilterIndex := 1;

if frmGL.OpenDialog1.Execute then AssignFile(F,frmGL.OpenDialog1.FileName)
                             else Exit;
Reset(F);
ReadLn(f);
Read(f,nor,na,SH);
// ввод молекулы
For i:=1 to na do ReadLn(f,x[1,i],x[2,i],x[3,i],t[i],ind[i]);
RV[1]:=0.85; RV[2]:=0.35; RV[3]:=1.1;RV[4]:=1.4; RV[5]:=1.3;RV[6]:=0.8;
RV[7]:=1.4; RV[9]:=0.85;
// ввод молекулы закончен
SVAZ;
// ввод поликуба
  ReadLn(f,N);
  For I:=1 to N do ReadLn(f,xp[I,1],xp[I,2],xp[I,3]);
  for i:=1 to 3 do
     begin xx[i]:=0;for j:=1 to n do xx[i]:=xx[i]+xp[j,i];end;
  for i:=1 to 3 do for j:=1 to n do xp[j,i]:=xp[j,i]-round(xx[i]/n);
// ввод поликуба закончен
For i:=1 to nor do
 begin
 ReadLn(f);
 for j:=1 to na do ReadLn(f);
 ReadLn(f,np2);
 for j:=1 to np2 do ReadLn(f);
 end;
ReadLn(f,np2);
 for j:=1 to np2 do ReadLn(f);
ReadLn(f,np2);
 for i:=1 to np2 do ReadLn(f,xp2[I,1],xp2[I,2],xp2[I,3]);


CloseFile(f);
For i:=1 to n do
  begin
  Xpol[i,1]:=xp[i,1]/8;
  xpol[i,2]:=xp[i,2]/8;
  xpol[i,3]:=xp[i,3]/8;
  end;
For i:=1 to na do
  begin
  Xat[1,i]:=x[1,i]/5;
  xat[2,i]:=x[2,i]/5;
  xat[3,i]:=x[3,i]/5;
  end;
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;

end.
