Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

курсач / Unit1

.pas
Скачиваний:
28
Добавлен:
08.03.2015
Размер:
6 Кб
Скачать
☆
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons;

type
  TForm1 = class(TForm)
    img1: TImage;
    btn1: TButton;
    btn2: TButton;
    btn3: TButton;
    btn4: TButton;
    btn5: TButton;
    btn6: TBitBtn;
    lbl1: TLabel;
    dlgOpen1: TOpenDialog;
    dlgSave1: TSaveDialog;
    procedure FormPaint(Sender: TObject);
    procedure img1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btn5Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btn4Click(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses DynStruct, SquareFinder;

const
  PointW = 10;
  PointH = 10;
  GridRows = 40;
  GridCols = 40;
  
var
  pointListRoot : pPointNode;
  squareListRoot : pSquareNode;


procedure TForm1.FormPaint(Sender: TObject);
const Colors : array[ 1..5 ] of TColor = ( clRed, clLime, clYellow, clFuchsia, clAqua );
var i : integer;
    tz : pPointNode;
    dz : pSquareNode;
    SCnt : integer;
begin
  form1.Canvas.Brush.Color := clSilver;
  form1.Canvas.Pen.Width := 1;
  form1.Canvas.Pen.Color := clBlack;
  form1.Canvas.FillRect( Rect( img1.Left, img1.Top, img1.Left + img1.Width, img1.Top + img1.Height ) );
  form1.Canvas.Rectangle( img1.Left, img1.Top, img1.Left + img1.Width, img1.Top + img1.Height );

  for i := 1 to GridCols - 1 do
  begin
    form1.Canvas.MoveTo( img1.Left + i * PointW, img1.Top );
    form1.Canvas.LineTo( img1.Left + i * PointW, img1.Top + img1.Height );
  end;

  for i := 1 to GridRows - 1 do
  begin
    form1.Canvas.MoveTo( img1.Left, img1.Top + i * PointH );
    form1.Canvas.LineTo( img1.Left + img1.Width, img1.Top + i * PointH );
  end;

  form1.Canvas.Brush.Color := clBlue;

  tz := pointListRoot^.next;
  while tz <> nil do
  begin
    form1.Canvas.FillRect( Rect(
      img1.Left + ( tz^.Point.X - 1 ) * PointW + 1,
      img1.Top + ( tz^.Point.Y - 1 ) * PointH + 1,
      img1.Left + tz^.Point.X * PointW,
      img1.Top + tz^.Point.Y * PointH ) );
    tz := tz^.Next;
  end;

  form1.Canvas.Pen.Width := 3;

  dz := squareListRoot^.Next;
  SCnt := 0;
  while dz <> nil do
  begin
    form1.Canvas.Pen.Color := Colors[ SCnt mod 5 + 1 ];

    form1.Canvas.MoveTo( img1.Left + dz^.Square[ 1 ].X * PointW - PointW div 2,
                         img1.Top  + dz^.Square[ 1 ].Y * PointH - PointH div 2 );
    form1.Canvas.LineTo( img1.Left + dz^.Square[ 2 ].X * PointW - PointW div 2,
                         img1.Top  + dz^.Square[ 2 ].Y * PointH - PointH div 2 );
    form1.Canvas.LineTo( img1.Left + dz^.Square[ 3 ].X * PointW - PointW div 2,
                         img1.Top  + dz^.Square[ 3 ].Y * PointH - PointH div 2 );
    form1.Canvas.LineTo( img1.Left + dz^.Square[ 4 ].X * PointW - PointW div 2,
                         img1.Top  + dz^.Square[ 4 ].Y * PointH - PointH div 2 );
    form1.Canvas.LineTo( img1.Left + dz^.Square[ 1 ].X * PointW - PointW div 2,
                         img1.Top  + dz^.Square[ 1 ].Y * PointH - PointH div 2 );
    dz := dz^.Next;
    inc( SCnt );
  end;

  lbl1.Caption := 'Квадратов ' + IntToStr( SCnt );

end;

procedure TForm1.img1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var iX, iY : integer;
begin
  iX := X div PointW + 1;
  iY := Y div PointH + 1;
  AddPointNode( pointListRoot, iX, iY );

  DestroySquareList( squareListRoot );
  squareListRoot := InitSquareList;

  Invalidate;
  Update;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  pointListRoot := InitPointList;
  squareListRoot := InitSquareList;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DestroyPointList( pointListRoot );
  DestroySquareList( squareListRoot );
end;

procedure TForm1.btn5Click(Sender: TObject);
begin
  DestroySquareList( squareListRoot );
  squareListRoot := FindSquares( pointListRoot );

  Invalidate;
  Update;
end;

procedure TForm1.btn3Click(Sender: TObject);
var i, X, Y : integer;
begin
  for i := 1 to 50 do
  begin
    X := random( GridCols ) + 1;
    Y := random( GridRows ) + 1;
    AddPointNode( pointListRoot, X, Y );
  end;

  Invalidate;
  Update;
end;

procedure ClearAll;
begin
  DestroyPointList( pointListRoot );
  DestroySquareList( squareListRoot );
  pointListRoot := InitPointList;
  squareListRoot := InitSquareList;
end;

procedure TForm1.btn4Click(Sender: TObject);
begin
  ClearAll;

  Invalidate;
  Update;
end;

procedure TForm1.btn1Click(Sender: TObject);
var f : TextFile;
    X, Y : integer;
begin
  if dlgOpen1.Execute then
  begin
    ClearAll;

    AssignFile( f, dlgOpen1.FileName );
    Reset( f );

    while not eof( f ) do
    begin
      readln( f, X );
      readln( f, Y );
      AddPointNode( pointListRoot, X, Y );
    end;

    CloseFile( f );
  end;

  Invalidate;
  Update;
end;

procedure TForm1.btn2Click(Sender: TObject);
var f : TextFile;
    tz : pPointNode;
begin
  if dlgSave1.Execute then
  begin
    AssignFile( f, dlgSave1.FileName );
    Rewrite( f );

    tz := pointListRoot^.Next;

    while tz <> nil do
    begin
      Writeln( f, tz^.Point.X );
      Writeln( f, tz^.Point.Y );

      tz := tz^.Next;
    end;

    CloseFile( f );
  end;

end;

end.
Соседние файлы в папке курсач