рисование линий на Canvas-e любой формы, задаваемые шаблоном

← →
claus (2003-11-12 12:02) [0]

как на графической канве рисовать линии существующими методами Canvasa, где типов линий не 16, а больше. чтобы их внешний вид можно было задавать неким растровым или векторным шаблоном. Если есть другие пути решения вопроса, не используя Canvas, сообщите о них. Спасибо.

← →
MBo © (2003-11-12 13:22) [1]

В NT-системах можно создавать свои типы перьев.
Кроме того, есть процедура LineDDA.

← →
Fenik © (2003-11-13 09:33) [2]

Привожу вырезку из демострационного проекта, который нашел давно на Королевстве.
Думаю, что этого хватит для понимания сути алгоритма.

Автор: Григорьев Антон (grigorievab@mail.ru), Черноголовка, 1999
Специально для Королевства Delphi (http://delphi.vitpc.com)

type
TLinesForm = class(TForm)
RGroupLine: TRadioGroup;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;X,Y:Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState;X,Y:Integer);
procedure FormCreate(Sender: TObject);
private
LineDrawing: Boolean;// Эта переменная True, если программа находится в режиме
// рисования линии.
BegX,BegY: Integer; // Здесь хранятся координаты начала "резиновой" линии.
OldX,OldY: Integer; // Здесь хранятся координаты конца "резиновой" линии на
// момент её последнего обновления на экране.
procedure Line(X1, Y1, X2, Y2: Integer);
end;

...

procedure LineDrawCross(X, Y: Integer; Canvas: TCanvas); stdcall;
//Линия, состоящая из отдельных крестиков.
begin
with Canvas do
begin
MoveTo(X - 2, Y);
LineTo(X + 3, Y);
MoveTo(X, Y - 2);
LineTo(X, Y + 3)
end;
end;

procedure TLinesForm.Line;
begin
LineDDA(X1, Y1, X2, Y2, @LineDrawCross, Integer(Canvas));
end;

procedure TLinesForm.FormMouseDown(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
begin
if Button = mbLeft then
begin
MouseCapture := True;
OldX := X;
OldY := Y;
BegX := X;
BegY := Y;
LineDrawing := True
end
end;

procedure TLinesForm.FormMouseMove(Sender:TObject;Shift:TShiftState;X,Y:Integer);
begin
if LineDrawing and ((X <> OldX) or (Y <> OldY)) then
with Canvas do
begin
SetROP2(Handle, R2_not);
Line(BegX, BegY, OldX, OldY); // Стираем старую линию.
Line(BegX, BegY, X, Y); // Рисуем новую.
OldX := X;
OldY := Y
end
end;

procedure TLinesForm.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift:TShiftState;X,Y:Integer);
begin
if (Button = mbLeft) and LineDrawing then
begin
case RGroupLine.ItemIndex of
2: Canvas.Pen.Color := clBlue;
3: begin
Canvas.Brush.Color := clRed;
Canvas.Pen.Color := clRed
end;
4: Canvas.Pen.Color := clGreen
end;
Line(BegX, BegY, X, Y);
LineDrawing := False;
MouseCapture := False
end
end;

Лишнего вырезал. Нужен ещё счетчик:

var Count: Integer;

procedure LineDrawCross(X, Y: Integer; Canvas: TCanvas); stdcall;
//Линия, состоящая из отдельных крестиков.
begin
if Count mod 7 = 0 then
with Canvas do begin
MoveTo(X - 2, Y);
LineTo(X + 3, Y);
MoveTo(X, Y - 2);
LineTo(X, Y + 3)
end;
Inc(Count);
end;

...

procedure TLinesForm.FormMouseDown(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
begin
if Button = mbLeft then
begin
Count := 0;
...

рисование линий на Canvas-e любой формы, задаваемые шаблоном Найти похожие ветки