рисование мышкой в canvas

← →
grrr © (2006-03-25 23:59) [0]

Подскажите пожалуйста, как создать инструмент наподобие карандаша или кисти из paint, которым можно свободно рисовать в canvas? Просто Canvas.Pixels[X, Y] оставляет пропуски, а нужно чтобы их не было. Зарание спасибо

← →
Zeqfreed © (2006-03-26 00:37) [1]

Запоминать предыдущие координаты и соединять с новыми линией. Например, вот так:

{. . . } var { . . . } downed : Boolean = false; oldx, oldy : Integer; { . . . } procedure TForm1.pbMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin downed := true; oldx := X; oldy := Y; end; procedure TForm1.pbMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin downed := false; end; procedure TForm1.pbMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if downed then with pb.Canvas do begin Pen.Color := clNavy; Pen.Width := 2; MoveTo(oldx, oldy); LineTo(X, Y); oldx := X; oldy := Y; end; end; { . . . }

← →
sniknik © (2006-03-26 01:05) [2]

Zeqfreed © (26.03.06 00:37) [1]
попроще

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin with Canvas do begin Pen.Color:= clNavy; Pen.Width:= 2; MoveTo(X, Y); end; end; procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if ssLeft in Shift then Canvas.LineTo(X, Y); end;

← →
grrr © (2006-03-26 04:13) [3]

Спасибо :)

← →
grrr © (2006-03-26 04:41) [4]

Ещё вопрос, при рисовании с большой Canvas.Pen.Width линия получается неровной, как это можно исправить?

← →
sniknik © (2006-03-26 11:26) [5]

> как это можно исправить?
меньше пить, чтобы руки не дрожали? ;)

а вообше попробуй сменить принцип для рисования линий, задавать ей начало и конец. (посмотри как в том же paint-е сделано. кстати там, если точками линию рисовать, тоже криво)
и еще, в дельфевских примерах есть пример простого граф редактора...

← →
grrr © (2006-03-26 11:56) [6]

не так выразился, не неровной а нечеткой, при толщине линии не равной 1 =)
а в простом граф. редакторе линии нет, только геометрические фигуры

← →
ArtemESC © (2006-03-26 12:56) [7]

Запомните N последних точек в массиве, и затем
Canvas.PolyBezierTo(<имя массива>);

← →
ArtemESC © (2006-03-26 13:20) [8]

Думую вот что тебе нужно...

unit PAint;

interface

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

type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
procedure FormCreate(Sender: TObject);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1 : TForm1;
Draw : Boolean;
arr : array[1..10] of TPoint;
Counter: Integer;
lastX, lastY :Integer;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
Canvas.Pen.Color := clGreen;
Canvas.Pen.Style := psSolid;
Draw := False;
Counter := 0;
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Draw := True;
lastX := X;
lastY := Y;
Counter:= 0;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
If not Draw then Exit;
If (X <> lastX) or (Y <> lastY) then
Inc(Counter);
If Counter > 10 then
begin
Canvas.Polyline(arr);
Counter := 1;
arr[1].X := arr[10].X;
arr[1].Y := arr[10].Y;
end else begin
If (X <> lastX) or (Y <> lastY) then
begin
arr[Counter].X := X;
arr[Counter].Y := Y;
lastX := X;
lastY := Y;
end;
end;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Draw := False;
end;

end.

← →
ArtemESC © (2006-03-26 13:24) [9]

Только везде перед Canvas нужно поставить PaintBox1.

← →
sniknik © (2006-03-26 13:36) [10]

> а в простом граф. редакторе линии нет, только геометрические фигуры
и первый из них линия... смотри внимательнее.

> ArtemESC © (26.03.06 13:20) [8]
еще один более сложный способ сделать тоже самое... (а я удивляюсь "и почему программы тормозят?..." ;о))

кстати еще и с глюком (незаметил сначала), не обрабатывается частичное наполнение массива при выходе (MouseUp), в следствии чего недоотрисовка будет.

> Ваш код несколько "угловатый", мой - рабочий...
"угловатость" кода "нерабочестью" не считается (кстати в чем она?) ;о)
а рисует точно то же самое (кроме указаного глюка, и "скачков" с задержкой отрисовки).
а если не видно разницы... зачем платить больше? ;)

рисование мышкой в canvas Найти похожие ветки