Документ взят из кэша поисковой машины. Адрес оригинального документа : http://www.abitu.ru/en2002/closed/viewwork.html?work=238 Дата изменения: Fri May 5 15:25:43 2006 Дата индексирования: Tue Oct 2 02:41:47 2012 Кодировка: koi8-r Поисковые слова: п п п п п п п п п п п п п п п п п п п п п п п п п п п п п п п п п п п п п п

РОССИЙСКАЯ НАУЧНО-СОЦИАЛЬНАЯ ПРОГРАММА
ДЛЯ МОЛОДЁЖИ И ШКОЛЬНИКОВ
«ШАГ В БУДУЩЕЕ»
Координационный центр по городу Тольятти
X «Конгресс молодых исследователей»





«Редактор виртуальных моделей кристаллов»



Исследовательская работа на научно-практическую конференцию

Секция: Информатика


Автор:
Лоозе Владимир Сергеевич
Россия, г. Тольятти
МОУ лицей ?36, 11А класс.
Научный руководитель:
Чуркин Валерий Конкордиевич,
к.т.н., доцент кафедры прикладной
и теоретической физики ТГУ



















Тольятти
2003 г.

Содержание

Введение
1. Разработка программы 3
1. Требования к программе 3
2. Математическая модель кристалла 3
3. Алгоритм работы 3
4. Среда программирования и 3D - библиотека 4
2. Код программы и внутренние алгоритмы 4
1. Главный модуль (mol.pas) 4
2. Вспомогательный модуль 1 (unit1.pas) 23
3. Вспомогательный модуль 2 (unit3.pas) 23
4. Вспомогательный модуль 3 (unit4.pas) 25
3. Интерфейс 30
1. Окна 30
1. Главное окно 30
2. Окно свойств 30
3. Окно опций 31
2. Быстрые клавиши 31
3. Мышь 31
4. Технические характеристики 31
1. Внутренние характеристики 31
2. Требования к оборудованию 31
5. Практическое значение 32
Список литературы 33



Введение

Кристаллы играют важную роль в современной технике. Они используются в
микроэлектронике при изготовлении сверхбольших интегральных схем,
микроустройств, полупроводниковых элементов и.т.д. Такое свойство
кристаллов, как анизотропность, позволяет использовать их в качестве
преобразователей механических напряжений в электрические сигналы и в
качестве активной среды при пропускании света. Изучение структуры
кристаллов позволяет прогнозировать эксплуатационные характеристики
изготовленной детали.[1,2].
Существует достаточное количество пособий, в которых отражены
особенности кристаллического состояния, разнообразие кристаллических
структур и их классификация[3]. Несмотря на доходчивость изложения
материала, у всех книг есть один недостаток: читателю сложно понять форму
кристалла по рисункам. Понятно, почему: в кристалле много повторяющихся
элементов и он трёхмерный. Изображение кристалла в статическом состоянии не
даёт полного представления о его структуре[1,3].
В данной работе представлена компьютерная программа, которая позволяет
моделировать, вращать кристалл, просматривать и изучать его структуру в
трёхмерном пространстве.

1. Разработка программы


1.2. Требования к программе, алгоритму и модели:
1. Математическая модель должна учитывать основные законы построения
кристаллов - иначе программа не имеет смысла
2. Математическая модель и алгоритм не должны быть очень сложными, чтобы
не замедлять программу
3. Программа должна быть как можно меньше размером, чтобы было удобно
распространять её по сети Интернет
4. Структуры файлов сохранённых моделей должны быть компактны, чтобы эти
файлы не занимали много места - ведь у одного пользователя может быть
несколько десятков моделей
5. Интерфейс должен быть удобен и прост
6. Технические характеристики программы должны позволять строить основные
типы кристаллических структур
7. Требования к компьютеру пользователя должны быть приемлемыми для
современных ПК


1.2. Математическая модель кристалла

В математической модели описаны основные законы физики кристаллов. Атомы -
материальные точки, соединённые невесомыми упругими неразрывными связями.
Взаимодействие связанных атомов определяется по закону Гука:
F=-kx
Сила, действующая на атом со стороны связи - по второму закону Ньютона:
F=ma
Приравняем правые части равенств:
-kx=ma
Следовательно, ускорение атома равно:
a=-kx/m
Вся система материальных точек помещена в вязкую среду для погашения
незатухающих колебаний точек. Скорость атома определится выражением:
v=v0n-kx/m
Где n-доля скорости, остающейся после воздействия сопротивления среды.

1.3. Алгоритм
В программе существуют два массива: массив атомов и массив связей, в
которых хранятся данные об атомах [координаты(1,2,3), составляющие вектора
скорости(4,5,6), масса(7) и размер(8)], и связях [номера связанных
атомов(1,2), длина(3), жёсткость(4)]. Программа перебирает по очереди все
связи и добавляет к вектору скорости каждого из связанных атомов вектор
ускорения, сообщённый атому связью. Таким образом, атомы располагаются в
пространстве таким образом, что длина каждой связи оказывается как можно
ближе к номинальному значению длины, установленному в массиве. При расчётах
учитываются размеры атомов, вязкость среды, связи считаются невесомыми и не
подверженными взаимодействиям со средой.


1.4. Среда программирования и 3D - библиотека
В современной компьютерной индустрии существует огромное количество
языков, сред, и макроязыков, которые позволяют создавать трёхмерные
приложения. Однако к программе предъявлены серьёзные требования. Макроязыки
не способны обеспечить низкоуровневую работу с трёхмерной графикой,
большинство из них не обеспечивают необходимого быстродействия. Свой выбор
я остановил на новом языке, языке Object Pascal в среде Delphi 5
enterprise[9].
Вторым выбором стал выбор библиотеки. По сети Интернет распространяются
очень удобные компоненты японских фирм и других сторонних производителей.
Эти компоненты обеспечивают очень комфортную работу с графикой, однако от
этого страдает быстродействие. Кроме того, они требуют установленного
DirectX, что есть не у всех. Для построения изображений я выбрал
стандартную библиотеку OpenGL[9], которая работает независимо от наличия
акселератора и драйверов на акселератор, проста в обращении и быстра в
работе, и, кроме того, она есть на каждом компьютере, где установлен
Windows95 или выше[9], что гарантирует её работу на любом современном ПК.


2. Код программы и внутренние алгоритмы

2.1. Главный модуль (mol.pas)

unit mol;
//главный модуль
interface
uses
Windows, Messages, SysUtils, Dialogs, Forms,
ExtCtrls, StdCtrls, Buttons, opengl,math,
ImgList, ToolWin, ComCtrls, Graphics, Controls, Classes;
//Главная форма
type
Tmoldes = class(TForm)
Timer1: TTimer;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ImageList1: TImageList;
ToolButton10: TToolButton;
ToolButton14: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton12: TToolButton;
ToolButton13: TToolButton;
ToolButton15: TToolButton;
CheckBox1: TCheckBox;
Button1: TButton;
ToolButton11: TToolButton;
OD: TOpenDialog;
SD: TSaveDialog;
ToolButton16: TToolButton;
CheckBox2: TCheckBox;
ToolButton6: TToolButton;
ToolButton17: TToolButton;
ToolButton18: TToolButton;
ToolButton9: TToolButton;
ToolButton19: TToolButton;
procedure Timer1Timer(Sender: TObject);
procedure Image2Click(Sender: TObject);
procedure Image4Click(Sender: TObject);
procedure Image5Click(Sender: TObject);
procedure Image1Click(Sender: TObject);
procedure recalc();
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure midle();
procedure FormShow(Sender: TObject);
procedure ToolButton15Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure atommodel();
procedure relationsmodel();
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ToolButton12Click(Sender: TObject);
procedure ToolButton11Click(Sender: TObject);
procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure ToolButton7Click(Sender: TObject);
procedure ToolButton19Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure setcuco();
//переменные, массивы
private
dc: hdc;
hrc: hglrc;
public
GrphMode: glenum ;//графический режим
grphstyle: glenum ;//стиль прорисовки
detaillevel: integer ;//уровень геометрической детализации
v: array[1..100] of tcolor;//цвета связей
c: array[1..100] of tcolor;//цвета атомов
p: array[1..200,1..8] of real;//сами атомы
s: array[1..500,1..5] of integer;//связи
clrred,clrblu,//цвета выделений red - для 1, blu - для 2 активного атома
defatomclr,defrelclr//цвета по умолчанию для атома и связи
:tcolor;
selradius,//радиус выделения

//Умолчания
defatommass,//масса атома
defatomradius,//размер атома
defrellength,//длина связи
defrelstrength,//жёсткость связи
defrelwidth//толщина связи
: integer;

cnt,cnt1,//кол-во атомов и связей увеличенное на 1
red,blu,//номера выделенных атомов
cuco//номер связи м/у выделенными атомами (если она есть)
:integer;

//установки степени зеркальности материала для:
red_shn,//выделения активного-1
blu_shn,//выделения активного-2
all_shn,//атомов
rel_shn//связей
:glfloat ;
//Установки материала (поглощение, рассеяние, отражение) для:
atomamb,atomdif,atomspc,//атомов
relamb,reldif,relspc,//связей
redamb,reddif,redspc,//выделения активного-1
bluamb,bludif,bluspc//выделения активного-2
:glfloat;

redblend,blublend:glfloat;//прозрачности выделений
oldx,oldy:integer;//"старые" координаты курсора мыши
sensivity:glfloat;//чувствительность мыши
ktr:glfloat;//коэффициент трения (условный)
end;
var
moldes: Tmoldes;//форма
const
//константы - номера дисплейных списков для атомов, связей, выделений
atoms:gluint=1;
relations:gluint=2;
selection:gluint=3;

implementation

uses Unit1, Unit3, Unit4;// вспомогательные модули

{$R *.DFM}

procedure Tmoldes.Timer1Timer(Sender: TObject);//событие таймера
begin
//обновим изображение
SwapBuffers(DC);
InvalidateRect(Handle, nil, False);
//центровка молекулы
moldes.midle();
//пересчёт координат и скоростей атомов
moldes.recalc();
//если на экране есть неактивная форма свойств, а
//фокус - у главного окна, то надо обновлять поля формы свойств
if not(propfm.active) and moldes.active then
begin
propfm.mass1.text:=floattostr(p[red,7]);
propfm.radius1.text:=floattostr(p[red,8]);
propfm.redcolor.brush.color:=c[red];
propfm.mass2.text:=floattostr(p[blu,7]);
propfm.radius2.text:=floattostr(p[blu,8]);
propfm.blucolor.brush.color:=c[blu];
propfm.length.text:=floattostr(s[cuco,3]);
propfm.strength.text:=floattostr(s[cuco,4]);
propfm.rwidth.text:=floattostr(s[cuco,5]);
propfm.relcolor.brush.color:=v[cuco];
end;
//если форма свойств активна, то надо переносить свойства
//в форме свойств на модель
if propfm.active then propfm.setupallsettings();
end;

procedure Tmoldes.Image2Click(Sender: TObject);//новый атом
begin
//инициализационные параметры атома
//координаты
p[cnt,1]:=P[RED,1]+random(20)-10;
p[cnt,2]:=P[RED,2]+random(20)-10;
p[cnt,3]:=P[RED,3]+random(20)-10;
//скорости
p[cnt,4]:=0;
p[cnt,5]:=0;
p[cnt,6]:=0;
//масса и размер
p[cnt,7]:=defatommass;
p[cnt,8]:=defatomradius;
//цвет
c[cnt]:=defatomclr;
//обозначаем его вторым активным
blu:=cnt;
//создаём связь м/у новым атомом и первым активным
//номера связываемых атомов
s[cnt1,1]:=cnt;
s[cnt1,2]:=red;
//длина и жёсткость
s[cnt1,3]:=defrellength;
s[cnt1,4]:=defrelstrength;
//толщина
s[cnt1,5]:=defrelwidth;
//цвет
v[cnt1]:=defrelclr;
//счётчики атомов и связей - увеличить на 1
inc(cnt);
inc(cnt1);
//определим номер связи м/у активными атомами
setcuco();
end;

