При нажатии кнопки Завершить незавершенная кривая рисуется уже не на самой форме, а на растре, содержащем фон. После этого кривая перестает существовать как кривая и становится набором пикселов на фоновой картинке, а программа вновь переходит в режим, когда нажатие кнопки мыши интерпретируется как создание новой кривой.
Реализацию интерактивной кривой в данном случае иллюстрирует листинг 1.61.
Листинг 1.61. Реализация интерактивной кривой
const
// чтобы перемещать точку кривой, пользователь должен попасть мышью
// в некоторую ее окрестность. Константа RectSize задает размер этой
// окрестности
RectSize = 3;
type
// Тип TDragPoint показывает, какую точку перемещает пользователь:
// ptNone — пользователь пытается тянуть несуществующую точку
// ptFirst - пользователь перемещает вторую точку "резиновой" прямой
// ptBegin - пользователь перемещает начало кривой
// ptInter1, ptInter2 - пользователь перемещает промежуточные точки
// ptEnd - пользователь перемещает конец кривой
TDragPoint = (dpNone, dpFirst, dpBegin, dpInter1, dpInter2, dpEnd);
TCurveForm = class(TForm)
BtnEnd: TButton;
RGroupType: TRadioGrour;
RGroupDrawMethod: TRadioGroup;
procedure FormCreate(Sender: TObject);
procedure FomMouseDown(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 FormPaint(Sender: TObject);
procedure BtnEndClick(Sender: TObject);
procedure RGroupTypeClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
// Если FNewLine = True, незавершённых кривых нет, и при нажатии на
// кнопку мыши начинает рисоваться новая кривая.
// Если FNewLine = False, есть незавершенная кривая, и нажатия мыши
// интерпретируются как попытки ее редактирования
FNewLine: Boolean;
// Поле FDragPoint указывает, какую точку перемещает пользователь
FDragPoint: TDragPoint;
// Поле FCurve хранит координаты незавершенной кривой
FCurve: TCurve;
// FBack - фоновый рисунок с завершенными кривыми
FBack: TBitmap;
// FCounter - счетчик точек, использующийся при рисовании отрезков
// с помощью LineDDA
FCounter: Integer;
// FDX, FDY - смещения относительно координаты точки кривой для
// рисования поперечной полосы
FDX, FDY: Integer;
// Функция PtNearPt возвращает True, если точка с координатами
// (X1, Y1) удалена от точки Pt по каждой из координат не более
// чем на RectSize
functionPtNearPt(X1, Y1: Integer; const Pt: TPoint): Boolean;
// Процедура DrawCurve рисует кривую по координатам FCurve вида,
// задаваемого RadioGroup.ItemIndex
procedure DrawCurve(Canvas: TCanvas);
end;
...
procedure TCurveForm.FormCreate(Sender: TObject);
begin
FNewLine := True;
FDragPoint := dpNone;
FBack := TBitmap.Create;
FBack.Canvas.Brush.Color := Color;
// Устанавливаем размер фонового рисунка равным размеру развернутого
// на весь рабочий стол окна
FBack.Width := GetSystemMetrics(SM_CXFULLSCREEN);
FBack.Height := GetSystemMetrics(SM_CYFULLSCREEN);
// Включаем режим двойной буферизации, чтобы незавершенная кривая
// не мерцала
DoubleBuffered := True;
end;
procedure TCurveForm.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
// Если незавершенных кривых нет, начинаем рисование новой кривой
if FNewLine then
begin
FDragPoint := dpFirst;
FCurve[0].X := X;
FCurve[0].Y := Y;
FCurve[3] := FCurve[0];
end
else
begin
// Если есть незавершенная кривая, определяем, в какую точку попал
// курсор мыши. Строго говоря, необходимо также запоминать,
// насколько отстоят координаты курсора мыши от координат
// контрольной точки, чтобы при первом перемещении не было скачка.
// Но т.к. окрестность точки очень мала, этот прыжок практически
// незаметен, и в данном случае этим можно пренебречь, чтобы
// не усложнять программу
if PtNearPt(X, Y, FCurve[0]) then FDragPoint := dpBegin
else if PtNearPt(X, Y, FCurve[1]) then FDragPoint := dpInter1
else if PtNearPt(X, Y, FCurve[2]) then FDragPoint : = dpInter2
else if PtNearPt(X, Y, FCurve[3]) then FDragPoint := dpEnd
else FDragPoint := dpNone;
end;
end;
end;
procedure TCurveForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if ssLeft in Shift then
begin
case FDragPoint of
dpFirst, dpEnd: begin
FCurve[3].X := X;
FCurve[3].Y := Y;
Refresh;
end;
dpBegin: begin
FCurve[0].X := X;
FCurve[0].Y := Y;
Refresh;
end;
dpInter1: begin
FCurve[1].X := X;
FCurve[1].Y := Y;
Refresh;
end;
dpInter2: begin
FCurve[2].X := X;
FCurve[2].Y := Y;
Refresh;
end;
end;
end;
end;
procedure TCurve Form.FormMouseUp(Sender: TObject; Button: ТМouseButton; Shift: TShiftState; X, Y: Integer);
begin
// Если кнопка отпущена при отсутствии незавершенной кривой, значит,
// пользователь закончил рисование резиновой прямой, на основе которой
// нужно делать новую кривую
if (Button = mbLeft) and (FDragPoint = dpFirst) then
begin
FNewLine := False;
FDragPoint := dpNone;
// Промежуточные точки равномерно распределяем по прямой
FCurve[1].X := FCurve[0].X + Round((FCurve[3].X - FCurve[0].X) / 3);
FCurve[1].Y := FCurve[0].Y + Round((FCurve[3].Y - FCurve[0].Y) / 3);
FCurve[2].X := FCurve[0].X + Round(2 + (FCurve[3].X - FCurve[0].X) / 3);
FCurve[2].Y := FCurve[0].Y + Round(2 + (FCurve[3].Y - (Curve[0].Y) / 3);
Refresh;
end;
end;
procedure TCurveForm.FormPaint(Sender: TObject);
var
I: Integer;
L: Extended;
begin
// Сначала выводим фон
Canvas.Draw(0, 0, FBack);
if FNewLine then
begin
// Если программа находится в режиме рисования резиновой прямой,
// рисуем прямую от точки FCurve[0] до FCurve[3]. Значение FCurve[1]
// и FCurve[2] на данном этапе игнорируется
if FDragPoint = dpFirst then
begin
FCounter := 0;
L :=
Sqrt(Sqr(FCurve[0].X - FCurve[3].X) +
Sqr(FCurve[0].Y - FCurve[3].Y));
if L > 0 then
begin
FDX := Round(4 * (FCurve[0].Y -FCurve[3].Y) / L);
FDY := Round(4 * (FCurve[3].X - FCurve[0].X) / L);
LineDDA(FCurve[0].X, FCurve[0].Y, FCurve[3].X, FCurve[3].Y,
@LineDrawFunc, Integer(Canvas));
end;
end;
end
else
begin
// Если есть незавершённая кривая и установлен режим рисования
// по опорным точкам, выводим отрезки, показывающие касательные
// к кривой в её начале и конце
if RGroupDrawMethod.ItemIndex = 0 then
begin
Canvas.Pen.Style := psDot;
Canvas.Pen.Width := 3;
Canvas.Pen.Color := clDkGrey;
Canvas.MoveTo(FCurve[0].X, FCurve[0].Y);
Canvas.LineTo(FCurve[1].X, FCurve[1].Y);
Canvas.MoveTo(FCurve[3].X, FCurve[3].Y);
Canvas.LineTo(FCurve[2].X, FCurve[2].Y);
end;
// Рисуем красные квадраты, показывающие точки, которые пользователь
// может перемещать
Canvas.Pen.Style := psSolid;
Canvas.Pen.Width := 1;
Canvas.Pen.Color := clRed;
Canvas.Brush.Style := bsClear;
for I := 0 to 3 do
Canvas.Rectangle(FCurve[I].X - RectSize, FCurve[I].Y - RectSize,
FCurve[I].X + RectSize + 1, FCurve[I].Y + RectSize + 1);
end;
end;
// функция PtNearPt возвращает True, если точка с координатами (X1, Y1)
// удалена от точки Pt по каждой из координат не более чем на RectSize
function TCurveForm.PtNearPt(X1, Yl: Integer; const Pt: TPoint): Boolean;
begin
Result :=
(X1 >= Pt.X - RectSize) and (X1 <= Pt.X + RectSize) and
(Y1 >= Pt.Y - RectSize) and (Y1 <= Pt.Y + RectSize);
end;
procedure TCurveForm.BtnEndClick(Sender: TObject);
begin
if not FNewLine then
