unit PolyF;
//*******************************************************
// Example program demonstrating linked lists of polygons
// each containing a linked list of points.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//*******************************************************

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls;

type
    PPointCell = ^TPointCell;
    TPointCell = record
        X, Y      : Integer;          // The point's coordinates.
        NextPoint : PPointCell;       // The next point.
    end;
    PPolylineCell = ^TPolylineCell;
    TPolylineCell = record
        NextPolyline : PPolylineCell; // The next polyline.
        FirstPoint   : PPointCell;    // The first point.
    end;

  TPolyForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    mnuExit: TMenuItem;
    Help1: TMenuItem;
    mnuAbout: TMenuItem;
    Picture1: TMenuItem;
    mnuClear: TMenuItem;
    procedure mnuAboutClick(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure mnuClearClick(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    TopPolyline     : PPolylineCell;
    NewPolyline    : PPolylineCell;
    Drawing        : Boolean;
    StartX, StartY : Integer;
    CurX, CurY     : Integer;
  public
    { Public declarations }
  end;

var
  PolyForm: TPolyForm;

implementation

{$R *.DFM}

procedure TPolyForm.mnuAboutClick(Sender: TObject);
const
    CRCR = #13#10#13#10;
    CR = #13#10;
begin

    MessageDlg(
        'Niniejszy program wykorzystuje listę linii łamanych,z których każda' + CR +
        'reprezentowana jest jako lista punktów.' + CRCR +
        'Kliknij lewym przyciskiem, aby dodać nowy punkt do bieżącej linii łamanej.' + CRCR +
        'Kliknij prawym przyciskiem, aby rozpocząć nową linię łamaną.'
        , mtInformation, [mbOK], 0);


end;

procedure TPolyForm.mnuExitClick(Sender: TObject);
begin
     Close;
end;

// Draw the polylines.
procedure TPolyForm.FormPaint(Sender: TObject);
var
    polyline : PPolylineCell;
    point    : PPointCell;
begin
    Canvas.Pen.Mode := pmCopy;
    polyline := TopPolyline;
    while (polyline <> nil) do
    begin
        // Draw this polyline.
        point := polyline^.FirstPoint;
        if (point = nil) then continue;
        Canvas.MoveTo(point^.X, point^.Y);

        point := point^.NextPoint;
        while (point <> nil) do
        begin
            Canvas.LineTo(point^.X, point^.Y);
            point := point^.NextPoint;
        end;

        polyline := polyline.NextPolyline;
    end;

    // Redraw the last rubberband line.
    Canvas.Pen.Mode := pmNot;
    if (Drawing) then
    begin
        Canvas.MoveTo(StartX, StartY);
        Canvas.LineTo(CurX, CurY);
    end;
end;

// Remove all the polylines.
procedure TPolyForm.mnuClearClick(Sender: TObject);
var
    polyline : PPolylineCell;
    point    : PPointCell;
begin
    while (TopPolyline <> nil) do
    begin
        // Free this polyline's points.
        while (TopPolyline^.FirstPoint <> nil) do
        begin
            point := TopPolyline^.FirstPoint;
            TopPolyline^.FirstPoint := point^.NextPoint;
            Dispose(point);
        end;

        // Free this polyline.
        polyline := TopPolyline;
        TopPolyline := polyline^.NextPolyline;
        Dispose(polyline);
    end;
    Refresh;
end;

// Continue rubberband drawing.
procedure TPolyForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    // Do nothing if we're not drawing.
    if (not Drawing) then exit;

    // Erase the old rubberband line.
    Canvas.MoveTo(StartX, StartY);
    Canvas.LineTo(CurX, CurY);

    // Draw the new rubberband line.
    CurX := X;
    CurY := Y;
    Canvas.MoveTo(StartX, StartY);
    Canvas.LineTo(CurX, CurY);
end;

// Finish rubberband drawing.
procedure TPolyForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
    point : PPointCell;
begin
    // On right button, stop drawing the polyline (if any).
    if (Button = mbRight) then
    begin
        NewPolyline := nil;
        // Erase the last rubberband line.
        if (Drawing) then
        begin
            Canvas.MoveTo(StartX, StartY);
            Canvas.LineTo(CurX, CurY);
            Drawing := False;
        end;
        exit;
    end;

    // See if we are drawing a polyline yet.
    if (NewPolyline = nil) then
    begin
        // Start a new polyline.
        New(NewPolyline);
        NewPolyline.FirstPoint := nil;
        NewPolyline.NextPolyline := TopPolyline;
        TopPolyline := NewPolyline;
    end else begin
        // Erase the rubberband line.
        Canvas.MoveTo(StartX, StartY);
        Canvas.LineTo(CurX, CurY);

        // Draw the final line.
        Canvas.Pen.Mode := pmCopy;
        Canvas.MoveTo(StartX, StartY);
        Canvas.LineTo(X, Y);
    end;

    // Add a point to this polyline.
    New(point);
    point^.X := X;
    point^.Y := Y;
    point^.NextPoint := NewPolyline.FirstPoint;
    NewPolyline.FirstPoint := point;

    // The next line starts here.
    StartX := X;
    StartY := Y;
    CurX := X;
    CurY := Y;
    Drawing := True;
    Canvas.Pen.Mode := pmNot;
end;

end.
