Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

рисование линий на Canvas-e любой формы, задаваемые шаблоном [D6, Win95/98, WinME, NT4, Win2k, WinXP]

claus © (2003-11-12 12:02:00)
как на графической канве рисовать линии существующими методами Canvasa, где типов линий не 16, а больше. чтобы их внешний вид можно было задавать неким растровым или векторным шаблоном. Если есть другие пути решения вопроса, не используя Canvas, сообщите о них. Спасибо.

Fenik (2003-11-22 22:43:00) [1]
Лишнего вырезал. Нужен ещё счетчик:

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;
...

Fenik (2003-11-13 09:33:00) [2]
Привожу вырезку из демострационного проекта, который нашел давно на Королевстве.
Думаю, что этого хватит для понимания сути алгоритма.

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

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

...

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

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

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

procedureTLinesForm.FormMouseMove(Sender:TObject;Shift:TShiftState;X,Y:Integer);
begin
ifLineDrawing and((X <> OldX) or(Y <> OldY)) then
withCanvas do
begin
SetROP2(Handle, R2_ not);
Line(BegX, BegY, OldX, OldY); // Стираем старую линию.
Line(BegX, BegY, X, Y); // Рисуем новую.
OldX := X;
OldY := Y
end
end;

procedureTLinesForm.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift:TShiftState;X,Y:Integer);
begin
if(Button = mbLeft) andLineDrawing then
begin
caseRGroupLine.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;

MBo (2003-11-12 13:22:00) [3]
В NT-системах можно создавать свои типы перьев.
Кроме того, есть процедура LineDDA.

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »