Визуализация воды

end;

procedure   TGLWater.AddHits(Pos_X,Pos_Y,Pos_Z,Power,Radius:Double);

var

   i,j:Byte;

   len:Double;

   Vec:TVector3D;

begin

     SetLength(FHits,Length(FHits)+FHitsCount);

     for i:=1 to FHitsCount do

     begin

          SetVector(FHits[Length(FHits)-i].Coord,Pos_X,Pos_Y,Pos_Z);

          SetVector(FHits[Length(FHits)-i].v,(-0.5+random)*Power*10,random*Power*10,(-0.5+random)*Power*10);

     end;

     for i:=0 to Segments-1 do

     for j:=0 to Segments-1 do

     begin

          len:=sqrt(Sqr(Pos_X-(-0.5+FNodes[i,j].Coord.X)*Width)+Sqr(Pos_Y-FNodes[i,j].Coord.Y)+Sqr(Pos_Z-(-0.5+FNodes[i,j].Coord.Z)*Height));

          if len<Radius

            then begin

                      SetVector(Vec,((-0.5+FNodes[i,j].Coord.X)*Width-Pos_X)/len,(FNodes[i,j].Coord.Y-Pos_Y)/len,((-0.5+FNodes[i,j].Coord.Z)*Height-Pos_Z)/len);

                      SetVector(FNodes[i,j].F_ext,Vec.X*(1-len/Radius)*Power,(Vec.Y*Power+MaxForce_Y/100)*(1-len/Radius),Vec.Z*(1-len/Radius)*Power);

                 end;

     end;

end;

end. 

unit MainUnit;

interface

uses

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

  Dialogs, ExtCtrls, OpenGL, Menus, ComCtrls, ActnList, XPStyleActnCtrls,

  ActnMan, StdCtrls, Spin, JPEG, FileCtrl, Buttons, Math, keyboard, MMSystem,

  TextureUnit, WaterUnit, GrisSpinEdit;

