Algorithme du Triangle de Pascal

Copy URL Solarsystem.nasa.gov
Venus de Botticelli : L'éclat de Venus comparé à d'autres étoiles et planètes a inspiré des visions d'une belle déesse.

Construction du triangle de Pascal

Calcul coefficients d'un binôme de Newton

Méthode utilisée L'objectif de cette routine est double; celle-ci permet de construire un triangle de Pascal à l'ordre « n » et de l'afficher si cela est demandé par paramètre.
Par ailleurs, cette routine retourne les coefficients du binôme de Newton à l'ordre n.

Exposé pratique de la méthode
Le triangle de Pascal est utilisé pour déterminer les coefficients du binôme de Newton ( x + a )n, où « n » est un nombre entier.

Constatations faites à partir des coefficients obtenus:

  1. Le premier coefficient de chaque binôme de Newton est 1, dans le cas où il est écrit selon l'ordre des puissances décroissantes.
  2. Le dernier coefficient de chaque binôme de Newton est 1, dans le cas où il est écrit selon l'ordre des puissances décroissantes.
  3. Les coefficients non égaux à 1 s'obtiennent de la façon suivante:
    - soit le jème coefficient du ième binôme de Newton; celui-ci s'obtient pas addition des coefficient (j-1) et (j) du (i-1)ème binôme de Newton; le coefficient à chercher n'est autre que- la somme de (Relation simple à démontrer en passant par les factorielles).
Construction du triangle de Pascal (programme):



Afin d'étendre la règle (3), nous ajouterons des 0 dans les colonnes non utilisées de
chaque ligne i traitée. Dans ce cas le dernier coefficient de chaque binôme pourra s'obtenir par l'addition de (1+0).

L'amorce d'un tel tableau se fera alors en plaçant 1 comme coefficient unique du premier binôme de Newton (n=0).

 

Tringle arithmetique de Pascal

{**Tringle arithmetique de Pascal + Mathes **}
{**programming: A.ARA 64150 Mourenx France.**}
PROGRAM triangle_Pascal;

uses crt,Box13,Mathes,H_Calcul,Get_Key;

Const EE=25; {***  puisance maximun ****}

Var  C      : Array[1..EE,1..EE+1] of LongInt;
     Signe1 : Array[1..20] Of Char;
     Signe2 : Array[1..20] Of Char;
     i,j,k  : integer;
     Ch     : byte;
     key    : byte;
     Signess: string;
     Signe  : byte;

     {**Programme de combinations**}

     PP,MM    : word;
     PP1,MM1  : real;
     ComResul : real;
     SS2,SS3  : string;
     Tot,TotM : extended;
     formule  : string;


{**Initalisation de tables a "0"**}

Procedure Inicialitation_Triangle;
begin
    for i:=1 To EE Do
     for j:=1 To EE+1 Do
      C[i,j]:=0;

    for k:=1 to EE Do
     begin
         C[K,1]:=1;
         C[K,2]:=K;
     end;

    {*** Calcul de C3 Cee ***}

    for i:=2 To EE Do
     begin
         for j:=3 To EE+1 Do
         C[i,j]:=C[i-1,j-1]+C[i-1,j];
     end;

    for i:=1 To 20 Do
     begin
         Signe1[i]:='+';
         if I Mod 2 = 0 Then Signe2[i]:='+'
         else  Signe2[i]:='-';
     end;
end;{ends inicialitation}



{***develope (a+b)^ ***}

Procedure Develo_selection(xx,yy,mm:byte;Signess:char);
Label Finis;
Var   R,aa,bb : integer;
      Entree  : boolean;
begin
    textAttr:=14;

    if (Signess<>'-') then Signe:=1
    else Signe:=2;
	
    if MM<=10 Then
    begin
       gotoxy(xx,yy);
       textAttr:=31;

       write('a^',mm);

       if signe=1 then Write(' '+Signe1[1]+' ')
       else
       write(' '+Signe2[1]+' ');

       for r:=1 To MM-1 Do
        begin
            textAttr:=29;
            write(C[mm,r+1]);

            textAttr:=31;
            if mm-r>1 Then Write('a^',mm-r)
            else
             write('a');

            textAttr:=30;
            if r>1 Then Write('b^',r)
            else write('b');

            if signe=1 Then Write(' '+Signe1[r+1]+' ')
            else
             write(' '+Signe2[r+1]+' ');
        end;

      textAttr:=30;
      write('b^',mm);
    end;

  Finis:
end;{ends Develo_selection}



{*** affiche le triangle pascal ***}

procedure Triangle(Lxx,Lyy,Nbr:integer);
 var
    EEE,yy,xx,pp,ss: integer;
    j,k            : integer;

begin
    ss:=0;
    EEE:=nbr;

    textattr:=114;{*vert - blanc*}
    boxfill(1,Lyy,80,Lyy+Nbr+6,' ');

    gotoxy(23,Lyy);
    write(' TRIANGLE  ARITHMETIQUE  DE  PASCAL ');

    textattr:=116;{**marrom, blanc**}
    gotoxy(15,Lyy+nbr+6);
    write(' selection : ',#25,' ',#24,'  -  entree : developement (a+b)^n');


    textattr:=31;
    boxfill(3,Lyy+1,78,Lyy+Nbr+5,' ');

    {**affichage du triangle**}

    gotoxy(Lxx,Lyy+2);

    for j:=1 to EEE Do
     begin
        textattr:=31;
        write('    (a+b)^  ->',j:2);
        textattr:=30;
        for k:=1 to (j+1) do write('  ',C[j,k]:3);
        writeln;
        gotoxy(3,wherey);
     end;

    xx:=31;
    yy:=Lyy+1;
    pp:=1;

    textattr:=26;
    writexy(65,Lyy+3,'Signe: +');

    yy:=Lyy+2;
    highbox(6,yy,xx,yy,5);

    Repeat

         CSOFF;
         Ch:=keyboard;
         if (Key_Code) and (Ch=80) and (yy<Lyy+11) then
          begin
            highbox(6,yy,xx,yy,5);
            inc(xx,5);inc(yy);
            inc(pp);
            highbox(6,yy,xx,yy,5);
          end
         else
         if (Key_Code) and (Ch=72) and (yy>Lyy+2) then
          begin
            highbox(6,yy,xx,yy,5);
            dec(xx,5);dec(yy);
            dec(pp);
            highbox(6,yy,xx,yy,5);
          end
         else
         if (not Key_Code) and (Ch=13) then
          begin
             window(5,1,75,25); {**fenetre de affichage developement**}

             if (ss=0) then
               Develo_selection(1,Lyy+13,pp,'+')
             else
               Develo_selection(1,Lyy+13,pp,'-');

             window(1,1,80,25); {**init fenetre**}

             CSOFF;
             Ch:=keyboard;
             textattr:=31;
             boxfill(3,Lyy+12,78,Lyy+15,' ');
          end

         else

         if (not Key_Code) and (Ch=45) and (ss=0) then
          begin
             ss:=1;
             textattr:=26;
             writexy(65,Lyy+3,'Signe: - ');
          end
         else
         if (not Key_Code) and (Ch=43) and (ss=1) then
          begin
             ss:=0;
             textattr:=26;
             writexy(65,Lyy+3,'Signe: + ');
          end;

    Until (Ch=27);

    textattr:=7;
    clrscr;
end;{*end triangle*}


{*** develope (a+b)^n avec valeurs ***}

Procedure Developement;
Label Finis;
Var   R,aa,bb,mm : integer;
      Entree     : boolean;
begin
    textAttr:=7;
    Clrscr;
    textAttr:=14;
    writecn(3,'Developpement de (a+b)^m avec le triangle de Pascal.  max=25');
    writecn(24,'Developpement a puisance 8 … 25 le resultat sur imprimante PRN.');
    textAttr:=13;
    writexy(25,5,'Donnez la valeur de "a": ');
    writexy(25,6,'Donnez la valeur de "b": ');
    textAttr:=14;
    writexy(25,7,'Donnez la puisance  "m": ');
    textAttr:=11;
    writexy(25,8,'Donnez le Signe "-" "+": ');
    textAttr:=13;
    aa:=ReadNum(50,5,4);

    if aa>0 Then
     begin
        bb:=ReadNum(50,6,4);
        if bb<=0 Then Goto finis;
        textAttr:=14;

        mm:=ReadNum(50,7,4);
        if (mm<=0) And (mm<=25) Then Goto finis;
        Signess:='+';

        textAttr:=11;
        Entree:=ReadBox(50,8,Signess,3,2);
        if (Signess<>'-') Then Signe:=1
        else
          Signe:=2;
     end

    else Goto Finis;

    Gotoxy(18,10);
    textAttr:=12;

    if Signe=1 Then
     write('Developpement de: (',aa,'+',bb,')^',mm,'   Ou    (a+b)^',MM)
    else  Write('Developpement de: (',aa,'-',bb,')^',mm,'   Ou    (a-b)^',MM);

    textAttr:=11;

    SetColor(0,7);
    boxfill(2,12,79,24,' ');
    Rectangle(2,12,79,24,Simple);

    window(4,14,77,23);

    Gotoxy(1,1);

    if MM<=10 Then
     begin
        textAttr:=114;
        write('a^',mm);

        if signe=1 Then Write(' '+Signe1[1]+' ')
        else Write(' '+Signe2[1]+' ');

        for r:=1 To MM-1 do
         begin
            textAttr:=116;
            write(C[mm,r+1]);

            if mm-r>1 Then Write('a^',mm-r)
            else write('a');

            textAttr:=121;
            if r>1 Then Write('b^',r)
            else write('b');

            if signe=1 Then Write(' '+Signe1[r+1]+' ')
            else write(' '+Signe2[r+1]+' ');
         end;

        textAttr:=121;
        write('b^',mm);
     end;
    writeln;

    {**develope les valeurs numeriques**}

    Gotoxy(1,wherey+1);

    if MM<=10 Then
     begin
        textAttr:=114;
        write('(',aa,'^',mm,')');

        if signe=1 Then Write(' '+Signe1[1]+' ')
        else Write(' '+Signe2[1]+' ');

        for r:=1 To MM-1 do
         begin
            textAttr:=116;
            write('(',C[mm,r+1],')x');

            if mm-r>1 Then Write('(',aa,'^',mm-r,')')
            else write('(',aa,')');

            textAttr:=121;
            if r>1 Then Write('x(',bb,'^',r,')')
            else write('x(',bb,')');

            if signe=1 Then Write(' '+Signe1[r+1]+' ')
            else write(' '+Signe2[r+1]+' ');
         end;

        textAttr:=121;
        write('(',bb,')^',mm);
     end;

    window(1,1,80,25);

    Csoff;
    Repeat
       Ch:=keyBoard;
    Until ch=27;
    textAttr:=7;
    Clrscr;
    Finis:
end;{ends Developement}


{*** calcul nombre de conbination posibles ***}

Procedure Combinations;
begin
   textAttr:=7;
   Clrscr;
   textAttr:=14;
   writeCn(3,'COMBINATIONS  ');
   writeCn(24,'Nombre de objec dans le combinations maximun 10');
   textAttr:=11;
   writexy(30,6,'Nombre de objec: ');
   writexy(30,7,'Combinations x : ');
   MM:=ReadNum(47,6,3);
   PP:=ReadNum(47,7,3);

   if (MM>0) And ((PP>0) And (PP<=10) ) Then
    begin
       {$R-}
         MM1:=MM;
         for i:=1 To (PP-1) Do
           MM1:=MM1*(MM-i);
         PP1:=PP;
         for i:=1 to (PP-1) Do
           PP1:=PP1*(PP-i);
         Gotoxy(1,9);
         ComResul:=MM1/PP1;
       {$R+}

       if ioresult<> 0 Then writeCn(12,'Erreur dans le calcul trop grands.!!!')
       else
        begin
           textAttr:=10;
           Gotoxy(23,10);
           writeln(' Resultat: ',ComResul:10:2,' posibilites');
        end;
    end
   else
    begin
       textAttr:=12;
       writeCn(12,'Erreur dans les nombres.!!!');
    end;

   Csoff;
   Repeat
       Ch:=keyBoard;
   Until ch=27;
end;{ends Combinations}




Procedure Arc;
Begin
   Clrscr;
   textAttr:=11;
   Rectangle(1,1,80,25,Simple);
   writeCn(3,'ARC  CORDE  FLECHE  SEGMENT');
   textAttr:=15;
   Calcul_Centre_Arc(25,7);
end;{ends arc}



Procedure Rayon;
begin
   Clrscr;
   textAttr:=11;
   Rectangle(1,1,80,25,Simple);
   writeCn(3,'CHERCHE RAYON ANGLE ');
   textAttr:=15;
   Cherche_Rayon(25,7);
end;{ends rayon}



Procedure Rotation;
begin

   Clrscr;
   textAttr:=11;
   Rectangle(1,1,80,25,Simple);
   writeCn(3,'ROTATION DES AXES ');
   textAttr:=15;
   Donne_Rotation_G3(25,7);
end;{ends rotation}


{*** Calculatrice  ***}

Procedure Calculator;
begin
   Clrscr;
   textAttr:=11;
   Rectangle(1,1,80,25,Simple);
   writeCn(3,'CALCULATRICE');
   textAttr:=15;
   Calculatrice(27,7,SS2,SS3,Tot,TotM);
End;{ends calculator}


{*** Init le menu du programme  ***}

Procedure Menu;
 var ix : Char;

begin
   Clrscr;
   Inicialitation_Triangle;

   Repeat
      textAttr:=31;
      Clrscr;

      writeCn(2,'DEVELOPPEMENT DE (a+b)^m');
      writeCn(4,'MATHEMATIQUES ');

      writexy(21,19,'programming: A.ARA 64150 Mourenx France.');
      Setcolor(0,7);
      BoxFill(20,6,60,17,' ');
      Rectangle(20,6,60,17,Simple);

      writexy(25,8,'[T]   Triangle de Pascal');
      writexy(25,9,'[D]   Developpement de (a+b)^m');
      Writexy(25,10,'[C]   Combinaisons');
      Writexy(25,11,'[R]   Rotation des axes de O..360');
      Writexy(25,12,'[X]   Cherche rayon');
      Writexy(25,13,'[A]   Arc Fleche Centre Relation');
      Writexy(25,14,'[W]   Calculatrice.');
      Writexy(25,15,'[Q]   Stop - Quit');

      Box13.SetColor(4,7);
      Writexy(25,8,'[T]');
      Writexy(25,9,'[D]');
      Writexy(25,10,'[C]');
      Writexy(25,11,'[R]');
      Writexy(25,12,'[X]');
      Writexy(25,13,'[A]');
      Writexy(25,14,'[W]');
      Writexy(25,15,'[Q]');

      Csoff;
      Repeat
         ix:=Readkey;

         if Ord(ix)=27 then ix:='Q';

      Until ix in['t','T','d','D','c','C','r','R','x','X','a','A','w','W','q','Q'];

      textAttr:=7;
      Clrscr;
      Case Upcase(ix) of

        'T': begin
                Triangle(3,2,10);
             end;

        'D': begin
                Developement;
                {**Develo_selection(1,2,4,'+');**}
             end;

        'C': Combinations;

        'R': begin
                Rotation;
             end;

        'X': begin
                 Rayon;
             end;

        'A': begin
                Arc;
             end;

        'W': begin
                Calculator;
             end;
      end;{*case*}

      textAttr:=7;
   Until Upcase(ix)='Q';

   textAttr:=7;
   Clrscr;
End;{ends menu}


{*** Programme triangle pascal ***}

begin
   Clrscr;
   Menu;
   textAttr:=7;
   Clrscr;
end.

Pointeur dynamiques

POINTEURS & VARIABLES DYNAMIQUES

Type Pointeur-Ptr = ^T;

Une variable de type Pointeur-Ptr est un pointeur ver une donnée de type T.
Le signe « ^ » se lit « pointeur vers ».

Var p : Pointeur-Ptr;
....
....
New(p);

Si « p » est une variable de type Pointeur-Ptr, la procédure prédéfinie « New » crée une variable de type « T », en lui allouant un emplacement mémoire, et affecte son adresse a la variable « P ».

Cette dernière est donc un pointeur ver la variable créée, qui, elle, est notée « P^ ».

Sur le schéma, « P » est type « T^ » (pointeur vers une variable de type « T ») et «P^» correspond a la variable de type «T».

Appelons noeud toute variable créée dynamiquement.

La place allouée à un noeud par la procédure « New » est située dans une portion de la mémoire centrale appelée « Tas(Heap)».

Les variables dynamiques peuvent être de n'importe quel type « T » en particulier de type enregistrement.
Si, de plus ces enregistrements contiennent un ou plusieurs champs de type pointeur « (^T) », des structures de données complexes peuvent être créées en chaînant des enregistrements:

C'est ainsi que les variables dynamiques peuvent être reliées pour former diverses structures.
L'emploi le plus répandu de ce type de variables est la modélisation de structures de données dynamiques.
En plus de la propriété d'avoir une dimension illimitée (si ce n'est par la taille de la mémoire disponible), ces structures on la propriété d'évoluer en cours de traitement. Les arbres et les graphes en sont des exemples.

UTILISATION DES POINTEURS

Type noeud = Record
               Nom : String[15];
               numero : Integer;
             end;

Reference = ^noeud;

Var p, q, r : Reference;

Les pointeurs « p , q », et « r » pointent ver des variables de type noeud.
Apres l'allocation
New(p);
New(q);

Les pointeurs « p » et « q » contiennent l'adresse mémoire des variables vers lesquelles ils pointent.
On peut représenter cette situation par le schéma suivant:

Une zone mémoire de la taille définie par le type noeud est réservée aux adresses contenues dans « p » et « q ». C'est donc uniquement par l'intermédiaire de pointeurs que l'on peut référencer une variable créée dynamiquement. La perte du contenu d'un pointeur entraîne également la perte de l'information vers laquelle il pointe.

Pour affecter une valeur à ces variables dynamiques, on utilise la notation pointée, puisqu'elles sont de type enregistrement :

P^.nom :='Dupont';
Q^.nom :='Lola';
Q^.numéro :=3;

Il est possible d'affecter à un pointeur la valeur contenu dans un autre pointeur du même type.

R :=P;

L'affectation suivante fait pointer « R » ver le même nœud que « P » autrement dit les deux pointeurs contiennent la même adresse.

 

Demos Pointeurs Listes

{===================================}
{ VARIABLES DYNAMIQUES ET POINTEURS }
{ LISTES CHAINEES                   }
{===================================}

Program Exemple_de_Liste;
Uses Crt;

Type Str10 = string[10];

     Ptr = ^Regis;
     Regis = Record
               Nom    : string[10];
               Suivant: Ptr;
             end;

Var premier, dernier, nouveau : Ptr;
    Ch  : char;
    Mot : Str10;

Procedure Ecrire_Liste(Chain:String);
begin
   New(nouveau);        {**element a inserer est pointé vers par nouveau**}
   Nouveau^.Nom    := Chain;
   Nouveau^.Suivant:= Nil;
   Dernier^.Suivant:= Nouveau;
   Dernier         := Nouveau;
end;{*ends*}



Procedure Affiche_Liste(Depart:Ptr);
begin
   Clrscr;
   while Depart <> Nil DO
    begin
       writeln(Depart^.nom);
       Depart:=Depart^.Suivant;
    end;
   writeln;
   writeln('Fin de liste');
   Ch:=Readkey;
end;{*ends*}


begin
   Clrscr;                {**Initialisation du premier element**}
   New(Premier);          {**Pointe vers le "premier" element de la liste**}
   Write('Nom: ');
   Readln(Mot);
   Premier^.Nom:=Mot;
   Premier^.Suivant:=Nil;
   dernier:=Premier;      {**Pointe vers le "Dernier" element de la liste**}

   {**Inseré en fin de list a l'aide de la procedure Ecrire_Liste**}

   Repeat
         write('Nom: ');
         Readln(Mot);
         if Mot <> '' Then
         Ecrire_Liste(Mot);
   Until Mot='';

   Affiche_Liste(Premier);
end.
{*ends exemple*}

 

{==============================================}
{ EXEPLE 2 : VARIABLES DYNAMIQUES ET POINTEURS }
{==============================================}

Program Exemple_de_Liste_Dynamique;
Uses Crt;

Type Str10 = string[10];

     Ptr = ^Regis;
     Regis = Record
                Nom:String[10];
                num:Byte;
                Suivant:Ptr;
             end;

Var Premier, dernier, nouveau : Ptr;
    Ch : char;
    Mot: Str10;
    nn : byte;

Procedure Ecrire_Liste(Chain:string;n:byte);
begin
   if premier=Nil Then
    begin
       New(Premier);         {**Pointe vers le "premier" élément de la liste**}
       Premier^.Nom:=chain;
       Premier^.num:=n;
       Premier^.Suivant:=Nil;
       dernier:=Premier;     {**Pointe vers le "Dernier" élément de la liste**}
    end
   else
    begin
       New(nouveau);
       Nouveau^.Nom:=Chain;
       Nouveau^.num:=n;
       Nouveau^.Suivant:=Nil;
       Dernier^.Suivant:=Nouveau;
       Dernier:=Nouveau;
    end;
end;{*ends*}



Procedure Affiche_Liste;
 var Depart:Ptr;
begin
   Clrscr;
   Depart:=Premier;
   while Depart <> Nil DO
    begin
       writeln(Depart^.nom,' Numero: ',Depart^.num );
       Depart:=Depart^.Suivant;
    end;
   writeln;
   writeln('Affichage Fin de liste');
end;{*ends*}



Procedure Recherche_Liste(n:byte);
 Const Trouve:Boolean=False;
 var Depart:Ptr;
begin
   Depart:=Premier;
   while (Depart <> Nil) And (not Trouve) DO
    begin
       if Depart^.num=n then
        begin
           Trouve:=True;
           writeln(Depart^.Nom,'  ',Depart^.num);
        end
       else
         Depart:=Depart^.Suivant;
    end;{*while*}
   writeln;
   if not trouve then writeln('Fin de liste pas trouve');
end;{*ends*}



Procedure Suprime(n:byte);
 const Suprime  : Boolean=False;
 var Pt,Temporal: PTR;
begin
   if premier <> Nil Then
     if Premier^.num = n Then
      begin
         Temporal:=Premier;
         Premier:=Premier^.suivant;
         Dispose(Temporal);
         Suprime:=True;
      end
     else
      begin
         Pt:=Premier;
         while (Pt^.Suivant <> Nil) And (not Suprime) Do
          begin
             if pt^.suivant^.num = n Then
              begin
                 Temporal:=Pt^.suivant;
                 Pt^.Suivant:=Pt^.Suivant^.suivant;
                 Dispose(Temporal);
                 Suprime:=True;
              end
             else Pt:=Pt^.suivant;
          end;{*while*}
      end;
	  
   if Suprime Then Write('Enregistrement suprime');
end;{*ends*}


begin
   Clrscr;
   Premier:=Nil;  {**Initialisation du premier élément sur rien**}
   Repeat
       Write('Nom: ');
       Readln(Mot);
       if Mot <> '' Then
        begin
           write('Num: ');
           Readln(nn);
           Ecrire_Liste(Mot,nn);
        end;
   Until Mot='';

   Affiche_Liste;
   Ch:=Readkey;
   Clrscr;
   write('Suprime numero: ');
   Readln(nn);
   Suprime(nn);
   Ch:=readkey;
   Affiche_liste;
   Ch:=readkey;
end.
{*ends exemple 2*}

Rotation G3

Rotation Centre X, Y | Angle degrés 0..360 | coordinat X, Y
Donne le point X,Y de rotation sens G3 : interpolation circulaire trigonométrique. 
Inverse horaire 3h:0°, 12h:90°, 9h :180°, 6h:270° etc. 
Le G2 : interpolation circulaire sens anti-trigonométrique sens horaire.
  
Exemples de rotation sens G3

1: centreX:50  centreY:50  angle:90  coordinateX:100  coordinateY: 50 RotationX:50.00  RotationY: 100.00
2: centreX:50  centreY:50  angle:45  coordinateX:100  coordinateY: 50 RotationX:85.355 RotationY:  85.355
3: centreX:50  centreY:50  angle:90  coordinateX:  0  coordinateY:100 RotationX: 0.000 RotationY:   0.000



{============================================================}
{ calcul de Graphe Trace usinage machines a c.n. NUM750      }
{ Programmation Turbo Pascal - Borland                       }
{ programmeur: A.ARA                                         }
{ 64150 Mourenx - France                                     }
{ Copyright (s) 1976-2011                                    }
{ Licence d'utilisation accord dans un but demostratif       }
{ fonction de Rotation d'un segment sens G3                  }
{============================================================}

{=============================}
{ Affichage d'une valeur Real }
{=============================}
Procedure Printnum(x,y:byte;nn:Real);
var s:string[10];
begin
   Putxy(X,y,'           ');
   Str(nn:5:3,s);
   Putxy(x,y,s);
End;

{============================}
{ Retourne le sinus          }                           
{============================}
Function Sinu(degres:Real):Real;
begin
   if degres=0 Then Sinu:=0
   else
   if degres=90 Then sinu:=1
   else
   Sinu:=Sin(Pi*degres/180);
end;

{===============================}
{  Retourne le cosinus          }
{===============================}
Function Cosi(degres:Real):Real;
begin
    if degres=0 Then cosi:=1
    else
    if degres=90 Then Cosi:=0
    else
    Cosi:=Cos(Pi*degres/180);
end;

{===============================================}
{  Rotation de poin sens G3 valeur de angle     }
{===============================================}
Procedure Rotation_sur_G3(var X,Y:Real;Angle:Real);
Var XX,YY:Real;
Begin
   if (Angle>=0) And (Angle<=360) Then
    begin
       XX:= (X*Cosi(Angle)) - (Y*Sinu(Angle));
       YY:= (X*Sinu(Angle)) + (Y*cosi(Angle));
       X:= XX;
       Y:= YY;
    end;
end;

{======================================}
{ rotation d'un poin en degres 0..360  } 
{ sens trigonometrique G3              }
{======================================}
Procedure Donne_Rotation_G3(X1,Y1:byte);
Var n,DX1,DY1,CenX,CenY,RX,RY : Real;
    key,y,chois:byte;
	Ang        : Real;
    Snx,snY    : string[9];
    ColorAttr  : byte;
begin
   DX1:=0.0;
   DY1:=0.0;
   RX:=0.0;
   RY:=0.0;
   CenX:=0.0;
   CenY:=0.0;
   Ang:=0.0;

   ColorAttr:=TextAttr;
   TextAttr:=Menu_Color;

   BoxFill(X1,Y1,X1+30,Y1+8,' ');
   Rectangle(X1,Y1,X1+30,Y1+8,Double);
   Putxy(X1+10,Y1,' Rotation G3 ');
   Putxy(X1+10,Y1+8,' F1 = Calcul ');

   Putxy(X1+3,Y1+1,'Centre X     :');
   Putxy(X1+3,Y1+2,'Centre Y     :');
   Putxy(X1+3,Y1+3,'Angle        :');
   Putxy(X1+3,Y1+4,'Coordinate X :');
   Putxy(X1+3,Y1+5,'Coordinate Y :');
   Y:=1;
   HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
   Repeat
     CSOFF;
     key:=keyBoard;
     if (key=80) and (Y<5)  Then
      begin
        HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
        inc(Y);
        HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
      end
     else
     if (key=72) and (Y>1)  Then
      begin
        HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
        dec(Y);
        HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
      end
     else
     if (not key_Code) And ((key=13) or (key in[45,48..57])) Then
      begin
         HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
         n:=0;
         n:=ReadReal(X1+19,Y+Y1,10,key);
         if (n>100000) or (n<-100000) Then key:=27;
         case y of
          1: if key=27 Then Printnum(X1+19,Y+Y1,CenX)
             else cenX:=N;
          2: if Key=27 Then Printnum(X1+19,Y+Y1,CenY)
             else CenY:=N;
          3: if (Key=27) OR ((N<=0) OR (N>360)) Then Printnum(X1+19,Y+Y1,Ang)
             else Ang:=N;
          4: if Key=27 Then Printnum(X1+19,Y+Y1,DX1)
             else DX1:=N;
          5: if Key=27 Then Printnum(X1+19,Y+Y1,DY1)
             else DY1:=N;
         end;
         if Y<5 Then inc(Y)
         else Y:=1;
         HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
         key:=0;
      end;
     if (key_Code) and (key=59) Then
      begin
          RX:=DX1-CenX;RY:=DY1-CenY;
          Rotation_sur_G3(RX,RY,Ang);
          Str(RX+CenX:5:3,Snx);
          Str(RY+CenY:5:3,Sny);
          textAttr:=116;
          Putxy(X1+3,Y1+6,'Rotation   X : ');Putxy(X1+19,Y1+6,Snx);
          Putxy(X1+3,Y1+7,'Rotation   Y : ');Putxy(X1+19,Y1+7,Sny);
          textAttr:=Menu_Color;
      end;
   Until Key=27;
   textAttr:=ColorAttr;
end; {*end rotation*}

{=====================================================================================}
{ Note: Procedures keyBoard, HighBox, Putxy, etc. se trouvent sur l'unite Bos13.pas   }
{=====================================================================================}

Distance & angle

Donne la distance du poin (A) a le poin (B) avec l'angle sens trigonométrique G3. 
Sens inverse horaire : 3h:0°,12h:90°,9h:180°,6h:270° etc. 

Exemples distance et Angle :
BeginX :  0     BeginY :  0  .... endX : 50  endY : 50   Rayon : 70.711  Angle :45°
BeginX :  0     BeginY :  0  .... endX :100  endY :100   Rayon :141.421  Angle :45°
BeginX :  0     BeginY :  0  .... endX :100  endY : 50   Rayon :111.803  angle :27°
BeginX :  0     BeginY :  0  .... endX : 50  endY :100   Rayon :111.803  angle :63°
BeginX :  0     BeginY :  0  .... endX :100  endY : 10   Rayon :100.499  angle :6°
BeginX : 50     BeginY : 50  .... endX :  0  endY :100   Rayon : 70.711  angle :135°
BeginX : 50     BeginY :  0  .... endX : 50  endY :100   Rayon :100.00   angle :90°
BeginX :100     BeginY :100  .... endX : 50  endY : 50   Rayon : 70.711  angle :225°

 

Function Radian_Degre(Radi:Real):Real;
begin
   Radian_Degre:=Radi*(360/(2*Pi));
end;


Function Angle__G3(XX1,YY1,CXX,CYY,RR:REal):Integer;
var Angle : Real;
begin
    Angle:=400;
    {*depar position 0*}
    if YY1>CYY Then
     begin
        if XX1>CXX Then
          Angle:=Radian_Degre(ArcSin((YY1-CYY)/RR))
        else
        if XX1<CXX Then
          Angle:=Radian_Degre(ArcSin((CXX-XX1)/RR))+90
        else
        if (Round((YY1-RR))=Round(CYY)) And (Round(XX1)=Round(CXX)) Then
          Angle:=90;
     end
    else
    if (CYY>YY1) Then
     begin
        if (Round(CYY-RR)=Round(YY1)) and (Round(CXX)=Round(XX1)) Then
          Angle:=270
        else
        if CXX>XX1 Then
          Angle:=180+Radian_Degre(ArcSin((CYY-YY1)/RR))
        else
        if CXX<XX1 Then
          Angle:=270+Radian_Degre(ArcSin((XX1-CXX)/RR));
     end
    else
    if (Round(CYY)=Round(YY1)) and (Round(CXX+RR)=Round(XX1)) Then Angle:=0
    else
    if (Round(YY1)=Round(CYY)) and (Round(CXX)=Round(XX1+RR)) Then
      Angle:=180;
    if (Angle>=0) and (Angle<=360) Then Angle__G3:=Round(Angle)
    else Angle__G3:=400;
end;{**end Angle__G3**}


Function Calcul_Rayon(Cx,Cy,X,Y:Real;Var Angle:Real):Real;
Var R,C,B,AG:Real;
begin
    C:=ABS(cx-X);
    B:=ABS(cy-Y);
    if C=0 Then C:=0.00001;
    if B=0 Then B:=0.00001;
    R:=SQRT(Abs(Sqr(C))+Abs(Sqr(B)));
    AG:=Angle__G3(X,Y,Cx,Cy,R);
    if AG=400 Then AG:=-1;
    Angle:=AG;
    Calcul_Rayon:=R;
End;


{============================================================}
{ donne la distance du poin (A) a le poin (B) avec son angle }
{============================================================}
Procedure Cherche_Rayon(X1,Y1:Byte);
Var n,DX1,DY1,CENX,CENY,Ray:REAL;
    key,Y,Chois : byte;
    Ang         : Real;
    Snx,snY     : string[9];
    ColorAttr   : byte;
begin
   DX1:=0.0;
   DY1:=0.0;
   CenX:=0.0;
   CenY:=0.0;
   Ang:=0.0;
   Ray:=0.0;
   ColorAttr:=TextAttr;
   TextAttr:=Menu_Color;
   
   BoxFill(X1,Y1,X1+30,Y1+7,' ');
   Rectangle(X1,Y1,X1+30,Y1+7,Double);
   Putxy(X1+10,Y1,' Distance ');
   Putxy(X1+10,Y1+7,' F1 = Calcul ');

   Putxy(X1+3,Y1+1,'Begin  X   :');
   Putxy(X1+3,Y1+2,'Begin  Y   :');
   Putxy(X1+3,Y1+3,'End    X   :');
   Putxy(X1+3,Y1+4,'End    Y   :');
   Y:=1;
   HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
   
   Repeat
     CsOff;
     key:=keyBoard;
     if (key=80) and (Y<4)  Then
      begin
        HighBox(x1+2,y+y1,x1+28,y+y1,bx);
        inc(Y);
        HighBox(x1+2,y+y1,x1+28,y+Y1,bx);
      end
     else
     if (key=72) And (Y>1)  Then
      begin
        HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
        Dec(Y);
        HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
      end
     else
     if (not Key_Code) and ((Key=13) or (Key in[45,48..57])) Then
      begin
        HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
        n:=0;
        n:=READREAL(X1+16,Y+Y1,10,key);
        if (N>100000) OR (N<-100000) Then key:=27;
        case y of
         1: if Key=27 Then Printnum(X1+16,Y+Y1,CenX)
            else cenX:=N;
         2: if Key=27 Then Printnum(X1+16,Y+Y1,CenY)
            else CenY:=N;
         3: if Key=27 Then Printnum(X1+16,Y+Y1,DX1)
            else DX1:=N;
         4: if Key=27 Then Printnum(X1+16,Y+Y1,DY1)
            else DY1:=N;
        end;
        if Y<4 Then inc(Y)
        else Y:=1;
        HighBox(x1+2,y+Y1,x1+28,y+Y1,BX);
        key:=0;
      end;
     if (key_Code) and (key=59) Then
      begin
         snx:='';
         sny:='';
         Ang:=0.0;
         Ray:=Calcul_Rayon(CenX,CenY,DX1,DY1,Ang);
         Str(Ray:5:3,Snx);
         Str(Ang:5:3,Sny);
         textAttr:=116;
         Putxy(X1+3,Y1+5,'Rayon      : ');Putxy(X1+16,Y1+5,Snx);
         Putxy(X1+3,Y1+6,'Angle      : ');Putxy(X1+16,Y1+6,Sny+#167);
         textAttr:=Menu_Color;
      end;
Until Key=27;
TextAttr:=ColorAttr;
End;  {*end cherche rayon*}

MICROCALCULATOR

MICROCALCULATOR
Ce programme en Turbo Pascal emploi les unités ayant été publiées dans ce site.
Ce sont des unités pouvant être employés indépendamment pour programmer d'autres programmes.

C'est quoi un programme ?
Tout simplement, c'est qu'une idée imagine dans la tête d'un programmeur.

download program MicroCal.exe : 80ko.


{==========  Programme Calcul formules MATHES =============}
{ Unite M_Calcul.pas calculs divers mathes Angles Rotation }
{ Le Triangle arithmetique de Pascal(a+b)^n ou (a-b)^n     }
{ unite Mathes.pas fonctions mathematiques                 }
{ unite F_Calculs.pas fonctions equations mathematiques    }
{ Unite Get_key, Box13, Buff : unitilitaires ecran machine }
{ programmation Turbo Pascal - Borland                     }
{ Copyright (S) 1997-2011                                  }
{ programmeur du programme A.Ara                           }
{ 64150 Mourenx - France.                                  }
{ Licence d'utilisation accord dans un but demonstratif    }
{ Program MicroCal.pas: calcul de formule; vente interdite }
{==========================================================}
{ Program MicroCal.exe & Reper..\Maths.ini Date:06/08/1998 }
{==========================================================}
{$N+}
PROGRAM MICROCALCULATOR;

 Uses Crt,Dos,Get_Key,Box13,Buff,F_Calcul,Mathes,pas_tri,M_CALCUL;

 Const
 Sqr_Limit      = 1E2466;
 Decimales:byte = 4;

 Menu='F1\Help\F5\Evaluate1\F6\Evaluate2\F7\Evaluate3\F10\Calc\F9\Pascal\Echap\Fin';
 NomSaveCalculs:string = '_Resut_.txt';  {*Nom du fichier de sauvegarde des calculs**}

 Type
     _Pick = Record
                 Formule1:string;
                 Formule2:string;
                 Formule3:string;

                 {***Calculatrice***}

                 Calcu_Total    :extended;
                 Calcu_TotalM   :extended;
                 Calcul_2       :string;
                 Calcul_3       :string;
                 Nbr_Decimales  :byte;
             end;

      Fichier_ini = File of _Pick;

      ST5 = string[5];

 Var  Error_Real  : integer;
      Libre10     : Fichier_ini;

      Disque_2    : string[2];      {*nom du disque de travail C: ou a:     *}
      Disque2,disk: string;         {*Nom du disque ou Repertoire du Fichier*}
      Repertoire  : string;


      point_Mem_tas: Pointer;
      ColorAttrib  : byte;

      FondBox     : byte;
      StrCalcul1  : string;
      StrResult1  : string;
      StrCalcul2  : string;
      StrResult2  : string;
      StrCalcul3  : string;
      StrResult3  : string;
      StrResult4  : string;

      chkey,yy,nnn,nn : byte;
      FFtext          : Text;
      debut           : string[2];

  
  {$i SaveMath.pas}

  
Procedure Nombre_Decimales;
 var nn,Err :integer;
     ch     :char;
begin
   textAttr:=Menu_Color;

   Readbuf(6,13,55,16,BuffDir^);
   BoxColor(8,14,55,16,FondBox);
   textAttr:=33;
   BoxFill(6,13,53,15,' ');
   Box13.Rectangle(6,13,53,15,Simple);
   Putxy(19,13,' Nombre decimales ');
   Putxy(8,14,'Nombre de decimales de 2 … 9 : ?..');
   Gotoxy(41,14);

   Repeat
       Ch:=Readkey;
   Until (Ord(Ch)=27) or (Ch in['2','3','4','5','6','7','8','9']);

   writebuf(6,13,55,16,BuffDir^);

   textAttr:=Menu_color;

   if (Ch in['2','3','4','5','6','7','8','9']) then
    begin
       {$R-}
         Val(Ch,nn,Err);
       {$R+}
       if Err = 0 then
        begin
           Decimales:=nn;
        end
       else
         Decimales:=4;
    end;
end;{*ends*}



Procedure LineMenuClose(xx,yy:byte; SS,SS_Non:string);
 Const  couleurLine = 113;
 var
    P : integer;
    S : string[80];
begin
   SS := SS + '\';
   Crt.textAttr:=couleurLine;   {**couleur de fond et texte**}
   Crt.gotoxy(xx,yy);

   while SS <> '' do
    begin
       System.write(' ');
       P := System.Pos('\', SS);

       if System.Copy(SS, 1, System.Pred(P)) = SS_Non then
         Crt.gotoxy(Crt.Wherex+System.Pred(P),yy)
       else
         System.write(System.Copy(SS, 1, System.Pred(P)));

       System.Delete(SS, 1, P);
       P := Pos('\', SS);

       if SS[1] = '\' then S := '-'
       else
         S:= '-' + System.Copy(SS, 1, System.Pred(P));

       System.write(S);
       System.Delete(SS, 1, P);
    end;

   Box13.Csoff;

end; {*ends LineMenuClose*}


Procedure LineMenu(xx,yy:byte; SS:string);
 Const CouleurLettes = 116;
       couleurLine   = 113;
 var
     P : integer;
     S : string[80];
begin
   SS := SS + '\';
   Crt.textAttr:=couleurLine;   {**couleur de fond et texte**}
   Crt.gotoxy(1,yy);
   Crt.ClrEOL;
   Crt.gotoxy(xx,yy);
   while SS <> '' do
    begin
       System.write(' ');
       P:= System.Pos('\', SS);
       Crt.textAttr := CouleurLettes;  {**coluleur de lettres**}
       System.write(System.Copy(SS, 1, System.Pred(P)));
       System.Delete(SS, 1, P);
       P:= Pos('\', SS);

       if SS[1] = '\' then  S:= '-'
       else
         S:= '-' + System.Copy(SS, 1, System.Pred(P));

       Crt.textAttr := couleurLine;  {**couleur de fond et texte**}
       System.write(S);
       System.Delete(SS, 1, P);
    end;
   Box13.Csoff;
end;{*ends lineMenu*}



Procedure Save_formule(i:byte);
 var Sn:string[2];
     ch:char;
     color: byte;
begin
    Str(i,Sn);

    color:=textAttr;
    textAttr:=Error_Color;

    Readbuf(3,13,78,18,BuffDir^);
    BoxFill(3,13,78,18,' ');
    Box13.Rectangle(3,13,78,18,Simple);
    Putxy(5,13,' To Save Disk Evaluate'+Sn+' ');
    Putxy(5,15,'Sauvergade: '+Repertoire+NomSaveCalculs+'[Y/N]?');

    csoff;
    Repeat
        Ch:=Readkey;

    Until (Ord(Ch)=27) or (Upcase(Ch) in['Y','N']);

    writebuf(3,13,78,18,BuffDir^);

    if Upcase(Ch) = 'Y' then
     begin
        Case i of
         1: Save_Deductions(StrCalcul1,StrResult1,1,Repertoire+NomSaveCalculs);
         2: Save_Deductions(StrCalcul2,StrResult2,2,Repertoire+NomSaveCalculs);
         3: Save_Deductions(StrCalcul3,StrResult3,3,Repertoire+NomSaveCalculs);
        end;
     end;

    textAttr:=Color;

end;{*ends*}



{**Genere un bip grave**}

Procedure Beep_Beep;
begin
   Sound(2800);
   Delay(200);
   NoSound;
end;{*ends Beep*}

 

Procedure formuleF5(N,Y:byte;Var formule,SR:string);

 Var Entree: boolean;
     Sn    : string[2];
     n1    : integer;
     SS,Str_result,Str_Reserve:string;

begin
   n1:=0;
   Str_Reserve:=formule;
   Str_result:=SR;

   BoxColor(5,Y+1,77,Y+4,FondBox);
   BoxFill(3,Y,75,Y+3,' ');
   Box13.Rectangle(3,Y,75,Y+3,Simple);
   textAttr:=116;
   Str(N,Sn);
   Putxy(33,Y,' Evaluate '+Sn+' ');
   textAttr:=Menu_Color;
   SS:=formule;
   write(#7,#7);

   Repeat
      SS:=formule;
      Entree:=ReadBox(5,Y+1,SS,68,160);
      formule:=SS;
      if (Entree) and (SS<>'') then
       begin
               {**insere Resultat 2 et 3 **}

          if (N = 1) and ((StrResult2<>'') or (StrResult3<>'')) then
           begin
              if Pos('R2',SS) <> 0 then
               begin
                 n1:=Pos('R2',SS);

                 while n1>0 Do
                  begin
                    Delete(SS,n1,2);
                    Insert(StrResult2,SS,n1);
                    n1:=Pos('R2',SS);
                  end;
               end;

              if Pos('R3',SS) > 0 then
               begin
                 n1:=Pos('R3',SS);

                 while n1>0 Do
                  begin
                     Delete(SS,n1,2);
                     Insert(StrResult3,SS,n1);
                     n1:=Pos('R3',SS);
                  end;
               end;
           end
          else
                  {**insere Resultat 1 et 3 **}

          if (N = 2) and ((StrResult1<>'') or (StrResult3<>'')) then
           begin
              if Pos('R1',SS) > 0 then
               begin
                  n1:=Pos('R1',SS);

                  while n1>0 Do
                   begin
                      Delete(SS,n1,2);
                      Insert(StrResult1,SS,n1);
                      n1:=Pos('R1',SS);
                   end;
               end;

          if Pos('R3',SS) > 0 then
           begin
              n1:=Pos('R3',SS);

              while n1>0 Do
               begin
                  Delete(SS,n1,2);
                  Insert(StrResult3,SS,n1);
                  n1:=Pos('R3',SS);
               end;
           end;

       end {*ends entree*}

      else {**insere Resultat 1 et 2 **}

      if (N = 3) and ((StrResult1<>'') or (StrResult2<>'')) then
       begin
          if Pos('R1',SS) > 0 then
           begin
              n1:=Pos('R1',SS);

              while n1>0 Do
               begin
                  Delete(SS,n1,2);
                  Insert(StrResult1,SS,n1);
                  n1:=Pos('R1',SS);
               end;
           end;
          if Pos('R2',SS) > 0 then
           begin
              n1:=Pos('R2',SS);

              while n1>0 Do
               begin
                  Delete(SS,n1,2);
                  Insert(StrResult2,SS,n1);
                  n1:=Pos('R2',SS);
               end;
           end;

       end;{*ends n=3*}

      if ( (StrResult4<>'') and (Pos('R4',SS) > 0 )) then
       begin
          Str(Calculatrice_Total,StrResult4);
          n1:=Pos('R4',SS);

          while n1>0 Do
           begin
              Delete(SS,n1,2);
              Insert(StrResult4,SS,n1);
              n1:=Pos('R4',SS);
           end;
       end;

      SR:=Act(SS,9,Decimales);

      Putxy(5,Y+2,'                                                                ');

      textAttr:=113;
      Putxy(5,Y+2,'Result: ');
      if (Result__Error = 1) then
       begin
           textAttr:=116;
           Putxy(13,Y+2,SR);
           SR:='';
           Beep_Beep;
       end
      else Putxy(13,Y+2,SR);

      textAttr:=Menu_Color;

    end;

   Until (Not Entree);

   Putxy(33,Y,' Evaluate '+Sn+' ');

   if (formule = '') then
    begin
       formule:=Str_Reserve;
       SR:=Str_result;
       if length(formule) < 69 then Putxy(5,Y+1,formule)
       else
         begin
            Str_Reserve:=Copy(formule,1,68);
            Putxy(5,Y+1,Str_Reserve);
         end;
       Putxy(5,Y+2,'                                                                ');
    end;

   LineMenu(2,25,Menu);
   textAttr:=Menu_Color;
end;{*ends*}


Procedure Ecran;
 var i,Y : byte;
     SSS : string[2];
     s   : string[68];

begin
   textAttr:=Menu_Color;
   Window(1,1,80,CrtGetMaxY);
   writechar(1,1,80,' ');

   writeCn(1,'CALCULATOR');
   writeCar(36,1,'C');
   writeCar(37,1,'A');
   writeCar(38,1,'L');
   writeCar(39,1,'C');
   writeCar(40,1,'U');
   writeCar(41,1,'L');
   writeCar(42,1,'A');
   writeCar(43,1,'T');
   writeCar(44,1,'O');
   writeCar(45,1,'R');
   textAttr:=Edit_Color;

   Box13.Rectangle(1,2,80,24,Simple);
   Putxy(36,2,'');

   ClearScreen(2, 3, 79, 23,Edit_Color);

   textAttr:=Menu_Color;
   Y:=4;

   for i:=1 To 3 Do
    begin
       BoxColor(5,Y+1,77,Y+4,FondBox);
       BoxFill(3,Y,75,Y+3,' ');
       Box13.Rectangle(3,Y,75,Y+3,Simple);
       Str(i,SSS);
       Putxy(33,Y,' Evaluate '+SSS+' ');

       if i =1 then
        begin
           if length(StrCalcul1) < 69 then Putxy(5,Y+1,StrCalcul1)
           else
             begin
                S:=Copy(StrCalcul1,1,68);
                Putxy(5,Y+1,S);
             end;
        end
       else

       if i =2 then
        begin
           if length(StrCalcul2) < 69 then Putxy(5,Y+1,StrCalcul2)
           else
             begin
                S:=Copy(StrCalcul2,1,68);
                Putxy(5,Y+1,S);
             end;
        end

       else
       if i =3 then
        begin
          if length(StrCalcul3) < 69 then Putxy(5,Y+1,StrCalcul3)
          else
            begin
                S:=Copy(StrCalcul3,1,68);
                Putxy(5,Y+1,S);
            end;
        end;

       Inc(Y,7);
    end;

   textAttr:=Menu_Color;
   BoxFill(1,25,80,25,' ');
   LineMenu(2,25,Menu);
end;{*ends*}



Procedure Help;
 var keyy:byte;

begin
   textAttr:=112;
   Readbuf(12,10,66,23,BuffDir^);
   BoxFill(12,10,66,23,' ');
   Box13.Rectangle(12,10,66,23,Simple);
   Putxy(27,10,' Help MicroCalculator ');
   textAttr:=113;
   Putxy(16,12,'  +   -   *   /   ^   (   )');
   Putxy(16,13,'PI(0) ABS   TAN  ATAN   COS    EXP    LN');
   Putxy(16,14,'SIN   SQRT  SQR  TRUNC  RADIA  ARSIN  ARCOS');
   Putxy(16,15,'ROUND FRAC  INT  ');
   textAttr:=112;
   Putxy(16,17,'Variables: R1 R2 R3 Result Evaluate 1,2,3');
   Putxy(16,18,'           R4       Total Calculatrice');
   putxy(16,19,'Exemp: sqrt(144)+((((2000+500)*2)+50)+1000)');
   putxy(16,20,'Total: 6062.0000');
   csoff;


   Repeat
     Keyy:=Keyboard;
   Until (not Key_Code) and (Keyy in[13,27,32]);

   BoxFill(13,11,65,22,' ');

   Putxy(16,12,'  [Ctrl-F1] Nombre de decimales');
   Putxy(16,13,'  [F2] Save Evaluate 1  sur Maths.doc');
   Putxy(16,14,'  [F3] Save Evaluate 2  sur Maths.doc');
   Putxy(16,15,'  [F4] Save Evaluate 3  sur Maths.doc');

   Putxy(16,16,'  [F9] D‚veloppement de (a+b)^m ou (a-b)^n');
   Putxy(16,17,'  [F10] Calculs & MicoCalculatrice.');
   csoff;

   Repeat
     Keyy:=Keyboard;
   Until (not Key_Code) and (Keyy in[13,27,32]);

   textAttr:=112;

   BoxFill(12,10,66,23,' ');
   Box13.Rectangle(12,10,66,23,Simple);
   Putxy(31,10,' A propos de... ');
   {Putxy(31,10,'   A propos de... ');}
   BoxFill(15,11,61,18,' ');
   textAttr:=121;

   Putxy(20,12,'MICROCALCULATor '+Babi_Ti('ĸ˿¼Ä¸ËÀÈ̼ʑ‘',2));
   textAttr:=113;
   Putxy(16,14,Babi_Ti('úúúúÍôìñîúãäúòäñèä¹úú̲¬×¯¯²¬Ã¯¯°¬Ö¯¯°ú',3));
   Putxy(16,15,Babi_Ti('‘‘‘‘çéæÞéØääÜì鱑‘¸¥¸É¸',2));
   Putxy(16,16,Babi_Ti('¿¿¿¿|zw{v¿¿“µ»¸«´¾¿¼¯²²«¿s¿Œ¸§´©«¿',1));
   putxy(20,17,'Date programme MicroCal:06/Aout/1998');
   putxy(20,18,'Vente interdite...');
   csoff;

   Repeat
     Keyy:=Keyboard;
   Until (not Key_Code) and (Keyy in[27,32,13]);

   keyy:=0;
   writebuf(12,10,66,23,BuffDir^);
   LineMenu(2,25,Menu);
   textAttr:=Menu_Color;
end;{*ends*}


Procedure Init_Maths(mode:byte);
 Label ErrorFin;

 Var RR     : _Pick;
     Attr   : word;
     f      : File;
     Erreur1: integer;

begin
    Assign(f,Repertoire + 'Maths.INI');
    {$i-}
    GetFattr(f,Attr);
    {$I+}
    if (DosError=0) and (Attr and $01 = $01) then
     begin
        {$I-}
         SetFattr(f,$20);
        {$I+}
        Erreur1:=DosError;
     end;

    Assign(f,Repertoire +'Maths.INI');
    {$i-}
     GetFattr(f,Attr);
    {$I+}
    if (DosError=0) and (Attr and $01 = $01) then
     begin
        {$I-}
         SetFattr(f,$20);
        {$I+}
     end;

    if Mode=1 then
    begin
       Assign(Libre10, Repertoire +'Maths.INI');
       {$I-}
        Reset(Libre10);
       {$I+}
       Erreur1:=IoResult;

       if Erreur1=0 then
        begin
           {$I-}
            Read(Libre10,RR);
           {$I+}
           Erreur1:=Ioresult;
           if Erreur1<>0 then
            begin
               Close(Libre10);
               Goto ErrorFin;
            end;

           if RR.Formule1<>'' then StrCalcul1:=RR.Formule1
           else
             StrCalcul1:='';
           if RR.Formule2<>'' then StrCalcul2:=RR.Formule2
           else
              StrCalcul2:='';
           if RR.Formule3<>'' then StrCalcul3:=RR.Formule3
           else
              StrCalcul3:='';
           if RR.Nbr_Decimales in [2..9] then Decimales:=RR.Nbr_Decimales
           else
              Decimales:=4;

           Calculatrice_Total  := RR.Calcu_Total;
           Calculatrice_TotalM := RR.Calcu_TotalM;
           Calculatrice_S2     := RR.Calcul_2;
           Calculatrice_S3     := RR.Calcul_3;

           Str(Calculatrice_Total,StrResult4);

           {$I-}
            Close(Libre10);
           {$I+}
        end

       else Goto ErrorFin;

    end {*mode =1*}

   else

   if Mode = 0 then
    begin
       Assign(Libre10,'C:\Maths.INI');
       {$I-}
       Rewrite(Libre10);
       {$I+}
       Erreur1:=IoResult;
       if Erreur1 = 0 then
        begin
           RR.Formule1:=StrCalcul1;
           RR.Formule2:=StrCalcul2;
           RR.Formule3:=StrCalcul3;

           RR.Calcu_Total    := Calculatrice_Total;
           RR.Calcu_TotalM   := Calculatrice_TotalM;
           RR.Calcul_2       := Calculatrice_S2;
           RR.Calcul_3       := Calculatrice_S3;
           RR.Nbr_Decimales  := Decimales;

           {$I-}
           write(Libre10,RR);
           {$I+}

           Erreur1:=IOresult;

           {$I-}
           Close(Libre10);
           {$I+}

           Goto ErrorFin;
      end;

    end;{*moode = 0*}

    ErrorFin:
end;{*ends*}


Procedure Machine_Calcul;
begin
   ReadBuf(49,4,51+26,5+11,BuffDir^);
   BoxColor(51,5,51+26,5+11,FondBox);
   Calculatrice(49,4,Calculatrice_S2,Calculatrice_S3,Calculatrice_Total,Calculatrice_TotalM);
   writeBuf(49,4,51+26,5+11,BuffDir^);
   Str(Calculatrice_Total,StrResult4);
end;


Procedure TrianglePascal;
begin
   Readbuf(1,1,80,1+24,BuffDir^);
    Inicialitation_Triangle;
    Triangle(3,2,10);
   writebuf(1,1,80,1+24,BuffDir^);
end;


Procedure Rotatio_G3;
begin
   ReadBuf(48,6,50+30,7+8,BuffDir^);
   DONNE_ROTATION_G3(48,6);
   writeBuf(48,6,50+30,7+8,BuffDir^);
end;


Procedure Rayon_G3;
begin
   ReadBuf(48,7,50+30,8+7,BuffDir^);
   Cherche_Rayon(48,7);
   writeBuf(48,7,50+30,8+7,BuffDir^);
end;


Procedure Centre_Arc_G3;
begin
   ReadBuf(48,8,50+30,9+11,BuffDir^);
   Calcul_Centre_Arc(48,8);
   writeBuf(48,8,50+30,9+11,BuffDir^);
end;


{$F+} Function Erreur_Tas(Size:word): integer; {$F-}
begin
      Erreur_Tas:=1;
end;{**Erreur_Tas**}



begin

    HeapError:=@Erreur_Tas;
    debut:='ok';
    ColorAttrib:=textAttr;

    textAttr:=7;
    Clrscr;

    {**initialise le disque et le repertoire courant**}

    GetDir(0,disk);
    Disque2:=Disk[1]+Disk[2];
    if Disk[length(Disk)] <> '\' then Repertoire:=Disk+'\'
    else
      Repertoire:=Disk;

    {**ends initialisation**}

    (*********declaration de l'unite BUFFS**********************************
      LinePtr       :Pointer;     {buffer de une ligne pour mesajes et del_ }
      SizeLinePtr   :word;        {Buffer de une Ligne}

      Menu_Buf      : Pointer;    {Menu_Buf_Ptr;}
      Size_Menu_Buf : word;

      Sub_Buf       : pointer;    {Sub_Buf_Ptr;}
      Size_Sub_Buf  : word;

      BuffDir       : Pointer;
      SizeDir       : word;

    ************************************************************************)

    Size_Menu_Buf:=CrtSize(55,16,73,22);
    GetMeM(Menu_Buf,Size_Menu_Buf);

    Size_Sub_buf:= CrtSize(1,1,80,4);
    GetMem(Sub_Buf,Size_Sub_Buf);

    SizeLinePtr:= CrtSize(1,1,80,1);
    GetMem(LinePtr,SizelinePtr);

    SizeDir:= CrtSize(1,1,80,25);
    GetMem(BuffDir,SizeDir);


    FondBox:=Edit_Color-(((Edit_Color and $70) shr 4) * 16);

    StrCalcul1:='';
    StrResult1:='';
    StrCalcul2:='';
    StrResult2:='';
    StrCalcul3:='';
    StrResult3:='';

    {***Calculatrice****}

    Calculatrice_Total    :=0;
    Calculatrice_TotalM   :=0;
    Calculatrice_S2       :='';
    Calculatrice_S3       :='';

    nnn:=0;


    Init_Maths(1);
    Ecran;

    Csoff;

    Repeat
        if (Key_Code) and (nnn = 63) then
         formuleF5(1,4, StrCalcul1,StrResult1)
        else
        if (Key_Code) and (nnn = 64) then
         formuleF5(2,11,StrCalcul2,StrResult2)
        else
        if (Key_Code) and (nnn = 65) then
         formuleF5(3,18,StrCalcul3,StrResult3)
        else
        if (Key_Code) and (nnn = 68) then
         begin

            Readbuf(55,17,73,22,Menu_Buf^);
            BoxFill(55,17,71,22,' ');
            Rectangle(55,17,71,22,Simple);

            Putxy(57,18,'Calculatrice');
            Putxy(57,19,'Rotation   G3');
            Putxy(57,20,'Distan  Angle');
            Putxy(57,21,'G3 Centre-Arc');

            yy:=18;
            highBox(56,yy,70,yy,Bx);

            csoff;
            Repeat
               chKey:=Keyboard;

               if (Key_Code) and (chKey=80) and (yy<21) then
                begin
                   HighBox(56,yy,70,yy,Bx);
                   inc(yy);
                   HighBox(56,yy,70,yy,Bx);
                end
               else
               if (Key_Code) and (chKey=72) and (yy>18) then
                begin
                   HighBox(56,yy,70,yy,Bx);
                   Dec(yy);
                   HighBox(56,yy,70,yy,Bx);
                end;

            Until chKey in[13,27];

            writebuf(55,17,73,22,Menu_Buf^);

            if (chkey=13) and (yy in[18,19,20,21]) then
            case yy of
              18 : Machine_Calcul;
              19 : Rotatio_G3;
              20 : Rayon_G3;
              21 : Centre_Arc_G3;
            end;


          end {*ends selection*}

        else

        if (Key_Code) and (nnn = 67) then TrianglePascal

        else

        if (Key_Code) and (nnn = 66) then
          begin {*Printer_Formule*} end
        else
              {**Sauvegarde**}

        if (Key_Code) and (nnn = 60) then
          Save_formule(1)
        else
        if (Key_Code) and (nnn = 61) then
          Save_formule(2)
        else
        if (Key_Code) and (nnn = 62) then
          Save_formule(3)
        else
        if (Ctrl) and (Key_Code) and (nnn = 94) then
          Nombre_Decimales;

        Csoff;

        if debut='ok' then begin Help; debut:=' '; end;

        Repeat

          nnn:=KeyBoard;

        Until ((Key_Code) and (nnn in[63,64,65,66,59,67,68,60,61,62])) OR
              ( (Ctrl) and (Key_Code) and (nnn=94)) or (nnn = 27);


        if (Key_Code) and (nnn in[63,64,65,59,68,67]) then
         begin
            LineMenuClose(2,25,Menu,'Echap');
         end;

        if (Key_Code) and (nnn = 59) then Help
        else
        if (Not Key_Code) and (nnn = 27) then
         begin
            write(#7);
            textAttr:=Menu_Color;
            BoxFill(1,25,80,25,' ');
            writeCn(25,'Termine le traitement [Y/N]');
            writeCar(50,25,'Y');
            writeCar(52,25,'N');

            Csoff;

            Repeat

              nn:=Keyboard;

            Until nn in[89,121,78,110];

            if nn in[78,110] then  {**Non = N, pas terminer continuer**}
             begin
                LineMenu(2,25,Menu);
                nnn:=0;
             end
            else
              begin
                 nnn:=27;
                 Key_Code:=False;
              end;
         end;

      Until (nnn = 27) and (Not Key_Code);

      Init_Maths(0);


     {**efface les pointeur actif*}

     if (Sub_Buf<>NIL) then FreeMem(Sub_Buf,Size_Sub_Buf);
     if (LinePtr<>NIL) then FreeMem(LinePtr,SizelinePtr);
     if (BuffDir<>NIL) then FreeMem(BuffDir,SizeDir);
     if (Menu_Buf<>Nil) then FreeMem(Menu_Buf,Size_Menu_Buf);

     textAttr:=ColorAttrib;
     Clrscr;

     Release(point_Mem_tas);
     {*Halt(1);*}
end.
{**ends programme MicroCalcul mathes avec MATHS.INI**}

3000 années âpres le soleil

3000 années âpres le soleil !
Trois mille années, âpres que le soleil se soit étain. La Galaxie, vivait dans le noir profond de l'Univers. La lumière du Soleil elle était parti vers d'autres temps, son image voyage quelque par dans l'infini du cosmos.
Le soleil cette étain à jamais, tout comme s'il na avait jamais existe. Il avait entendu parler par les anciens, que autre fois un soleil il illumine toute la Galaxie, mais lui il avait toujours bécue sue les néons, de fois il essayait d'imaginer comme c'était autrefois, mais sa panse était extraite, il ne pouvait pas lui donner une forme, il étai mal alaises, il étouffait, il aura voulu fuir, mais il n'avait pas de issu, partout cette pareil cette la surpopulation.

Il marche dans la rue, machinalement comme il avait l'habitude. D'ailleurs il alla ou ?
Lui-même il l'ignorait, personne l'attendait, il alla nulle par, il marcha au milieu de la foule sans que personne fasse attention à lui, il était perdu, oublie, il était la mais au juste il ne le savait pas pourquoi il étai la. À mesure qu'il avançait, une sensation l'envasait dans son l'esprit, tout comme l'oublie de l'inutile de mort. Comme s'il venait de cet réveiller de un rêve. Il ne comprenait rien, il était dans un monde inouï, hostile, ou personne se souci de personne, ou chaque-un se dirige dan une direction bien détermine, comme s'ils avaient été programmes. De temps en temps, il était bouscule par de passants plus presses.

La foule, était épaisse comme dans une fourmilière ou chaque-un il avait sa tache à exécuter sans aucun sentiment de sensibilité ver les autres, tout comme des robots. Les néons au dessus de lui éclairant l'avenue, que la nuit camouflait dans le noir le plus complet. Les Andromède qui tenaient le pouvoir sur la planète ils étaient de l'autre cote du grillage, personne ne pouvait le franchir, cette strictement interdit par la loi, il ave déjà qu'ils avaient enselle, mais sans aucun résultat une force magnétique les empêchait.

Il allait chez lui, mais chez lui ce n'était nulle part, il fallait trouver une chambre ou il reste encore de la place. Machinalement il leva la tête au dessous de lui, il apercevait une tour qui se perdait dans l'infini, il ignorait combien de étages prouve en avoir, le noir de la nuit, ce noir profond aveuglait les perspective qui se perdaient dans le ciel sans fin.

Il monte dans l'ascenseur appuya un bouton au hasard au bout de quelques instants l'ascenseur se arrêta, il sotie en longeant le couloir qui se étalait devant lui derrière les portes, ont entendait des murmures, il aperçu une porte entrouverte il avait une jambe qui dépassait, ont entendu un murmure au fond de la pièce qu'il disait « la porte » une vois lui répondue « ma jambe elle est coince » une autre vois cria « Que-ont ce la coupe… »

A. ARA
Suite Dans une autre Galaxie :: Programmation pascal…[1]    Editeur de texte…[2]
Page Last Updated: Octobre 29, 2011 | Page Editor: A. Ara | SiteMap Dans Une Autre Galaxie
Cet emplacement web non-commercial, et totalement libre & indépendant de tout les parti politique ou d'organisme officiel de toute nature.
Nous réflexions sont exclusivement l'avis de personnes qui rejettent le massacre que la société fait aux animaux pour tout motif.