movimiento y ejecucion simultanea. Programacion emergente

hola Luis Garcia

gracias por contestar.

Al dia siguiente de mi ultimo mensaje ya habia usado algunas de tus
sugerencias.

ya vere lo del screenupdating

hasta pronto

hola manuel romero

Lo que me dices es interesante y tratare de encontar algo de literatura por
ahi a ver si me aclaro. ¿sabes de algun codigo de ejemplo?; ¿tal vez alguna
aplicacion viable?.

gracias

Si quieres ejecutar dos procedimientos simultaneos, tendrias que usar
Threads con APIs, pero su uso en VB no esta recomendado

Hola de nuevo

Te cuento: he estado haciendo comparaciones de tiempo de ejecucion del
programa. Asi, si ejecutas el codigo de matrices que te mande tarda unos 12
segundos para 100 objetos, y 24 seg. para 200(por cierto, el codigo tiene un
pequeño error en un bucle que pone for k=1 to 20 y deberia decir for k=1 to
conta).

Ejecutando tu codigo, si eliminas las acciones de pintar(que relentizan
bastante) y añades un cells(1,1).select entre los dos next finales, tarda 11
segegundos para 100 objetos y 22 seg. para 200.

Es decir, que aun empleando tu codigo sin que pinte,o sea un codigo sin
apenas bucles, se obtiene una mejora relativa (1 seg cada 100 objetos).

Ahora vienen las preguntas:

Como veras, para que se vea el movimiento, si no pintas las posiciones, me
he visto obligado a poner un cells(1,1).select para que se vea el movimiento,
si no, el procesador hace todas las operaciones sin mover nada, hasta que al
final, despues de 100 iteraciones (for i= 1 to 100) pone las posiciones
finales (en esto solo consume 8 segundos para 100 objetos). Por cierto usar
el screenupdating en lugar del cells(1,1).select, hace que el movimiento se
vea a saltos.

¿Como puedo ver el movimiento sin usar el cells(1,1).select ni el updating?

¿Sabes de alguna forma mas eficaz para compara un dato con los elementos de
una matriz?

No obstante lo anterior, creo que el sistema es aun lento, ya que
veinti-tantos segundos en 100 iteraciones me parece excesivo, teniendo en
cuenta que aun hay que añadirle todo tipo de interacciones entre objetos,
pero, en fin.

Esperando noticias

luisf

"luisf" escribió en el mensaje
news:

Hola tocayo:

Te comento alguna cosilla:

If x <> 0 And y <> 0 Then 'si se va a mover...

La condicion deberia ser: x <> 0 OR y <> 0.

Creo que si utilizas una variable para ActiveSheet y otra para
ActiveSheet.Shapes(n) puedes ganar tiempo.

Y (como comentario extra) tambien creo que podrias 'cambiar' la forma de
acceder/mover a los objetos, lo que implicaria cambiar toda la funcion:

Podria ser interesante trabajar con una matriz estilo:

aElems(1 to 40, 1 to 70) As Shape

Recorrer todos los elementos (shapes) y rellenarla con:

Set aElems(oShape.Row, oShape.Column) = oShape

Para el movimiento, recorrer la matriz por todas las filas/columnas y en
cada elemento tienes acceso al objeto Shape y 'sus adyacentes':

For nRow = 1 to 40
For nCol = 1 to 70
If Not aElems(nRow, nCol) Is Nothing Then
If aElems(nRow + x, nCol + y) Is Nothing Then
aElems(nRow, nCol).Mover
Set aElems(nRow+x, nCol+y) = aElems(nRow, nCol)
Set aElems(nRow, nCol) = Nothing

Y con esto (y un poco de codigo mas), ya tendrias el movimiento realizado.

Saludos

Hola KL

Gracias de nuevo por contestar.

Hoy solo tengo tiempo para enviarte este mensje. Mañana tatare de probar
algunas cosas de las de tu codigo, ya que hay cosas que ni sabia que

existian

(el problema de ser autodidacta y aprender a base de grabar macros y leer

la

ayuda en linea)

No obstante, te mando lo que hice ayer para que veas coma va la cosa.

Basicamente me he adelantado a alguna sugerencia tuya y me he basado en
matrices que guardan las posiciones de los objetos y comparacion con la
posiciones futuras a ocupar.

Por cierto, el error que comentas, no llega a darse en realidad ya que, lo
primero que hago es crear el marco (en blanco: colorindex=2) donde se

mueven

los objetos, hay un if que si se va a mover al blanco deja x e y a cero

(es

dcir, no se mueve esta vuelta. De todas formas te añado las macros de

crear

el marco y generar objetos (muy sencillitas evidentemente) ya que mas vale

un

codigo que mil palabras.

++++++++++++++++++++++++++++++++++++++++++++++++++

codigo para animacion por matrices (ahora va muy rapido)

Sub movunimatriz()

Dim matrizpos() As Integer
Dim matrizcom(1 To 2, 1) As Integer
Dim conta As Integer
Dim fil5, col5 As Integer
Dim x, y As Integer
Dim i, j, k As Integer

For Each s In ActiveSheet.Shapes 'cuenta los objetos que hay
conta = conta + 1
Next
ReDim matrizpos(2, conta)
For i = 1 To conta ' guarda las primeras posiciones

matrizpos(1, i) = ActiveSheet.Shapes(i).TopLeftCell.Rows.Row
matrizpos(2, i) = ActiveSheet.Shapes(i).TopLeftCell.Columns.Column
Next


For j = 1 To 100 'repite el proceso 100 veces
i = 0
For i = 1 To conta 'hace la accion para los i objetos



fil5 = ActiveSheet.Shapes(i).TopLeftCell.Rows.Row
col5 = ActiveSheet.Shapes(i).TopLeftCell.Columns.Column


Randomize
x = (Int(3 * Rnd) - 1)
y = (Int(3 * Rnd) - 1)

If Cells(fil5 + x, col5 + y).Interior.ColorIndex = 2 Then 'no se sale
del marco
x = 0
y = 0
End If

If x <> 0 And y <> 0 Then 'si se va a mover...
matrizcom(1, 1) = fil5 + x
matrizcom(2, 1) = col5 + y
For k = 1 To 20 '... compara para ver si esta ocupado
If matrizcom(1, 1) = matrizpos(1, k) And matrizcom(2, 1) > matrizpos(2, k) Then
GoTo fin1
End If
Next


ActiveSheet.Shapes(i).IncrementLeft y * 10 'se mueve
ActiveSheet.Shapes(i).IncrementTop x * 10


matrizpos(1, i) = ActiveSheet.Shapes(i).TopLeftCell.Rows.Row 'guarda
nueva posicion
matrizpos(2, i) = ActiveSheet.Shapes(i).TopLeftCell.Columns.Column

End If
fin1:

Next
Cells(1, 1).Select 'para que se vea el movimiento (sin parpadeos)
''Application.ScreenUpdating = True'se ve el movimientos con parpadeos de
pantalla
Next


End Sub


++++++++++++++++++++++++++++++++++++++++++++++++

**************************************************

Aqui esta la macro que genera el marco (dode se moveran), recuerda que las
hojas de calculo las redimensiono a 13x13 pixeles

Sub blanco2()
'
' Macro44 Macro
' Macro grabada el 10/09/2005 por luis
'

'
Range("A1:B40,B39:BV40,BU1:BV39,B1:BV2").Select
Range("BV1").Activate
Selection.Interior.ColorIndex = 2
Range("A1").Select
End Sub


************************************************
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Y ahora la macro que genera 10 objetos como el primero que hagas

Sub llenado2()

For m = 1 To 10
Randomize
a = Int((36 - 4 + 1) * Rnd + 4)
b = Int((70 - 4 + 1) * Rnd + 4)

ActiveSheet.Shapes(1).Select
Selection.Copy
Cells(a, b).Select
ActiveSheet.Paste
Cells(a, b).Interior.ColorIndex = 0
Next

End Sub

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

de nuevo gracias y ya te ire contando.

luisf