Carré magique d’ordre 3 à 99 et plus si affinité !

rem ============================================================================
rem             Carré magique d’ordre 3 à 99 et plus si affinité !
rem                     Par Papydall Juillet 2017
rem ============================================================================

Que_La_Magie_Se_Magnifeste()

end
rem ============================================================================
SUB Init()    
    dim n,c                          : ' Dimension du carré de 3 à ... 99
    dim sz         : sz = 36         : ' Taille des cases en pixels
    dim TopMargin  : TopMargin  = 25 : ' marge supérieure à utiliser pour l'affichage
    dim LeftMargin : LeftMargin = 25 : ' marge gauche
    dim largeur                      : ' Largeur du PICTURE (dépend du nombre des cases
    dim hauteur                      : ' hauteur du PICTURE
    dim gauche     : gauche = 25     : ' Position du PICTURE
    dim haut       : haut = 50       : ' ................
    dim sq                           : ' Nombre de cases du carré magique
    dim r$, about%
END_SUB
rem ============================================================================
SUB Que_La_Magie_Se_Magnifeste()
    label calculer, Info, About, Quitter
    full_space 0 : color 0,255,255,255
    picture 10 : 2d_target_is 10 : print_target_is 10 : font_bold 10
    alpha 20 : top 20,10 : left 20,100 : font_bold 20 : font_size 20,20
    font_color 20,255,0,0 : font_name 20,"arial" : caption 20 , "Carré magique"
    alpha 30 : top 30,15 : left 30,350 : font_bold 30 : font_size 30,16
    font_color 30,0,0,255 : caption 30,"Dimension du carré"
    
    edit 40 : top 40,18 : left 40,550 : width 40,50 : font_bold 40 : set_focus 40
    hint 40,"Entrer un entier pair ou impair de 3 à 99"
    button 50 : top 50,15 : left 50,620 : font_bold 50 : caption 50,"&Calculer"
    button 60 : top 60,15 : left 60,860 : font_bold 60 : caption 60,"&Quitter"
    
    alpha 70 : top 70,40  : left 70,1000-900 : font_bold 70 : font_size 70,14
    font_color 70,0,0,255
    button 80 : top 80,15 : left 80,700 : font_bold 80 : caption 80,"&?"
    button 90 : top 90,15 : left 90,780 : font_bold 90 : caption 90,"&A propos"
    on_click 50, calculer : on_click 60, quitter : on_click 80,Info : on_click 90,About
    
    Application_title "Carrée magique d'ordre n = 3 ... 99 et plus si affinité !"
    Init()
END_SUB
rem ============================================================================
Calculer:
   r$ = text$(40)
   if numeric(r$) = 0
      message "La dimension doit être numérique" : return
   end_if  
   c = val(r$)
   if (c < 3) or (c > 99)
      message " La dimension doit être entre 3 (mini) et 99 (maxi)" : return
   end_if
   n = c
   largeur = sz * (n+1)
   hauteur = sz * (n+1)
   sq = n*n
   width 10, largeur : height 10, hauteur : top 10,haut : left 10,gauche
   Dessiner_Grille()
   Dessiner_Carre_Magic()
return
rem ============================================================================
SUB Dessiner_Grille()
    cls
    dim_local i
     for i = 0 to n : ' dessiner les lignes horizontales
         2d_line LeftMargin,TopMargin+I*Sz,LeftMargin+N*Sz,TopMargin+I*Sz
     next i
     for i = 0 to n : ' dessiner les lignes verticales
         2d_line LeftMargin+I*Sz,TopMargin,LeftMargin+I*sz,TopMargin+N*SZ
     next i
END_SUB
rem ============================================================================
' Dessiner le carré magique lorsque la dimension  des côtes est impaire
SUB Draw_Odd()
    dim_local i%,j%,h%,v%,w%
    w% = 1 : h% = int(n/2)
     v% = h%-1
    for i% = 0 to n-1
        h% = h% + 1 : v% = v% + 1
        for j% = 0 to n-1
            Draw_Slot(mod(v%,n)*n+mod(h%,n),w%)
            w% = w% + 1 : h% = h% + 1 : v% = v% + n-1
        next j%
    next i%
