alguien sabe traducir c en vb

[0_kool]

tengo un pequeñó programa en c y lo quiero en vb , alguien le pega a ambos leguajes

[boluart]

Estoy seguo que aqui hay alguien que entienda de ambos lenguajes, porque no pones aqui el codigo para ver que es lo que se puede hacer.

[vangh]

Si, pon el codigo aqui, talvez yo te pueda ayudar
pero es C,C++,C# o cual,

[0_kool]

Iniciado por vangh

Si, pon el codigo aqui, talvez yo te pueda ayudar
pero es C,C++,C# o cual,

no se que C es puesto que no se nada de C , la extension del unico archivo es pas , quiero este archivo en un proyecto en vbasic , si lo puedes traducir agradecido

aqui va

program magic_square;

{ Generate magic squares }



uses crt, MyStuff;

const MaxOrder = 175;

var
i, j, n, n2, width, device : integer;

constant : longint;

cell : array[ 1 .. MaxOrder, 1 .. MaxOrder] of integer;

DoPause : boolean;


procedure exchange( i, j, s, t : integer);
{ Exchange cell [ i, j] with cell[ s, t] }

var temp : integer;

begin
temp := cell[ i, j];
cell[ i, j] := cell[ s, t];
cell[ s, t] := temp
end; {*** exchange ***}


{.PA}
procedure PrintSquare;
{ print the results }

var i, j, k, i1, i2, lines, columns : integer;

begin

columns := n;
lines := 1;

if columns * width > 79 then
begin
columns := 69 div width;
lines := (n - 1) div columns + 1
end;

if device = 1 then clrscr;

writeln( f, 'Magic square of order ', n, ' with constant ', constant);
writeln( f);

for j := 1 to n do
begin
for k := 1 to lines do
begin
if lines > 1 then
if k = 1 then write( f, 'Row ', j :3, ' : ')
else write( f, ' ' :10);

i2 := k * columns;
i1 := i2 - columns + 1;

if i2 > n then i2 := n;

for i := i1 to i2 do write( f, cell[ i, j] :width);

if lines > 1 then writeln( f)
end;

writeln( f)
end;

if device = 2 then PageF;

close( f)

end; {*** Print Square ***}



{.PA}
procedure DoublyEven;
{ Method for magic squares when order mod 4 = 0. (Doubly even) }
{ Reference : Mathematical recreations and Essays, MacMillan, 1947 }
{ By W. W. Rouse Ball, Revised by H. S. M. Coxeter }
{ Republished by Dover in 1987 }

var i, j, k, m, ndivm, n2plus1 : integer;

begin

m := n div 4;
ndivm := n div m;
n2plus1 := n * n + 1;

for i := 1 to n do
for j := 1 to n do cell[ i, j] := n * (j - 1) + i;

for i := 0 to m - 1 do
for j := 0 to m - 1 do
for k := 1 to 4 do
begin
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]

end
end; {*** doubly even method ***}



