Ver Mensaje Individual
  #6 (permalink)  
Antiguo 07/03/2007, 15:41
boluart
 
Fecha de Ingreso: enero-2007
Ubicación: Tingo María - Perú
Mensajes: 399
Antigüedad: 17 años, 3 meses
Puntos: 13
Re: alguien sabe traducir c en vb

Mira aqui tengo un avance estoy aun viendo algunas cosas de la funcion Main y por cierto es pascal

Const MaxOrder = 175
Dim i As Integer, j As Integer, n As Integer, n2 As Integer, width As Integer, device As Integer
Dim constant As Long
Dim cell(MaxOrder, MaxOrder) As Integer
Private Sub exchange(ByVal i As Integer, ByVal j As Integer, ByVal s As Integer, ByVal t As Integer)
Dim temp As Integer
temp = cell(i, j)
cell(i, j) = cell(s, t)
cell(s, t) = temp
End Sub
Private Sub PrintSquare()
Dim i As Integer, j As Integer, k As Integer, i1 As Integer, i2 As Integer, lines As Integer, columns As Integer
columns = n
lines = 1
If columns * width > 79 Then
columns = 69 \ width
lines = (n - 1) \ (columns + 1)
End If
If device = 1 Then
'clrscr()
End If
'WriteLine(f, "Magic square of order ', n, ' with constant ", constant)
'WriteLine(f)
For j = 1 To n
For k = 1 To lines
If lines > 1 Then
If k = 1 Then
'write( f, 'Row ', j :3, ' : ')
Else
'write( f, ' ' :10)
End If
End If
i2 = k * columns;
i1 = i2 - columns + 1
If i2 > n Then i2 = n
For i = i1 To i2
'write( f, cell( i, j) :width)
Next
If lines > 1 Then
'WriteLine(f)
End If
Next
'writeln(f)
Next

''if device = 2 then PageF;
''close(f)
End Sub
Private Sub DoublyEven()
Dim i As Integer, j As Integer, k As Integer, m As Integer, ndivm As Integer, n2plus1 As Integer
m = n \ 4
ndivm = n \ m
n2plus1 = n * n + 1
For i = 1 To n
For j = 1 To n
cell(i, j) = n * (j - 1) + i
Next
Next
For i = 0 To m - 1
For j = 0 To m - 1
For k = 1 To 4
cell(i * 4 + k, j * 4 + k) = n2plus1 - cell(i * 4 + k, j * 4 + k)
cell(i * 4 + k, j * 4 + 5 - k) = n2plus1 - cell(i * 4 + k, j * 4 + 5 - k)
Next
Next
Next

End Sub
Private Sub Loubere(ByVal n As Integer)
Dim i As Integer, x As Integer, y As Integer
x = (n + 1) \ 2
y = 1
cell(x, y) = 1
For i = 2 To n * n 'do
x = x + 1
y = y - 1
If x > n Then x = 1
If y < 1 Then y = n
While cell(x, y) > 0 'do
x = x - 1
y = y + 2
If x < 1 Then x = n
If y > n Then y = y - n
End While
cell(x, y) = i
Next

End Sub
Private Sub Strachey()
Dim i As Integer, j As Integer, m As Integer, mid As Integer, ndiv2 As Integer, biasb As Integer, biasc As Integer, biasd As Integer, cij As Integer
ndiv2 = n \ 2
biasb = ndiv2 * ndiv2
biasc = 2 * biasb
biasd = biasb + biasc
Loubere(ndiv2)
For i = 1 To ndiv2
For j = 1 To n \ 2
cij = cell(i, j)
cell(i + ndiv2, j + ndiv2) = cij + biasb
cell(i + ndiv2, j) = cij + biasc
cell(i, j + ndiv2) = cij + biasd
Next
Next
m = (n - 2) \ 4
mid = (ndiv2 + 1) \ 2
For i = 2 To 2 + m - 1
exchange(i, mid, i, mid + ndiv2)
Next

For j = 1 To ndiv2
If j <> mid Then
For i = 1 To m
exchange(i, j, i, j + ndiv2)
Next
End If

Next

For i = n To n - m + 2 Step -1
For j = 1 To ndiv2
exchange(i, j, i, j + ndiv2)
Next
Next


End Sub
Private Sub check()
Dim sum As Long
For i = 1 To n
sum = 0
For j = 1 To n
sum = sum + cell(i, j)
Next
If sum <> constant Then
'WriteLine( "Col ", i:4, " doesn''t check ", sum)
End If
Next
For i = 1 To n
sum = 0
For j = 1 To n
sum = sum + cell(j, i)
If sum <> constant Then
' 'writeln( 'Row ', i:4, ' doesn''t check ', sum);
' 'dopause := true
End If
Next
Next

sum = 0
For i = 1 To n 'do
sum = sum + cell(i, j)
Next
If sum <> constant Then
'writeln( 'First diagonal doesn''t check ', sum);
'dopause := true
End If
For i = 1 To n
sum = sum + cell(i, n - j)
Next
If sum <> constant Then
'writeln( 'Second diagonal doesn''t check ', sum);
'dopause := true
End If
End Sub

claro que la funcion 'WriteLine no te va a servir yo lo traduci al VB.NET como un proyecto de cosola en VB6.0 tendrias que usar el Me.Print o algo similar o si fuese mejor aun mostrarlos en un grid. En todo caso apenas culmine la traduccion te paso el proyecto completo.

Y otra cosa seria bueno que busques este algoritmo en VB6.0 porque ni por mas que lo traduscamos este codigo es muy probable que tenga algunos defectos.