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

Перед выводом  третей (последней плоскости) необходимо установить следующие параметры OpenGL:

Здесь также  выводится плоскость, которая параллельна  предыдущим, но "чуть-чуть" приподнята относительно них по вектору наблюдения, для избежания пересечений. На плоскость накладывается текстура (1), при этом координаты никак не пересчитываются (в отличии от предыдущей).

В итоге получается изображение, на котором виден "микрорельеф".

Расскажем теперь, как bump mapping применяется по отношению к моделированию водных поверхностей. Предположим, что необходимо моделировать большую водную поверхность, без видимых границ (граница - линия горизонта), на которой присутствуют лишь небольшие волны, то есть она достаточно "спокойна". Тогда можно не разбивать водную поверхность на множество плоскостей, а сделать одну большую плоскость, для которой применить bump mapping с динамически изменяемой картой поверхности. Обычно сразу загружается достаточное количество карт глубины (10-15), затем они меняют друг друга, в соответствие со временем изменения водной поверхности, а в конце происходит их зацикливание. Таким образом нам достаточно выводить только один полигон (то есть 3 - в нашей реализации bump mapping'а), а не разбивать поверхность на множество полигонов.

Реально же используют следующую модель: водную поверхность  разбивают на полигонов (но уже не так много как раньше) и с  помощью этих полигонов задают общую  модель поведения водной поверхности, например, в соответствии с алгоритмом рассказанным в самом начале. Затем для каждой плоскости производится bump mapping, для передачи более точных характеристик водной поверхности.

 

Текст программы

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;