END_SUB
rem ============================================================================
' afficher le nombre affecté à une case
SUB Draw_Slot(slot,nombre)
    dim_local s$,h,v
    s$ = str$(nombre)
    h = text_width(s$,10) : ' Pour afficher au milieu de la case
    v = text_height(s$,10)
    print_locate LeftMargin+mod(Slot,N)*Sz + int(((Sz-H) / 2)),TopMargin+int(Slot / N)*SZ + int((Sz-V) / 2)
    print s$
END_SUB
rem ============================================================================
' dessiner les cases quand la dimension des côtés est divisible par 4
SUB Draw_Dim4(b,m)
    dim_local i,j,w,c,petit, grand
    petit = int(n/4) : grand = int(n/4)*3
    if b = 0 then c = 0 : else : c = n+1
    w = 0
    for j = 0 to m-1
        for i = 0 to m-1
            if (((J < Petit) or (J >= Grand)) AND ((I < Petit) or (I >= Grand))) OR ((J >= Petit) and (J < Grand) and (I >= Petit) and (I < Grand))
               Draw_Slot(J*N+I+C,W+B+1)
            else
               Draw_Slot(J*N+I+C,Sq-B-W)
            end_if
            w = w+1
        next i
    next j
END_SUB
rem ============================================================================
SUB Dessiner_Carre_Magic()
    hide 70
    if odd(n) = 1  
       Draw_Odd()  : ' si les côtés comportent un nombre de cases impaires      
    else
       if mod(n,4) = 0
          Draw_Dim4(0,n) : ' si les côtés comportent un nombre de case divisible par 4
       else              : ' côtés de dimension paire mais pas divisible par 4
          Draw_Border()  : ' dessiner les cases en bordure  
          Draw_Dim4((N*N-(N-2)*(N-2)) / 2,  N-2 ) : ' dessiner le centre (toujours divisible par 4)
       end_if
    end_if
    caption 70,"Somme magique : " + str$(n*(1+n*n)/2) : show 70
END_SUB
rem ============================================================================
' dessiner les cases en bordure, pour les carrés magiques dont la dimension
' des côtés est paire, mais pas divisible par 4
SUB DRaw_Border()
    dim_local j,k,l
    Draw_Slot(0,1)
    Draw_Slot(Sq-1,Sq)
    Draw_Slot(Sq-N,2)
    Draw_Slot(N-1,Sq-1)
    Draw_Slot(2*N-1,3)
    Draw_Slot(N,Sq-2)
    Draw_Slot(3*N-1,4)
    Draw_Slot(2*N,Sq-3)
    Draw_Slot(4*N-1,5)
    Draw_Slot(3*N,Sq-4)
    Draw_Slot(1,6)
    Draw_Slot(Sq-N+1,Sq-5)
    Draw_Slot(Sq-N+3,7)
    Draw_Slot(3,Sq-6)
    Draw_Slot(Sq-N+2,8)
    Draw_Slot(2,Sq-7)
    Draw_Slot(4*N,9)
    Draw_Slot(5*N-1,Sq-8)
    Draw_Slot(4,10)
    Draw_Slot(Sq-N+4,Sq-9)
    if n > 6 : ' pour les carrés plus grand que 6*6    
       for J = 0 to int((N-10) / 4)
          k = j*4
          l = j*8
          Draw_Slot(K+5,L+11)
          Draw_Slot(Sq-N+K+5,Sq-L-10)
          Draw_Slot((6+K)*N-1,L+12)
          Draw_Slot((5+K)*N,Sq-L-11)
          Draw_Slot(Sq-N+K+6,L+13)
          Draw_Slot(K+6,Sq-L-12)
          Draw_Slot((6+K)*N,L+14)
          Draw_Slot((7+K)*N-1,SQ-L-13)
          Draw_Slot((7+K)*N,L+15)
          Draw_Slot((8+K)*N-1,Sq-L-14)
          Draw_Slot(Sq-N+K+7,L+16)
          Draw_Slot(7+K,Sq-L-15)
          Draw_Slot((9+K)*N-1,L+17)
          Draw_Slot((8+K)*N,Sq-L-16)
          Draw_Slot(8+K,L+18)
          Draw_Slot(Sq-N+K+8,SQ-L-17)
       next j
    end_if
