Club Delphi  
    Paypal   FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Coloboración Paypal con ClubDelphi

 
 
Herramientas Buscar en Tema Desplegado
  #6  
Antiguo 09-04-2015
Avatar de ecfisa
ecfisa ecfisa is offline
Moderador
 
Registrado: dic 2005
Ubicación: Tres Arroyos, Argentina
Posts: 10.508
Poder: 38
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
 


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
TVE intentó boicotear a Chikilicuatre marcoszorrilla La Taberna 3 10-03-2008 18:32:00
Intento hacer consulta SQL parametrica jefraub SQL 6 23-02-2005 12:21:02
Relato informático (tercer intento) Al González Debates 1 28-06-2004 03:12:50


La franja horaria es GMT +2. Ahora son las 16:07:54.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi