this slowpoke moves

Calculate Canvas Bezier

public
    { Public declarations }
    Arr_pt: Array[0..3] Of TPoint;
    DraggingPt: Boolean;
    IndDraggingPt: Integer;
    function PontoEm(x, y: Integer; Ponto: TPoint): Boolean;
    
//

procedure TForm1.Button1Click(Sender: TObject);
begin
  Arr_pt[0] := Point(StrToInt(Edit1.Text), StrToInt(Edit3.Text));
  Arr_pt[1] := Point(StrToInt(Edit3.Text), StrToInt(Edit4.Text));
  Arr_pt[2] := Point(StrToInt(Edit5.Text), StrToInt(Edit6.Text));
  Arr_pt[3] := Point(StrToInt(Edit7.Text), StrToInt(Edit8.Text));

  PaintBox1.Refresh;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  DraggingPt := False;
  Button1.OnClick(Nil);
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);

        procedure DesenharPonto(Ponto: TPoint; CorPen: TColor; CorBrush: TColor);
        begin
          PaintBox1.Canvas.Pen.Color   := CorPen;
          PaintBox1.Canvas.Brush.Color := CorBrush;

          PaintBox1.Canvas.Rectangle(Ponto.X-2, Ponto.Y-2, Ponto.X+2, Ponto.Y+2);
        end;

        procedure MoverPara(Ponto: TPoint);
        begin
          PaintBox1.Canvas.MoveTo(Ponto.x, Ponto.Y);
        end;

        procedure Linha(PontoInicial: TPoint; PontoFinal: TPoint; Cor: TColor);
        begin
          PaintBox1.Canvas.Pen.Color := Cor;
          MoverPara(PontoInicial);
          PaintBox1.Canvas.LineTo(PontoFinal.X, PontoFinal.Y);
        end;

begin
  With PaintBox1.Canvas Do
  begin
    Brush.Color := clWhite;
    Pen.Color   := clBlack;
    FillRect(PaintBox1.ClientRect);
    PolyBezier(Arr_pt);
    Linha(Arr_pt[0], Arr_pt[1], clRed);          // P1 e P2 ...
    Linha(Arr_pt[3], Arr_pt[2], clRed);          // P4 e P3 ...
    DesenharPonto(Arr_pt[0], clBlack, clYellow);
    DesenharPonto(Arr_pt[1], clBlack, clBlack);
    DesenharPonto(Arr_pt[2], clBlack, clBlack);
    DesenharPonto(Arr_pt[3], clBlack, clYellow);
  end;
end;

function  TForm1.PontoEm(x, y: Integer; Ponto: TPoint): Boolean;
begin
  RESULT := (Ponto.X >= x-2) And (Ponto.X <= x+2)
              And (Ponto.y >= y-2) And (Ponto.y <= y+2);
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  DraggingPt := False;

  If PontoEm(x, y, Arr_pt[0])
  Then Begin
    DraggingPt := True;
    IndDraggingPt := 0;
  End;

  If PontoEm(x, y, Arr_pt[1])
  Then Begin
    DraggingPt := True;
    IndDraggingPt := 1;
  End;

  If PontoEm(x, y, Arr_pt[2])
  Then Begin
    DraggingPt := True;
    IndDraggingPt := 2;
  End;

  If PontoEm(x, y, Arr_pt[3])
  Then Begin
    DraggingPt := True;
    IndDraggingPt := 3;
  End;

  If DraggingPt
  Then PaintBox1.Cursor := crHandPoint;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  If DraggingPt
  Then Begin
    Arr_pt[IndDraggingPt] := Point(x, y);
    TEdit( FindComponent('E' + IntToStr(IndDraggingPt)+ 'X') ).Text := IntToStr(x);
    TEdit( FindComponent('E' + IntToStr(IndDraggingPt)+ 'Y') ).Text := IntToStr(y);
    PaintBox1Paint(Nil);
  End
  Else
    If PontoEm(x, y, Arr_pt[0]) Or PontoEm(x, y, Arr_pt[1])
      Or PontoEm(x, y, Arr_pt[2]) Or PontoEm(x, y, Arr_pt[3])
    Then PaintBox1.Cursor := crHandPoint
    Else PaintBox1.Cursor := crDefault;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  If DraggingPt
  Then Begin
    PaintBox1MouseMove(PaintBox1, Shift, x, y);
    DraggingPt := False;
    PaintBox1.Cursor := crDefault;
  End;
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate