Ver Mensaje Individual
  #6  
Antiguo 09-04-2015
Avatar de ecfisa
ecfisa ecfisa is offline
Moderador
 
Registrado: dic 2005
Ubicación: Tres Arroyos, Argentina
Posts: 10.508
Reputación: 36
ecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to behold
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
Archivos Adjuntos
Tipo de Archivo: zip bulc.zip (24,4 KB, 12 visitas)
__________________
Daniel Didriksen

Guía de estilo - Uso de las etiquetas - La otra guía de estilo ....
Responder Con Cita