MoviendoImagen (Intento)

[bulc]

Quiero hacer un juego de colocar letras (TImage) dentro de cuadros (TShape) o de otra imagen en forma de cuadro, con objeto de formar palabras. La imagen se desplaza debajo del TShape y queda oculta. Además no consigo crear un algoritmo para discriminar qué letra puede quedarse en el cuadro. En fin, es para una escuela. Tal vez algún programador más diestro que yo me pueda echar una mano. He hecho este juego usando Drag and Drop sin problemas. Me lo he tomado como una forma de hacerlo más realista. Ya que con el Drag/Drop desaparece la imagen de la letra.
He aquí el código que he hecho hasta ahora:

unit MoveImage1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
AImage1: TImage;
BImage2: TImage;
Shape1: TShape;
Shape2: TShape;
Shape3: TShape;
Image3: TImage;
procedure AImage1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure AImage1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure AImage1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Moving: Boolean;
MouseDownSpot: TPoint;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Moving:=False;
end;
//
//
procedure TForm1.AImage1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Moving:=True;
MouseDownSpot.X := x;
MouseDownSpot.Y := Y;
end;
//
//
procedure TForm1.AImage1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
Var
Image: TImage;
begin
if Moving then begin // Se hizo true en MouseDown.
TImage(Sender).Left := TImage(Sender).Left - (MouseDownSpot.x - x);
TImage(Sender).Top := TImage(Sender).Top - (MouseDownSpot.y - y);
TImage(Sender).ShowHint := True;
Image := TImage(Sender);
// dentro del Parent
if (Image.Left < 0) then begin
Image.Left := 0;
end;
if (Image.Top < 0) then
begin Image.Top := 0; end;
if ((Image.Left + Image.Width) >= TImage(Sender).Parent.Width) then
begin
Image.Left := (TImage(Sender).Parent.Width - Image.Width)
end;
if ((Image.Top + Image.Height) >= TImage(Sender).Parent.Height) then
begin
Image.Top := (TImage(Sender).Parent.Height - Image.Height)
end;
end;
end;
//
//
procedure TForm1.AImage1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Var
ImgName:String;
begin // 1
if Moving then begin //2
ReleaseCapture;
Moving := false;
TImage(Sender).Left := TImage(Sender).Left - (MouseDownSpot.x - x);
TImage(Sender).Top := TImage(Sender).Top - (MouseDownSpot.y - y);
TImage(Sender).Cursor:=crDefault;
end; //2
if (Sender is TImage) then
begin //3
ImgName:= (Sender as TImage).Name;
ImgName:= COPY(ImgName,1,1);
//Last := TImage(Sender);
ShowMessage(ImgName+' ' + IntToStr(X) +' ' + IntToStr(Y) );
if ((ImgName ='A' ) AND (( (X>38) and(X<65)) AND ((Y>46) and (y<58)))) then
BEGIN //4
(Sender as TImage).Visible:=False;
//Image3.Visible:=True;
END;//4
end; //3
end; //1
end.

Gracias.
Bulc

[ecfisa]

Hola bulc.

