Главная » Delphi » Графика » Рисуем ломаную линию и таскаем её за точки.

Рисуем ломаную линию и таскаем её за точки.

15:35
Скриншот - 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.