Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

SauloBr

Manipulando linhas do Canvas

Recommended Posts

Bom dia colegas,

 

É o seguinte, tenho os códigos abaixo que manipulam as linhas criadas em canvas. Estou colocando aqui apenas a parte focada nisso, dentro de um programa q to desenvolvendo.

 

Este código abaixo é dos pontos criados nas linhas.

 

procedure TFrmEdituni.DrawPoints;
  var
	i:  WORD;
begin
  WITH FrmEditUni.Canvas DO
  BEGIN

	Pen.Color := clBlack;
	Pen.Style := psSolid;
	Pen.Width := 1;

	For i:=1 to num do
	begin
	 MoveTo(Reta[i].Linha.StartPoint.X, Reta[i].Linha.StartPoint.Y);
	 LineTo(Reta[i].Linha.EndPoint.X,Reta[i].Linha.EndPoint.Y);
	 //LineTo(Reta[i].Linha.StartPoint.X,Reta[i].Linha.StartPoint.Y);
	 repaint;
	end;

	IF   Selecao IN [lsPoint1, lsPoint2, lsLine]
	then begin
	  //Linha selecionada fica Vermelha
	  if apagando then
		Pen.Color :=color
	  else
	  begin
		Pen.Color := clRed;
		Pen.Width := 3;
		MoveTo(Origem.X, Origem.Y);
		LineTo(movept.X, movept.Y);
	  end;
	 // Criação dos Quadrados nas pontas da linha
	  Pen.Width :=2;
	  Pen.Color :=clyellow;   //cor de borda
	  Canvas.Brush.Color :=clblue;   //cor de preenchimento do ponto 1
	  Rectangle (Origem.X-2, Origem.Y-2, Origem.X+2, Origem.Y+2);
	  Canvas.Brush.Color :=clgreen;  // cor de preenchimento do ponto 2
	  Rectangle (movept.X-2, movept.Y-2, movept.X+2, movept.Y+2); 
	  end;
	end;
end;

A seguir os códigos do OnMousemove,OnMouseDown, e Mouse Up

 

procedure TFrmEditUni.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i:integer;
begin

  if button=mbleft then
  begin
	FlagDesenho := True;
	Canvas.MoveTo(X, Y);
	Origem := Point(X, Y);
	MovePt := Point(X, Y);


  Selecao := lsNotSelected;
  PosAntiga := Point(X,Y);
  //Primeiro, prioridade para os extremos, os pontos}
  for i := 1 to 50 do
  begin
  IF   AreaContemPonto(Reta[i].Linha.StartPoint, 2, PosAntiga)
  THEN Selecao := lsPoint1
  ELSE
	IF   AreaContemPonto(Reta[i].Linha.EndPoint, 2, PosAntiga)
	THEN Selecao := lsPoint2;
  IF   Selecao IN [lsPoint1, lsPoint2, lsLine]
  THEN BEGIN
	lnsel := i;
	origem := Reta[i].Linha.StartPoint;
	movept := Reta[i].Linha.EndPoint;
	Screen.Cursor := crDrag;
	RestrigirArea(self);
	break;
  END
  end;
  IF Selecao = lsNotSelected then   // prioridade para as linhas depois
  for i := 1 to 50 do
  begin
  IF   LinhaProxima(PosAntiga, Reta[i].Linha.StartPoint, Reta[i].Linha.EndPoint)
	THEN Selecao:= lsLine;
  IF   Selecao IN [lsLine]
  THEN BEGIN
	lnsel := i;
	Origem:= Reta[i].Linha.StartPoint;
	Movept:= Reta[i].Linha.EndPoint;
	Screen.Cursor := crDrag;
	RestrigirArea(Frmedituni);
	break;
  END
  end;

  drawpoints;
  //repaint;
  end;
end;
procedure TFrmEditUni.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i:integer;
begin
case  Ferramenta of

frLinha:

	begin
	 apagando:=false;
	 If movelinha = false then   // se não tiver manipulando linha
	 begin

   //  Canvas.MoveTo(Origem.X, Origem.Y);
   //  Canvas.LineTo(X, Y);
   //  flagdesenho:=false;

	  //Grava informações sobre as linhas criadas no record
	  num:=num+1;
	  Reta[num].Id := num;
	  Reta[num].Nome :='Linha'+inttostr(num);
	  Reta[num].Linha.StartPoint :=Origem;
	  Reta[num].Linha.EndPoint := Movept;

	  drawpoints;

	// Mostra valores na lista a cada linha criada
	  vleobjeto.Strings.clear;
	  vleObjeto.Values['Nome']:=  Reta[num].Nome;
	  vleObjeto.Values['Ponto Inicial']:= inttostr(Reta[num].Linha.StartPoint.X);
	  vleObjeto.Values['Ponto Final']:=inttostr(Origem.y);//inttostr(Reta[i].Linha.StartPoint.y);
	 end;
	   if (button=mbleft) then
		 begin
		   Canvas.MoveTo(Origem.X, Origem.Y);
		   Canvas.LineTo(X, Y);
		   FlagDesenho := False;
		 end;
	end;

end;
  movelinha:=false;
  Screen.Cursor := crDefault;
  Selecao := lsNotSelected;
  RemoveRestricaoCursor;

 For i:= 0 to num do
 begin
  if Reta[i].Id <> 0 then   // se linha diferente de apagada
  begin
   canvas.pen.width:= frmprefer.linha;
   canvas.Pen.Color := frmprefer.corlinha;
   Canvas.MoveTo(Reta[i].Linha.StartPoint.x,Reta[i].Linha.StartPoint.y);
   Canvas.LineTo(Reta[i].Linha.EndPoint.x ,Reta[i].Linha.EndPoint.y );
  end;
 end;
end;

Compartilhar este post


Link para o post
Compartilhar em outros sites

Continuando...o MouseMove

 

 

procedure TFrmEditUni.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
 Delta:  TPoint;
	 i: integer;
 setacursor : integer;
begin
  frmedituni.Cursor := crdefault;
  case Ferramenta of

  frLinha :

	begin
	  Screen.cursor:= crcross;
	  if FlagDesenho then
	  begin
		Canvas.Pen.Mode := pmNotXor; { usa o modo XOR para . desenhar}
		Canvas.MoveTo(Origem.X, Origem.Y); {move a caneta para a origem}
		Canvas.LineTo(MovePt.X, MovePt.Y); { apaga a linha . anterior}
		Canvas.MoveTo(Origem.X, Origem.Y); { volta para a origem}
		Canvas.LineTo(X, Y); { desenha a nova . linha}
	  end;

	   MovePt := Point(X, Y); { memoriza as coordenadas para o próximo movimento}
	   Canvas.Pen.Mode := pmCopy; {retorna ao modo Copy (default)}
	IF   Selecao IN [lsPoint1, lsPoint2, lsLine]
		THEN BEGIN
		// Update the moving point(s)
		 CASE Selecao OF
		  lsPoint1:;
		  lsPoint2:;
		  lsLine :  BEGIN
						Delta := SubtrairPontos( Point(X,Y), PosAntiga );
						PosAntiga := Point(X,Y);
						Origem := AddPontos(origem, Delta);
						Movept := AddPontos(Movept, Delta);
						movelinha:=true;
					 END
		  END;
		 Reta[lnsel].Linha.StartPoint := Origem;
		 Reta[lnsel].Linha.EndPoint := Movept;
		// Make background "white"
		//  Canvas.Brush.Color := color;
		//  Canvas.FillRect(Frmedituni.Canvas.cliprect );
		  DrawPoints;
	   END
	   ELSE
		BEGIN
		 for i := 1 to num do
		  IF  AreaContemPonto(Reta[i].Linha.StartPoint, 2, Point(X,Y) ) OR
		  AreaContemPonto(Reta[i].Linha.EndPoint, 2, Point(X,Y) ) OR
		  LinhaProxima(Point(X,Y), Reta[i].Linha.StartPoint, Reta[i].Linha.EndPoint)
		  THEN
		  begin setacursor := 1; break; end
		  ELSE  setacursor := 2;
		  if SetaCursor = 1 then
		  begin
		  Screen.Cursor := crHandPoint;
		  vleobjeto.Strings.clear;
		  end
		  else
		  Screen.Cursor := crcross;
		  END;

	end;

end;

  Label2.Caption := 'Coordenadas:' + ' X:'+inttostr(x)+'	 Y:'+inttostr(y);

end;

Ai eu pergunto, como eu faço para apagar corretamente as linhas? Por este código eu consigo apagar, mas depois desenhando outras linhas , as anteriores aparecem de novo.

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.