Fijate si te sirve este ejemplo (basado en el hilo: Mover TSpeedButton en Runtime (http://www.clubdelphi.com/foros/showthread.php?t=82787)):

...
implementation

var
ori: TPoint;
CtrlPress: Boolean = False;

procedure TForm1.FormCreate(Sender: TObject);
begin
// Imágenes al frente
Image1.BringToFront;
Image2.BringToFront;
DoubleBuffered:= True;
end;

procedure TForm1.ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ori:= Point( X, Y );
CtrlPress:= ssCtrl in Shift;
end;

procedure TForm1.ImageMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if CtrlPress then
with TImage(Sender) do
begin
Left := X - ori.X + Left;
Top := Y - ori.Y + Top;
end;
end;

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

no olvides asignar los eventos ImageMouseDown, ImageMouseMove e ImageMouseUp a los eventos correspondientes de cada uno de los TImage que utilices.

Saludos :)

[bulc]

Muchas gracias ecfisa. !Siempre tan a punto!
He añadido (en el evento onMouseDown) la linea:

IF (Sender is TImage) then (Sender as TImage).BringToFront;

Y ya puedo posar las letras imágenes en los cuadros de texto. Pensaba que era algo así como StayOnTop, pero es lo que tú dices.
Me puedes decir, ¿cómo identifico cada TImage para que se detenga en cada TShape la letra correcta? Dame una pista y ya intento hacerlo yo.
He probado con las coordenadas y no me va bien.
¿O tal vez el código enviado cubre este aspecto?

[Neftali [Germán.Estévez]]

Te dejo esta entrada antigua en mi blog donde se habla de crear imágene en runtime y moverlas con el ratón (http://neftali.clubdelphi.com/?p=170).
A ver si te sirve de algo. La técnica es similar a la que estás utilizando.

Tienes el código fuente del ejemplo por si quieres echarle un vistazo.

[bulc]

Hola ecfisa.
Mi pregunta era sobre cómo discriminar el TImage correcto, cuando este se deja sobre uno de los cuadros TShape, en concreto sobre el que le corresponde.
Ya sé crear TImages at runtime. Lo que no sé es cómo validar el TImage que se lleva dentro del TShape al hacer MouseUp. He pensado que tal vez se pueden poner los TShape con valor Unabled:=False y luego
al coger el TImage (letra) correcta habilitarlo. He intentado usar los parámetros X,Y de situación pero el MouseUp proporciona los parámetros del TImage movido y no los del TShape.
En fin, si no supone mucho marear la perdiz, tal vez a alguien se le ocurra algo. Cuando usas el Drag/Drop tienes los valores del Source y del Sender que facilitan mucho la labor. Seguiré intentándolo.
Perdona por la insistencia en ese punto.
Saludos, bulc.

[ecfisa]

Hola bulc.

Supongo que debe haber mejores formas, pero es la que se me ocurrió ahora...

La idea, basicamente, consiste en asignarle a cada dupla image-shape un mismo número en la propiedad Tag, datos estos que se verifican en el evento OnMouseDown. Al finalizar el mensaje del resultado, las imágenes vuelven a su lugar de origen para iniciar un nuevo intento.

El ejemplo utiliza la función IntersectRect (https://msdn.microsoft.com/en-us/library/windows/desktop/dd145001%28v=vs.85%29.aspx) para determinar si la imágen toca el shape correspondiente, por lo que los shapes deben estar separados por una distancia que impida que la imagen toque dos al mismo tiempo.


...
implementation

var
ori : TPoint;
CtrlPress : Boolean = False;
ShapeArray : array of TShape;
ImageArray : array of TPoint;

procedure TForm1.FormCreate(Sender: TObject);
var
i, cs, ci: Integer;
sh: TShape;
begin
Image1.BringToFront;
Image2.BringToFront;
Image3.BringToFront;
Image1.Tag := 1;
Image2.Tag := 2;
Image3.Tag := 3;
DoubleBuffered:= True;

for i:= 0 to ComponentCount-1 do
begin
if Components[i] is TShape then
begin
SetLength ( ShapeArray, Length( ShapeArray ) + 1 );
ShapeArray [High( ShapeArray )]:= TShape( Components[i] );
end;
if Components[i] is TImage then
begin
SetLength ( ImageArray, Length( ImageArray ) + 1 );
ImageArray[High( ImageArray )].X := TImage( Components[i] ).Left;
ImageArray[High( ImageArray )].Y := TImage( Components[i] ).Top;
end;
end;
end;

procedure TForm1.ImagesMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ssCtrl in Shift then
begin
ori := Point( X, Y );
CtrlPress:= True;
end;
end;

procedure TForm1.ImagesMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if CtrlPress then
with TImage( Sender ) do
begin
Left := X - ori.X + Left;
Top := Y - ori.Y + Top;
end;
end;

procedure TForm1.ImagesMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
im: TImage;
i, sh : Integer;
R : TRect;
ok: Boolean;
begin
if CtrlPress then
begin
CtrlPress:= False;
im := TImage( Sender );
ok := False;

for i:= Low( ShapeArray ) to High( ShapeArray ) do
if IntersectRect( R, im.BoundsRect, ShapeArray[i].BoundsRect ) then
if im.Tag = ShapeArray[i].Tag then
begin
sh:= ShapeArray[i].Tag;
ok := True;
end;

if ok then
ShowMessage( '¡Correcto!' )
else
ShowMessage('Inténtalo otra vez');

TImage(Sender).Left := ImageArray[im.Tag-1].X;
TImage(Sender).Top := ImageArray[im.Tag-1].Y;
end;
end;
end.


La prueba tiene este formato inicial:
http://sia1.subirimagenes.net/img/2015/04/09/150409051810281130.jpg

(Te adjunto el código fuente)
Saludos :)

[bulc]

Ecfisa, el hecho de tener que separar los TShape de destino es un impedimento, ya que en mi caso, los destinos mostrarán letras. Pero bueno, tu esfuerzo ya es de agradecer. Probaré con esa técnica. Yo había pensado en inhabilitar los TShape de partida y habilitar el correcto al hacer MouseDown de la imagen correspondiente. También pensé en hacer lo mismo usando las coordenadas del TShape correcto. Pero el TImage da las TPoint del TImage al hacer el evento OnMouseUp, no las del Form que serían más útiles. En fin, le daré vueltas a ver qué pasa.
Muchas gracias, ecfisa.
Bulc

[ecfisa]

Hola bulc.
el hecho de tener que separar los TShape de destino es un impedimento, ya que en mi caso, los destinos mostrarán letras.
No se si entiendo el comportamiento del juego, pero si los Shapes estan juntos, estimo que las imágenes serán de menor tamaño que los primeros y en ese caso no tendrías problema.

Saludos :)

[ecfisa]

Hola bulc.

Bueno, de todos modos cambié un poquito el código para que te indique exáctamente cuando está dentro del shape, de modo que puedan estar lindantes.

implementation {$R *.dfm}

var
ori : TPoint;
CtrlPress : Boolean = False;
ShapeArray : array of TShape;
ImageArray : array of TRect;

procedure TForm1.FormCreate(Sender: TObject);
var
i, cs, ci: Integer;
sh: TShape;
begin
Image1.BringToFront;
Image2.BringToFront;
Image3.BringToFront;
Image1.Tag := 1;
Image2.Tag := 2;
Image3.Tag := 3;
DoubleBuffered:= True;

for i:= 0 to ComponentCount-1 do
begin
if Components[i] is TShape then
begin
SetLength ( ShapeArray, Length( ShapeArray ) + 1 );
ShapeArray [High( ShapeArray )]:= TShape( Components[i] );
end;
if Components[i] is TImage then
begin
SetLength ( ImageArray, Length( ImageArray ) + 1 );
ImageArray[High( ImageArray )].Left := TImage( Components[i] ).Left;
ImageArray[High( ImageArray )].Top := TImage( Components[i] ).Top;
end;
end;
end;

procedure TForm1.ImagesMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ssCtrl in Shift then
begin
ori := Point( X, Y );
CtrlPress:= True;
end;
end;

procedure TForm1.ImagesMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if CtrlPress then
with TImage( Sender ) do
begin
Left := X - ori.X + Left;
Top := Y - ori.Y + Top;
end;
end;

procedure TForm1.ImagesMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
function IsInShape(I: TImage; S: TShape): Boolean;
begin
Result:= ((I.Left > S.Left)and(I.Top > S.Top)) and
((I.Left+I.Width < S.Left+S.Width)and(I.Top+I.Height < S.Top+S.Height));
end;
var
img: TImage;
i : Integer;
R : TRect;
ok : Boolean;
begin
if CtrlPress then
begin
CtrlPress:= False;
img := TImage( Sender );
ok := False;
for i:= Low( ShapeArray ) to High( ShapeArray ) do
if IsInShape(img, ShapeArray[i]) then
if img.Tag = ShapeArray[i].Tag then
begin
ok := True;
Break;
end;
if ok then
ShowMessage( '¡Correcto!' )
else
ShowMessage('Inténtalo otra vez');

TImage(Sender).Left := ImageArray[img.Tag-1].Left;
TImage(Sender).Top := ImageArray[img.Tag-1].Top;
end;
end;
end.


Saludos :)

[bulc]

El ejemplo anterior no mueve las bolas (TImage). El evento OnMouseMove de la imagen debe tener algún error.
Se me ha ocurrido probar con Drag and Drop pero moviendo la imagen. A ver que sale. Pero también miraré atentamente el último código que añades.
Muchas gracias por tu atención.
bulc

[ecfisa]

Hola bulc.

El ejemplo me funciona correctamente. Antes de adjuntarte los fuentes te pregunto, ¿ Presionas la tecla Ctrl junto con el botón del mouse ?

Saludos :)

[bulc]

Con esta pequeña corrección, las bolas ya se mueven.

procedure TForm1.ImagesMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// if ssCtrl in Shift then
//begin
CtrlPress:= True;
PriorSpot.X := X; //PriorSpot := Point( X,Y);
PriorSpot.Y := Y;
//end;
end;

procedure TForm1.ImagesMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if CtrlPress then
begin
(Sender as TImage).Left := TImage(Sender).Left - (PriorSpot.X - X);
(Sender as TImage).Top := TImage(Sender).Top - ( PriorSpot.Y - Y);
end;
end;

Ahora veo tu última modificación, Ecfisa.
Gracias.
bulc

[ecfisa]

De nada bulc, te pregunté lo de la tecla Ctrl por que caí en la cuenta que no había echo mención a ese detalle antes...

