Manipulación de Excel desde VB.NET

Hola,
Recientemente publiqué como se hace la manipulación de un fichero Excel desde FreePascal-Lazarus. Ahora toca el equivalente desde VB.NET.

Para el caso de .NET hay mucha más información en Internet. En este enlace por ejemplo, se hace una utilización básica: http://social.msdn.microsoft.com/Forums/vstudio/en-US/4fe0c8c2-e952-4196-96d7-b833292a9c2e/open-an-excel-file-using-vbnet?forum=vbgeneral

En Visual Studio 2010, habría que agregar la referencia "Microsoft Excel Object Library" (después del término Excel suele aparecer la versión 11.0, 12.0, 14.0,...). Para agregar la referencia recordemos que hay que ir al Menú PROYECTO, Opción AGREGAR REFERENCIA y Pestaña COM.

Imaginemos que estamos haciendo un proyecto VB.NET de tipo APLICACIÓN DE CONSOLA. En ese caso el programa por defecto consiste en un MÓDULO, llamado MODULE1. Antes del cuerpo de MODULE1 tenemos que importar el espacio de nombres siguiente:

Imports Excel = Microsoft.Office.Interop.Excel

Ahora ya podemos utilizar tranquilamente las funciones y procedimientos para acceder a las celdas de las hojas y de los libros Excel que queramos. En cuanto termine el programa que estoy haciendo subiré el código fuente. Mientras tanto, la utilización más básica, está en el enlace que he puesto arriba.

Saludos.

Microsoft.Jet.OLEDB.4.0 no está registrado en el equipo local

ERROR al conectar o recuperar los datos:

El proveedor 'Microsoft.Jet.OLEDB.4.0' no está registrado en el equipo local.

Este error te aparece al intentar compilar un proyecto Visual Studio.NET con las opciones de compilación por defecto (al menos en Visual Studio 2010). Como estés compilando el proyecto con un procesador de 64 bits, al no existir ese proveedor para 64 bits saltará el error.


SOLUCIÓN:

En el explorador de soluciones seleccionamos nuestro proyecto, botón derecho, propiedades.
Vamos a la sección de compilación y clic en botón "CONFIGURACIÓN DE COMPILADOR AVANZADA":

En CPU de destino quitamos AnyCPU y ponemos x86.

Saludos.

Visual Basic .NET Leer un fichero de texto

Tenemos que leer un fichero.

.CONFIG
En el fichero .config de la aplicación tenemos una indicación de dónde está el fichero. Lo indicamos así:

add key="pathFicheroPumadata" value="c:\programa-gestion\pumapc\pumadata.dat"

Primero leemos la entrada, luego comprobamos si el fichero está en su sitio. Si no está, se captura la excepción y se muestra el mensaje correspondiente al usuario.

Se lee el fichero procesando cada línea.

Private Sub mnuLeerFichero_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles mnuLeerFichero.Click
    Dim configurationAppSettings As System.Configuration.AppSettingsReader = New System.Configuration.AppSettingsReader
    Dim ficheroPumadata As String
    Dim contador As Integer = 0
    ficheroPumadata = configurationAppSettings.GetValue("pathFicheroPumadata", GetType(System.String))
    If ficheroPumadata = "" Then
        ficheroPumadata = Application.StartupPath
    End If
    Try
        If System.IO.File.Exists(ficheroPumadata) = False Then
            MessageBox.Show("El fichero pumadata.dat no está en su sitio.")
            Exit Sub
        End If
        strPATH_BASEDATOS = ficheroPumadata
        'Abrir el fichero de texto:
        Dim sr As New System.IO.StreamReader( _
                ficheroPumadata, _
                System.Text.Encoding.Default, _
                True)
        ' Leer el contenido mientras no se llegue al final
        While sr.Peek() <> -1
            ' Leer una línea del fichero
            Dim s As String = sr.ReadLine()
            If String.IsNullOrEmpty(s) Then
                Continue While
            End If
            contador = contador + 1
            escribirLinea(s)
        End While
        ' Cerrar el fichero
        sr.Close()
        MessageBox.Show(contador & " repostajes leídos")
    Catch ex As Exception
        MessageBox.Show("ERROR: " & ex.Message & vbCrLf & "El fichero pumadata.data no está en su sitio")
        Exit Sub
    End Try
End Sub

Saludos.

Crear un fichero .doc por programación

A veces puede interesar automatizar por programación la creación de un fichero .doc (Word).

Esto te puede ayudar en dos casos:

1. Si generas periódicamente, o frecuentemente, el mismo tipo de documento con ligeras variaciones (facturas, informes, etc.)




2. Si tienes que crear un documento a partir de un montón de imágenes, ficheros, otros documentos...
   

