Основы программирования

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Unit2;
 
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  b: TBitmap;
 
  bitmap: array [0..600, 0..600] of TColor;
 
  sx,sy: integer;                  // use in Unit2
  P: Projection;                   // use in Unit2
  xnew,ynew,xold,yold: integer;    // use in Unit2
  x,y,z,a: real;                   // use in Unit2
 
  needexit: boolean = true;
  pma: boolean = true;             //plus/minus for var A
 
implementation
 
{$R *.DFM}
 
procedure TForm1.FormCreate(Sender: TObject);
var
 x,y: integer;
begin
  b := TBitMap.Create;
  b.pixelformat := pf24bit;
  b.width := Screen.width;
  b.height := Screen.height;
  sx:=Screen.width div 2;
  sy:=Screen.height div 2-30;
  a:=0.01;
 
  for x:= 0 to 600 do
    for y:= 0 to (900 div 3) do
      bitmap[x,y]:= RGB(0,0,255);
  for x:= 0 to 600 do
    for y:= (900 div 3) to 2 * (900 div 3) do
      bitmap[x,y]:= RGB(255,255,0);
 
end;
 
procedure TForm1.FormPaint(Sender: TObject);
begin
 while needexit do
  begin
    b.Canvas.Brush.Color:=clBlack;
    b.Canvas.FillRect(Rect(0,0,b.Width,b.Height));
    cdp(30,P);
    drawsurf;
    if pma then a:=a+0.09 else a:=a-0.09;
    a:=a+0.09;
 
    Form1.Canvas.Draw(0,0,b);
    Application.ProcessMessages;
  end;
 Close;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
 b.Free;
end;
 
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 needexit:=not needexit;
end;
 
end.
 

unit Unit2;
 
interface
 
type
  vector = array [1..3] of real;
  projection = array [1..2] of vector;
 
Procedure NormLine(x0,y0,x1,y1,color: integer);
Procedure CDP(alpha: real; var P: Projection);
Procedure Project(const P: Projection; const x,y,z: real; const u0,v0: integer; var u,v: integer);
Procedure DrawSurf;
Procedure FindCoord(var x,y: real; var xp,yp: integer);
Function  Fun(x,y: real):real;
 
implementation
uses Unit1, Graphics;
 
Procedure NormLine(x0,y0,x1,y1,color: integer);
begin
b.Canvas.Pen.Color:=color;
b.Canvas.MoveTo(sx+x0,sy-y0);
b.Canvas.LineTo(sx+x1,sy-y1);
end;
 
Procedure CDP(alpha: real; var P: Projection);  //перспектива угол и положение
var t: real;
begin
alpha:= pi*alpha/180.0;
P[1,1]:=-1.0/sqrt(2.0);
P[1,2]:=-P[1,1];
P[1,3]:=0.0;
t:=sin(alpha)/cos(alpha);
P[2,1]:=t*P[1,1];
P[2,2]:=P[2,1];
P[2,3]:=sqrt(1.0-sqr(t));
end;
 
Procedure Project(const P: Projection; const x,y,z: real; const u0,v0: integer; var u,v: integer);
begin
u:= u0+round(P[1,1]*x+P[1,2]*y+P[1,3]*z);
v:= v0+round(P[2,2]*x+P[2,1]*y+P[2,3]*z);
end;
 
Function Fun(x,y: real):real;     //    кол во и размер волн
begin
Fun:=sin(x/2+a);
end;
 
Procedure FindCoord(var x,y: real; var xp,yp: integer);    //угол изгиба волн 
begin
z:= 10*Fun(0.1*x,0.1*y);
project(P,x,y,z,0,0,xnew,ynew);
end;
 
Procedure DrawSurf;
var i,j: integer;
begin
{for i:= 0 to 100 do
  begin
  x:=-300+i*6;
  y:=-300;
  FindCoord(x,y,xnew,ynew);
  xold:=xnew;
  yold:=ynew;
  for j:= 1 to 100 do
    begin
    y:=-300+j*6;
    FindCoord(x,y,xnew,ynew);
    NormLine(xnew,ynew,xold,yold,bitmap[Round(x)+300,Round(y)+300]);
    xold:=xnew;
    yold:=ynew;
    end;
  end;  }
for i:= 0 to 100 do     //длина количество полосочек(флага)   по горизонтале
  begin
  y:=-300+i*6;
  x:=-300;
  FindCoord(x,y,xnew,ynew);
  xold:=xnew;
  yold:=ynew;
  for j:= 1 to 100 do
    begin
    x:=-300+j*6;
    FindCoord(x,y,xnew,ynew);
    NormLine(xnew,ynew,xold,yold,bitmap[Round(x)+300,Round(y)+300]);
    xold:=xnew;
    yold:=ynew;
    end;
end;
end;
 
end.