tengo un proyecto que se me extravio y lo tengo respaldado es codigo en pascal y desep pasalo a vb
si alguien se interesa publico el codigo
| |||
alguien sabe traducir de pascal a vb no vb.net tengo un proyecto que se me extravio y lo tengo respaldado es codigo en pascal y desep pasalo a vb si alguien se interesa publico el codigo |
| |||
Re: alguien sabe traducir de pascal a vb no vb.net Cita: ahi 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 ***} |