{.PA}
procedure Loubere( n : integer);
{ Loubere's method for odd order magic squares. }
{ Reference : Mathematical recreations and Essays, MacMillan, 1947 }
{ By W. W. Rouse Ball, Revised by H. S. M. Coxeter }
{ Republished by Dover in 1987 }
{ Reference : Mathematical Diversions by J. A. H. Hunter & Joseph S. Madachy }
{ Page 25-26. (C) 1975 by Dover Publications }

var i, x, y : integer;

begin
x := (n + 1) div 2;
y := 1;

cell[ x, y] := 1;

for i := 2 to n * n do
begin
x := x + 1;
y := y - 1;

if x > n then x := 1;
if y < 1 then y := n;

while cell[ x, y] > 0 do
begin
x := x - 1;
y := y + 2;

if x < 1 then x := n;
if y > n then y := y - n
end;

cell[ x, y] := i
end {** for i := 2 to n **}

end; {*** Loubere's method ***}



{.PA}
procedure Strachey;
{ Strachey's method for magic squares when order mod 4 = 2. }
{ Reference : Mathematical recreations and Essays, MacMillan, 1947 }
{ By W. W. Rouse Ball, Revised by H. S. M. Coxeter }
{ Republished by Dover in 1987 }

var i, j, m, mid, ndiv2, biasb, biasc, biasd, cij : integer;

begin
ndiv2 := n div 2;
biasb := ndiv2 * ndiv2;
biasc := 2 * biasb;
biasd := biasb + biasc;

Loubere( ndiv2);

for i := 1 to ndiv2 do
for j := 1 to n div 2 do
begin
cij := cell[ i, j];

cell[ i + ndiv2, j + ndiv2] := cij + biasb;
cell[ i + ndiv2, j ] := cij + biasc;
cell[ i , j + ndiv2] := cij + biasd
end;

m := (n - 2) div 4;
mid := (ndiv2 + 1) div 2;

for i := 2 to 2 + m - 1 do exchange( i, mid, i, mid + ndiv2);

for j := 1 to ndiv2 do
if j <> mid then
for i := 1 to m do exchange( i, j, i, j + ndiv2);

for i := n downto n - m + 2 do
for j := 1 to ndiv2 do exchange( i, j, i, j + ndiv2)

end; {*** Strachey's method ***}


{ procedure check;

var sum : longint;

begin
for i := 1 to n do
begin
sum := 0;

for j := 1 to n do sum := sum + cell[ i, j];

if sum <> constant then
writeln( 'Col ', i:4, ' doesn''t check ', sum)
end;

for i := 1 to n do
begin
sum := 0;

for j := 1 to n do sum := sum + cell[ j, i];

if sum <> constant then
begin
writeln( 'Row ', i:4, ' doesn''t check ', sum);
dopause := true
end
end;

sum := 0;

for i := 1 to n do sum := sum + cell[ i, j];

if sum <> constant then
begin
writeln( 'First diagonal doesn''t check ', sum);
dopause := true
end;

for i := 1 to n do sum := sum + cell[ i, n - j];

if sum <> constant then
begin
writeln( 'Second diagonal doesn''t check ', sum);
dopause := true
end

end; *** check ***}


{.PA}
{*** main program ***}
begin

usecolors := false;

clrscr;


writeln( 'This program generates magic squares up to 175 X 175.');
writeln;

writeln;
writeln(
'A magic square is an N by N arrangement of the integers from 1 to N squared');
writeln(
'such that the numbers in each row, each column and each main diagonal sum ');
writeln( 'to the same number, called the constant of the matrix.');
writeln;
writeln( 'The most famous magic square is the ancient one of order 3 :');
writeln( ' 8 1 6');
writeln( ' 3 5 7');
writeln( ' 4 9 2');
writeln( 'where the magic constant is 15.');
writeln;

repeat
n := 0;

writeln;
write( 'Enter the order of the magic square ');
readln( n);

if n < 0 then
begin
Beep;
writeln( 'The order must be positive.')
end;

if n > MaxOrder then
begin
Beep;
writeln( 'The order must be < ', MaxOrder + 1)
end

until (n >= 0) and (n <= MaxOrder);

if n < 1 then halt;

if GetBoolean( 'Do you want to send the output to the printer (Y/N) ? ')
then
begin
assign( f, 'prn');
device := 2
end
else
begin
assigncrt( f);
device := 1
end;

rewrite( f);

n2 := n * n;
constant := n * (n2 + 1) div 2;

for i := 1 to n do for j := 1 to n do cell[ i, j] := 0;

width := 4;

if n2 > 999 then width := 5;
if n2 > 9999 then width := 6;

if odd( n) then Loubere( n);

if n mod 4 = 0 then DoublyEven;

if not odd( n) and (n mod 4 <> 0) and (n > 2) then Strachey;

if n = 2 then writeln( 'There are no magic squares of order 2.')
else PrintSquare

end. {*** Magic Square ***}

[vangh]

woa! Si es algo laborioso
pero no es C, es pascal.. conozco a una profesora que puede ayudar, solo es cuestion de esperar , le voy a dar el código y espero nos ayude pronto a resolver ok?

[boluart]

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.

[0_kool]

gracias por ayudar , por cierto era pascal , no se de donde saque que era c , bueno lo importante es que funcione y luego lo voy puliendo

vb.net no lo he visto , hace mucho que no veo vb por falta de tiempo , pero ayudando a otro amigo del foro lo instale de nuevo y justo tengo que usar este programa pero en vb


cualquier ayuda se agradece