Saludos :)

[bulc]

Hola ecfisa. Debido a que llevaba en la cabeza que la utilidad fuera lo más sencilla posible, no llegué a pulsar la tecla de CTRL. De todos modos creo que tu ayuda ha sido definitiva. Estudiaré el código y me buscaré la manera de dejarlo a mi gusto, ya por mi cuenta.
Es para escolares de infantil que aún no saben leer demasiado. Pero con un programa así, aprenden con total independencia.
Un abrazo,
bulc

[ecfisa]

Hola bulc.

Así queda el ejemplo sin el uso de la tecla Ctrl:

implementation

var
ori : TPoint;
CtrlPress : Boolean = False;
ShapeArray : array of TShape;
ImageArray : array of TRect;

procedure TForm1.FormCreate(Sender: TObject);
var
i, cs, ci: Integer;
sh: TShape;
begin
Image1.BringToFront;
Image2.BringToFront;
Image3.BringToFront;
Image1.Tag := 1;
Image2.Tag := 2;
Image3.Tag := 3;
DoubleBuffered:= True;

for i:= 0 to ComponentCount-1 do
begin
if Components[i] is TShape then
begin
SetLength ( ShapeArray, Length( ShapeArray ) + 1 );
ShapeArray [High( ShapeArray )]:= TShape( Components[i] );
end;
if Components[i] is TImage then
begin
SetLength ( ImageArray, Length( ImageArray ) + 1 );
ImageArray[High( ImageArray )].Left := TImage( Components[i] ).Left;
ImageArray[High( ImageArray )].Top := TImage( Components[i] ).Top;
end;
end;
end;

procedure TForm1.ImagesMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ori := Point( X, Y );
CtrlPress:= True;
end;

procedure TForm1.ImagesMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if CtrlPress then
with TImage( Sender ) do
begin
Left := X - ori.X + Left;
Top := Y - ori.Y + Top;
end;
end;

procedure TForm1.ImagesMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
function IsInShape(I: TImage; S: TShape): Boolean;
begin
Result:= ((I.Left > S.Left)and(I.Top > S.Top)) and
((I.Left+I.Width < S.Left+S.Width)and(I.Top+I.Height < S.Top+S.Height));
end;
var
img: TImage;
i : Integer;
R : TRect;
ok : Boolean;
begin
img := TImage( Sender );
ok := False;
for i:= Low( ShapeArray ) to High( ShapeArray ) do
if IsInShape(img, ShapeArray[i]) then
if img.Tag = ShapeArray[i].Tag then
begin
ok := True;
Break;
end;
if ok then
ShowMessage( '¡Correcto!' )
else
begin
ShowMessage('Inténtalo otra vez');
TImage(Sender).Left := ImageArray[img.Tag-1].Left;
TImage(Sender).Top := ImageArray[img.Tag-1].Top;
end;
CtrlPress:= False;
end;
end.

Este último código deja la imágen en el shape cuando la elección es correcta, en caso contrario, la regresa a la posición de orígen.

Saludos :)

[bulc]