Por ejemplo organismos que generan miles de de documentos diarios como los tribunales de Ginebra utilizan un módulo Perl: MsOffice-Word-HTML-Writer-1.01

Para usar ese módulo Perl no hace falta ni Windows, ni tener el Word instalado.

Código fuente copiado del enlace indicado:

use MsOffice::Word::HTML::Writer;
  my $doc = MsOffice::Word::HTML::Writer->new(
    title        => "My new doc",
    WordDocument => {View => 'Print'},
  );

  $doc->write("<p>hello, world</p>",
              $doc->page_break,
              "<p>hello from another page</p>");

  $doc->create_section(
    page => {size   => "21.0cm 29.7cm",
             margin => "1.2cm 2.4cm 2.3cm 2.4cm"},
    header => sprintf("Section 2, page %s of %s",
                                  $doc->field('PAGE'),
                                  $doc->field('NUMPAGES')),
    footer => sprintf("printed at %s",
                                  $doc->field('PRINTDATE')),
    new_page => 1, # or 'left', or 'right'
  );
  $doc->write("this is the second section, look at header/footer");

  $doc->attach("my_image.gif", $path_to_my_image);
  $doc->write("<img src='files/my_image.gif'>");

  $doc->save_as("/path/to/some/file");

Si tenemos que hacerlo en un PC Windows va a ser más sencillo utilizar VB.NET como nos explican aquí: Cómo automatizar Word desde Visual Basic .NET para crear un nuevo documento


Código fuente copiado del enlace:

Private Sub Button1_Click(ByVal sender As System.Object, _
      ByVal e As System.EventArgs) Handles Button1.Click

        Dim oWord As Word.Application
        Dim oDoc As Word.Document
        Dim oTable As Word.Table
        Dim oPara1 As Word.Paragraph, oPara2 As Word.Paragraph
        Dim oPara3 As Word.Paragraph, oPara4 As Word.Paragraph
        Dim oRng As Word.Range
        Dim oShape As Word.InlineShape
        Dim oChart As Object
        Dim Pos As Double

        'Start Word and open the document template.
        oWord = CreateObject("Word.Application")
        oWord.Visible = True
        oDoc = oWord.Documents.Add

        'Insert a paragraph at the beginning of the document.
        oPara1 = oDoc.Content.Paragraphs.Add
        oPara1.Range.Text = "Heading 1"
        oPara1.Range.Font.Bold = True
        oPara1.Format.SpaceAfter = 24    '24 pt spacing after paragraph.
        oPara1.Range.InsertParagraphAfter()

        'Insert a paragraph at the end of the document.
        '** \endofdoc is a predefined bookmark.
        oPara2 = oDoc.Content.Paragraphs.Add(oDoc.Bookmarks.Item("\endofdoc").Range)
        oPara2.Range.Text = "Heading 2"
        oPara2.Format.SpaceAfter = 6
        oPara2.Range.InsertParagraphAfter()

        'Insert another paragraph.
        oPara3 = oDoc.Content.Paragraphs.Add(oDoc.Bookmarks.Item("\endofdoc").Range)
        oPara3.Range.Text = "This is a sentence of normal text. Now here is a table:"
        oPara3.Range.Font.Bold = False
        oPara3.Format.SpaceAfter = 24
        oPara3.Range.InsertParagraphAfter()

        'Insert a 3 x 5 table, fill it with data, and make the first row
        'bold and italic.
        Dim r As Integer, c As Integer
        oTable = oDoc.Tables.Add(oDoc.Bookmarks.Item("\endofdoc").Range, 3, 5)
        oTable.Range.ParagraphFormat.SpaceAfter = 6
        For r = 1 To 3
            For c = 1 To 5
                oTable.Cell(r, c).Range.Text = "r" & r & "c" & c
            Next
        Next
        oTable.Rows.Item(1).Range.Font.Bold = True
        oTable.Rows.Item(1).Range.Font.Italic = True

        'Add some text after the table.
        'oTable.Range.InsertParagraphAfter()
        oPara4 = oDoc.Content.Paragraphs.Add(oDoc.Bookmarks.Item("\endofdoc").Range)
        oPara4.Range.InsertParagraphBefore()
        oPara4.Range.Text = "And here's another table:"
        oPara4.Format.SpaceAfter = 24
        oPara4.Range.InsertParagraphAfter()

        'Insert a 5 x 2 table, fill it with data, and change the column widths.
        oTable = oDoc.Tables.Add(oDoc.Bookmarks.Item("\endofdoc").Range, 5, 2)
        oTable.Range.ParagraphFormat.SpaceAfter = 6
        For r = 1 To 5
            For c = 1 To 2
                oTable.Cell(r, c).Range.Text = "r" & r & "c" & c
            Next
        Next
        oTable.Columns.Item(1).Width = oWord.InchesToPoints(2)   'Change width of columns 1 & 2
        oTable.Columns.Item(2).Width = oWord.InchesToPoints(3)

        'Keep inserting text. When you get to 7 inches from top of the
        'document, insert a hard page break.
        Pos = oWord.InchesToPoints(7)
        oDoc.Bookmarks.Item("\endofdoc").Range.InsertParagraphAfter()
        Do
            oRng = oDoc.Bookmarks.Item("\endofdoc").Range
            oRng.ParagraphFormat.SpaceAfter = 6
            oRng.InsertAfter("A line of text")
            oRng.InsertParagraphAfter()
        Loop While Pos >= oRng.Information(Word.WdInformation.wdVerticalPositionRelativeToPage)
        oRng.Collapse(Word.WdCollapseDirection.wdCollapseEnd)
        oRng.InsertBreak(Word.WdBreakType.wdPageBreak)
        oRng.Collapse(Word.WdCollapseDirection.wdCollapseEnd)
        oRng.InsertAfter("We're now on page 2. Here's my chart:")
        oRng.InsertParagraphAfter()

        'Insert a chart and change the chart.
        oShape = oDoc.Bookmarks.Item("\endofdoc").Range.InlineShapes.AddOLEObject( _
            ClassType:="MSGraph.Chart.8", FileName _
            :="", LinkToFile:=False, DisplayAsIcon:=False)
        oChart = oShape.OLEFormat.Object
        oChart.charttype = 4 'xlLine = 4
        oChart.Application.Update()
        oChart.Application.Quit()
        'If desired, you can proceed from here using the Microsoft Graph 
        'Object model on the oChart object to make additional changes to the
        'chart.
        oShape.Width = oWord.InchesToPoints(6.25)
        oShape.Height = oWord.InchesToPoints(3.57)

        'Add text after the chart.
        oRng = oDoc.Bookmarks.Item("\endofdoc").Range
        oRng.InsertParagraphAfter()
        oRng.InsertAfter("THE END.")

        'All done. Close this form.
        Me.Close()

    End Sub

