Ver Mensaje Individual
  #4 (permalink)  
Antiguo 05/03/2007, 15:03
0_kool
 
Fecha de Ingreso: febrero-2007
Mensajes: 24
Antigüedad: 17 años, 2 meses
Puntos: 0
Re: alguien sabe traducir c en vb

Cita:
Iniciado por vangh Ver Mensaje
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

Cita:
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 ***}

Última edición por 0_kool; 05/03/2007 a las 15:13