AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Summe ausgeben, nur wie?

Ein Thema von Sn00bY · begonnen am 6. Feb 2009 · letzter Beitrag vom 8. Feb 2009
 
Sn00bY

Registriert seit: 5. Feb 2009
8 Beiträge
 
#19

Re: Summe ausgeben, nur wie?

  Alt 7. Feb 2009, 16:22
Hallo Jürgen, ich hab gefunden, was ich gesucht habe, dank dir.
Jetzt hab ich nur noch ein Problem:

In dem Programm was ich geschrieben hab, konnte ich per Eingabe festlegen, wie groß das quadrat sein soll.
Dies geht jetzt leider nicht, obwohl ich es mit

write ('blabla'); readln (n);
Setlength(quadrat,1,n);

dazu bringen wollte.

hier der Code:



Delphi-Quellcode:
program magisch_quadrat;

    {$APPTYPE CONSOLE}

uses SysUtils;

const ord=6; //soll wegfallen

var quadrat, matrix1, matrix2 : array[1..ord, 1..ord] of integer; // array[1..ord, 1..ord] soll zu array of array of integer werden
i, j : integer; // n : integer

procedure odd;
var x, y, anz :integer;
begin
// hier müsste jetzt write ('blabla'); readln (n);
// Setlength(quadrat,1,n);
   x:=(ord+1) div 2;
   y:=1;
   anz:=0;
   for i:=1 to (ord*ord) do
   begin
      quadrat[x, y]:=i;
      inc(anz);
      if (anz mod ord=0) then inc(y)
      else
      begin
         if (x=ord) then x:=1 else inc(x);
         if (y=1) then y:=ord else dec(y);
      end;
   end
end;

procedure oddmod2;
var x, y, anz, zw : integer;

begin
   x:=(ord div 2+1) div 2;
   y:=1;
   anz:=0;
   for i:=1 to (ord*ord div 4) do
   begin
      quadrat[y, x]:=i;
      inc(anz);
      if (anz mod (ord div 2)=0) then inc(y)
      else
      begin
         if (x=ord div 2) then x:=1 else inc(x);
         if (y=1) then y:=ord div 2 else dec(y);
      end;
   end;

   x:=(ord div 2+1) div 2 +(ord div 2);
   y:=1+(ord div 2);
   anz:=0;
   for i:=1 to (ord*ord div 4) do
   begin
      quadrat[y, x]:=i+(ord*ord div 4);
      inc(anz);
      if (anz mod (ord div 2)=0) then inc(y)
    else
    begin
      if (x=ord) then x:=ord div 2 +1 else inc(x);
      if (y=ord div 2 +1) then y:=ord else dec(y);
    end;
   end;

   x:=(ord div 2+1) div 2 +(ord div 2);
   y:=1;
   anz:=0;
   for i:=1 to (ord*ord div 4) do
   begin
      quadrat[y, x]:=i+2*(ord*ord div 4);
      inc(anz);
      if (anz mod (ord div 2)=0) then inc(y)
      else
      begin
        if (x=ord) then x:=ord div 2+1 else inc(x);
        if (y=1) then y:=ord div 2 else dec(y);
      end;
   end;

   x:=(ord div 2+1) div 2;
   y:=1+(ord div 2);
   anz:=0;
   for i:=1 to (ord*ord div 4) do
   begin
      quadrat[y, x]:=i+3*(ord*ord div 4);
      inc(anz);
      if (anz mod (ord div 2)=0) then inc(y)
      else
      begin
        if (x=ord div 2) then x:=1 else inc(x);
        if (y=ord div 2+1) then y:=ord else dec(y);
      end;
   end;

   for i:=1 to (ord div 3) do
   begin
      zw:=quadrat[i, i];
      quadrat[i, i]:=quadrat[ord div 2+i, i];
      quadrat[ord div 2+i, i]:=zw;

      if (i<>ord div 3) then
      begin
         zw:=quadrat[ord div 2+1-i, i];
         quadrat[ord div 2+1-i, i]:=quadrat[ord+1-i, i];
         quadrat[ord+1-i, i]:=zw;
      end;
   end;
end;

procedure mod4;
var a, b, erg, zw : integer;
begin
   zw:=ord div 4;
   for i:=1 to ord do
   for j:=1 to ord do
   begin
      a:=((i-1) div (zw));
      b:=((j-1) div (zw));
      erg:=a*4+b+1;
      case erg of
       1, 4, 6, 7, 10, 11, 13, 16: quadrat[i, j]:=(i-1)*ord+j;
       else quadrat[ord+1-i, ord+1-j]:=(i-1)*ord+j;
      end;
   end;
end;


procedure ausgabe;
begin
   for i:=1 to ord do
   begin
      for j:=1 to ord do Write(quadrat[i, j]:3);
      Writeln;
   end;
   Readln;
end;

begin
   if (ord mod 4=0) then mod4
   else if (ord mod 2=1) then odd
   else oddmod2;
   ausgabe;
end.


bitte um ideen ^^
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 03:31 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz