https://foro.gambas-es.org/viewtopic.php?f=5&t=3223&p=18170#p18170
-----------------------------------
Shell
Martes, 25 Junio 2013, 19:55

Ejemplo De Movimiento De Un Objeto Dibujado En Un DrawingArea
-----------------------------------
Hola!.

Es el primer ejemplo que hago dibujando en el control DrawingArea y no desplazando un control Picturebox sobre el.
El ejemplo es muy sencillo.

Este ejemplo primero lo hice con una clase heredada Picturebox y este lo desplazaba por el DrawingArea.
Y luego decidí hacerlo con un picture y desplazar este.

Se pretende que el dibujo se desplace un cuadrado de celda cada movimiento. Así que salta de uno en uno los cuadrados.

En este ejemplo veremos:

- Actualizamos el contenido del DrawingArea cada cierto tiempo. No se usa cached a true.
- Uso un poco de aritmética modular para que el objeto si sale por un extremo del area de dibujo, entre por el lado contrario.
- Uso de timers. En este caso tres. Un Timer se encarga de refrescar el control de dibujo cada 16 segundos, un timer para
  comprobar si el objeto esta sobre otro. Y el ultimo para mostrar un valor en un labelcd
- El uso de la rejilla para ver por donde van y como se colocan los objetos en el área de dibujo.

 [img]http://foro.gambas-es.org/files/images/768/primerejemplo.png[/img] 

Este es el código:

[code linenumbers=false syntax=gambas]
Const celda As Integer = 48
Private htux As Picture
Private htuxpos As Point
Private hpc As Picture
Private hpcpos As Point

Private cuentapcs As Integer 
Private contador As Integer

Public Sub _new()  
  
End

Public Sub Form_Open()
  
  Me.Center 
  Randomize   
  htux = Picture.Load("Tux2.png")
  htuxpos = GeneraPosicion()
   
  hpc = Picture.Load("Pc.png")
  hpcpos = GeneraPosicion()
   
  Timer1.Start
  Timer_Encontrar.Start
  Tiempo_Pasado.Start
  
End

Public Sub Form_KeyPress()

    Select Case Key.Code
      Case Key.Left
        htuxpos.X -= celda
      Case Key.Right
        htuxpos.X += celda
      Case Key.Up
        htuxpos.Y -= celda
      Case Key.Down
        htuxpos.Y += celda
    End Select 
    
    htuxpos.X = htuxpos.X Mod DrawingArea1.Width
    If htuxpos.x < 0 Then htuxpos.X = DrawingArea1.Width - celda
    htuxpos.Y = htuxpos.Y Mod DrawingArea1.Height 
    If htuxpos.Y < 0 Then htuxpos.Y = DrawingArea1.Height - celda
  
End

Public Sub Timer_Encontrar_Timer()   

  If cuentapcs < 3 Then
    If htuxpos.X = hpcpos.x And htuxpos.Y = hpcpos.Y Then            
      Tiempo_Pasado.Stop
      hpc = Null     
      Message.Title = "Tux"
      Message.Info("Yupi!")
      contador = 0
      cuentapcs += 1      
      hpc = Picture.Load("Pc.png")
      hpcpos = GeneraPosicion()       
      Tiempo_Pasado.Start
    Endif
  Else       
    Timer_Encontrar.Stop
    Tiempo_Pasado.Stop
    Timer1.Stop
    Message.Title = "Aviso"
    Message.Info("Tienes 3 Pc's")    
  Endif      
End

Public Sub Timer1_Timer()  
  DrawingArea1.Refresh  
End

Public Sub DrawingArea1_Draw()  
  
  DibujaRejilla  
  Draw.Picture(htux, htuxpos.X, htuxpos.Y)
  If cuentapcs < 3 And hpc <> Null Then Draw.Picture(hpc, hpcpos.X, hpcpos.y)
    
End

Public Sub GeneraPosicion() As Point  
  
  Dim punto As New Point
  
  punto.X = Int(Rnd(10)) * celda
  punto.Y = Int(Rnd(10)) * celda 
  
  Return punto    
  
End

Public Sub DibujaRejilla()  
  
  Dim x As Integer
  Dim y As Integer
  
  For y = 0 To DrawingArea1.Height Step celda
    Draw.Line(0, y, DrawingArea1.Height, y)  
  Next
  For x = 0 To DrawingArea1.Width Step celda
    Draw.Line(x, 0, x, DrawingArea1.Width)
  Next
  
End

Public Sub Tiempo_Pasado_Timer()
  contador += 1
  LCDLabel1.Text = CStr(contador)
End


Public Sub TlbSalir_Click()
  Message.Title = "Programador"  
  Select Case Message.Question("¿ Te ha gustado ?", "Si", "Mmm", "Vale!")  
  Case 1
      Message.Title = "Respuesta"  
      Message.Info("Gracias!")
  Case 2
      Message.Title = "Respuesta"  
      Message.Error("Eeeeh!.:-)")
  Case 3
      Message.Title = "Respuesta"  
      Message.Info("Pues claro!. :-D")
  End Select
  Me.Close
  
End
[/code]

Y aquí el ejemplo para descargar.

Jugando también se aprende. :-)

Saludos