END_SUB
rem ============================================================================
Info:
    r$ = " En mathématiques, un carré magique d'ordre n est composé de n*n entiers" + chr$(13)
    r$ = r$ + "strictement positifs, écrits sous la forme d'un tableau carré." + chr$(13)
    r$ = r$ + "Ces nombres sont disposés de sorte que leurs sommes sur chaque rangée,"+chr$(13)
    r$ = r$ + "sur chaque colonne et sur chaque diagonale principale soient égales."
    message r$
return
rem ============================================================================
About:
   r$ = ""
   dll_on "shell32"
   about% = dll_call4("ShellAboutA",handle(0), adr(r$),adr(r$),0)
   dll_off
return
rem ============================================================================
Quitter:
terminate
rem ============================================================================

unit magic;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

Type TMyControl = class (TCustomControl)
                    private
                      N,Sz,Sq,
                      TopMargin,LeftMargin : integer;
                      procedure DrawCanevas;
                      procedure DrawOdd;
                      procedure DrawDim4 (B,M : integer);
                      procedure DrawBorder;
                      procedure DrawSlot(Slot,Nombre : integer);
                    public
                      procedure Paint; override;
                    published
                      constructor Create(AOwner : TComponent; C : integer);
                  end;
type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Cote: TEdit;
    Button1: TButton;
    procedure Dessiner(Sender: TObject);
  private
    MyControl : TMyControl;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

constructor TMyControl.Create (AOwner : TComponent; C : integer);
{ création du controle d'affichage du carré }
begin
  inherited Create(AOwner);
  N := C;                  { dimension du carré }
  Sz := 36;                { taille des cases en pixels }
  TopMargin := 25;         { marge supérieure à utiliser pour l'affichage du contrôle }
  LeftMargin := 25;        { marge gauche }
  width := Sz*(N+1);       { largeur du contrôle (dépend du nombre de cases) }
  height := Sz*(N+1);      { hauteur du contrôle }
  left := 25;              { position du contrôle sur le formulaire }
  Top := 50;
  Sq := N*N;               { nombre de case du carré magique }
  Canvas.Font.Style := [fsBold];
  Canvas.Brush.Color := $d0d0d0;
end;

procedure TMyControl.DrawCanevas;
{ dessiner les cases du carré magique }
var I : integer;
begin
  with Canvas do
  begin
    for I := 0 to N do                 { dessiner les lignes horizontales }
    begin
      MoveTo (LeftMargin,TopMargin+I*Sz);
      LineTo(LeftMargin+N*Sz,TopMargin+I*Sz);
    end;
    for I := 0 to N do                 { dessiner les lignes verticales}
    begin
      MoveTo(LeftMargin+I*Sz,TopMargin);
      LineTo(LeftMargin+I*sz,TopMargin+N*SZ);
    end;
  end;
end;

procedure TMyControl.DrawOdd;
{ dessiner le carré magique lorsque la dimension  des côtes est impaire }
var I,J,H,V,W: integer;
begin
  W := 1;
  H := (N div 2);
  V := H - 1;
  for I := 0 to N-1 do
  begin
    inc(H);
    inc(V);
    for J := 0 to N-1 do
    begin
      DrawSlot((V mod N)*N+(H mod N),W);
      inc(W);
      inc(H);
      inc(V,N-1);
    end;
  end;

end;

procedure TMyControl.DrawBorder;
{ dessiner les cases en bordure, pour les carrés magiques dont la dimension
  des côtés est paire, mais pas divisible par 4 }
var J,K,L : integer;
begin                          { dessiner les cases 22 cases en bordure pour un carré de 6*6 }
  DrawSlot(0,1);
  DrawSlot(Sq-1,Sq);
  DrawSlot(Sq-N,2);
  DrawSlot(N-1,Sq-1);
  DrawSlot(2*N-1,3);
  DrawSlot(N,Sq-2);
  DrawSlot(3*N-1,4);
  DrawSlot(2*N,Sq-3);
  DrawSlot(4*N-1,5);
  DrawSlot(3*N,Sq-4);
  DrawSlot(1,6);
  DrawSlot(Sq-N+1,Sq-5);
  DrawSlot(Sq-N+3,7);
  DrawSlot(3,Sq-6);
  DrawSlot(Sq-N+2,8);
  DrawSlot(2,Sq-7);
  DrawSlot(4*N,9);
  DrawSlot(5*N-1,Sq-8);
  DrawSlot(4,10);
  DrawSlot(Sq-N+4,Sq-9);
                                  { dessiner les autres cases en bordure }
  for J := 0 to (N-10) div 4 do   { pour les carrés plus grand que 6*6 }
  begin
    K := J SHL 2;
    L := J SHL 3;
    DrawSlot(K+5,L+11);
    DrawSlot(Sq-N+K+5,Sq-L-10);
    DrawSlot((6+K)*N-1,L+12);
    DrawSlot((5+K)*N,Sq-L-11);
    DrawSlot(Sq-N+K+6,L+13);
    DrawSlot(K+6,Sq-L-12);
    DrawSlot((6+K)*N,L+14);
    DrawSlot((7+K)*N-1,SQ-L-13);
    DrawSlot((7+K)*N,L+15);
    DrawSlot((8+K)*N-1,Sq-L-14);
    DrawSlot(Sq-N+K+7,L+16);
    DrawSlot(7+K,Sq-L-15);
    DrawSlot((9+K)*N-1,L+17);
    DrawSlot((8+K)*N,Sq-L-16);
    DrawSlot(8+K,L+18);
    DrawSlot(Sq-N+K+8,SQ-L-17);
  end;
end;

procedure TMyControl.DrawSlot(Slot,Nombre : integer);
{ afficher le nombre affecté à une case }
var S : string[8];
    H,V : integer;
begin
  S := IntToStr(Nombre);
  with Canvas do
  begin
    H := Textwidth(S);         { pour afficher au milieu de la case }
    V := TextHeight(S);
    TextOut(LeftMargin+(Slot mod N)*Sz + ((Sz-H) div 2),
             TopMargin+(Slot div N)*SZ + ((Sz-V) div 2),S);
  end;
end;

procedure TMyControl.DrawDim4 (B,M : integer);
{ dessiner les cases quand la dimension des côtés est divisible par 4 }
var I,J,W,C : integer;
    Petit,Grand : integer;
begin
  Petit := N div 4;
  Grand := (N div 4)*3;
  if B = 0 then C := 0 else C := N+1;
  W := 0;
  for J := 0 to M-1 do
  begin
    for I := 0 to M-1 do
    begin
      if (((J < Petit) or (J >= Grand)) AND ((I < Petit) or (I >= Grand))) OR
         ((J >= Petit) and (J < Grand) and (I >= Petit) and (I < Grand)) then DrawSlot(J*N+I+C,W+B+1)
                                                                         else DrawSlot(J*N+I+C,Sq-B-W);
      inc(W);
    end;
  end;
end;

procedure TMyControl.Paint;
{ dessiner tout le carré magique }
begin
  DrawCanevas;                              { dessiner les lignes horizontales et verticales }
  If odd(N) then DrawOdd                    { si les côtés comportent un nombre de cases impaires }
  else if (N mod 4) = 0 then DrawDim4(0,N)  { si les côtés comportent un nombre de case divisible par 4 }
  else
  begin                                     { côtés de dimension paire mais pas divisible par 4 }
    DrawBorder;                             { dissiner les cases en bordure }
    DrawDim4((N*N-(N-2)*(N-2)) div 2,N-2);  { dessiner le centre (toujours divisible par 4) }
  end;
end;

procedure TForm1.Dessiner;
var N : integer;
begin
  try
    N := StrToInt(Cote.text);                { lire la dimension souhaitée }
  except
    on exception do
    begin
      Showmessage('La dimension des côtés doit être numérique');
      exit;
    end;
  end;
  if (N < 3) then                           { impossible de générer un carré magique de dimension inférieure à 3*3 }
  begin
    ShowMessage('La dimension minimum doit être 3');
    exit;
  end;
  if MyControl <> nil then
  begin
    Removecontrol(MyControl);               { d'abord détruire le précédent carré magique }
    MyControl.Free;
  end;
  MyControl := TMyControl.Create(Self,N);   { créer un carré magique }
  InsertControl(MyControl);                 { déclare rel contrôle. La& procedure paint va se charger de l'affichage }
end;

begin
end.

K := J SHL 2;
L := J SHL 3;

 K = J*4
 J = J*8

- Opérateurs de décalage :

        shl   '   décalage à gauche (x shl n : décale de n bits = multiplie par 2^n)
        shr   '   décalage à droite (x shr n : décale de n bits = divise par 2^n)