MoviendoImagen (Intento)
 

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:

Código Delphi [-]
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

Hola bulc.

Fijate si te sirve este ejemplo (basado en el hilo: Mover TSpeedButton en Runtime):

Código Delphi [-]
...
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 :)

Gracias
 

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

Código Delphi [-]
 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?

Te dejo esta entrada antigua en mi blog donde se habla de crear imágene en runtime y moverlas con el ratón.
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.

¿Cómo seleccionar el TShape válido?
 

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.

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 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.

Código Delphi [-]
...
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:


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

Gracias por el esfuerzo
 

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

Hola bulc.
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 :)

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.

Código Delphi [-]
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 :)

Estudiaré atentamente lo que pones
 

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

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 :)

Epur si e muove - Ya se mueven
 

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

Código Delphi [-]
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

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 :)

Se me había pasado por alto Shift
 

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

Hola bulc.

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

Código Delphi [-]
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 :)

Muy atento
 

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

Nunca había visto una función incrustada en un procedimiento
 

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

Intento de Array of Record
 

Intento esto pero no lo puedo condensar:

Código Delphi [-]
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.

Código Delphi [-]
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

Hola bulc.

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

Código Delphi [-]
  ...
  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 :)

Qué bien se come a mesa puesta!!
 

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