Saludos.

Juego de la vida de Conway (parte 3):

En la parte 2 mostraba el código fuente del programa hecho en VB.NET.
Alguien me ha dicho que le gustaría verlo en ejecución, así que aquí va una muestra de algunas estructuras simples y otras complejas del autómata celular de Conway:

Hay formas básicas que no se mueven y otras que apenas te guiñan un ojo:



Esto lo tenéis que ver porque las formas creadas de forma totalmente aleatoria tienen su propia belleza y proporción (lo he grabado por pura casualidad. Por eso hay algún tiempo muerto y algún intento de meter más puntos en el tablero. Luego he visto que la vida evoluciona en bonitas formas similares a letras y dibujos sugerentes, así que lo he subido como está).



Por último aquí vemos que la complejidad puede ir en aumento sin límite alguno. Bueno, la limitación de mi programa es que todo se reduce a un array de 20x20.

El juego de la vida de Conway (parte 2):

En la parte 1 de este tema, comentaba que Alan Turing siguiendo su propia intuición descubrió y demostró matemáticamente la AUTOORGANIZACIÓN.

Posiblemente las células de los seres vivos evolucionen de forma similar. No tienen una comunicación clara con el resto de células, y tampoco hay nada que controle todas la células, pero cada una de ellas termina teniendo una función diferenciada.

Turing abrió el camino, pero luego otros se dedicaron a "diseñar" sus propios "autómatas celulares". En 1970 John Horton Conway publicó su autómata en Scientific American en la sección dedicada a juegos matemáticos.

Hoy en día es el autómata celular más conocido y se llama "JUEGO DE LA VIDA". Las reglas son muy sencillas:

Es un juego en el que tenemos un tablero dónde inicialmente colocamos una serie de células vivas.

Generación a generación las células del tablero irán naciendo o muriendo siguiente estas reglas:

1.-Si una célula viva tiene a su alrededor menos de 2 células vivas se muere por "soledad".
2.-Si una célula viva tiene a su alrededor más de 3 células vivas se muere por "superpoblación".
3.-En una celda que esté rodeada por exactamente 3 células vivas surgirá vida en forma de una célula viva.

Este es el programa que he hecho en VB.NET.

Muestra un tablero de 20 x 20, dónde podemos marcar las celdas con células vivas.
Hay tres botones:

1. Haciendo clic en "Una hora más" aplicamos las reglas para pasar a ver cómo queda la siguiente generación de células.
2. Pinchando "Lanzar hasta el final" vemos como evolucionan las células hasta el infinito.
3. Para terminar la simulación clic en "FIN".

En el próximo post publicaré en algún sitio el ejecutable (se aceptan sugerencias), y algunas de las figuras más conocidas que se crean, y que reciben un nombre que describe su comportamiento.

El código fuente:

Option Explicit On
Option Strict On

Imports System.Drawing.Drawing2D
Imports System.Math 'para truncate()
Imports System.Threading.Thread 'para usar sleep()

Public Class Form1

    Dim oPen As Pen
    Dim oGrafico As Graphics
    Dim cuadro(20, 20) As Boolean

    Private Sub Form1_Load(ByVal sender As System.Object, _
                       ByVal e As System.EventArgs) Handles MyBase.Load
        Me.BackColor = Color.Gray
        Dim i, j As Integer
        For i = 1 To 20
            For j = 1 To 20
                cuadro(i, j) = False
            Next
        Next
    End Sub

    Private Sub Form1_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseClick
        Dim punto As Point
        Dim cuadroX As Integer
        Dim cuadroY As Integer
        If e.Location.X > 30 And e.Location.X < 630 And e.Location.Y > 30 And e.Location.Y < 630 Then
            cuadroX = CInt(Truncate(e.Location.X / 30))
            cuadroY = CInt(Truncate(e.Location.Y / 30))
            cuadro(cuadroX, cuadroY) = True
            punto.X = cuadroX * 30
            punto.Y = cuadroY * 30
            'Dibujamos un círculo negro...
            oGrafico.FillEllipse(New SolidBrush(Color.Black), New Rectangle(punto, New Size(30, 30)))
        End If
    End Sub
    Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint

        Dim x, y As Integer
        oGrafico = Me.CreateGraphics
        oPen = New Pen(Color.White, 1)

        For x = 1 To 21
            'Ponemos 21 columnas:
            Dim pt1 As New Point(30 * x, 30)
            Dim pt2 As New Point(30 * x, 630)
            oGrafico.DrawLine(oPen, pt1, pt2)

        Next
        For y = 1 To 21
            'Ponemos 21 filas:
            Dim pt1 As New Point(30, 30 * y)
            Dim pt2 As New Point(630, 30 * y)
            oGrafico.DrawLine(oPen, pt1, pt2)
        Next
        dibujarCelulas()
    End Sub

    Private Sub btnUnaHoraMas_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnUnaHoraMas.Click
        nuevaGeneracion()
    End Sub

    Private Sub btnLanzarHastaElFinal_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLanzarHastaElFinal.Click
        Timer1.Enabled = True
    End Sub

    Private Sub nuevaGeneracion()
        Dim i, j, numVecinos As Integer
        Dim cuadroNuevo(20, 20) As Boolean
        For i = 1 To 20
            For j = 1 To 20
                cuadroNuevo(i, j) = cuadro(i, j)
                numVecinos = vecinos(i, j)
                If cuadro(i, j) Then 'si la célula está viva...
                    If numVecinos <> 2 And numVecinos <> 3 Then
                        cuadroNuevo(i, j) = False
                    End If
                Else 'si la célula está muerta...
                    If numVecinos = 3 Then cuadroNuevo(i, j) = True
                End If
            Next
        Next
        cuadro = cuadroNuevo
        dibujarCelulas()
    End Sub

    Private Sub dibujarCelulas()
        Dim punto As Point
        'dibujar la nueva situación:
        For i = 1 To 20
            For j = 1 To 20
                punto.X = i * 30
                punto.Y = j * 30
                If cuadro(i, j) Then
                    'Dibujamos círculo negro
                    oGrafico.FillEllipse(New SolidBrush(Color.Black), New Rectangle(punto, New Size(30, 30)))
                Else 'Dibujamos círculo gris que es como borra ya que el fondo es gris.
                    oGrafico.FillEllipse(New SolidBrush(Color.Gray), New Rectangle(punto, New Size(30, 30)))
                End If
            Next
        Next
    End Sub

    Private Function vecinos(ByVal i As Integer, ByVal j As Integer) As Integer
        Dim numero As Integer = 0
        If i > 1 And j > 1 Then
            If cuadro(i - 1, j - 1) Then numero = numero + 1
        End If
        If i > 1 Then
            If cuadro(i - 1, j) Then numero = numero + 1
        End If
        If i > 1 And j < 20 Then
            If cuadro(i - 1, j + 1) Then numero = numero + 1
        End If
        If j > 1 Then
            If cuadro(i, j - 1) Then numero = numero + 1
        End If
        If j < 20 Then
            If cuadro(i, j + 1) Then numero = numero + 1
        End If
        If i < 20 And j > 1 Then
            If cuadro(i + 1, j - 1) Then numero = numero + 1
        End If
        If i < 20 Then
            If cuadro(i + 1, j) Then numero = numero + 1
        End If
        If i < 20 And j < 20 Then
            If cuadro(i + 1, j + 1) Then numero = numero + 1
        End If
        Return numero
    End Function

    Private Sub btnFin_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFin.Click
        Timer1.Enabled = False
        Application.Exit()
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        nuevaGeneracion()
    End Sub