procedure Tmoldes.Image4Click(Sender: TObject);//новая связь
begin
//определим номер связи м/у активными атомами
setcuco();
//если ноль, то там нет связи, значит, можно добавлять связь
if cuco=0 then
begin
//параметры связи по умолчанию
s[cnt1,1]:=red;
s[cnt1,2]:=blu;
s[cnt1,3]:=defrellength;
s[cnt1,4]:=defrelstrength;
s[cnt1,5]:=defrelwidth;
v[cnt1]:=defrelclr;
//увеличиваем счётчик
inc(cnt1);
//номер связи
setcuco();
end;
end;

procedure Tmoldes.Image5Click(Sender: TObject);//удаление связи
var n:integer;
label dl;
begin
//если связи нет, то удалять нечего
if cuco=0 then goto dl;
//уменьшаем счётчик
cnt1:=cnt1-1;
//переносим последнюю связь на место удалённой
for n:=1 to 5 do
begin
s[cuco,n]:=s[cnt1,n];
end;
v[cuco]:=v[cnt1];
//теперь связи нет
cuco:=0;
dl:
end;

procedure Tmoldes.Image1Click(Sender: TObject);//новая модель
begin
//устанавливаем два атома со связью, все значения - по умолчанию
p[1,1]:=5;
p[1,2]:=10;
p[1,3]:=15;
p[1,4]:=0;
p[1,5]:=0;
p[1,6]:=0;
p[1,7]:=defatommass;
p[1,8]:=defatomradius;
c[1]:=defatomclr;
p[2,1]:=-5;
p[2,2]:=-15;
p[2,3]:=-10;
p[2,4]:=0;
p[2,5]:=0;
p[2,6]:=0;
p[2,7]:=defatommass;
p[2,8]:=defatomradius;
c[2]:=defatomclr;
s[1,1]:=1;
s[1,2]:=2;
s[1,3]:=defrellength;
s[1,4]:=defrelstrength;
s[1,5]:=defrelwidth;
v[1]:=defrelclr;
//значения счётчиков
cnt:=3;
cnt1:=2;
//номера активных атомов
red:=1;
blu:=2;
//номер связи активных атомов
cuco:=1;
end;

procedure tmoldes.recalc();//пересчёт координат и скоростей
var m ,s11,s22:integer ;
var r,r1,r2:variant;
var a1,a2,s1,s2:variant;
var x1,x2,y1,y2,z1,z2:variant;
label next;
begin
m:=1 ;
while m < cnt1 do // перебираем все связи
begin
s1:=s[m,1];
s2:=s[m,2];
s11:=s1;
s22:=s2;
//фиксируем параметры связанных атомов
x1:= p[s11, 1];
y1:= p[s11, 2];
z1:= p[s11, 3];
x2:= p[s22, 1];
y2:= p[s22, 2];
z2:= p[s22, 3];
//текущее расстояние между атомами
r:= SQRt((x2-x1)*(x2-x1) + (y2-y1)*(y2-y1)+(z2-z1)*(z2-z1));
//ускорения атомов
a1:=(r- (s[m,3]+p[s11,8]+p[s22,8]))*s[m,4]/ p[s11, 7];
a2:=(r- (s[m,3]+p[s11,8]+p[s22,8]))*s[m,4]/ p[s22, 7];
//векторы скоростей атомов
r1:=sqrt((p[s11,4])*(p[s11,4])+(p[s11,5])*(p[s11,5])+(p[s11,6])*(p[s11,6]));

r2:=sqrt((p[s22,4])*(p[s22,4])+(p[s22,5])*(p[s22,5])+(p[s22,6])*(p[s22,6]));


