SauloBr 0 Denunciar post Postado Maio 26, 2008 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
SauloBr 0 Denunciar post Postado Maio 26, 2008 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
SauloBr 0 Denunciar post Postado Maio 26, 2008 Se precisar e tiver como eu passo o restante do código em word ou .pas mesmo! Abraço! Compartilhar este post Link para o post Compartilhar em outros sites