home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / dos / prg / geutsrce / mygui.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-05  |  5.0 KB  |  216 lines
  1. UNIT MyGUI;{Mini MyGUI v1.0ß: le 28/04/94}
  2.  
  3.  
  4. INTERFACE
  5.  
  6.  
  7. USES Y360x480;
  8.  
  9.  
  10. TYPE
  11.   TypeCarac =ARRAY[0..255,0..13] OF BYTE;
  12.   TypePolice=^TypeCarac;
  13.  
  14.  
  15. VAR
  16.   PoliceActive  :TypePolice;
  17.   BeigeXClair,
  18.   BeigeClair,
  19.   BeigeMoyen,
  20.   BeigeFonce,
  21.   BeigeXFonce,
  22.   GrisClair,
  23.   GrisFonce     :BYTE;
  24.   CouleurPolice,
  25.   CouleurArriere:BYTE;
  26.   Transparence  :BOOLEAN;
  27.  
  28.  
  29. PROCEDURE InitialisationsCouleurs;
  30. PROCEDURE PanneauCcv(x1,y1,x2,y2:WORD;couleur:BYTE);
  31. PROCEDURE PanneauCvx(x1,y1,x2,y2:WORD;couleur:BYTE);
  32. PROCEDURE Cadre(x1,y1,x2,y2:WORD;couleur:BYTE);
  33. FUNCTION  ChargePolice(VAR Police:TypePolice;NomFichier:STRING):INTEGER;
  34. FUNCTION  DechargePolice(VAR Police:TypePolice):INTEGER;
  35. PROCEDURE ParametresPolice(CoulPolice,CoulArriere:BYTE;Masque:BOOLEAN);
  36. PROCEDURE TexteNormal(x,y:WORD;espaces:BYTE;texte:STRING);
  37. PROCEDURE TexteCreux(x,y:WORD;coulpolice,espaces:BYTE;texte:STRING);
  38. PROCEDURE TexteRelief(x,y:WORD;coulpolice,espaces:BYTE;texte:STRING);
  39. PROCEDURE TexteGras(x,y:WORD;espaces:BYTE;texte:STRING);
  40. PROCEDURE TexteOmbre(x,y:WORD;coulpolice,espaces:BYTE;texte:STRING);
  41.  
  42.  
  43. IMPLEMENTATION
  44.  
  45.  
  46. VAR
  47.   i:WORD;
  48.  
  49.  
  50. PROCEDURE InitialisationsCouleurs;
  51. BEGIN
  52.   BeigeXClair:=248;
  53.   BeigeClair :=249;
  54.   BeigeMoyen :=250;
  55.   BeigeFonce :=251;
  56.   BeigeXFonce:=252;
  57.   GrisClair  :=253;
  58.   GrisFonce  :=254;
  59.   YEcritCouleur(BeigeXClair,44,40,33);
  60.   YEcritCouleur(BeigeClair ,38,34,27);
  61.   YEcritCouleur(BeigeMoyen ,32,28,21);
  62.   YEcritCouleur(BeigeFonce ,26,22,15);
  63.   YEcritCouleur(BeigeXFonce,20,16,09);
  64.   YEcritCouleur(GrisClair  ,45,45,45);
  65.   YEcritCouleur(GrisFonce  ,18,18,18);
  66. END;
  67.  
  68.  
  69. PROCEDURE PanneauCcv(x1,y1,x2,y2:WORD;couleur:BYTE);
  70. BEGIN
  71.   FOR i:=y1+2 TO y2-2 DO
  72.     YLigneH(x1,i,x2,couleur);
  73.   YLigneH(x1,y1,x2,GrisClair);
  74.   YLigneH(x1,y1+1,x2,GrisClair);
  75.   YLigneH(x1,y2,x2-1,GrisFonce);
  76.   YLigneH(x1,y2-1,x2-1,GrisFonce);
  77.   YLigneV(x1,y1+2,y2,GrisFonce);
  78.   YLigneV(x2,y1,y2,GrisClair);
  79. END;
  80.  
  81.  
  82. PROCEDURE PanneauCvx(x1,y1,x2,y2:WORD;couleur:BYTE);
  83. BEGIN
  84.   FOR i:=y1+2 TO y2-2 DO
  85.     YLigneH(x1,i,x2,couleur);
  86.   YLigneH(x1,y1,x2,GrisFonce);
  87.   YLigneH(x1,y1+1,x2,GrisFonce);
  88.   YLigneH(x1,y2,x2-1,GrisClair);
  89.   YLigneH(x1,y2-1,x2-1,GrisClair);
  90.   YLigneV(x1,y1+2,y2,GrisClair);
  91.   YLigneV(x2,y1,y2,GrisFonce);
  92. END;
  93.  
  94.  
  95. PROCEDURE Cadre(x1,y1,x2,y2:WORD;couleur:BYTE);
  96. BEGIN
  97.   PanneauCcv(x1,y1,x2,y2,couleur);
  98.   YLigneH(x1+2,y1+4,x2-2,GrisFonce);
  99.   YLigneH(x1+2,y1+5,x2-2,GrisFonce);
  100.   YLigneH(x1+2,y2-4,x2-2,GrisClair);
  101.   YLigneH(x1+2,y2-5,x2-2,GrisClair);
  102.   YLigneV(x1+2,y1+4,y2-4,GrisClair);
  103.   YLigneV(x2-2,y1+6,y2-6,GrisFonce);
  104. END;
  105.  
  106.  
  107. FUNCTION ChargePolice(VAR Police:TypePolice;NomFichier:STRING):INTEGER;
  108. VAR
  109.   Fichier:FILE;
  110. BEGIN
  111.   ChargePolice:=0;
  112.   {$I-}
  113.   ASSIGN(Fichier,NomFichier+'.F14');
  114.   Reset(Fichier,1);
  115.   GetMem(Police,3584);
  116.   BlockRead(Fichier,Police^,3584);
  117.   Close(Fichier);
  118.   {$I+}
  119.   IF IOResult<>0 THEN
  120.     ChargePolice:=-1;
  121. END;
  122.  
  123.  
  124. FUNCTION DechargePolice(VAR Police:TypePolice):INTEGER;
  125. BEGIN
  126.   DechargePolice:=0;
  127.   {$I-}
  128.   FreeMem(Police,3584);
  129.   {$I+}
  130.   IF IOResult<>0 THEN
  131.     DechargePolice:=-1;
  132. END;
  133.  
  134.  
  135. PROCEDURE ParametresPolice(CoulPolice,CoulArriere:BYTE;Masque:BOOLEAN);
  136. BEGIN
  137.   CouleurPolice :=CoulPolice;
  138.   CouleurArriere:=CoulArriere;
  139.   Transparence  :=Masque;
  140. END;
  141.  
  142.  
  143. PROCEDURE TexteNormal(x,y:WORD;espaces:BYTE;texte:STRING);
  144. VAR
  145.   i,j,k,l,m,symbole:BYTE;
  146. BEGIN
  147.   FOR i:=1 TO length(texte) DO
  148.   BEGIN
  149.     symbole:=Ord(texte[i]);
  150.     m:=1;
  151.     FOR j:=0 TO 7 DO    {LARGEUR}
  152.     BEGIN
  153.       l:=128 DIV m;
  154.       m:=m SHL 1;
  155.       FOR k:=0 TO 13 DO {HAUTEUR}
  156.       BEGIN
  157.         IF (PoliceActive^[symbole][k] AND l)=l
  158.           THEN YEcritPoint(x+j,y+k,CouleurPolice)
  159.           ELSE IF NOT Transparence
  160.                  THEN YEcritPoint(x+j,y+k,CouleurArriere);
  161.       END;
  162.     END;
  163.     IF espaces<>0 THEN
  164.     BEGIN
  165.       FOR l:=1 TO espaces DO
  166.       BEGIN
  167.         FOR k:=0 TO 13 DO
  168.           IF NOT Transparence
  169.             THEN YEcritPoint(x+7+1+l,y+k,CouleurArriere);
  170.       END;
  171.     END;
  172.     x:=x+7+1+espaces;   {LARGEUR=7+1+?}
  173.   END;
  174. END;
  175.  
  176.  
  177. PROCEDURE TexteCreux(x,y:WORD;coulpolice,espaces:BYTE;texte:STRING);
  178. BEGIN
  179.   ParametresPolice(GrisClair,0,True);
  180.   TexteNormal(x,y+2,espaces,texte);
  181.   ParametresPolice(GrisFonce,0,True);
  182.   TexteNormal(x+2,y,espaces,texte);
  183.   ParametresPolice(coulpolice,0,True);
  184.   TexteNormal(x+1,y+1,espaces,texte);
  185. END;
  186.  
  187.  
  188. PROCEDURE TexteRelief(x,y:WORD;coulpolice,espaces:BYTE;texte:STRING);
  189. BEGIN
  190.   ParametresPolice(GrisFonce,0,True);
  191.   TexteNormal(x,y+2,espaces,texte);
  192.   ParametresPolice(GrisClair,0,True);
  193.   TexteNormal(x+2,y,espaces,texte);
  194.   ParametresPolice(coulpolice,0,True);
  195.   TexteNormal(x+1,y+1,espaces,texte);
  196. END;
  197.  
  198.  
  199. PROCEDURE TexteGras(x,y:WORD;espaces:BYTE;texte:STRING);
  200. BEGIN
  201.   TexteNormal(x  ,y,espaces,texte);
  202.   TexteNormal(x+1,y,espaces,texte);
  203. END;
  204.  
  205.  
  206. PROCEDURE TexteOmbre(x,y:WORD;coulpolice,espaces:BYTE;texte:STRING);
  207. BEGIN
  208.   ParametresPolice(0,0,True);
  209.   TexteNormal(x  ,y+2,espaces,texte);
  210.   ParametresPolice(coulpolice,0,True);
  211.   TexteNormal(x+1,y,espaces,texte);
  212. END;
  213.  
  214.  
  215. END.
  216.