type

  TMainForm = class(TForm)

    DrawTimer: TTimer;

    PageControl: TPageControl;

    WaterTabSheet: TTabSheet;

    KeyTimer: TTimer;

    WaterSegmentsLabel: TLabel;

    WaterSegmentsEdit: TGrisSpinEdit;

    WaterMassLabel: TLabel;

    WaterMassEdit: TGrisSpinEdit;

    WaterCompressCoefLabel: TLabel;

    WaterCompressCoefEdit: TGrisSpinEdit;

    WaterDempfCoefLabel: TLabel;

    WaterDempfCoefEdit: TGrisSpinEdit;

    WaterMaxForceLabel: TLabel;

    WaterMaxForceEdit: TGrisSpinEdit;

    WaterMaxForceYLabel: TLabel;

    WaterMaxForceYEdit: TGrisSpinEdit;

    WaterRandomForceTimeLabel: TLabel;

    WaterRandomForceTimeEdit: TGrisSpinEdit;

    WaterAlphaLabel: TLabel;

    WaterAlphaEdit: TGrisSpinEdit;

    GeneralTabSheet: TTabSheet;

    ShowWaterCheckBox: TCheckBox;

    ShowGroundCheckBox: TCheckBox;

    ShowBoxCheckBox: TCheckBox;

    ShowLightCheckBox: TCheckBox;

    WaterLineCheckBox: TCheckBox;

    GroundLineCheckBox: TCheckBox;

    BoxLineCheckBox: TCheckBox;

    LightLineCheckBox: TCheckBox;

    HitsTabSheet: TTabSheet;

    HitsEnableCheckBox: TCheckBox;

    HitsCountLabel: TLabel;

    HitsCountEdit: TGrisSpinEdit;

    HitsSizeLabel: TLabel;

    HitsSizeEdit: TGrisSpinEdit;

    HitsGravityLabel: TLabel;

    HitsGravityEdit: TGrisSpinEdit;

    HitsPowerLabel: TLabel;

    HitsPowerEdit: TGrisSpinEdit;

    HitsRadiusLabel: TLabel;

    HitsRadiusEdit: TGrisSpinEdit;

    WaterUseRandomForceCheckBox: TCheckBox;

    CaustTimer: TTimer;

    CaustLabel: TLabel;

    CaustEdit: TGrisSpinEdit;

    ShowCaustCheckBox: TCheckBox;

    CaustLineCheckBox: TCheckBox;

    WaterUseBumpCheckBox: TCheckBox;

    WaterRelaxBtn: TButton;

    procedure FormCreate(Sender: TObject);

    procedure FormResize(Sender: TObject);

    procedure DrawTimerTimer(Sender: TObject);

    procedure Draw;

    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

    procedure KeyTimerTimer(Sender: TObject);

    procedure WaterSegmentsEditChange(Sender: TObject);

    procedure WaterMassEditChange(Sender: TObject);

    procedure WaterCompressCoefEditChange(Sender: TObject);

    procedure WaterDempfCoefEditChange(Sender: TObject);

    procedure WaterMaxForceEditChange(Sender: TObject);

    procedure WaterMaxForceYEditChange(Sender: TObject);

    procedure WaterRandomForceTimeEditChange(Sender: TObject);

    procedure WaterAlphaEditChange(Sender: TObject);

    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure HitsCountEditChange(Sender: TObject);

    procedure HitsSizeEditChange(Sender: TObject);

    procedure HitsGravityEditChange(Sender: TObject);

    procedure WaterUseRandomForceCheckBoxClick(Sender: TObject);

    procedure CaustTimerTimer(Sender: TObject);

    procedure CaustEditChange(Sender: TObject);

    procedure WaterUseBumpCheckBoxClick(Sender: TObject);

    procedure WaterRelaxBtnClick(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

   MainForm: TMainForm;

   ghRC:HGLRC;

   ghDC:HDC;

   Light_pos: TGLArrayf4 = (-100,100,-100,1);  //Положение источника  света

   Light_dif: TGLArrayf4 = (1,1,1,1);          //Диффузия  света

   Light_amb: TGLArrayf4 = (0.7,0.7,0.7,1);    //Свет окружающей  среды

   mx,my:Integer;

   CurCaust:Byte=0;

   CurTime : cardinal;

   Cam_X:Single = 100;

   Cam_Y:Single = 100;

   Cam_Z:Single = 100;

   Cam_Radius:Single;

   Cam_Angle_X:Single;

   Cam_Angle_Y:Single;

   Target_X:Single = 99.9;

   Target_Y:Single = 99.9;

   Target_Z:Single = 99.9;

   //Текстуры

   TexGround:TGLTexture;

   TexWater:TGLTexture;

   TexCaust1:TGLTexture;

   TexCaust2:TGLTexture;

   TexCaust3:TGLTexture;

   TexCaust4:TGLTexture;

   TexCaust5:TGLTexture;

   //Вода

   Water:TGLWater;

const

     GroundSegment=64;

var

   GroundMas:array [0..GroundSegment-1,0..GroundSegment-1] of double;

implementation

{$R *.dfm}

function bSetupPixelFormat(DC:HDC):boolean;

var

   pfd:PIXELFORMATDESCRIPTOR;

   pixelformat:integer;

begin

     //Настраиваем видео-режим

     pfd.dwFlags  := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;

     {Тип пикселя}

     pfd.iPixelType := PFD_TYPE_RGBA;

     {Глубина цвета}

     pfd.cColorBits := 32;

     {Размер буфера глубины}

     pfd.cDepthBits := 32;

     //Выбираем видео-режим

     pixelformat := ChoosePixelFormat(dc, @pfd);

     if pixelformat=0

       then begin

                 Showmessage('Error. Не могу обнаружить видео-режим');

                 bSetupPixelFormat:=false;

                 exit;

          end;

     if not SetPixelFormat(dc, pixelformat, @pfd)

       then begin

                 Showmessage('Error. Видео-режим не запускается');

                 bSetupPixelFormat:=false;

                 exit;

            end;

     bSetupPixelFormat:=true;

end;

procedure ResetCamAngles;

begin

     //Переводим  декартовые координаты камеры в сферические

     Cam_Radius:=sqrt(sqr(Cam_X-Target_X)+sqr(Cam_Y-Target_Y)+sqr(Cam_Z-Target_Z));

     Cam_Angle_Y:=arcsin((Cam_Y-Target_Y)/Cam_Radius)/pi*180;

     if Cam_X>0

       then Cam_Angle_X:=arcsin((Cam_Z-Target_Z)/Cam_Radius)/pi*180

       else if Cam_Z>0

              then Cam_Angle_X:=arccos((Cam_X-Target_X)/Cam_Radius)/pi*180

              else Cam_Angle_X:=180-arcsin((Cam_Z-Target_Z)/Cam_Radius)/pi*180;

end;

procedure ResetCamCoords;

begin

     //Переводим  сферические координаты камеры в декартовые

     Cam_Y:=Target_Y+Cam_Radius*sin(Cam_Angle_Y/180*pi);

     Cam_X:=Target_X+Cam_Radius*cos(Cam_Angle_Y/180*pi)*cos(Cam_Angle_X/180*pi);

     Cam_Z:=Target_Z+Cam_Radius*cos(Cam_Angle_Y/180*pi)*sin(Cam_Angle_X/180*pi);

end;

procedure TMainForm.FormCreate(Sender: TObject);

var

   f:TFileStream;

   i,j: Integer;

begin

     //Нужно для включения OpenGL

     ghDC := GetDC(Handle);

     if not bSetupPixelFormat(ghDC)=false

       then close;

     ghRC := wglCreateContext(ghDC);

     wglMakeCurrent(ghDC, ghRC);

     glEnable(GL_DEPTH_TEST);     //Включаем проверку глубины

     glEnable(GL_LIGHTING);       //Включаем отражение света

     //Установка  источника света

     glEnable(GL_LIGHT0);

     glLightfv(GL_LIGHT0,GL_POSITION,@Light_pos);

     //Установка  цветов

     glLightfv(GL_LIGHT0, GL_DIFFUSE, @Light_dif);

     glLightfv(GL_LIGHT0, GL_AMBIENT, @Light_amb);

     //Активируем текстурирование

     glEnable(GL_TEXTURE_2D);

     //Настройка текстуры

     glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);

     glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);

     glLineWidth(5);

     //Загрузка текстур

     TexGround:=TGLTexture.CreateWithPrep('Ground.jpg');

     TexCaust1:=TGLTexture.CreateWithPrep('Caust1.jpg');

     TexCaust2:=TGLTexture.CreateWithPrep('Caust2.jpg');

     TexCaust3:=TGLTexture.CreateWithPrep('Caust3.jpg');

     TexCaust4:=TGLTexture.CreateWithPrep('Caust4.jpg');

     TexCaust5:=TGLTexture.CreateWithPrep('Caust5.jpg');

     Water:=TGLWater.Create('Water.jpg','hits.jpg','Bump.jpg');

     Water.UseRandomForce:=false;

     ResetCamAngles;

     //Загрузка поверхности земли

     f:=TFileStream.Create('terrain.ter',fmOpenRead);

       for i:=0 to GroundSegment-1 do

       for j:=0 to GroundSegment-1 do

       f.ReadBuffer(GroundMas[i,j],SizeOf(GroundMas[i,j]));

     f.Free;

    CurTime := timeGetTime;

end;

procedure AddHits(X,Y:Integer;Power,Radius:Double);

var

   Viewport : Array [0..3] of GLInt;

   mvMatrix, ProjMatrix : Array [0..15] of GLDouble;

   RealY : GLint ;       // позиция OpenGL y - координаты

   wx, wy, wz: Double ;  // возвращаемые мировые x, y, z координаты

   Zval : GLfloat;

   tx,tz:Double;

   g,h:Integer;

begin

     if (X<0) or

        (Y<0) or

        (X>MainForm.ClientWidth-MainForm.PageControl.Width-1) or

        (Y>MainForm.ClientHeight-1)

       then exit;

     glGetIntegerv (GL_VIEWPORT, @Viewport);