K210.ORG

Скриншот - http://dfc.com.ru/img/lines_screen.gif

Unit1.dfm

object Form1: TForm1

  Left = 192

  Top = 118

  Width = 870

  Height = 640

  Caption = 'Lines'

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'MS Sans Serif'

  Font.Style = []

  OldCreateOrder = False

  Position = poScreenCenter

  OnCreate = FormCreate

  PixelsPerInch = 96

  TextHeight = 13

  object Panel1: TPanel

    Left = 0

    Top = 0

    Width = 720

    Height = 589

    Align = alClient

    BevelOuter = bvLowered

    Color = clBlack

    TabOrder = 0

    object PaintBox1: TPaintBox

      Left = 1

      Top = 1

      Width = 718

      Height = 587

      Align = alClient

      ParentShowHint = False

      ShowHint = True

      OnMouseDown = PaintBox1MouseDown

      OnMouseMove = PaintBox1MouseMove

      OnMouseUp = PaintBox1MouseUp

      OnPaint = PaintBox1Paint

    end

  end

  object StatusBar1: TStatusBar

    Left = 0

    Top = 589

    Width = 862

    Height = 19

    Panels = <>

    SimplePanel = False

  end

  object Panel2: TPanel

    Left = 720

    Top = 0

    Width = 142

    Height = 589

    Align = alRight

    BevelOuter = bvNone

    TabOrder = 2

    DesignSize = (

      142

      589)

    object GroupBox1: TGroupBox

      Left = 4

      Top = 8

      Width = 133

      Height = 85

      Caption = #1052#1077#1083

      TabOrder = 0

      object Label1: TLabel

        Left = 8

        Top = 24

        Width = 49

        Height = 13

        Caption = #1058#1086#1083#1097#1080#1085#1072':'

      end

      object Label2: TLabel

        Left = 12

        Top = 56

        Width = 28

        Height = 13

        Caption = #1062#1074#1077#1090':'

      end

      object UpDown1: TUpDown

        Left = 109

        Top = 20

        Width = 15

        Height = 21

        Associate = Edit1

        Min = 0

        Max = 10

        Position = 2

        TabOrder = 0

        Wrap = False

        OnClick = UpDown1Click

      end

      object Edit1: TEdit

        Left = 64

        Top = 20

        Width = 45

        Height = 21

        ReadOnly = True

        TabOrder = 1

        Text = '2'

      end

      object Panel3: TPanel

        Left = 64

        Top = 52

        Width = 61

        Height = 21

        Color = clWhite

        TabOrder = 2

        OnClick = Panel3Click

      end

    end

    object GroupBox2: TGroupBox

      Left = 4

      Top = 100

      Width = 133

      Height = 49

      Caption = #1044#1086#1089#1082#1072

      TabOrder = 1

      object Label3: TLabel

        Left = 8

        Top = 20

        Width = 28

        Height = 13

        Caption = #1062#1074#1077#1090':'

      end

      object Panel4: TPanel

        Left = 64

        Top = 16

        Width = 61

        Height = 21

        Color = clBlack

        TabOrder = 0

        OnClick = Panel4Click

      end

    end

    object Memo1: TMemo

      Left = 0

      Top = 524

      Width = 142

      Height = 65

      Align = alBottom

      Color = clBtnFace

      Lines.Strings = (

        '  '#1051#1077#1074#1072#1103' '#1082#1085#1086#1087#1082#1072' - '#1089#1086#1079#1076#1072#1090#1100' '

        #1090#1086#1095#1082#1091','

        '  '#1055#1088#1072#1074#1072#1103' '#1082#1085#1086#1087#1082#1072' - '#1091#1076#1072#1083#1080#1090#1100' '

        #1090#1086#1095#1082#1091'.')

      ReadOnly = True

      TabOrder = 2

    end

    object Button1: TButton

      Left = 24

      Top = 492

      Width = 97

      Height = 25

      Anchors = [akLeft, akBottom]

      Caption = #1054#1095#1080#1089#1090#1080#1090#1100

      TabOrder = 3

      OnClick = Button1Click

    end

  end

  object ColorDialog1: TColorDialog

    Ctl3D = True

    Left = 704

    Top = 52

  end

  object ColorDialog2: TColorDialog

    Ctl3D = True

    Left = 696

    Top = 116

  end

end

Unit1.pas

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ExtCtrls, ComCtrls, StdCtrls;

 

type

  TForm1 = class(TForm)

    Panel1: TPanel;

    StatusBar1: TStatusBar;

    Panel2: TPanel;

    GroupBox1: TGroupBox;

    UpDown1: TUpDown;

    Edit1: TEdit;

    PaintBox1: TPaintBox;

    Label1: TLabel;

    Panel3: TPanel;

    Label2: TLabel;

    ColorDialog1: TColorDialog;

    GroupBox2: TGroupBox;

    Label3: TLabel;

    Panel4: TPanel;

    ColorDialog2: TColorDialog;

    Memo1: TMemo;

    Button1: TButton;

    procedure FormCreate(Sender: TObject);

    procedure PaintBox1Paint(Sender: TObject);

    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,

      Y: Integer);

    procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);

    procedure Panel3Click(Sender: TObject);

    procedure Panel4Click(Sender: TObject);

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

    ptarray: array of TPoint;

    count, PenWidth: integer;

    drag: boolean;

    dragpoint: integer;

    procedure DeletePoint(ptNumber: integer);

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

procedure TForm1.FormCreate(Sender: TObject);

begin

  PaintBox1.canvas.Pen.Width := 2;

  PaintBox1.canvas.Pen.Color := clWhite;

  PaintBox1.color := clBlack;

  Panel1.DoubleBuffered := true;

  PenWidth := 2;

end;

 

procedure TForm1.DeletePoint(ptNumber: integer);

var

  i, j: integer;

begin

  i := 0;

  j := 0;

  while i <> High(ptarray) do begin

    if j = ptNumber then inc(j);

    ptarray[i].X := ptarray[j].X;

    ptarray[i].Y := ptarray[j].Y;

    inc(i);

    inc(j);

  end;

  Dec(count);

  setlength(ptarray, count);

end;

 

procedure TForm1.PaintBox1Paint(Sender: TObject);

var

  i, x, y: integer;

begin

  for i := 0 to High(ptarray) do begin

    x := ptarray[i].X;

    y := ptarray[i].Y;

    with PaintBox1.Canvas do begin

      if i = 0 then

        MoveTo(x, y);

      Pen.Width := PenWidth;

      LineTo(x, y);

      MoveTo(x, y);

      Pen.Width := 1;

      Ellipse(x - 3, y - 3, x + 3, y + 3);

    end;

  end;

 

end;

 

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  drag := false;

  if count = 0 then

    PaintBox1.cursor := crDefault;

end;

 

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  if Button = mbRight then begin

    if count = 0 then begin

      //cursor := crDefault;

      exit;

    end;

    if PaintBox1.cursor = crHandPoint then begin

      DeletePoint(dragpoint);

      PaintBox1.Invalidate;

      exit;

    end;

  end;

  if PaintBox1.cursor = crHandPoint then begin

    drag := true;

    exit;

  end

  else

    drag := false;

  inc(count);

  setlength(ptarray, count);

  ptarray[count - 1] := Point(x, y);

  with PaintBox1.Canvas do begin

    Pen.Width := PenWidth;

    if count <> 1 then

      LineTo(x, y);

    MoveTo(x, y);

    Pen.Width := 1;

    Ellipse(x - 3, y - 3, x + 3, y + 3);

  end;

end;

 

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

var

  i: integer;

begin

  statusbar1.SimpleText := inttostr(x) + ':' + inttostr(y);

  if drag then begin

    ptarray[dragpoint].X := X;

    ptarray[dragpoint].Y := Y;

    PaintBox1.Invalidate;

  end;

  for i := 0 to High(ptarray) do begin

    if ptinrect(rect(ptarray[i].x - 3, ptarray[i].y - 3, ptarray[i].x + 3, ptarray[i].y + 3),

      point(x, y)) then begin

      PaintBox1.cursor := crHandPoint;

      dragpoint := i;

      exit;

    end else begin

      PaintBox1.cursor := crDefault;

    end;

  end;

 

end;

 

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);

begin

  PenWidth := UpDown1.Position;

  PaintBox1.Invalidate;

end;

 

procedure TForm1.Panel3Click(Sender: TObject);

begin

  if ColorDialog1.Execute then begin

    Panel3.Color := ColorDialog1.Color;

    PaintBox1.canvas.Pen.Color := Panel3.Color;

    PaintBox1.Invalidate;

  end;

end;

 

procedure TForm1.Panel4Click(Sender: TObject);

begin

  if ColorDialog2.Execute then begin

    Panel4.Color := ColorDialog2.Color;

    Panel1.Color := Panel4.Color;

    PaintBox1.Invalidate;

  end;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

  count := 0;

  setlength(ptarray, count);

  PaintBox1.Invalidate;

end;

 

end.