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

unit Main;
 
interface
 
uses WinProcs,Controls,Forms,ExtCtrls,Classes,Graphics;
 
const maxIndex=100;      { Максимальное кол-во видимых линий}
 
type
  LineRec = record     { начало, конец линии  и цвет}
    X1,Y1,X2,Y2 : Integer;
    Color: TColor;
  end;
 
type
  TMainForm = class(TForm)
    Timer: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  private
    LineArray: array[0..maxIndex-1] of LineRec;
    Index: Integer;   { индекс LineArray }
    Erasing: Boolean; { истина, если удалены старые линии }
    function Sign(N: Integer): Integer;
    procedure InitLineArray;
    procedure MakeNewLine(R: TRect; Index: Integer);
    procedure DrawLine(Index: Integer);
  end;
 
var
  MainForm: TMainForm;
  dx1: Integer = 4;  { Значения "дельта" для  расчета анимации }
  dy1: Integer = 5;
  dx2: Integer = 3;
  dy2: Integer = 9;
 
implementation
 
{$R *.DFM}
 
procedure TMainForm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(params);
 
  with Params.WindowClass do Style:=Style or cs_HRedraw or cs_VRedraw;
end;
 
function TMainForm.Sign(N: Integer): Integer;
begin if N<0 then Sign:=-1 else Sign:=1 end;
 
{ Стереть LineArray и задать X1 = -1 как флаг "нет линии"  }
procedure TMainForm.InitLineArray;
var I: Integer;
begin
  Index:=0;
  Erasing:=False;
  FillChar(LineArray,SizeOf(LineArray),0);
  for I:=0 to maxIndex-1 do LineArray[I].X1:=-1;
end;
 
{ Нарисовать новую линию,направление и цвет }
procedure TMainForm.MakeNewLine(R: TRect; Index: Integer);
  procedure NewCoord(var C, Change: Integer; Max: Integer; var Color: TColor);
  var Temp: Integer;
  begin
    Temp:=C+Change;
    if (Temp<0)or(Temp>Max) then begin
      Change:=Sign(-Change)*(3+Random(12));
      repeat
        Color:=RGB(Random(256),Random(256),Random(256));
        Color:=GetNearestColor(Canvas.Handle,Color);
      until Color<>GetBkColor(Canvas.Handle);
    end else C:=Temp;
  end;
begin
  with LineArray[Index] do begin
    NewCoord(X1,dx1,R.Right,Color);
    NewCoord(Y1,dy1,R.Bottom,Color);
    NewCoord(X2,dx2,R.Right,Color);
    NewCoord(Y2,dy2,R.Bottom,Color);
  end
end;
 
{ Нарисовать или стереть линию, определенную по индексу}
procedure TMainForm.DrawLine(Index: Integer);
begin
  with Canvas, LineArray[Index] do begin
    Pen.Color:=Color;
    MoveTo(X1,Y1);
    LineTo(X2,Y2);
  end;
end;
 
{ Отрисовка несколько линий на каждом интервале таймера}
procedure TMainForm.TimerTimer(Sender: TObject);
var
  R: TRect;
  I,OldIndex: Integer;
begin
  R:=GetClientRect;
  for I:=1 to 5 do begin { 5 = число линий }
    OldIndex:=Index;
    Inc(Index);
    if Index=maxIndex-1 then begin
      Index:=0;       { Обнуление индекса для начала }
      Erasing:=True;  { истина, пока изменяются размеры окна }
    end;
    if Erasing then DrawLine(Index); { вытереть старую линию }
    LineArray[Index]:=LineArray[OldIndex];
    MakeNewLine(R,Index);
    DrawLine(Index);  { рисовать новую линию }
  end;
end;
 
{ Закрасить или перекрасить экран используя данные в LineArray  }
procedure TMainForm.FormPaint(Sender: TObject);
var I: Integer;
begin
  for I:=0 to maxIndex-1 do
   if LineArray[I].X1>=0 then DrawLine(I); { рисуем линию, если флаг не -1 }
end;
 
{ начать новую линию при изменении размера окна }
procedure TMainForm.FormResize(Sender: TObject);
begin
  InitLineArray; { стереть LineArray и сбросить глобальные }
end;
 
{ инициализация глобальных и LineArray }
procedure TMainForm.FormCreate(Sender: TObject);
begin
  with Canvas.Pen do begin
    Style:=psSolid;
    Width:=1;
    Mode:=pmXor;
  end;
  Randomize;
  InitLineArray;
end;
 
end.