Читать онлайн «О чём не пишут в книгах по Delphi». Страница 43

При нажатии кнопки Завершить незавершенная кривая рисуется уже не на самой форме, а на растре, содержащем фон. После этого кривая перестает существовать как кривая и становится набором пикселов на фоновой картинке, а программа вновь переходит в режим, когда нажатие кнопки мыши интерпретируется как создание новой кривой.

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