Текст программы
unit GrisSpinEdit;
interface
uses Windows, Classes, StdCtrls, ExtCtrls, Controls, Messages, SysUtils,
Forms, Graphics, Menus, Buttons,spin;
type
{ TGrisSpinEdit }
TGrisSpinEdit = class(TCustomEdit)
private
FMinValue: Extended;
FMaxValue: Extended;
FIncrement: Extended;
FButton: TSpinButton;
FEditorEnabled: Boolean;
FBackUp: Extended;
function GetMinHeight: Integer;
function GetValue: Extended;
function CheckValue (NewValue: Extended): Extended;
procedure SetValue (NewValue: Extended);
procedure SetMinValue (Value:Extended);
procedure SetMaxValue (Value:Extended);
procedure SetEditRect;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure WMPaste(var Message: TWMPaste); message WM_PASTE;
procedure WMCut(var Message: TWMCut); message WM_CUT;
protected
procedure Change; override;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
function IsValidChar(Key: Char): Boolean; virtual;
procedure UpClick (Sender: TObject); virtual;
procedure DownClick (Sender: TObject); virtual;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Button: TSpinButton read FButton;
published
property Anchors;
property AutoSelect;
property AutoSize;
property Color;
property Constraints;
property Ctl3D;
property DragCursor;
property DragMode;
property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True;
property Enabled;
property Font;
property Increment: Extended read FIncrement write FIncrement;
property MaxLength;
property MaxValue: Extended read FMaxValue write SetMaxValue;
property MinValue: Extended read FMinValue write SetMinValue;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop;
property Value: Extended read GetValue write SetValue;
property Visible;
property OnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
end;
//------------------------------------------------------------------------------
procedure Register;
//------------------------------------------------------------------------------
implementation
procedure Register;
begin
RegisterComponents('Gris''s Edits', [TGrisSpinEdit]);
end;
{ TGrisSpinEdit }
constructor TGrisSpinEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FButton := TSpinButton.Create(Self);
FButton.Width := 15;
FButton.Height := 17;
FButton.Visible := True;
FButton.Parent := Self;
FButton.FocusControl := Self;
FButton.OnUpClick := UpClick;
FButton.OnDownClick := DownClick;
Text := '0';
ControlStyle := ControlStyle - [csSetCaption];
FIncrement := 1;
FEditorEnabled := True;
ParentBackground := False;
end;
destructor TGrisSpinEdit.Destroy;
begin
FButton := nil;
inherited Destroy;
end;
procedure TGrisSpinEdit.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
end;
procedure TGrisSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
if Key = VK_UP then UpClick (Self)
else if Key = VK_DOWN then DownClick (Self);
inherited KeyDown(Key, Shift);
end;
procedure TGrisSpinEdit.KeyPress(var Key: Char);
begin
if not IsValidChar(Key) then
begin
Key := #0;
end;
if Key <> #0 then inherited KeyPress(Key);
end;
function TGrisSpinEdit.IsValidChar(Key: Char): Boolean;
begin
Result := (Key in [DecimalSeparator, '-', '0'..'9']) or
((Key < #32) and (Key <> Chr(VK_RETURN)));
if (Key='-')and(pos('-',Text)>0)
then Result:=false;
if not FEditorEnabled and Result and ((Key >= #32) or
(Key = Char(VK_BACK)) or (Key = Char(VK_DELETE))) then
Result := False;
end;
procedure TGrisSpinEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
{ Params.Style := Params.Style and not WS_BORDER; }
Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
end;
procedure TGrisSpinEdit.CreateWnd;
begin
inherited CreateWnd;
SetEditRect;
end;
procedure TGrisSpinEdit.SetEditRect;
var
Loc: TRect;
begin
SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
Loc.Bottom := ClientHeight + 1; {+1 is workaround for windows paint bug}
Loc.Right := ClientWidth - FButton.Width - 2;
Loc.Top := 0;
Loc.Left := 0;
SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc)); {debug}
end;
procedure TGrisSpinEdit.WMSize(var Message: TWMSize);
var
MinHeight: Integer;
begin
inherited;
MinHeight := GetMinHeight;
{ text edit bug: if size to less than minheight, then edit ctrl does
not display the text }
if Height < MinHeight then
Height := MinHeight
else if FButton <> nil then
begin
if NewStyleControls and Ctl3D then
FButton.SetBounds(Width - FButton.Width - 5, 0, FButton.Width, Height - 5)
else FButton.SetBounds (Width - FButton.Width, 1, FButton.Width, Height - 3);
SetEditRect;
end;
end;
function TGrisSpinEdit.GetMinHeight: Integer;
var
DC: HDC;
SaveFont: HFont;
I: Integer;
SysMetrics, Metrics: TTextMetric;
begin
DC := GetDC(0);
GetTextMetrics(DC, SysMetrics);
SaveFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
ReleaseDC(0, DC);
I := SysMetrics.tmHeight;
if I > Metrics.tmHeight then I := Metrics.tmHeight;
Result := Metrics.tmHeight + I div 4 + GetSystemMetrics(SM_CYBORDER) * 4 + 2;
end;
procedure TGrisSpinEdit.UpClick (Sender: TObject);
begin
if ReadOnly then MessageBeep(0)
else Value := Value + FIncrement;
end;
procedure TGrisSpinEdit.DownClick (Sender: TObject);
begin
if ReadOnly then MessageBeep(0)
else Value := Value - FIncrement;
end;
procedure TGrisSpinEdit.WMPaste(var Message: TWMPaste);
begin
if not FEditorEnabled or ReadOnly then Exit;
inherited;
end;
procedure TGrisSpinEdit.WMCut(var Message: TWMPaste);
begin
if not FEditorEnabled or ReadOnly then Exit;
inherited;
end;
procedure TGrisSpinEdit.CMExit(var Message: TCMExit);
begin
inherited;
if CheckValue (Value) <> Value then
SetValue (Value);
Value:=FBackUp;
end;
function TGrisSpinEdit.GetValue: Extended;
begin
try
if (Text<>'')and(Text<>'-')
then Result := StrToFloat (Text)
else Result := FBackUp;
except
Result := FBackUp;
end;
end;
procedure TGrisSpinEdit.SetValue (NewValue: Extended);
begin
Text := FloatToStr (CheckValue (NewValue));
end;
function TGrisSpinEdit.CheckValue (NewValue: Extended): Extended;
begin
Result := NewValue;
if (FMaxValue <> FMinValue) then
begin
if NewValue < FMinValue then
Result := FMinValue
else if NewValue > FMaxValue then
Result := FMaxValue;
end;
end;
procedure TGrisSpinEdit.CMEnter(var Message: TCMGotFocus);
begin
if AutoSelect and not (csLButtonDown in ControlState) then
SelectAll;
inherited;
FBackUp:=Value;
end;
procedure TGrisSpinEdit.Change;
begin
if (Text<>'')and(Text<>'-')
then begin
inherited Change;
SetValue (Value);
FBackUp:=Value;
end;
end;
procedure TGrisSpinEdit.SetMinValue (Value:Extended);
begin
if FMinValue<>Value
then begin
FMinValue:=Value;
if FMaxValue<FMinValue
then FMaxValue:=FMinValue;
if CheckValue (Value) <> Value
then SetValue (Value);
end;
end;
procedure TGrisSpinEdit.SetMaxValue (Value:Extended);
begin
if FMaxValue<>Value
then begin
FMaxValue:=Value;
if FMaxValue<FMinValue
then FMinValue:=FMaxValue;
if CheckValue (Value) <> Value
then SetValue (Value);
end;
end;
end.
unit TextureUnit;
interface
uses OpenGL, JPEG, SysUtils, Windows, Graphics;
type
PPixelArray = ^TPixelArray;
TPixelArray = array [0..0] of Byte;
TGLTexture=class(TObject)
private
FWidth:Integer;
FHeight:Integer;
FData : PPixelArray;
protected
public
constructor Create;
constructor CreateWithPrep(FileName:String);
constructor CreateWithPrepDiv2(FileName:String);
constructor CreateWithPrepDiv2_Inv(FileName:String);
destructor Destroy; override;
procedure PrepareImage(FileName:String);
procedure PrepareImageDiv2(FileName:String);
procedure PrepareImageDiv2_Inv(FileName:String);
procedure ApplyTexture;
property Width:Integer read FWidth;
property Height:Integer read FHeight;
property Data:PPixelArray read FData;
end;
implementation
constructor TGLTexture.Create;
begin
FWidth:=0;
FHeight:=0;
FData:=nil;
end;
constructor TGLTexture.CreateWithPrep(FileName:String);
begin
Create;
PrepareImage(FileName);
end;
constructor TGLTexture.CreateWithPrepDiv2(FileName:String);
begin
Create;
PrepareImageDiv2(FileName);
end;
constructor TGLTexture.CreateWithPrepDiv2_Inv(FileName:String);
begin
Create;
PrepareImageDiv2_Inv(FileName);
end;
destructor TGLTexture.Destroy;
begin
if Assigned(FData)
then FreeMem(Data);
end;
procedure TGLTexture.PrepareImage(FileName:String);
var
Bitmap : TBitmap;
JPG:TJPEGImage;
BMInfo : TBitmapInfo;
I, ImageSize : Integer;
Temp : Byte;
MemDC : HDC;
begin
JPG:=TJPEGImage.Create;
Bitmap := TBitmap.Create;
//Чтение изображения
if SameText(copy(FileName,Length(FileName)-3,4),'.bmp')
then Bitmap.LoadFromFile (FileName)
else begin
JPG.LoadFromFile (FileName);
Bitmap.Assign(JPG);
end;
//Получение текстуры
with BMinfo.bmiHeader do begin
FillChar (BMInfo, SizeOf(BMInfo), 0);
biSize := sizeof (TBitmapInfoHeader);
biBitCount := 24;
biWidth := Bitmap.Width;
biHeight := Bitmap.Height;
FWidth := biWidth;
FHeight := biHeight;
ImageSize := biWidth * biHeight;
biPlanes := 1;
biCompression := BI_RGB;
MemDC := CreateCompatibleDC (0);
if Assigned(FData)
then FreeMem(Data);
GetMem (FData, ImageSize * 3);
try
GetDIBits (MemDC, Bitmap.Handle, 0, biHeight, Data, BMInfo, DIB_RGB_COLORS);
For I := 0 to ImageSize - 1 do begin
Temp := Data [I * 3];
Data [I * 3] := Data [I * 3 + 2];
Data [I * 3 + 2] := Temp;
end;
finally
DeleteDC (MemDC);
Bitmap.Free;
JPG.Free;
end;
end;
end;
procedure TGLTexture.PrepareImageDiv2(FileName:String);
var
Bitmap : TBitmap;
JPG:TJPEGImage;
BMInfo : TBitmapInfo;
I,j, ImageSize : Integer;
Temp : Byte;
MemDC : HDC;
R,G,B:Byte;
begin
JPG:=TJPEGImage.Create;
Bitmap := TBitmap.Create;
//Чтение изображения
if SameText(copy(FileName,Length(FileName)-3,4),'.bmp')
then Bitmap.LoadFromFile (FileName)
else begin
JPG.LoadFromFile (FileName);
Bitmap.Assign(JPG);
end;
for i:=0 to Bitmap.Height-1 do
for j:=0 to Bitmap.Width-1 do
begin
R:=GetRValue(Bitmap.Canvas.Pixels[j,i]) div 2;
G:=GetRValue(Bitmap.Canvas.Pixels[j,i]) div 2;
B:=GetRValue(Bitmap.Canvas.Pixels[j,i]) div 2;
Bitmap.Canvas.Pixels[j,i]:=RGB(R,G,B);
end;
//Получение текстуры
with BMinfo.bmiHeader do begin
FillChar (BMInfo, SizeOf(BMInfo), 0);
biSize := sizeof (TBitmapInfoHeader);
biBitCount := 24;
biWidth := Bitmap.Width;
biHeight := Bitmap.Height;
FWidth := biWidth;
FHeight := biHeight;
ImageSize := biWidth * biHeight;
biPlanes := 1;
biCompression := BI_RGB;
MemDC := CreateCompatibleDC (0);
if Assigned(FData)
then FreeMem(Data);
GetMem (FData, ImageSize * 3);
try
GetDIBits (MemDC, Bitmap.Handle, 0, biHeight, Data, BMInfo, DIB_RGB_COLORS);
For I := 0 to ImageSize - 1 do begin
Temp := Data [I * 3];
Data [I * 3] := Data [I * 3 + 2];
Data [I * 3 + 2] := Temp;
end;
finally
DeleteDC (MemDC);
Bitmap.Free;
JPG.Free;
end;
end;
end;
procedure TGLTexture.PrepareImageDiv2_Inv(FileName:String);
var
Bitmap : TBitmap;
JPG:TJPEGImage;
BMInfo : TBitmapInfo;
I,j, ImageSize : Integer;
Temp : Byte;
MemDC : HDC;
R,G,B:Byte;
begin
JPG:=TJPEGImage.Create;
Bitmap := TBitmap.Create;
//Чтение изображения
if SameText(copy(FileName,Length(FileName)-3,4),'.bmp')
then Bitmap.LoadFromFile (FileName)
else begin
JPG.LoadFromFile (FileName);
Bitmap.Assign(JPG);
end;
for i:=0 to Bitmap.Height-1 do
for j:=0 to Bitmap.Width-1 do
begin
R:=(255-GetRValue(Bitmap.Canvas.Pixels[j,i])) div 2;
G:=(255-GetRValue(Bitmap.Canvas.Pixels[j,i])) div 2;
B:=(255-GetRValue(Bitmap.Canvas.Pixels[j,i])) div 2;
Bitmap.Canvas.Pixels[j,i]:=RGB(R,G,B);
end;
//Получение текстуры
with BMinfo.bmiHeader do begin
FillChar (BMInfo, SizeOf(BMInfo), 0);
biSize := sizeof (TBitmapInfoHeader);
biBitCount := 24;
biWidth := Bitmap.Width;
biHeight := Bitmap.Height;
FWidth := biWidth;
FHeight := biHeight;
ImageSize := biWidth * biHeight;
biPlanes := 1;
biCompression := BI_RGB;
MemDC := CreateCompatibleDC (0);
if Assigned(FData)
then FreeMem(Data);
GetMem (FData, ImageSize * 3);
try
GetDIBits (MemDC, Bitmap.Handle, 0, biHeight, Data, BMInfo, DIB_RGB_COLORS);
For I := 0 to ImageSize - 1 do begin
Temp := Data [I * 3];
Data [I * 3] := Data [I * 3 + 2];
Data [I * 3 + 2] := Temp;
end;
finally
DeleteDC (MemDC);
Bitmap.Free;
JPG.Free;
end;
end;
end;
procedure TGLTexture.ApplyTexture;
begin
//Активировать текстуру
glTexImage2d(GL_TEXTURE_2D, 0, 3, FWidth, FHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, Data);
end;
end.
unit WaterUnit;
interface
uses
OpenGL, Math, dialogs, sysutils,
TextureUnit;
type
TVector3D=record
X,Y,Z:Double;
end;
TNode=record
F:TVector3D;
F_ext:TVector3D;
Coord:TVector3D;
a:TVector3D;
v:TVector3D;
end;
TNodes=array of array of TNode;
THit=record
Coord:TVector3D;
v:TVector3D;
end;
THits=array of THit;
TGLWater=class(TObject)
private
FNodes:TNodes;
FSegments:Byte;
FMass:Double;
FCompressCoef:Double;
FDempfCoef:Double;
FMaxForce:Double;
FMaxForce_Y:Double;
FRandomForceTime:Integer;
FRandomForceRemainedTime:Integer;
FUseRandomForce:Boolean;
FUseBumping:Boolean;
FHitsSize:Double;
FGravity:Double;
FHitsCount:Byte;
FHits:THits;
FPosition:TVector3D;
FWidth:Double;
FHeight:Double;
FTexWater:TGLTexture;
FTexHits:TGLTexture;
FTexBump1:TGLTexture;
FTexBump2:TGLTexture;
FAlpha:Double;
protected
procedure SetSegments(Value:Byte);
procedure SetMass(Value:Double);
procedure SetRandomForceTime(Value:Integer);
procedure SetAlpha(Value:Double);
public
constructor Create(WaterTex,HitsTex,BumpTex:String);
destructor Destroy; override;
procedure Animation(const Deltatime_ms:Integer);
procedure AddHits(Pos_X,Pos_Y,Pos_Z,Power,Radius:Double);
procedure RandomForce;
procedure Draw(Cam_X,Cam_Y,Cam_Z:Double);
procedure DrawWithHits(Cam_X,Cam_Y,Cam_Z,Normal_X,Normal_Y,Normal_Z:Double);
property Nodes:TNodes read FNodes write FNodes;
property Segments:Byte read FSegments write SetSegments;
property Mass:Double read FMass write SetMass;
property CompressCoef:Double read FCompressCoef write FCompressCoef;
property DempfCoef:Double read FDempfCoef write FDempfCoef;
property MaxForce:Double read FMaxForce write FMaxForce;
property MaxForce_Y:Double read FMaxForce_Y write FMaxForce_Y;
property RandomForceTime:Integer read FRandomForceTime write SetRandomForceTime;
property RandomForceRemainedTime:Integer read FRandomForceRemainedTime write FRandomForceRemainedTime;
property UseRandomForce:Boolean read FUseRandomForce write FUseRandomForce;
property UseBumping:Boolean read FUseBumping write FUseBumping;
property HitsSize:Double read FHitsSize write FHitsSize;
property Gravity:Double read FGravity write FGravity;
property HitsCount:Byte read FHitsCount write FHitsCount;
property Hits:THits read FHits write FHits;
property Position:TVector3D read FPosition write FPosition;
property Width:Double read FWidth write FWidth;
property Height:Double read FHeight write FHeight;
property TexWater:TGLTexture read FTexWater;
property TexHits:TGLTexture read FTexHits;
property TexBump1:TGLTexture read FTexBump1;
property TexBump2:TGLTexture read FTexBump2;
property Alpha:Double read FAlpha write SetAlpha;
end;
procedure SetVector(var Vector:TVector3D;const NewX,NewY,NewZ:Double);
implementation
procedure SetVector(var Vector:TVector3D;const NewX,NewY,NewZ:Double);
begin
Vector.X:=NewX;
Vector.Y:=NewY;
Vector.Z:=NewZ;
end;
constructor TGLWater.Create(WaterTex,HitsTex,BumpTex:String);
begin
//Инициализация атрибутов
FUseRandomForce:=false;
Segments:=32;
Mass:=4;
CompressCoef:=7;
DempfCoef:=0.05;
MaxForce:=0.25;
MaxForce_Y:=1000;
RandomForceTime:=1000;
FUseRandomForce:=true;
FUseBumping:=true;
FHitsSize:=2;
FGravity:=-100;
FHitsCount:=128;
SetVector(FPosition, 0, 0, 0);
Width:=200;
Height:=200;
FTexWater:=TGLTexture.CreateWithPrep(WaterTex);
FTexHits:=TGLTexture.CreateWithPrep(HitsTex);
FTexBump1:=TGLTexture.CreateWithPrepDiv2(BumpTex);
FTexBump2:=TGLTexture.CreateWithPrepDiv2_Inv(BumpTex);
Alpha:=0.7;
end;
destructor TGLWater.Destroy;
begin
SetLength(FNodes,0);
SetLength(FHits,0);
FTexWater.Free;
FTexHits.Free;
FTexBump1.Free;
FTexBump2.Free;
end;
procedure TGLWater.SetSegments(Value:Byte);
var
i,j: Integer;
begin
if (FSegments<>Value)and(Value>1)
then begin
FSegments:=Value;
SetLength(FNodes,FSegments,FSegments);
for i:=0 to Segments-1 do
for j:=0 to Segments-1 do
begin
SetVector(FNodes[i,j].F, 0, 0, 0);
SetVector(FNodes[i,j].F_ext, 0, 0, 0);
SetVector(FNodes[i,j].Coord, j/(Segments-1), 0, i/(Segments-1));
SetVector(FNodes[i,j].a, 0, 0, 0);
SetVector(FNodes[i,j].v, 0, 0, 0);
end;
if FUseRandomForce
then RandomForce;
end;
end;
procedure TGLWater.SetMass(Value:Double);
begin
if (FMass<>Value)and(Value>0)
then FMass:=Value;
end;
procedure TGLWater.SetRandomForceTime(Value:Integer);
begin
if (FRandomForceTime<>Value)and(Value>0)
then begin
FRandomForceTime:=Value;
FRandomForceRemainedTime:=Value;
end;
end;
procedure TGLWater.SetAlpha(Value:Double);
begin
if (FAlpha<>Value)and(Value>=0)and(Value<=1)
then FAlpha:=Value;
end;
procedure TGLWater.Draw(Cam_X,Cam_Y,Cam_Z:Double);
var
i,j: Integer;
Alph: TGLArrayf4;
Vec_X,Vec_Y,Vec_Z,len:Double;
begin
//Запомнем матрицу
glPushMatrix;
//Определим прозрачность
Alph[0]:=1;
Alph[1]:=1;
Alph[2]:=1;
Alph[3]:=Alpha;
glMaterialfv(GL_FRONT_AND_BACK, GL_DIFFUSE, @Alph);
//Переместим воду в заданные координаты
if UseBumping
then begin
glTranslatef(Position.X,Position.Y-0.2,Position.Z);
//Применим текстуру
TexBump1.ApplyTexture;
glDisable(GL_BLEND);
glDisable(GL_LIGHTING);
//Нарисуем треугольниками bump1
glBegin(GL_TRIANGLES);
for i:=0 to Segments-2 do
for j:=0 to Segments-2 do
begin
glTexCoord(j/(Segments-1),i/(Segments-1));
glVertex3d((-0.5+FNodes[i,j].Coord.X)*Width, FNodes[i,j].Coord.Y, (-0.5+FNodes[i,j].Coord.Z)*Height);
glTexCoord(j/(Segments-1),(i+1)/(Segments-1));
glVertex3d((-0.5+FNodes[i+1,j].Coord.X)*Width, FNodes[i+1,j].Coord.Y, (-0.5+FNodes[i+1,j].Coord.Z)*Height);
glTexCoord((j+1)/(Segments-1),(i+1)/(Segments-1));
glVertex3d((-0.5+FNodes[i+1,j+1].Coord.X)*Width, FNodes[i+1,j+1].Coord.Y, (-0.5+FNodes[i+1,j+1].Coord.Z)*Height);
//----------------------------------------------------------------
glTexCoord(j/(Segments-1),i/(Segments-1));
glVertex3d((-0.5+FNodes[i,j].Coord.X)*Width, FNodes[i,j].Coord.Y, (-0.5+FNodes[i,j].Coord.Z)*Height);
glTexCoord((j+1)/(Segments-1),i/(Segments-1));
glVertex3d((-0.5+FNodes[i,j+1].Coord.X)*Width, FNodes[i,j+1].Coord.Y, (-0.5+FNodes[i,j+1].Coord.Z)*Height);
glTexCoord((j+1)/(Segments-1),(i+1)/(Segments-1));
glVertex3d((-0.5+FNodes[i+1,j+1].Coord.X)*Width, FNodes[i+1,j+1].Coord.Y, (-0.5+FNodes[i+1,j+1].Coord.Z)*Height);
end;
glEnd;
glTranslatef(0,0.1,0);
//Определим вектор смещения текстуры
Vec_X:=Cam_X-Position.X;
Vec_Y:=Cam_Y-Position.Y;
Vec_Z:=Cam_Z-Position.Z;
//Нормируем вектор и домножаем на коэффициент
len:=sqrt(sqr(Vec_X)+sqr(Vec_Y)+sqr(Vec_Z));
Vec_X:=Vec_X/len*0.1;
Vec_Y:=Vec_Y/len*0.1;
//Применим текстуру
TexBump2.ApplyTexture;
glEnable(GL_BLEND);
glBlendFunc(GL_ONE,GL_ONE);
glDepthFunc(GL_LEQUAL);
//Нарисуем треугольниками bump2
glBegin(GL_TRIANGLES);
for i:=0 to Segments-2 do
for j:=0 to Segments-2 do
begin
glTexCoord(Vec_X+j/(Segments-1),Vec_Y+i/(Segments-1));
glVertex3d((-0.5+FNodes[i,j].Coord.X)*Width, FNodes[i,j].Coord.Y, (-0.5+FNodes[i,j].Coord.Z)*Height);
glTexCoord(Vec_X+j/(Segments-1),Vec_Y+(i+1)/(Segments-1));
glVertex3d((-0.5+FNodes[i+1,j].Coord.X)*Width, FNodes[i+1,j].Coord.Y, (-0.5+FNodes[i+1,j].Coord.Z)*Height);
glTexCoord(Vec_X+(j+1)/(Segments-1),Vec_Y+(i+1)/(Segments-1));
glVertex3d((-0.5+FNodes[i+1,j+1].Coord.X)*Width, FNodes[i+1,j+1].Coord.Y, (-0.5+FNodes[i+1,j+1].Coord.Z)*Height);
//----------------------------------------------------------------
glTexCoord(Vec_X+j/(Segments-1),Vec_Y+i/(Segments-1));
glVertex3d((-0.5+FNodes[i,j].Coord.X)*Width, FNodes[i,j].Coord.Y, (-0.5+FNodes[i,j].Coord.Z)*Height);
glTexCoord(Vec_X+(j+1)/(Segments-1),Vec_Y+i/(Segments-1));
glVertex3d((-0.5+FNodes[i,j+1].Coord.X)*Width, FNodes[i,j+1].Coord.Y, (-0.5+FNodes[i,j+1].Coord.Z)*Height);
glTexCoord(Vec_X+(j+1)/(Segments-1),Vec_Y+(i+1)/(Segments-1));
glVertex3d((-0.5+FNodes[i+1,j+1].Coord.X)*Width, FNodes[i+1,j+1].Coord.Y, (-0.5+FNodes[i+1,j+1].Coord.Z)*Height);
end;
glEnd;
glDisable(GL_BLEND);
glEnable(GL_LIGHTING);
glTranslatef(0,0.1,0);
glBlendFunc(GL_DST_COLOR,GL_SRC_COLOR);
end
else begin
glTranslatef(Position.X,Position.Y,Position.Z);
glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA);
end;
//Применим текстуру
TexWater.ApplyTexture;
//Активируем прозрачность
glEnable(GL_BLEND);
//Нарисуем треугольниками воду
glBegin(GL_TRIANGLES);
for i:=0 to Segments-2 do
for j:=0 to Segments-2 do
begin
glTexCoord(j/(Segments-1),i/(Segments-1));
glVertex3d((-0.5+FNodes[i,j].Coord.X)*Width, FNodes[i,j].Coord.Y, (-0.5+FNodes[i,j].Coord.Z)*Height);
glTexCoord(j/(Segments-1),(i+1)/(Segments-1));
glVertex3d((-0.5+FNodes[i+1,j].Coord.X)*Width, FNodes[i+1,j].Coord.Y, (-0.5+FNodes[i+1,j].Coord.Z)*Height);
glTexCoord((j+1)/(Segments-1),(i+1)/(Segments-1));
glVertex3d((-0.5+FNodes[i+1,j+1].Coord.X)*Width, FNodes[i+1,j+1].Coord.Y, (-0.5+FNodes[i+1,j+1].Coord.Z)*Height);
//----------------------------------------------------------------
glTexCoord(j/(Segments-1),i/(Segments-1));
glVertex3d((-0.5+FNodes[i,j].Coord.X)*Width, FNodes[i,j].Coord.Y, (-0.5+FNodes[i,j].Coord.Z)*Height);
glTexCoord((j+1)/(Segments-1),i/(Segments-1));
glVertex3d((-0.5+FNodes[i,j+1].Coord.X)*Width, FNodes[i,j+1].Coord.Y, (-0.5+FNodes[i,j+1].Coord.Z)*Height);
glTexCoord((j+1)/(Segments-1),(i+1)/(Segments-1));
glVertex3d((-0.5+FNodes[i+1,j+1].Coord.X)*Width, FNodes[i+1,j+1].Coord.Y, (-0.5+FNodes[i+1,j+1].Coord.Z)*Height);
end;
glEnd;
glDisable(GL_BLEND);
glPopMatrix;
end;
procedure GetAngles(Vec_X,Vec_Y,Vec_Z:Double;var Angle_X,Angle_Y:Double);
begin
//Определим углы поворота вектора
Angle_Y:=arcsin(Vec_Y)/pi*180;
if Vec_X>0
then Angle_X:=arcsin(Vec_Z)/pi*180
else if Vec_Z>0
then Angle_X:=arccos(Vec_X)/pi*180
else Angle_X:=180-arcsin(Vec_Z)/pi*180;
end;
procedure GetVectorByAngles(Angle_X,Angle_Y:Double;var Vec_X,Vec_Y,Vec_Z:Double);
begin
//Определим направление вектора по углам
Vec_Y:=sin(Angle_Y/180*pi);
Vec_X:=cos(Angle_Y/180*pi)*cos(Angle_X/180*pi);
Vec_Z:=cos(Angle_Y/180*pi)*sin(Angle_X/180*pi);
end;
procedure TGLWater.DrawWithHits(Cam_X,Cam_Y,Cam_Z,Normal_X,Normal_Y,Normal_Z:Double);
var
Len:Double;
Angle_X,Angle_Y:Double;
Vec1_X,Vec1_Y,Vec1_Z:Double;
Vec2_X,Vec2_Y,Vec2_Z:Double;
i:Integer;
begin
Draw(Cam_X,Cam_Y,Cam_Z);
//Нарисуем всплески
//Запомнем матрицу
glPushMatrix;
glTranslatef(Position.X,Position.Y,Position.Z);
//Нормализуем "Нормаль"
Len:=Sqrt(Sqr(Normal_X)+Sqr(Normal_Y)+Sqr(Normal_Z));
Normal_X:=Normal_X/Len;
Normal_Y:=Normal_Y/Len;
Normal_Z:=Normal_Z/Len;
//Определим углы поворота нормали
GetAngles(Normal_X,Normal_Y,Normal_Z,Angle_X,Angle_Y);
//Определим векторы перпендикулярные нормали
GetVectorByAngles(Angle_X,Angle_Y+90,Vec1_X,Vec1_Y,Vec1_Z);
GetVectorByAngles(Angle_X-90,Angle_Y,Vec2_X,Vec2_Y,Vec2_Z);
FTexHits.ApplyTexture;
glEnable(GL_BLEND);
glBlendFunc(GL_ONE,GL_ONE);
glBegin(GL_QUADS);
for i:=0 to Length(FHits)-1 do
begin
glTexCoord(0,0);
glVertex3f(FHits[i].Coord.X-Vec1_X*FHitsSize/2-Vec2_X*FHitsSize/2,
FHits[i].Coord.Y-Vec1_Y*FHitsSize/2-Vec2_Y*FHitsSize/2,
FHits[i].Coord.Z-Vec1_Z*FHitsSize/2-Vec2_Z*FHitsSize/2);
glTexCoord(1,0);
glVertex3f(FHits[i].Coord.X-Vec1_X*FHitsSize/2+Vec2_X*FHitsSize/2,
FHits[i].Coord.Y-Vec1_Y*FHitsSize/2+Vec2_Y*FHitsSize/2,
FHits[i].Coord.Z-Vec1_Z*FHitsSize/2+Vec2_Z*FHitsSize/2);
glTexCoord(1,1);
glVertex3f(FHits[i].Coord.X+Vec1_X*FHitsSize/2+Vec2_X*FHitsSize/2,
FHits[i].Coord.Y+Vec1_Y*FHitsSize/2+Vec2_Y*FHitsSize/2,
FHits[i].Coord.Z+Vec1_Z*FHitsSize/2+Vec2_Z*FHitsSize/2);
glTexCoord(0,1);
glVertex3f(FHits[i].Coord.X+Vec1_X*FHitsSize/2-Vec2_X*FHitsSize/2,
FHits[i].Coord.Y+Vec1_Y*FHitsSize/2-Vec2_Y*FHitsSize/2,
FHits[i].Coord.Z+Vec1_Z*FHitsSize/2-Vec2_Z*FHitsSize/2);
end;
glEnd;
glDisable(GL_BLEND);
glPopMatrix;
end;
procedure TGLWater.Animation(const Deltatime_ms:Integer);
var
i,j: Integer;
g,h: Integer;
Len,CurLen,k:Double;
begin
if FUseRandomForce
then begin
//Определим оставшееся время до изменения внешней силы
dec(FRandomForceRemainedTime,Deltatime_ms);
//Определяем не пора ли изменить внешнее воздействие
if FRandomForceRemainedTime<=0
then begin
while FRandomForceRemainedTime<=0 do
inc(FRandomForceRemainedTime,FRandomForceTime);
RandomForce;
end;
end;
//Определим внутренную силу натяжения каждого узла
for i:=1 to Segments-2 do
for j:=1 to Segments-2 do
begin
SetVector(FNodes[i,j].F, 0, 0, 0);
for g:=i-1 to i+1 do
for h:=j-1 to j+1 do
if (g>=0)and(h>=0)and(g<=Segments-1)and(h<=Segments-1)
then begin
Len:=sqrt(sqr(i/(Segments-1)-g/(Segments-1))+sqr(j/(Segments-1)-h/(Segments-1)));
CurLen:=sqrt(sqr(FNodes[i,j].Coord.X-FNodes[g,h].Coord.X)+sqr(FNodes[i,j].Coord.Y-FNodes[g,h].Coord.Y)+sqr(FNodes[i,j].Coord.Z-FNodes[g,h].Coord.Z));
k:=round(((1-Len/CurLen)*CompressCoef)*1000000)*0.000001;
FNodes[i,j].F.X:=FNodes[i,j].F.X+k*(FNodes[i,j].Coord.X-FNodes[g,h].Coord.X);
FNodes[i,j].F.Y:=FNodes[i,j].F.Y+k*(FNodes[i,j].Coord.Y-FNodes[g,h].Coord.Y);
FNodes[i,j].F.Z:=FNodes[i,j].F.Z+k*(FNodes[i,j].Coord.Z-FNodes[g,h].Coord.Z);
end;
end;
//Получение новых координат узлов
for i:=1 to Segments-2 do
for j:=1 to Segments-2 do
begin
//Вычислим ускорение
FNodes[i,j].a.X:=1/Mass*(FNodes[i,j].F_ext.X-DempfCoef*FNodes[i,j].v.X-FNodes[i,j].F.X);
FNodes[i,j].a.Y:=1/Mass*(FNodes[i,j].F_ext.Y-DempfCoef*FNodes[i,j].v.Y-FNodes[i,j].F.Y);
FNodes[i,j].a.Z:=1/Mass*(FNodes[i,j].F_ext.Z-DempfCoef*FNodes[i,j].v.Z-FNodes[i,j].F.Z);
SetVector(FNodes[i,j].F_ext, 0, 0, 0);
//Определим скорость. Делим на 1000, так как в мс
FNodes[i,j].v.X:=FNodes[i,j].v.X+FNodes[i,j].a.X*Deltatime_ms/1000;
FNodes[i,j].v.Y:=FNodes[i,j].v.Y+FNodes[i,j].a.Y*Deltatime_ms/1000;
FNodes[i,j].v.Z:=FNodes[i,j].v.Z+FNodes[i,j].a.Z*Deltatime_ms/1000;
//Определим координаты узла
FNodes[i,j].Coord.X:=FNodes[i,j].Coord.X+FNodes[i,j].v.X*Deltatime_ms/1000;
FNodes[i,j].Coord.Y:=FNodes[i,j].Coord.Y+FNodes[i,j].v.Y*Deltatime_ms/1000;
FNodes[i,j].Coord.Z:=FNodes[i,j].Coord.Z+FNodes[i,j].v.Z*Deltatime_ms/1000;
end;
//Получение новых координат капель всплеска
for i:=0 to Length(FHits)-1 do
begin
//Определим скорость. Делим на 1000, так как в мс
FHits[i].v.Y:=FHits[i].v.Y+FGravity*Deltatime_ms/1000;
//Определим координаты узла
FHits[i].Coord.X:=FHits[i].Coord.X+FHits[i].v.X*Deltatime_ms/1000;
FHits[i].Coord.Y:=FHits[i].Coord.Y+FHits[i].v.Y*Deltatime_ms/1000;
FHits[i].Coord.Z:=FHits[i].Coord.Z+FHits[i].v.Z*Deltatime_ms/1000;
end;
//Удалим капли, которые должны исчезнуть при попадании в воду
i:=0;
while i<Length(FHits)-1 do
if FHits[i].Coord.Y<FPosition.Y
then begin
for j:=i+1 to Length(FHits)-1 do
begin
FHits[j-1].Coord.X:=FHits[j].Coord.X;
FHits[j-1].Coord.Y:=FHits[j].Coord.Y;
FHits[j-1].Coord.Z:=FHits[j].Coord.Z;
FHits[j-1].v.X:=FHits[j].v.X;
FHits[j-1].v.Y:=FHits[j].v.Y;
FHits[j-1].v.Z:=FHits[j].v.Z;
end;
SetLength(FHits,Length(FHits)-1);
end
else inc(i);
end;
procedure TGLWater.RandomForce;
var
i,j: Integer;
begin
//Установка случайной внешней силы
for i:=0 to Segments-1 do
for j:=0 to Segments-1 do
SetVector(FNodes[i,j].F_ext, (-0.5+random)*MaxForce, (-0.5+random)*MaxForce_Y, (-0.5+random)*MaxForce);
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);
glGetDoublev (GL_MODELVIEW_MATRIX, @mvMatrix);
glGetDoublev (GL_PROJECTION_MATRIX, @ProjMatrix);
// viewport[3] - высота окна в пикселях
RealY := viewport[3] - Y - 1;
glReadPixels(X, RealY, 1, 1, GL_DEPTH_COMPONENT, GL_FLOAT, @Zval);
gluUnProject (X, RealY, Zval,@mvMatrix, @ProjMatrix, @Viewport, wx, wy, wz);
if (wx<100) and (wx>-100) and (wz<100) and (wz>-100)
then begin
if (MainForm.ShowBoxCheckBox.Checked)and((wx>89) or (wx<-89) or (wz>89) and (wz<-89))
then exit;
if MainForm.ShowGroundCheckBox.Checked
then begin
//Определим в какую ячейку земли попадает точка (wx,wy,wz)
tx:=wx;
tz:=wz;
g:=0;
while tx>-100+200/(GroundSegment-1) do
begin
tx:=tx-200/(GroundSegment-1);
inc(g);
end;
h:=0;
while tz>-100+200/(GroundSegment-1) do
begin
tz:=tz-200/(GroundSegment-1);
inc(h);
end;
//Точка должна быть выше земли
if (wy<GroundMas[g,h]+1)and(GroundMas[g,h]>0)or
(wy<GroundMas[g+1,h]+1)and(GroundMas[g+1,h]>0)or
(wy<GroundMas[g,h+1]+1)and(GroundMas[g,h+1]>0)or
(wy<GroundMas[g+1,h+1]+1)and(GroundMas[g+1,h+1]>0)
then exit;
end;
//Чтобы всплески были видны, иначе они будут сразу же исчезать
if wy<1
then wy:=1;
Water.AddHits(wx,wy,wz,Power,Radius);
end;
end;
procedure TMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (ssRight in Shift)and(HitsEnableCheckBox.Checked)
then AddHits(X,Y,HitsPowerEdit.Value,HitsRadiusEdit.Value);
end;
procedure TMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift
then begin
//Поворот камеры
Cam_Angle_X:=Cam_Angle_X+x-mx;
Cam_Angle_Y:=Cam_Angle_Y+y-my;
if Cam_Angle_Y<-89
then Cam_Angle_Y:=-89;
if Cam_Angle_Y>89
then Cam_Angle_Y:=89;
ResetCamCoords;
Resize;
end;
mx:=X;
my:=Y;
end;
procedure TMainForm.FormResize(Sender: TObject);
begin
//Устанавливае размер окна OpenGL
glViewport(0, 0, ClientWidth-PageControl.Width, ClientHeight);
glMatrixMode(GL_PROJECTION);
glLoadIdentity();
gluPerspective(30, 1.25, 1,1000);
//Ставим камеру
GLULookAt(Cam_X,Cam_Y,Cam_Z,Target_X,Target_Y,Target_Z,0,1,0);
glMatrixMode(GL_MODELVIEW);
end;
procedure TMainForm.HitsCountEditChange(Sender: TObject);
begin
Water.HitsCount:=round(HitsCountEdit.Value);
end;
procedure TMainForm.HitsGravityEditChange(Sender: TObject);
begin
Water.Gravity:=HitsGravityEdit.Value;
end;
procedure TMainForm.HitsSizeEditChange(Sender: TObject);
begin
Water.HitsSize:=HitsSizeEdit.Value;
end;
procedure TMainForm.KeyTimerTimer(Sender: TObject);
var
speed:Single;
Vect,Temp:TGLArrayf3;
Rad:Single;
begin
//Клавиши управления камерой
Vect[0]:=Target_X-Cam_X;
Vect[1]:=0;
Vect[2]:=Target_Z-Cam_Z;
Rad:=Sqrt(Sqr(Cam_X-Target_X)+Sqr(Cam_Z-Target_Z));
Vect[0]:=Vect[0]/Rad;
Vect[1]:=Vect[1]/Rad;
Vect[2]:=Vect[2]/Rad;
if IsKeyDown(VK_SHIFT)
then speed:=5
else if IsKeyDown(VK_Control)
then speed:=1
else speed:=3;
if IsKeyDown('Q')
then begin
Cam_Y:=Cam_Y+speed;
Target_Y:=Target_Y+speed;
Resize;
MainForm.SetFocus;
end;
if IsKeyDown('E')
then begin
Cam_Y:=Cam_Y-speed;
Target_Y:=Target_Y-speed;
Resize;
end;
if IsKeyDown('W')
then begin
Cam_X:=Cam_X+Vect[0]*speed;
Cam_Z:=Cam_Z+Vect[2]*speed;
Target_X:=Target_X+Vect[0]*speed;
Target_Z:=Target_Z+Vect[2]*speed;
Resize;
end;
if IsKeyDown('S')
then begin
Cam_X:=Cam_X-Vect[0]*speed;
Cam_Z:=Cam_Z-Vect[2]*speed;
Target_X:=Target_X-Vect[0]*speed;
Target_Z:=Target_Z-Vect[2]*speed;
Resize;
end;
Temp[0]:=-Vect[2];
Temp[2]:=Vect[0];
Vect[0]:=Temp[0];
Vect[2]:=Temp[2];
if IsKeyDown('D')
then begin
Cam_X:=Cam_X+Vect[0]*speed;
Cam_Z:=Cam_Z+Vect[2]*speed;
Target_X:=Target_X+Vect[0]*speed;
Target_Z:=Target_Z+Vect[2]*speed;
Resize;
end;
if IsKeyDown('A')
then begin
Cam_X:=Cam_X-Vect[0]*speed;
Cam_Z:=Cam_Z-Vect[2]*speed;
Target_X:=Target_X-Vect[0]*speed;
Target_Z:=Target_Z-Vect[2]*speed;
Resize;
end;
end;
procedure TMainForm.WaterAlphaEditChange(Sender: TObject);
begin
Water.Alpha:=WaterAlphaEdit.Value;
end;
procedure TMainForm.WaterCompressCoefEditChange(Sender: TObject);
begin
Water.CompressCoef:=WaterCompressCoefEdit.Value;
end;
procedure TMainForm.WaterDempfCoefEditChange(Sender: TObject);
begin
Water.DempfCoef:=WaterDempfCoefEdit.Value;
end;
procedure TMainForm.WaterMassEditChange(Sender: TObject);
begin
Water.Mass:=WaterMassEdit.Value;
end;
procedure TMainForm.WaterMaxForceEditChange(Sender: TObject);
begin
Water.MaxForce:=WaterMaxForceEdit.Value;
end;
procedure TMainForm.WaterMaxForceYEditChange(Sender: TObject);
begin
Water.MaxForce_Y:=WaterMaxForceYEdit.Value;
end;
procedure TMainForm.WaterRandomForceTimeEditChange(Sender: TObject);
begin
Water.RandomForceTime:=round(WaterRandomForceTimeEdit.Value);
end;
procedure TMainForm.WaterRelaxBtnClick(Sender: TObject);
var
i,j: Integer;
begin
for i:=0 to Water.Segments-1 do
for j:=0 to Water.Segments-1 do
begin
SetVector(Water.Nodes[i,j].F, 0, 0, 0);
SetVector(Water.Nodes[i,j].F_ext, 0, 0, 0);
SetVector(Water.Nodes[i,j].Coord, j/(Water.Segments-1), 0, i/(Water.Segments-1));
SetVector(Water.Nodes[i,j].a, 0, 0, 0);
SetVector(Water.Nodes[i,j].v, 0, 0, 0);
end;
end;
procedure TMainForm.WaterSegmentsEditChange(Sender: TObject);
begin
Water.Segments:=round(WaterSegmentsEdit.Value);
end;
procedure TMainForm.WaterUseBumpCheckBoxClick(Sender: TObject);
begin
Water.UseBumping:=WaterUseBumpCheckBox.Checked;
end;
procedure TMainForm.WaterUseRandomForceCheckBoxClick(Sender: TObject);
begin
Water.UseRandomForce:=WaterUseRandomForceCheckBox.Checked;
end;
procedure TMainForm.DrawTimerTimer(Sender: TObject);
var
NewTime : cardinal;
begin
//Определим время между кадрами
NewTime := TimeGetTime;
Water.Animation(NewTime-CurTime);
Draw;
CurTime:=NewTime;
end;
procedure DrawBox(Pos_X,Pos_Y,Pos_Z,Width,Height,Depth:Double);
begin
glPushMatrix;
//Рисует кубик
glTranslatef(Pos_X,Pos_Y,Pos_Z);
glBegin(GL_QUADS);
//Низ
glTexCoord(0,0);
glVertex(-Width, 0, -Depth);
glTexCoord(1,0);
glVertex( Width, 0, -Depth);
glTexCoord(1,1);
glVertex( Width, 0, Depth);
glTexCoord(0,1);
glVertex(-Width, 0, Depth);
//Верх
glTexCoord(0,0);
glVertex(-Width, Height, -Depth);
glTexCoord(1,0);
glVertex( Width, Height, -Depth);
glTexCoord(1,1);
glVertex( Width, Height, Depth);
glTexCoord(0,1);
glVertex(-Width, Height, Depth);
//Лево
glTexCoord(0,0);
glVertex(-Width, 0, -Depth);
glTexCoord(1,0);
glVertex(-Width, 0, Depth);
glTexCoord(1,1);
glVertex(-Width, Height, Depth);
glTexCoord(0,1);
glVertex(-Width, Height, -Depth);
//Право
glTexCoord(0,0);
glVertex(Width, 0, Depth);
glTexCoord(1,0);
glVertex(Width, 0, -Depth);
glTexCoord(1,1);
glVertex(Width, Height, -Depth);
glTexCoord(0,1);
glVertex(Width, Height, Depth);
//Перед
glTexCoord(0,0);
glVertex( Width, 0, Depth);
glTexCoord(1,0);
glVertex(-Width, 0, Depth);
glTexCoord(1,1);
glVertex(-Width, Height, Depth);
glTexCoord(0,1);
glVertex( Width, Height, Depth);
//Зад
glTexCoord(0,0);
glVertex(-Width, 0, -Depth);
glTexCoord(1,0);
glVertex( Width, 0, -Depth);
glTexCoord(1,1);
glVertex( Width, Height, -Depth);
glTexCoord(0,1);
glVertex(-Width, Height, -Depth);
glEnd;
glPopMatrix;
end;
procedure DrawGround;
var
i,j:Byte;
Width:Double;
Height:Double;
begin
//Запомнем матрицу
glPushMatrix;
TexGround.ApplyTexture;
//Нарисуем треугольниками землю
glBegin(GL_TRIANGLES);
Width:=200;
Height:=200;
for i:=0 to GroundSegment-2 do
for j:=0 to GroundSegment-2 do
begin
glTexCoord(j/(GroundSegment-1),i/(GroundSegment-1));
glVertex3d((-0.5+j/(GroundSegment-1))*Width, GroundMas[i,j], (-0.5+i/(GroundSegment-1))*Height);
glTexCoord(j/(GroundSegment-1),(i+1)/(GroundSegment-1));
glVertex3d((-0.5+j/(GroundSegment-1))*Width, GroundMas[i+1,j], (-0.5+(i+1)/(GroundSegment-1))*Height);
glTexCoord((j+1)/(GroundSegment-1),(i+1)/(GroundSegment-1));
glVertex3d((-0.5+(j+1)/(GroundSegment-1))*Width, GroundMas[i+1,j+1], (-0.5+(i+1)/(GroundSegment-1))*Height);
//----------------------------------------------------------------
glTexCoord(j/(GroundSegment-1),i/(GroundSegment-1));
glVertex3d((-0.5+j/(GroundSegment-1))*Width, GroundMas[i,j], (-0.5+i/(GroundSegment-1))*Height);
glTexCoord((j+1)/(GroundSegment-1),i/(GroundSegment-1));
glVertex3d((-0.5+(j+1)/(GroundSegment-1))*Width, GroundMas[i,j+1], (-0.5+i/(GroundSegment-1))*Height);
glTexCoord((j+1)/(GroundSegment-1),(i+1)/(GroundSegment-1));
glVertex3d((-0.5+(j+1)/(GroundSegment-1))*Width, GroundMas[i+1,j+1], (-0.5+(i+1)/(GroundSegment-1))*Height);
end;
glEnd;
glPopMatrix;
end;
procedure DrawCaust;
var
i,j:Byte;
Width:Double;
Height:Double;
begin
//Запомнем матрицу
glPushMatrix;
case CurCaust of
0:TexCaust1.ApplyTexture;
1:TexCaust2.ApplyTexture;
2:TexCaust3.ApplyTexture;
3:TexCaust4.ApplyTexture;
4:TexCaust5.ApplyTexture;
end;
glEnable(GL_BLEND);
glBlendFunc(GL_ONE,GL_ONE_MINUS_SRC_COLOR);
//Нарисуем треугольниками землю
glBegin(GL_TRIANGLES);
Width:=200;
Height:=200;
for i:=0 to GroundSegment-2 do
for j:=0 to GroundSegment-2 do
begin
if (GroundMas[i,j]<-0.9)and(GroundMas[i+1,j]<-0.9)and(GroundMas[i+1,j+1]<-0.9)
then begin
glTexCoord(j/(GroundSegment-1),i/(GroundSegment-1));
glVertex3d((-0.5+j/(GroundSegment-1))*Width, GroundMas[i,j]+0.1, (-0.5+i/(GroundSegment-1))*Height);
glTexCoord(j/(GroundSegment-1),(i+1)/(GroundSegment-1));
glVertex3d((-0.5+j/(GroundSegment-1))*Width, GroundMas[i+1,j]+0.1, (-0.5+(i+1)/(GroundSegment-1))*Height);
glTexCoord((j+1)/(GroundSegment-1),(i+1)/(GroundSegment-1));
glVertex3d((-0.5+(j+1)/(GroundSegment-1))*Width, GroundMas[i+1,j+1]+0.1, (-0.5+(i+1)/(GroundSegment-1))*Height);
end;
//----------------------------------------------------------------
if (GroundMas[i,j]<-0.9)and(GroundMas[i,j+1]<-0.9)and(GroundMas[i+1,j+1]<-0.9)
then begin
glTexCoord(j/(GroundSegment-1),i/(GroundSegment-1));
glVertex3d((-0.5+j/(GroundSegment-1))*Width, GroundMas[i,j]+0.1, (-0.5+i/(GroundSegment-1))*Height);
glTexCoord((j+1)/(GroundSegment-1),i/(GroundSegment-1));
glVertex3d((-0.5+(j+1)/(GroundSegment-1))*Width, GroundMas[i,j+1]+0.1, (-0.5+i/(GroundSegment-1))*Height);
glTexCoord((j+1)/(GroundSegment-1),(i+1)/(GroundSegment-1));
glVertex3d((-0.5+(j+1)/(GroundSegment-1))*Width, GroundMas[i+1,j+1]+0.1, (-0.5+(i+1)/(GroundSegment-1))*Height);
end;
end;
glEnd;
glDisable(GL_BLEND);
glPopMatrix;
end;
procedure DrawGroundBox;
begin
//Запомнем матрицу
glPushMatrix;
TexGround.ApplyTexture;
glBegin(GL_QUADS);
//Низ
glTexCoord(0,0);
glVertex(-100, -100, -100);
glTexCoord(1,0);
glVertex( 100, -100, -100);
glTexCoord(1,1);
glVertex( 100, -100, 100);
glTexCoord(0,1);
glVertex(-100, -100, 100);
glEnd;
//Лево
DrawBox(-100,-100,0,10,120,90);
//Право
DrawBox(100,-100,0,10,120,90);
//Перед
DrawBox(0,-100,100,110,120,10);
//Зад
DrawBox(0,-100,-100,110,120,10);
glEnd;
glPopMatrix;
end;
procedure DrawLight;
var
quadObj :GLUquadricObj;
begin
quadObj:=gluNewQuadric;
//Запомнем матрицу
glPushMatrix;
glDisable(GL_LIGHTING);
glColor3f(1,1,1);
glTranslatef(Light_pos[0],Light_pos[1],Light_pos[2]);
gluSphere(quadObj,1,8,8);
gluDeleteQuadric(quadObj);
glEnable(GL_LIGHTING);
glPopMatrix;
end;
procedure TMainForm.CaustEditChange(Sender: TObject);
begin
CaustTimer.Interval:=round(CaustEdit.Value);
end;
procedure TMainForm.CaustTimerTimer(Sender: TObject);
begin
CurCaust:=(CurCaust+1) mod 5;
end;
procedure TMainForm.Draw;
begin
//Устанавливаем фоновый цвет
glClearColor(0.9, 0.9, 0.9, 1);
//Очистим буфер цвета и глубины
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
if ShowBoxCheckBox.Checked
then begin
if BoxLineCheckBox.Checked
then glPolygonMode(GL_FRONT_AND_BACK, GL_LINE)
else glPolygonMode(GL_FRONT_AND_BACK, GL_FILL);
DrawGroundBox;
end;
if ShowGroundCheckBox.Checked
then begin
if GroundLineCheckBox.Checked
then glPolygonMode(GL_FRONT_AND_BACK, GL_LINE)
else glPolygonMode(GL_FRONT_AND_BACK, GL_FILL);
DrawGround;
end;
if ShowCaustCheckBox.Checked
then begin
if CaustLineCheckBox.Checked
then glPolygonMode(GL_FRONT_AND_BACK, GL_LINE)
else glPolygonMode(GL_FRONT_AND_BACK, GL_FILL);
DrawCaust;
end;
if ShowWaterCheckBox.Checked
then begin
if WaterLineCheckBox.Checked
then glPolygonMode(GL_FRONT_AND_BACK, GL_LINE)
else glPolygonMode(GL_FRONT_AND_BACK, GL_FILL);
Water.DrawWithHits(Cam_X,Cam_Y,Cam_Z,Target_X-Cam_X,Target_Y-Cam_Y,Target_Z-Cam_Z);
end;
if ShowLightCheckBox.Checked
then begin
if LightLineCheckBox.Checked
then glPolygonMode(GL_FRONT_AND_BACK, GL_LINE)
else glPolygonMode(GL_FRONT_AND_BACK, GL_FILL);
DrawLight;
end;
//Нужно для прорисовки на окне приложения
SwapBuffers(ghDC);
end;
end.
Вывод:
В ходе выполнения курсовой работы были реализованы следующие задачи:
Моделирование динамически изменяющейся водной поверхности;
Интерактивное управление изменениями поверхности (добавить всплеск и др.)
Реализация прозрачности и преломления в водной поверхности
Перемещение наблюдателя по сцене
Реализация каустиков и визуализация донных поверхностей
Использование bumpmapping'а для более точной передачи водной поверхности
С реализацией отражения в водной поверхности возникли проблемы, вследствие чего данный пункт задания реализован не был.
В целом же данная работа отвечает поставленным требованиям и корректно работает.