Ya lo había conseguido, pero gracias de todos modos. Ya estoy en los últimos retoques. Gracias, ecfisa.

[bulc]

Al analizar tu programa me he quedado con cara de asombro al ver una función incrustada dentro de un procedimiento. Me refiero a IsInShape. Muy elegante la solución. La cosa queda muy clara. No me había percatado que todo Array/matriz dinámico tiene su origen en cero. Pensaba que se comportaba como los arrays estáticos.
Por otro lado usas un Array de TRect para guardar los parámetros de ubicación y tamaño de los TImage. Creo que también se podría usar un array dinámico de TPoint. Ya que con la ubicación tenemos suficiente. Y luego hay algunas variables que no se usan y que tras compilar se pueden quitar.
Me has quitado la venda de los ojos, ecfisa.
Espero que sirva para muchos otros delphineros!
Saludos,
bulc

[bulc]

Intento esto pero no lo puedo condensar:

unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage; Image2: TImage; Image3: TImage; Image4: TImage;
Button1: TButton; Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
Type
TImg_AR = Array of Record
L, T, R, B, Tg : Integer;
end;
Var
Img_A : TImg_AR;
I, A: Integer;
N: Integer;
Begin
Memo1.Clear;
Memo1.Lines.Add(' Puntos Left, Top, R=Left+Width, B=Top+Height, Tag' );
Memo1.Lines.Add(' Left, Top, Right, Bottom, Tag') ;
SetLength(Img_A, 4); //
for I :=0 To ComponentCount - 1 do
if (Components[I] is TImage) then
begin
for N := 0 to 3 do
begin
Img_A[N].L := TImage(Components[I]).Left; ;
Img_A[N].T := TImage(Components[I]).Top;
Img_A[N].R := TImage(Components[I]).Left + TImage(Components[I]).Width ;
Img_A[N].B := TImage(Components[I]).Top + TImage(Components[I]).Height ;
Img_A[N].Tg:= TImage(Components[I]).Tag;
end;
end;
For I := 0 to 3 do
Memo1.Lines.Add(' L' +IntToStr ( Img_A[I].L ) +' T'+ IntToStr (Img_A[I].T ) +
' R' + IntToStr ( Img_A[I].R ) +' B'+ IntToStr ( Img_A[I].B ) +' Tg' + IntToStr(Img_A[I].Tg) );

end;
end.


Y en cambio con este código me funciona. A pesar de su 'pesadez'.
for I :=0 To ComponentCount - 1 do
if (Components[I] is TImage) then
begin
if (Components[I].Name ='Image1') then
begin
Img_A[0].L := TImage(Components[I]).Left; ;
Img_A[0].T := TImage(Components[I]).Top;
Img_A[0].R := TImage(Components[I]).Left + TImage(Components[I]).Width ;
Img_A[0].B := TImage(Components[I]).Top + TImage(Components[I]).Height ;
Img_A[0].Tg:= TImage(Components[I]).Tag;
end;
if (Components[I].Name ='Image2') then
begin
Img_A[1].L := TImage(Components[I]).Left; ;
Img_A[1].T := TImage(Components[I]).Top;
Img_A[1].R := TImage(Components[I]).Left + TImage(Components[I]).Width ;
Img_A[1].B := TImage(Components[I]).Top + TImage(Components[I]).Height ;
Img_A[1].Tg:= TImage(Components[I]).Tag;
end;



Te ruego le des un vistazo a ver qué hago mal. Muchas gracias por tu tiempo.
bulc

[ecfisa]

Hola bulc.

Según lo que entendí que deseas hacer sería:

...
SetLength(Img_A, 4);
N:= 0;
for i :=0 To ComponentCount - 1 do
if (Components[i] is TImage) then
begin
Img_A[N].L := TImage(Components[i]).Left;
Img_A[N].T := TImage(Components[i]).Top;
Img_A[N].R := TImage(Components[i]).Left + TImage(Components[i]).Width ;
Img_A[N].B := TImage(Components[i]).Top + TImage(Components[i]).Height ;
Img_A[N].Tg:= TImage(Components[i]).Tag;
Inc(N);
end;
...


Saludos :)

[bulc]

Eres un portento. A toro pasado parece tan fácil!!
Gracias.