А. Григорьев - О чём не пишут в книгах по Delphi

Реализацию интерактивной кривой в данном случае иллюстрирует листинг 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;