Canvas dolor de cabeza+helpme

[Comandant]

Hola a todos este es mi primer post asi que espero hacerme entender.
Bien mi problema radica en que quiero copiar un canvas que creo en una imagen. Bien ya esta casi todo menos la ubicación exacta del canvas origen que aun no he podido resolver, ya que en el canvas destino me sale corrido. Desde ya muchas gracias.
//Creo k se puede probar al tok poniendo un timage y sus respectivos eventos.

...
public
var
alto, ancho, StartX, StartY : integer;
...
procedure TForm1.imagenMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
begin
//para sakar el inicio del canvas
StartX:= X;
StartY:= Y;
end;


procedure TForm1.imagenMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Origen, Destino, R: TRect;
begin
//realizar el canvas
Canvas.Brush.Style:= bsClear;
with Canvas do
begin
R.Left := StartX;
R.Top := StartY;
R.Right := x;
R.Bottom := y;
Canvas.Rectangle(R);
Origen:= R;
Destino.Left := 0;
Destino.Top := 0;
Destino.Right := ancho;
Destino.Bottom := alto;
CopyRect( Destino, Imagen.Canvas, Origen );
end;
end;


procedure TForm1.imagenMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
arriba, abajo, izquierda, derecha: integer;
begin
//para sakar el alto y el ancho
if ssLeft in Shift then { make sure button is down }
begin
if Y > StartY then
begin
abajo:= Y;
arriba:= StartY;
end
else
begin
arriba:= Y;
abajo:= StartY;

end;
if X > StartX then
begin
izquierda:= StartX;
derecha:= X;
end
else
begin
izquierda:= X;
derecha:= StartX;
end;
alto:= abajo - arriba;
ancho:= derecha - izquierda;
end;
end;

[Casimiro Notevi]

Bienvenido a clubdelphi, ¿ya leiste nuestra guía de estilo (http://www.clubdelphi.com/foros/guiaestilo.php)?, gracias por tu colaboración :)

Recuerda poner los tags correctos al código fuente, ejemplo:

http://neftali.clubdelphi.com/images/UtilizarTAGs.png

Y no olvides poner títulos descriptivos a tus preguntas, sirven luego para las búsquedas y ordenar los temas: "canvas dolor de cabeza+helme" no es ningún título descriptivo sobre lo que preguntas.

Gracias :)

[Comandant]

Ok perdon no volvera a pasar, creo que no se puede editar titulo y aun así no se me ocurre ninguno jeje. Copiar selección del canvas a otro canvas se me ocurre

[Casimiro Notevi]

Bueno, no te preocupes, es tu primer mensaje en estos foros y es normal que no lo supieras.

Lo del título sirve, entre otras cosas, porque al final de esta página aparecen enlaces con términos similares y puede que alguno sea lo que buscas.
En este caso, como puedes ver, han salido enlaces que no sirven para nada, al igual que el titulo que has puesto.

Creo que lo que quieres es copiar una imagen, supongo que de un TImage a otro sitio, a ver si alguien puede echarte una mano con eso.
Saludos.

[escafandra]

Creo que es esto lo que quieres hacer:
var
StartX, StartY : integer;

procedure TForm1.ImagenMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Origen, Destino: TRect;
begin
Origen.Left := StartX;
Origen.Top := StartY;
Origen.Right := x;
Origen.Bottom := y;

Destino.Left := 0;
Destino.Top := 0;
Destino.Right := abs(Origen.Left - Origen.Right);
Destino.Bottom := abs(Origen.Top - Origen.Bottom);
Canvas.Rectangle(Destino);
Canvas.CopyRect(Destino, Imagen.Picture.Bitmap.Canvas, Origen);
end;

procedure TForm1.ImagenMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
StartX:= X;
StartY:= Y;
end;




Saludos.

[Comandant]

Hola nuevamente, agradezco por su atención y estoy en deuda, aunque hoy estuve viendo mi código y me anduvo muy bien, nose porque la otra vez no me dio el resultado esperado me quede pensando en el porque?, Bien escafandra tu código es lo mismo que el mio nada mas que mas simplificado y me diste nuevas ideas con el valor absoluto, porque había probado de sumar a su left el width de un elemento dado y a veces me daba excepciones por el número negativo, dejo avisando que ambos códigos tienen un problema y es que cuando haces un rectángulo de derecha a izquierda da como un resultado final una imagen tipo espejo, no creo que sea muy difícil de solucionar así que me pondré a trabajar. Desde ya muchas Gracias

Aqui esta código final para los que lo quieran, obviamente el resto ya lo saben...

procedure TForm2.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Origen, Destino: TRect;
begin
//realizar el canvas
Canvas.Brush.Style:= bsClear;
with Canvas do
begin
if StartX > X then
begin
Origen.Left := X;
Origen.Right := StartX;
end
else
begin
Origen.Left := StartX;
Origen.Right := x;
end;
if StartY > Y then
begin
Origen.Top := Y;
Origen.Bottom := StartY;
end
else
begin
Origen.Top := StartY;
Origen.Bottom := y;
end;
Canvas.Rectangle(Origen);
Destino.Left := 0;
Destino.Top := 0;
Destino.Right := abs(Origen.Left - Origen.Right);
Destino.Bottom := abs(Origen.Top - Origen.Bottom);
CopyRect( Destino, Image1.Canvas, Origen);
end;
end;

[escafandra]

cuando haces un rectángulo de derecha a izquierda da como un resultado final una imagen tipo espejo...

Puedes simplificarlo así:
uses Math;
var
StartX, StartY : integer;

procedure TForm1.ImagenMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Origen, Destino: TRect;
begin
Origen.Left := Min(StartX, x);
Origen.Top := Min(StartY, y);
Origen.Right := Max(StartX, x);
Origen.Bottom := Max(StartY, y);;

Destino.Left := 0;
Destino.Top := 0;
Destino.Right := abs(Origen.Left - Origen.Right);
Destino.Bottom := abs(Origen.Top - Origen.Bottom);
Canvas.Rectangle(Destino);
Canvas.CopyRect(Destino, Imagen.Picture.Bitmap.Canvas, Origen);
end;

procedure TForm1.ImagenMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
StartX:= X;
StartY:= Y;
end;



Saludos.