Al otro lado de la pantalla
Estoy (entre aplicaciones que una y otra se me ocurren) haciendo un comienzo de editor de laberinto o caracteres.
Esta muy muy verde.Pero la idea es de de practicar y ver que hace.
En esta imagen recuerda una especie de editor de gráficos definidos por el usuario.(G.D.U)
(Reconozco que me tira mucho la época de los 8 bits).
La aplicación crea una rejilla y luego haces clic en una de la celdas y se rellana con una imagen de 32x32.
Haciendo de nuevo click se elimina y queda en blanco la celda en concreto.
Me encontré ciertos problemas usando un array de objetos y opte por una colección, que le añades el índice.
Buscaba en el array de picturebox un valor que no existia (el last.tag). El número de elementos que había
en el array no era el mismo y este índice del componente llegaba a ser mayor que el de los del array.
Ahora ya funciona.
Tengo otras cuestiones, pero es mas bien por afinar un poco.
Puedo grabar el mapa creado y cargarlo. El archivo texto que genera, cuando acaba, genera un espacio
entre "muro" creado, para que no este todo junto. En la rutina de lectura de este archivo de texto.
Leo el archivo con LINE INPUT, pero claro hay que asignar ese valor leído a algo, aunque sea
un espacio, lo asigno a una variable que no va a ninguna parte.No tiene uso, pero me hace el
apaño.
Const tablero As Integer = 480
Const celda As Integer = 32
Const picmuro As String = "Bloque.png"
Private muro As PictureBox
Private amapa As New Collection
Private cuentamuros As Integer
Public Sub _new()
End
Public Sub Form_Open()
Me.Caption = "Editor de laberinto"
Me.Center
dibujaRejilla
End
Public Sub dibujaRejilla()
Dim x As Integer
Dim y As Integer
drwArea.Clear
Draw.Begin(drwArea)
For y = 0 To tablero Step celda
Draw.Line(0, y, tablero, y)
Next
For x = 0 To tablero Step celda
Draw.Line(x, 0, x, tablero)
Next
Draw.End
End
Public Sub drwArea_MouseDown()
Dim casillax As Integer
Dim casillay As Integer
casillax = Int(Mouse.x / celda)
casillay = Int(Mouse.y / celda)
muro = New PictureBox(drwArea) As "GrupoMuro"
With muro
.Picture = Picture[picmuro]
.Width = celda
.Height = celda
.x = casillax * celda
.y = casillay * celda
.Tag = cuentamuros
End With
amapa.Add(muro, cuentamuros)
cuentamuros += 1
End
Public Sub GrupoMuro_MouseDown()
'Hacemos click sobre un muro y lo eliminamos del mapa de muros y como objeto existente en el drawingarea
amapa.Remove(Last.Tag)
Last.delete()
cuentamuros -= 1
End
Public Sub btnSalir_Click()
Me.Close
End
Public Sub btnGraba_Click()
Dim fichero As String
Dim unpicturebox As PictureBox
For Each unpicturebox In amapa
With unpicturebox
fichero &= .Width & "\n"
fichero &= .Height & "\n"
fichero &= .X & "\n"
fichero &= .Y & "\n"
fichero &= .Tag & "\n"
End With
fichero &= "\n"
Next
If Dialog.SaveFile() Then Return
File.Save(Dialog.Path, fichero)
End
Public Sub btnLeer_Click()
Dim unpicturebox As PictureBox
Dim fichero As File
Dim unespacio As String
For Each unpicturebox In amapa
unpicturebox.Delete
Next
If Dialog.OpenFile() Then Return
fichero = Open Dialog.Path For Input
Do While Not Eof(fichero)
muro = New PictureBox(drwArea) As "GrupoMuro"
With muro
.Picture = Picture[picmuro]
Line Input #fichero, .Width
Line Input #fichero, .Height
Line Input #fichero, .X
Line Input #fichero, .Y
Line Input #fichero, .Tag
Line Input #fichero, unespacio
End With
amapa.Add(muro, cuentamuros)
cuentamuros += 1
Loop
Close #fichero
End
Const celda As Integer = 32
Const picmuro As String = "Bloque.png"
Private muro As PictureBox
Private amapa As New Collection
Private cuentamuros As Integer
Public Sub _new()
End
Public Sub Form_Open()
Me.Caption = "Editor de laberinto"
Me.Center
dibujaRejilla
End
Public Sub dibujaRejilla()
Dim x As Integer
Dim y As Integer
drwArea.Clear
Draw.Begin(drwArea)
For y = 0 To tablero Step celda
Draw.Line(0, y, tablero, y)
Next
For x = 0 To tablero Step celda
Draw.Line(x, 0, x, tablero)
Next
Draw.End
End
Public Sub drwArea_MouseDown()
Dim casillax As Integer
Dim casillay As Integer
casillax = Int(Mouse.x / celda)
casillay = Int(Mouse.y / celda)
muro = New PictureBox(drwArea) As "GrupoMuro"
With muro
.Picture = Picture[picmuro]
.Width = celda
.Height = celda
.x = casillax * celda
.y = casillay * celda
.Tag = cuentamuros
End With
amapa.Add(muro, cuentamuros)
cuentamuros += 1
End
Public Sub GrupoMuro_MouseDown()
'Hacemos click sobre un muro y lo eliminamos del mapa de muros y como objeto existente en el drawingarea
amapa.Remove(Last.Tag)
Last.delete()
cuentamuros -= 1
End
Public Sub btnSalir_Click()
Me.Close
End
Public Sub btnGraba_Click()
Dim fichero As String
Dim unpicturebox As PictureBox
For Each unpicturebox In amapa
With unpicturebox
fichero &= .Width & "\n"
fichero &= .Height & "\n"
fichero &= .X & "\n"
fichero &= .Y & "\n"
fichero &= .Tag & "\n"
End With
fichero &= "\n"
Next
If Dialog.SaveFile() Then Return
File.Save(Dialog.Path, fichero)
End
Public Sub btnLeer_Click()
Dim unpicturebox As PictureBox
Dim fichero As File
Dim unespacio As String
For Each unpicturebox In amapa
unpicturebox.Delete
Next
If Dialog.OpenFile() Then Return
fichero = Open Dialog.Path For Input
Do While Not Eof(fichero)
muro = New PictureBox(drwArea) As "GrupoMuro"
With muro
.Picture = Picture[picmuro]
Line Input #fichero, .Width
Line Input #fichero, .Height
Line Input #fichero, .X
Line Input #fichero, .Y
Line Input #fichero, .Tag
Line Input #fichero, unespacio
End With
amapa.Add(muro, cuentamuros)
cuentamuros += 1
Loop
Close #fichero
End
Bueno, continuaremos con esto si es que no se me ocurre otra cosa y no abarco..
Saludos
| CreaLaberinto.tar.gz | ||
| Descripción: |  Descargar |
|
| Nombre del archivo: | CreaLaberinto.tar.gz | |
| Tamaño: | 8.26 KB | |
| Descargado: | 25 veces | |
| CreaLaberinto.tar.gz | ||
| Descripción: | Descargar |
|
| Nombre del archivo: | CreaLaberinto.tar.gz | |
| Tamaño: | 8.26 KB | |
| Descargado: | 25 veces | |
| CreaLaberinto.tar.gz | ||
| Descripción: | Descargar |
|
| Nombre del archivo: | CreaLaberinto.tar.gz | |
| Tamaño: | 8.26 KB | |
| Descargado: | 25 veces | |