End Class

8 reinas con las soluciones singulares y derivadas

Recordad que el problema que se planteaba no es la típica de las 8 damas.
Tiene un extra y es localizar las 12 soluciones originales y sus derivadas que en total son 92.

El autor del programa es Eduardo Prez de Argentina. Este autor ha colaborado también en buenos sitios de programación como el de Elguille. Aquí un ejemplo.

Por cierto, el autor ha elegido QBASIC (novedad del MSDOS 5.0 ) que sustituyó el GWBASIC de 1983 (mi primer lenguaje con el MSDOS 3.3, sniff sniff).

GWBASIC requería numerar las líneas lo cual era un rollo a la hora de toquetear el código. Si además utilizabas el GOTO la interpretación de programas ya era una locura.

QBASIC ya no requiere la numeración, aunque yo se la he añadido sólo para facilitar la lectura.

Enseguida recordaréis el mayor problema del QBASIC. No facilita la programación estructurada con tanto GOSUB sin especificar parámetros, sin declaración previa de funciones, Bloques IF sin delimitadores de bloque, posibilidad de utilizar el GOTO del demonio, etc. etc.

Aclaración:

Cada solución es un string con 8 coordenadas. En el formato empleado cada coordenada está compuesta por 4 caracteres (longitud = 32).

Ejemplo del string con solución no válida: |11||25||38||46||53||67||72||84|

 1 '8DAMAS.BAS-2010.09.11-22:54-2010.09.16-11:46
 2 DIM StrSol12$, IntSol92%
 3 DIM StrSol92$, IntSol12%
 4 DIM StrO$(12), IntO%, StrA$, IntA%
 5 DIM StrSo$(12), IntSo%, Hasta%
 6 DIM K$, KN$, Dama$, MA$, M$, U$, D$, V$, C$, Z$
 7 DIM Li%, Co%, Grabar%, VDis%, Ve%, Ka%, I%, J%, R%, x%, W%
 8 '=============================================================================
 9 CLS
10 GOSUB InicioDamasTxt
11        Li% = 1
12        Co% = 1
13  IntSol92% = 0
14  IntSol12% = 0
15     IntSo% = 0
16         V$ = "|1 ||2 ||3 ||4 ||5 ||6 ||7 ||8 |"
17 K$ = ""
18 '=============================================================================
19 DO
20 GOSUB VerificarDisponibilidad
21 IF VDis% = 1 THEN 'if-01 comienza dama a tira solucion
22            'K$ = |11||22||33||44||55||66||77||88|
23                        Dama$ = MID$(STR$(Li%), 2) + MID$(STR$(Co%), 2)
24        K$ = K$ + "|" + Dama$ + "|"
25 '=============================================================================
26 IF LEN(K$) = 32 THEN 'if-02 comienza completo 32 caracteres
27 '=============================================================================
28 'normalizar solucion
29 KN$ = "":                                       FOR R% = 1 TO 8
30                      W% = INSTR(K$, "|" + MID$(STR$(R%), 2))
31 KN$ = KN$ + MID$(K$, W%, 4)
32                                                NEXT R%
33 '=============================================================================
34                            Grabar% = 1 's1 grabar por defecto
35 OPEN "8DAMAS.TXT" FOR INPUT AS #1
36                    DO WHILE EOF(1) = False
37                     LINE INPUT #1, D$
38                     IF KN$ = LEFT$(D$, 32) THEN 'if-03
39                            Grabar% = 0 'n0 grabar ya existe en la lista
40                    EXIT DO
41                     END IF 'if-03
42                    LOOP
43                          CLOSE #1
44 '=============================================================================
45                         IF Grabar% = 1 THEN 'if-04 comienza grabar
46  D$ = KN$
47 '=============================================================================
48 GOSUB GiroYVolteo
49        IntSo% = IntSo% + 1
50 StrSo$(IntSo%) = StrO$(1)
51                                           FOR R% = 1 TO 8: IntSol92% = IntSol92%
52                                           + 1
53                                    Z$ = StrO$(R%)
54                          PRINT #1, Z$
55                                          NEXT R%
56                          CLOSE #1
57 IF IntSol92% = 96 THEN 'if-10
58          FOR R% = 1 TO 12
59        StrO$(R%) = StrSo$(R%)
60         NEXT R%
61 Hasta% = 12: GOSUB Ordenar
62          FOR R% = 1 TO 12
63       StrSo$(R%) = StrO$(R%)
64 PRINT StrSo$(R%)
65         NEXT R%
66 GOSUB InicioDamasTxt
67  IntSol92% = 0
68  IntSol12% = 0
69         FOR x% = 1 TO 12
70 D$ = StrSo$(x%): GOSUB GiroYVolteo: GOSUB Imprimir
71        NEXT x%
72 INPUT "PULSAR ENTER PARA SALIR", Z$
73 END'salida FIN
74 END IF
75 '=============================================================================
76 END IF 'if-04 finaliza grabar
77 END IF 'if-02 finaliza completo 32 caracteres
78 END IF 'if-01 finaliza dama a tira solucion
79 GOSUB CambiarCol
80 LOOP
81 END'salida FIN
82 '=============================================================================
83 VerificarDisponibilidad:
84        VDis% = 1 ' disponible s1,
85 '========================================================
86 'verificar si la linea    esta ocupada
87                       FOR Ka% = 1 TO LEN(K$) STEP 4
88     IF Li% = VAL(MID$(K$, Ka% + 1, 1)) THEN 'if-07
89        VDis% = 0 'disponible n0, linea    ocupada       'LINOCU 100976/8=12622
90        RETURN    'no verificar nada mas, salir urgente
91 END IF'if-07
92                      NEXT Ka%
93 '========================================================
94 'verificar si la columna  esta ocupada
95                       FOR Ka% = 1 TO LEN(K$) STEP 4
96     IF Co% = VAL(MID$(K$, Ka% + 2, 1)) THEN 'if-08
97        VDis% = 0 'disponible n0, columna  ocupada       'COLOCU 106384/8=13298
98        RETURN    'no verificar nada mas, salir urgente
99 END IF'if-08
100                      NEXT Ka%
101 '========================================================
102 'verificar si la diagonal esta ocupada
103                           FOR Ka% = 1 TO LEN(K$) STEP 4
104     IF ABS(Li% - VAL(MID$(K$, Ka% + 1, 1))) = ABS(Co% - VAL(MID$(K$, Ka% + 2, 1))
105     ) THEN 'if-09
106        VDis% = 0 'disponible n0, diagonal ocupada       'DIAOCU  33784/8= 4223
107        RETURN    'no verificar nada mas, salir urgente
108 END IF'if-09
109                          NEXT Ka%
110 RETURN
111 '=============================================================================
112 formato:
113                                                         IntA% = IntA% + 1
114                                       StrA$ = MID$(STR$(IntA%), 2)
115 StrA$ = STRING$(2 - LEN(StrA$), 48) + StrA$
116 RETURN
117 '=============================================================================
118 OtraLinea:
119             IntA% = IntSol92%: GOSUB formato
120 IntSol92% = IntA%
121 StrSol92$ = StrA$
122 RETURN
123 '=============================================================================
124 CambiarCol:
125 IF Li% = 8 AND Co% = 8 THEN 'if-11
126                   U$ = RIGHT$(K$, 4)   'IF11--  26072/8= 3259
127            K$ = LEFT$(K$, LEN(K$) - 4) 'quita ultima dama
128    Li% = VAL(MID$(U$, 2, 1))
129    Co% = VAL(MID$(U$, 3, 1))
130 IF Co% < 8 THEN 'if-12
131    Co% = Co% + 1'IF12SI  23832/8= 2979
132    ELSE
133                   U$ = RIGHT$(K$, 4)  'IF12NO   2240/8=  280
134           K$ = LEFT$(K$, LEN(K$) - 4) 'quita ultima dama
135    Li% = VAL(MID$(U$, 2, 1))
136    Co% = VAL(MID$(U$, 3, 1)) + 1
137 END IF'if-12
138 RETURN
139 END IF'if-11
140     IF Co% < 8 THEN 'if-13
141        Co% = Co% + 1                  'IF13SI 222352/8=27794
142 ELSE
143     GOSUB CambiarLin                  'IF13NO  21088/8= 2636
144        Co% = 1
145 END IF'if-13
146 RETURN
147 '=============================================================================
148 CambiarLin:
149 IF Li% < 8 THEN Li% = Li% + 1'if-14
150 RETURN
151 '=============================================================================
152 Imprimir:
153             IntA% = IntSol12%: GOSUB formato
154 IntSol12% = IntA%
155 StrSol12$ = StrA$
156 GOSUB OtraLinea
157                         FOR S% = 1 TO 8
158 MA$ = "|":       M$ = StrO$(S%)
159                  FOR R% = 1 TO 32 STEP 4
160 MA$ = MA$ + MID$(M$, R% + 1, 3)
161                 NEXT R%
162                       StrO$(S%) = MA$
163                        NEXT S%
164 
165                                     Z$ = StrO$(1) + " (" + StrSol92$ + ") SALEN 
166                                     DE: " + StrO$(1) + " (" + StrSol12$ + ")"
167                           PRINT #1, Z$
168                               PRINT Z$
169                                            FOR IntO% = 2 TO 8
170                   IF StrO$(IntO% - 1) <> StrO$(IntO%) THEN 'if-06
171         GOSUB OtraLinea
172                                     Z$ = StrO$(IntO%) + " (" + StrSol92$ + ")"
173                           PRINT #1, Z$
174                               PRINT Z$
175 END IF 'if-06
176                                           NEXT IntO%
177                                     Z$ =
178                                     "============================================
179                                     ==========================="
180                           PRINT #1, Z$
181                               PRINT Z$
182                           CLOSE #1
183 RETURN
184 '=============================================================================
185 Ordenar:
186             FOR I% = 1 TO Hasta% - 1
187                         FOR J% = I% + 1 TO Hasta%
188        IF StrO$(I%) > StrO$(J%) THEN 'if-05
189      SWAP StrO$(I%), StrO$(J%)
190 END IF 'if-05
191                        NEXT J%
192            NEXT I%
193 RETURN
194 '=============================================================================
195 GiroYVolteo:
196 'giro 90 grados direccion reloj
197         IntO% = 0
198  FOR Ve% = 1 TO 4
199      K$ = V$
200                   FOR R% = 1 TO 32 STEP 4
201                                              C$ = MID$(STR$((9 - VAL(MID$(D$, R%
202                                              + 1, 1)))), 2) 'giro 90 grados 
203                                              direccion reloj
204 MID$(K$, VAL(MID$(D$, R% + 2, 1)) * 4 - 1) = C$
205                  NEXT R%
206 '=============================================================================
207            IntO% = IntO% + 1
208      StrO$(IntO%) = K$ 'guarda giro 90 grados direccion reloj
209 '=============================================================================
210 'volteo vertical
211  D$ = K$
212       K$ = V$
213                               FOR R% = 1 TO 32 STEP 4
214                     C$ = MID$(D$, R% + 2, 1) 'volteo vertical
215 MID$(K$, 32 - R%) = C$
216                              NEXT R%
217 '=============================================================================
218 D$ = StrO$(IntO%) 'inicializa proxima solucion a girar
219            IntO% = IntO% + 1
220      StrO$(IntO%) = K$ 'guarda volteo vertical
221 NEXT Ve%
222 '=============================================================================
223 'ordenar de menor a mayor
224 Hasta% = 8: GOSUB Ordenar
225 '=============================================================================
226 OPEN "8DAMAS.TXT" FOR APPEND AS #1
227 '=============================================================================
228 RETURN
229 '=============================================================================
230 InicioDamasTxt:
231 OPEN "8DAMAS.TXT" FOR OUTPUT AS #1
232                           PRINT #1, "Listado de soluciones Posibles         
233                           Listado de soluciones Diferentes"
234                           PRINT #1,
235                           "======================================================
236                           ================="
237                           CLOSE #1
238 RETURN
239 '=============================================================================
240 'IF12NO   2240/8=  280
241 'IF13NO  21088/8= 2636
242 'IF12SI  23832/8= 2979
243 'IF11--  26072/8= 3259
244 'DIAOCU  33784/8= 4223
245 'LINOCU 100976/8=12622
246 'COLOCU 106384/8=13298
247 'IF13SI 222352/8=27794
248 '                67091---> 1.53125/67091=.000022823478559 segundos x if 
249 'TIEMPO TOTAL DE EJECUCION 1.53125 SEGUNDOS -2010.09.16-11:51
250 