//пересчитываем вектор скорости для атома
if r1=0 then //если нет скорости
begin
p[s11, 4] := p[s11, 4]+ (x2 - x1) / r *a1;
p[s11, 5] := p[s11, 5]+ (y2 - y1) / r *a1;
p[s11, 6] := p[s11, 6]+ (z2 - z1) / r *a1;
end
else //если скорость есть
begin
p[s11, 4] := p[s11, 4]+ (x2 - x1) / r *a1-(p[s11,4]/r1)*ktr;
p[s11, 5] := p[s11, 5]+ (y2 - y1) / r *a1-(p[s11,5]/r1)*ktr;
p[s11, 6] := p[s11, 6]+ (z2 - z1) / r *a1-(p[s11,6]/r1)*ktr;
end;
//то же для другого атома
if r2=0 then
begin
p[s22, 4] := p[s22, 4]+ (x1 - x2) / r *a2;
p[s22, 5] := p[s22, 5]+ (y1 - y2) / r *a2;
p[s22, 6] := p[s22, 6]+ (z1 - z2) / r *a2;
end
else
begin
p[s22, 4] := p[s22, 4]+ (x1 - x2) / r *a2-(p[s22,4]/r2)*ktr;
p[s22, 5] := p[s22, 5]+ (y1 - y2) / r *a2-(p[s22,5]/r2)*ktr;
p[s22, 6] := p[s22, 6]+ (z1 - z2) / r *a2-(p[s22,6]/r2)*ktr;
end;
//теперь пересчитываем координаты в соответствии со скоростями
p[s11, 1] := p[s11, 1] + p[s11, 4];
p[s11, 2] := p[s11, 2] + p[s11, 5];
p[s11, 3] := p[s11, 3] + p[s11, 6];
p[s22, 1] := p[s22, 1] + p[s22, 4];
p[s22, 2] := p[s22, 2] + p[s22, 5];
p[s22, 3] := p[s22, 3] + p[s22, 6];
m:=m+1;
end;
end;

procedure Tmoldes.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);//быстрые клавиши
var m,r,b:integer;
begin
case key of
vk_f1: moldes.Image2Click(nil);//новый атом
vk_f2: moldes.toolbutton3Click(nil);//удалить атом
vk_f3: moldes.Image4Click(nil);//новая связь
vk_f4: moldes.Image5Click(nil);//удалить связь
vk_f5: moldes.Image1Click(nil);//новая модель
vk_capital: moldes.Button1Click(nil);//меняем атомы местами
ord('2')..ord('9')://строим многоугольник
begin
if ssctrl in shift then
begin
r:=red;
b:=blu;
for m:=1 to (strtoint(chr(key))-1) do
begin
moldes.Image2Click(nil);
moldes.Button1Click(nil);
end;
blu:=b;
moldes.Image4Click(nil);
red:=r;
blu:=b;
end;
end;
vk_escape: moldes.Close;//выход из программы
end;
end;

procedure tmoldes.midle();//центровка атомов
var m:integer;
var xm,ym,zm,r:variant;
begin
//вычисляем геометрический центр модели
xm:=0;
ym:=0;
zm:=0;
m:=1;
//сложим координаты всех атомов
while m begin
xm:=xm+p[m,1];
ym:=ym+p[m,2];
zm:=zm+p[m,3];
m:=m+1;
end;
//и разделим на количество атомов
xm:=xm / cnt;
ym:=ym / cnt;
zm:=zm / cnt;
//совместим этот центр с точкой отсчёта
m:=1;
while m begin
p[m, 1]:=p[m, 1]- xm;
p[m, 2]:=p[m, 2]- ym;
p[m, 3]:=p[m, 3]- zm;
m:=m+1;
end;
//если стоит флажок "расправить" то расправляем модель
if checkbox1.checked=true then
begin
m:=1;
while m begin
//расстояние от геометрического центра
r:=sqrt((p[m,1])*(p[m,1])+(p[m,2])*(p[m,2])+(p[m,3])*(p[m,3]));
//расталкиваем все атомы, которые дальше 10 от центра
IF r>10 then
begin
p[m,1]:=p[m,1]+p[m,1]/r;
p[m,2]:=p[m,2]+p[m,2]/r;
p[m,3]:=p[m,3]+p[m,3]/r;
end;
m:=m+1;
end;
end;
end;

