home *** CD-ROM | disk | FTP | other *** search
/ PC Interdit / pc-interdit.iso / graph / font.pas < prev    next >
Pascal/Delphi Source File  |  1994-10-06  |  5KB  |  129 lines
  1. Unit Font;
  2.  
  3. Interface
  4.  
  5. Procedure Print_Char(Chr:Char);
  6. {affiche un caractère en mode X }
  7. Procedure Print_String(Str:String);
  8. {affiche une chaîne de caractères en mode X }
  9.  
  10. Procedure Scrl_Move;
  11. {déplace la partie visible du Scrolly vers la gauche }
  12. Procedure Scrl_Append;
  13. {ajoute des données nouvelles au bord droit du Scrolly}
  14.  
  15. Var Scrl_Y:Word; {position verticale du Scrolly}
  16.  
  17. Const
  18.   Scrl_Nombre=4;
  19.   {nombre de chaînes disponibles dans Scrl_Txt }
  20.   Scrl_Txt:Array [1..Scrl_Nombre] of String =
  21.   {Ceci n'est qu'un texte de démonstration que vous pouvez modifier ou compléter librement.!}
  22.   ('Bonjour, ceci est un defileur de demonstration tire du livre P C  I N T E R D I T'
  23.   +'  de Micro Application. Bon d accord ce n est pas le grand luxe           , ',
  24.    'mais il se programme avec un minimum d effort et sa vitesse est '
  25.   +'bonne. Meme sur les ordinateurs lents, il est possible d adjoindre ',
  26.    'des effets supplementaires. Notez bien que ce programme ne consomme  '
  27.   +'que 10 pour 100 des ressources de calcul disponibles sur un 486-40 avec Turbo desactive ',
  28.    '. Attention Scrolly va demarrer '
  29.   +'             ---------------------------             ');
  30.  
  31.  
  32. Implementation
  33. Uses ModeXLib;
  34. Const
  35.   CharPos:Array[' '..'Z', 0..1] of Word=
  36.   {positions et largeurs des différents caractères,
  37.    décomptés en mots-CPU }
  38.    ((71,4),(0,0),(0,0),(0,0),(0,0),(0,0),
  39.     (0,0),(0,0),(0,0),(0,0),(0,0),(0,0),
  40.     (1906,3),(1909,3),(1912,3),(1915,4),      {,-./}
  41.     (3600,5),(3605,3),(3608,5),(3613,5),      {0..3}
  42.     (3618,5),(3623,5),(3628,5),(3633,5),      {4..7}
  43.     (3638,5),(3643,5),(3648,3),(3651,3),      {8..;}
  44.     (3654,5),(3659,5),(3664,5),(3669,4),      {<..?}
  45.     (0,0),(0,5),(5,5),(10,5),(15,6),(21,5),    {@..E}
  46.     (26,4),(30,7),(37,5),(42,3),(45,4),(49,5),{F..K}
  47.     (54,4),(58,8),(66,5),(1840,7),(1847,5),    {L..P}
  48.     (1852,7),(1859,5),(1864,4),(1868,4),      {Q..T}
  49.     (1872,5),(1877,6),(1883,8),(1891,5),      {U..X}
  50.     (1896,5),(1901,5));                        {YZ}
  51.  
  52. Var Cur_X,                  {coordonnées courantes }
  53.     Cur_Y:Integer;          {du curseur }
  54.  
  55.     Scrl_Number, {numéro de la chaîne de défilement présentement active }
  56.     Scrl_Pos, {position à l'intérieur de cette chaîne }
  57.     Scrl_ChrPos:Word;       {position à l'intérieur du caractère }
  58.  
  59. Procedure Print_Char(Chr:Char);
  60. {affiche un caractère en mode X et avance le curseur }
  61. Begin
  62.   Chr:=UpCase(Chr); {ne prend que des majuscules }
  63.   If Chr in [' '..'Z'] Then Begin {le caractère est-il dans la table ?, oui :}
  64.     If 80- Cur_X <  {reste-t-il assez de place ?}
  65.     CharPos[Chr,1] Then Begin
  66.       Cur_X:=0; {non, ligne suivante, x à 0}
  67.       Inc(Cur_Y,25); {y augmenté de la hauteur d'un caractère}
  68.     End;
  69.   Copy_Block(Cur_Y*80+Cur_X, 48000+Charpos[Chr,0], CharPos[Chr,1], 22);
  70.   {copie le caractère de la position de fonte (lue dans la table CharPos)
  71.   à la position du curseur (Cur_Y * 80 byte par ligne + Cur_X)
  72.   (hauteur = 22 lignes) }
  73.   Inc(Cur_X,CharPos[Chr,1]); {avance le curseur de la largeur du caractère }
  74.   End;
  75. End;
  76.  
  77. Procedure Print_String(Str:String);
  78. {affiche une chaîne en mode X,
  79.   utilise Print_Char}
  80. Var i:Word;
  81. Begin
  82.   For i:=1 to Length(Str) do {parcourt l'ensemble de la chaîne }
  83.     Print_Char(Str[i]); {et l'envoie caractère par caractère à Print_Char}
  84. End;
  85.  
  86. Procedure Scrl_Move;
  87. {déplace simplement le contenu de l'image à l'emplacement du Scrolly
  88. d'une position vers la gauche c'est-à-dire copie 79 bytes de l'abscisse
  89. 1 à l'abscisse 0}
  90. Begin
  91.   Copy_Block(Scrl_y*80, Scrl_Y*80 +1, 79,22);
  92. End;
  93.  
  94. Procedure Scrl_Append;
  95. Var Chr:Char; {caractère courant }
  96. Begin
  97.   Chr:=UpCase(Scrl_txt[Scrl_Number,Scrl_pos]);
  98.                              {lit le caractère, le convertir en majuscule }
  99.   If Chr in [' '..'Z'] Then Begin  {le caractère est-il dans le jeu ?, oui :}
  100.     If CharPos[Chr,1] > 0 Then {n'affiche que les caractères disponibles }
  101.       Copy_Block(Scrl_y*80+79, 48000+CharPos[Chr,0]+Scrl_ChrPos, 1, 22);
  102. {puis copie 1 colonne du jeu de caractères au bord droit de l'écran }
  103.     Inc(Scrl_ChrPos);      {colonne suivante à l'intérieur du caractère }
  104.     If Scrl_ChrPos >= CharPos[Chr,1] Then Begin
  105.       Inc(Scrl_Pos);       {caractère traité, au suivant }
  106.       Scrl_ChrPos:=0;      {réinitialise la colonne à 0}
  107.       If Scrl_Pos > Length(Scrl_Txt[Scrl_Number]) Then Begin
  108.         Inc(Scrl_Number);  {chaîne traitée, à la suivante }
  109.         Scrl_Pos:=1;       {remet la position à 0}
  110.         If Scrl_Number > Scrl_Nombre Then Begin
  111.           Scrl_Number:=1;  {texte traité, on recommence }
  112.           Scrl_Pos:=1;
  113.           Scrl_ChrPos:=0;
  114.         End;
  115.       End;
  116.     End;
  117.   End;
  118. End;
  119.  
  120. Begin
  121.   Cur_X:=0;                {curseur au coin supérieur gauche }
  122.   Cur_Y:=0;
  123.  
  124.   Scrl_Y:=50;              {Valeur par défaut de l'ordonnée }
  125.   Scrl_Number:=1;          {on commence par la chaîne 1,}
  126.   Scrl_Pos:=1;             {le caractère 1, la colonne 0 }
  127.   Scrl_ChrPos:=0;
  128. End.
  129.