Resultado de la ejecución:

Listado de soluciones Posibles Listado de soluciones Diferentes
=======================================================================
|11|25|38|46|53|67|72|84| (01) SALEN DE: |11|25|38|46|53|67|72|84| (01)
|11|27|35|48|52|64|76|83| (02)
|13|26|34|42|58|65|77|81| (03)
|14|22|37|43|56|68|75|81| (04)
|15|27|32|46|53|61|74|88| (05)
|16|23|35|47|51|64|72|88| (06)
|18|22|34|41|57|65|73|86| (07)
|18|24|31|43|56|62|77|85| (08)
=======================================================================
|11|26|38|43|57|64|72|85| (09) SALEN DE: |11|26|38|43|57|64|72|85| (02)
|11|27|34|46|58|62|75|83| (10)
|13|25|32|48|56|64|77|81| (11)
|14|27|35|42|56|61|73|88| (12)
|15|22|34|47|53|68|76|81| (13)
|16|24|37|41|53|65|72|88| (14)
|18|22|35|43|51|67|74|86| (15)
|18|23|31|46|52|65|77|84| (16)
=======================================================================
|12|24|36|48|53|61|77|85| (17) SALEN DE: |12|24|36|48|53|61|77|85| (03)
|13|28|34|47|51|66|72|85| (18)
|14|22|38|46|51|63|75|87| (19)
|14|27|33|48|52|65|71|86| (20)
|15|22|36|41|57|64|78|83| (21)
|15|27|31|43|58|66|74|82| (22)
|16|21|35|42|58|63|77|84| (23)
|17|25|33|41|56|68|72|84| (24)
=======================================================================
|12|25|37|41|53|68|76|84| (25) SALEN DE: |12|25|37|41|53|68|76|84| (04)
|13|26|32|47|51|64|78|85| (26)
|14|21|35|48|52|67|73|86| (27)
|14|26|38|43|51|67|75|82| (28)
|15|23|31|46|58|62|74|87| (29)
|15|28|34|41|57|62|76|83| (30)
|16|23|37|42|58|65|71|84| (31)
|17|24|32|48|56|61|73|85| (32)
=======================================================================
|12|25|37|44|51|68|76|83| (33) SALEN DE: |12|25|37|44|51|68|76|83| (05)
|13|26|32|47|55|61|78|84| (34)
|13|26|38|41|54|67|75|82| (35)
|14|28|31|45|57|62|76|83| (36)
|15|21|38|44|52|67|73|86| (37)
|16|23|31|48|55|62|74|87| (38)
|16|23|37|42|54|68|71|85| (39)
|17|24|32|45|58|61|73|86| (40)
=======================================================================
|12|26|31|47|54|68|73|85| (41) SALEN DE: |12|26|31|47|54|68|73|85| (06)
|13|21|37|45|58|62|74|86| (42)
|13|25|37|41|54|62|78|86| (43)
|14|26|31|45|52|68|73|87| (44)
|15|23|38|44|57|61|76|82| (45)
|16|24|32|48|55|67|71|83| (46)
|16|28|32|44|51|67|75|83| (47)
|17|23|38|42|55|61|76|84| (48)
=======================================================================
|12|26|38|43|51|64|77|85| (49) SALEN DE: |12|26|38|43|51|64|77|85| (07)
|13|27|32|48|56|64|71|85| (50)
|14|22|35|48|56|61|73|87| (51)
|14|28|35|43|51|67|72|86| (52)
|15|21|34|46|58|62|77|83| (53)
|15|27|34|41|53|68|76|82| (54)
|16|22|37|41|53|65|78|84| (55)
|17|23|31|46|58|65|72|84| (56)
=======================================================================
|12|27|33|46|58|65|71|84| (57) SALEN DE: |12|27|33|46|58|65|71|84| (08)
|12|28|36|41|53|65|77|84| (58)
|14|21|35|48|56|63|77|82| (59)
|14|27|35|43|51|66|78|82| (60)
|15|22|34|46|58|63|71|87| (61)
|15|28|34|41|53|66|72|87| (62)
|17|21|33|48|56|64|72|85| (63)
|17|22|36|43|51|64|78|85| (64)
=======================================================================
|12|27|35|48|51|64|76|83| (65) SALEN DE: |12|27|35|48|51|64|76|83| (09)
|13|26|34|41|58|65|77|82| (66)
|14|22|37|43|56|68|71|85| (67)
|14|28|31|43|56|62|77|85| (68)
|15|21|38|46|53|67|72|84| (69)
|15|27|32|46|53|61|78|84| (70)
|16|23|35|48|51|64|72|87| (71)
|17|22|34|41|58|65|73|86| (72)
=======================================================================
|13|25|32|48|51|67|74|86| (73) SALEN DE: |13|25|32|48|51|67|74|86| (10)
|14|26|38|42|57|61|73|85| (74)
|15|23|31|47|52|68|76|84| (75)
|16|24|37|41|58|62|75|83| (76)
=======================================================================
|13|25|38|44|51|67|72|86| (77) SALEN DE: |13|25|38|44|51|67|72|86| (11)
|13|26|38|42|54|61|77|85| (78)
|13|27|32|48|55|61|74|86| (79)
|14|22|38|45|57|61|73|86| (80)
|15|27|31|44|52|68|76|83| (81)
|16|22|37|41|54|68|75|83| (82)
|16|23|31|47|55|68|72|84| (83)
|16|24|31|45|58|62|77|83| (84)
=======================================================================
|13|26|32|45|58|61|77|84| (85) SALEN DE: |13|26|32|45|58|61|77|84| (12)
|13|26|38|41|55|67|72|84| (86)
|14|22|37|45|51|68|76|83| (87)
|14|27|31|48|55|62|76|83| (88)
|15|22|38|41|54|67|73|86| (89)
|15|27|32|44|58|61|73|86| (90)
|16|23|31|48|54|62|77|85| (91)
|16|23|37|44|51|68|72|85| (92)
=======================================================================