procedure Tmoldes.FormShow(Sender: TObject);
begin
//устанавливаем опции
optionsfm.Button1click(nil);
//автоматически - новая модель
moldes.image1click(nil);
//включаем таймер
timer1.enabled:=true;
end;

procedure Tmoldes.ToolButton15Click(Sender: TObject);
begin
//форма "о программе"
aboutform.show;
end;

procedure Tmoldes.Button1Click(Sender: TObject);
var m:integer;
begin
//меняем активные атомы местами
m:=red;
red:=blu;
blu:=m;
end;

procedure BTF(c:tcolor;var a:array of glfloat;k:real);
begin
//преобразуем tcolor в массив glfloat
a[0]:=getrvalue(c)/255*k;
a[1]:=getgvalue(c)/255*k;
a[2]:=getbvalue(c)/255*k;
end;

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

procedure tmoldes.setcuco();//номер связи активных атомов
var m:integer;
label est,net;
begin
//ищем связь
for m:=1 to cnt1-1 do
begin
if (s[m,1]=red) and (s[m,2]=blu) then goto est;
if (s[m,1]=blu) and (s[m,2]=red) then goto est;
end;
goto net;
est:
//нашли её номер
cuco:=m;
exit;
net:
//если её нет - то ноль
cuco:=0;
end;

procedure Tmoldes.FormCreate(Sender: TObject);
begin
DC := GetDC (Handle);//дескриптор формы
SetDCPixelFormat(DC);//установить формат пикселя
hrc := wglCreateContext(DC);//создаём контекст
wglMakeCurrent(DC, hrc);//делаем его активным
glClearColor (0.0, 0.0, 0.0, 1.0);//фон
glMatrixMode (GL_PROJECTION);//режим матрицы - проекция
glLoadIdentity;
gluPerspective(45.0, Width/Height, 1.0, 1000.0);//устанавливаем проекцию
glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);//коррекция перспективы
glMatrixMode (GL_MODELVIEW);//режим матрицы - модель
glLoadIdentity;
glTranslatef(0.0, 0.0, -200.0);//немного удаляем модель
selradius:=3;//радиус выделения
end;

procedure Tmoldes.FormDestroy(Sender: TObject);
begin
//при закрытии формы надо удалить контекст
wglMakeCurrent(0, 0);
wglDeleteContext(hrc);
ReleaseDC (Handle, DC);
DeleteDC (DC);
end;

