О чём не пишут в книгах по Delphi

Григорьев Антон Борисович

// с помощью 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);