Главная » 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.