procedure Tmoldes.FormPaint(Sender: TObject);
begin
//очистим буферы
glClear (GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
//откомпилируем дисплейные списки
relationsmodel();
atommodel();
//включим свет
glEnable (GL_LIGHTING);
glEnable (GL_LIGHT0);
//нормализация
glenable(gl_normalize);
//затенение
glshademodel(grphmode);
//тест глубины
glenable(gl_depth_test);
//отображаем атомы и связи
glcalllist(Atoms);
glcalllist(relations);
//альфа-тест и блендинг. В книге [9] рекомендовано использовать
//команду glcullface(), но здесь это не обязательно
//наложения примитивов не будет - объекты не испытывают поворота
glenable(gl_alpha_test);
//способ подсчёта прозрачности
glblendfunc(GL_ONE_MINUS_src_ALPHA,GL_src_ALPHA);
glenable(gl_blend);
//отображаем выделения
glcalllist(selection);
//выключить альфа-тест и блендинг
gldisable(gl_blend);
gldisable(gl_alpha_test);
end;

procedure tmoldes.atommodel();//дисплейный список для атомов
var
q:GLUquadricObj;
m,s11,s22:integer;
x,y,z,r,y1,z1:real;
a:array[0..3] of glfloat;
b:tcolor;
begin
m:=1;
//новый список
glnewlist(Atoms,gl_compile);
//материал
glmaterialfv(gl_front_and_back,gl_shininess,@all_shn);
while m begin
//координаты атома
x:=p[m,1];
y:=p[m,2];
z:=p[m,3];
//цвет атома
b:=c[m];
a[0]:=0;a[1]:=0;a[2]:=0;a[3]:=0;
//все свойства материала
glmaterialfv(gl_front_and_back,gl_shininess,@all_shn);
BTF(b,a,atomamb);
glmaterialfv(gl_front_and_back,gl_ambient,@a);
BTF(b,a,atomdif);
glmaterialfv(gl_front_and_back,gl_diffuse,@a);
BTF(clwhite,a,atomspc);
glmaterialfv(gl_front_and_back,gl_specular,@a);
//сохрани матрицу в стеке
glpushmatrix();
//переносим точку отсчёта в координаты атома
gltranslatef(x,y,z);
//создаём сферу с радиусом атома
q:=glunewquadric();
gluquadricdrawstyle(q,grphstyle);
gluquadricnormals(q,grphmode);
glusphere(q,p[m,8],detaillevel,detaillevel);
//восстановим матрицу со стека
glpopmatrix();
m:=m+1;
end;
glendlist();
//дисплейный список выделений
glnewlist(Selection,gl_compile);
//если стоит флажок "активные" то показываем выделения
if checkbox2.checked then
begin
//сохраним матрицу в стеке
glpushmatrix();
//свойства материала
A[3]:=redblend;
glmaterialfv(gl_front,gl_shininess,@red_shn);
btf(clrred,a,redamb);
glmaterialfv(gl_front,gl_ambient,@a);
btf(clrred,a,reddif);
glmaterialfv(gl_front,gl_diffuse,@a);
btf(clrred,a,redspc);
glmaterialfv(gl_front,gl_specular,@a);
//переносим начало координат
gltranslate(p[red,1],p[red,2],p[red,3]);
//строим сферу
q:=glunewquadric();
gluquadricdrawstyle(q,glu_FILL);
gluquadricnormals(q,grphmode);
glusphere(q,p[red,8]+selradius,detaillevel,detaillevel);
//восстановим матрицу
glpopmatrix();
//сохраним матрицу и начнём строить второе выделение
glpushmatrix();
//материал
A[3]:=blublend;
glmaterialfv(gl_front_and_back,gl_shininess,@blu_shn);
btf(clrblu,a,bluamb);
glmaterialfv(gl_front_and_back,gl_ambient,@a);
btf(clrblu,a,bludif);
glmaterialfv(gl_front_and_back,gl_diffuse,@a);
btf(clrblu,a,bluspc);
glmaterialfv(gl_front_and_back,gl_specular,@a);
//переносим начало координат
gltranslate(p[blu,1],p[blu,2],p[blu,3]);
q:=glunewquadric();
gluquadricdrawstyle(q,glu_FILL);
gluquadricnormals(q,grphmode);
glusphere(q,p[blu,8]+selradius,detaillevel,detaillevel);
//восстановим матрицу
glpopmatrix();
end;
glendlist();//лист закончился
end;

procedure tmoldes.relationsmodel();//дисплейный список для связей
var
q:GLUquadricObj;
m,s11,s22:integer;
x,y,z,x1,y1,z1,xa,ya,za,r,rxy,rzx,rzy:real;
a: array[0..3] of glfloat;
b:tcolor;
begin
z:=0;
z1:=0;
//новый список
glnewlist(relations,gl_compile);
m:=1;
while m begin
//параметры материала
b:=v[m];
glmaterialfv(gl_front_and_back,gl_shininess,@rel_shn);
BTF(b,a,relamb);
glmaterialfv(gl_front_and_back,gl_ambient,@a);
BTF(b,a,reldif);
glmaterialfv(gl_front_and_back,gl_diffuse,@a);
BTF(b,a,relspc);
glmaterialfv(gl_front_and_back,gl_specular,@a);
//номера связываемых атомов
s11:=s[m,1];
s22:=s[m,2];
x:=p[s11,1];
y:=p[s11,2];
z:=p[s11,3];
x1:=p[s22,1];
y1:=p[s22,2];
z1:=p[s22,3];
//теперь вычисляем углы поворота матрицы такими, что
//линия связи атомов оказывается на оси Z
r:=sqrt((x1-x)*(x1-x)+(y1-y)*(y1-y)+(z1-z)*(z1-z));
rxy:=sqrt((x1-x)*(x1-x)+(y1-y)*(y1-y));
ya:=(x1-x)/rxy;
xa:=-(y1-y)/rxy;
za:=arccos((z1-z)/r)/pi*180;
//новый quadric - объект
q:=glunewquadric();
gluquadricdrawstyle(q,grphstyle);
gluquadricnormals(q,grphmode);
glpushmatrix();
//поворачиваем матрицу
gltranslatef(x,y,z);
glrotatef(za,xa,ya,0);
//цилиндр
glucylinder(q,s[m,5],s[m,5],r,detaillevel,detaillevel);
//восстанавливаем матрицу
glpopmatrix();
m:=m+1;
end;
glendlist();
end;

//процедура поворота координат точки
procedure RotateCoords(x,y,z,xa,ya,za:real;var rx,ry,rz:real);
var
x1,y1,z1,x2,y2,z2:glfloat;
begin
//вокруг X
x1:=x;
y1:=y*cos(xa)-z*sin(xa);
z1:=y*sin(xa)+z*cos(xa);

//вокруг Y
x2:=x1*cos(ya)+z1*sin(ya);
y2:=y1;
z2:=-x1*sin(ya)+z1*cos(ya);

//вокруг Z
rx:=x2*cos(za)-y2*sin(za);
ry:=x2*sin(za)+y2*cos(za);
rz:=z2;
end;

//движение мыши
procedure Tmoldes.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var r,cx,cy,cz,r1,r2,ax,ay,az,rlook:glfloat;
x1,y1,z1,x2,y2,z2:gldouble;
a,b,c:gldouble;
a1,b1,c1:glfloat;
m:integer;
begin
//если нажат shift, то поворачиваем модель
if ssshift in shift then
begin
for m:=1 to cnt-1 do //перебираем все атомы
begin
//поворачиваем координаты атомов
rotatecoords(p[m,1],p[m,2],p[m,3],0,(x-
oldx)/100*sensivity,0,p[m,1],p[m,2],p[m,3]);
rotatecoords(p[m,1],p[m,2],p[m,3],(y-
oldy)/100*sensivity,0,0,p[m,1],p[m,2],p[m,3]);
//а также векторы скоростей
rotatecoords(p[m,4],p[m,5],p[m,6],0,(x-
oldx)/100*sensivity,0,p[m,4],p[m,5],p[m,6]);
rotatecoords(p[m,4],p[m,5],p[m,6],(y-
oldy)/100*sensivity,0,0,p[m,4],p[m,5],p[m,6]);
end;
end;
//запомнили координаты как "старые"
oldx:=x;
oldy:=y;
end;

procedure Tmoldes.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var n,r1,r,red1,blu1:variant;
x1,y1,z1:double;
var m:integer;
viewport :array[0..4] of GLint;
projection:array[0..16]of GLdouble;
modelview :array[0..16]of GLdouble;
x2,y2,z2:gldouble;
z:glfloat;
label vw,nd,nne;
begin
//узнали параметры viewport
glGetIntegerv(GL_VIEWPORT,@viewport);
//обязательный пересчёт в экранные координаты
y:=viewport[3]-y-1;
//глубина пикселя
glreadpixels(x,y,1,1,GL_DEPTH_COMPONENT, GL_float,@z);
//текущие матрицы
glGetDoublev(GL_PROJECTION_MATRIX,@projection);
glGetDoublev(GL_MODELVIEW_MATRIX,@modelview);
//узнаём мировые координаты
gluunproject(x,y,z,@modelview,@projection,@viewport,x2,y2,z2);
r1:=1000000000;
//запомнили номера активных атомов
red1:=red;
blu1:=blu;
n:=0;
for m:=1 to cnt-1 do//перебираем все атомы
begin
x1:= p[m, 1];
y1:= p[m, 2];
z1:= p[m, 3];
//расстояние от центра атома до точки выделения
r:=sqrt((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1)+(z2-z1)*(z2-z1));
//если расстояние меньше радиуса выделения
if r<=(p[m,