home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 16 / CD_ASCQ_16_0994.iso / news / 572 / xgrafic2 / util / edpixel.pas < prev    next >
Pascal/Delphi Source File  |  1994-07-20  |  8KB  |  311 lines
  1. {EDPIXEL : Programme qui permet de créer des boutons graphiques}
  2. {Ces sprites,boutons,etc... sont ensuite utilisables par XGRAPHIC pour Turbo pascal}
  3. {dans tous les modes graphiques disponibles}
  4.  
  5.  
  6. program edibouton;
  7.  
  8.  
  9.  
  10. {Réalisé avec fonctions de XGRAPHIC v2.0 pour Pascal}
  11. {Dominique DELAIRE - 1994}
  12.  
  13.  
  14. Uses XGRAPHIC, GRAPH, CRT;
  15.  
  16.  
  17. var boucle,passage : integer;
  18.     a : integer;
  19.     coulcour : integer;
  20.     b,c : integer;
  21.     d,e : integer;
  22.     fichier : string;
  23.     F : File;
  24.     img : Pointer;
  25.     Size,pixelcolor : word;
  26.  
  27.  
  28. procedure dessclcour(num : integer);
  29. begin
  30.    panneau3d(590,10,610,30,num);
  31. end;
  32.  
  33. procedure dessmatrice;
  34. begin
  35.         setcolor(15);
  36.         a := 0;
  37.         while a <= 25
  38.         do begin
  39.            line(190,100 + (a * 10),440,100 + (a * 10));
  40.            line(190 + (a * 10),100,190 + (a * 10),350);
  41.            a := a + 1;
  42.         end;
  43. end;
  44.  
  45.  
  46. procedure colorepointgrille(x1,y1,x2,y2,num : integer);
  47. begin
  48.     remplissage(x1,y1,x2,y2,num);
  49. end;
  50.  
  51.  
  52.  
  53. {PROGRAMME PRINCIPAL}
  54. BEGIN
  55.     modevga480;
  56.     initsouris;
  57.     affichesouris;
  58.  
  59.     coulcour := 0;
  60.     boucle := 0;
  61.     passage := 0;
  62.     while boucle = 0
  63.     do begin
  64.      if passage = 0
  65.      then begin
  66.         cachesouris;
  67.         efface;
  68.         affichepcx('edpixel.pcx');
  69.         cadre3d(570,40,620,480,7);
  70.         panneau3din(580,70,610,472,7);
  71.         Choisirpolice(2,2);
  72.         texte3d(580,50,16,15,'COULEURS');
  73.         {couleurs possibles}
  74.         panneau3d(585,75,605,95,1);
  75.         panneau3d(585,100,605,120,2);
  76.         panneau3d(585,125,605,145,3);
  77.         panneau3d(585,150,605,170,4);
  78.         panneau3d(585,175,605,195,5);
  79.         panneau3d(585,200,605,220,6);
  80.         panneau3d(585,225,605,245,7);
  81.         panneau3d(585,250,605,270,8);
  82.         panneau3d(585,275,605,295,9);
  83.         panneau3d(585,300,605,320,10);
  84.         panneau3d(585,325,605,345,11);
  85.         panneau3d(585,350,605,370,12);
  86.         panneau3d(585,375,605,395,13);
  87.         panneau3d(585,400,605,420,14);
  88.         panneau3d(585,425,605,445,15);
  89.         panneau3d(585,450,605,470,16);
  90.  
  91.         dessclcour(coulcour);
  92.  
  93.         Choisirpolice(2,4);
  94.         panneau3din(190,50,216,76,16);
  95.         choisirpolice(2,4);
  96.         icone3d(130,400,220,425,7,16,'   QUITTER');
  97.         icone3d(230,400,320,425,16,2,'   CHARGER');
  98.         icone3d(330,400,420,425,16,2,'   SAUVER');
  99.         afficheXgr(430,400,'new.xgr');
  100.         remplissage(190,100,440,350,16);
  101.         dessmatrice;
  102.         EffetChaine(10,5,11,'EDPIXEL - Dominique Delaire - 1994');
  103.         EffetChaine(10,15,14,'Editeur de Boutons,de petits sprites,etc... pour Xgraphic');
  104.  
  105.         affichesouris;
  106.         passage := 1;
  107.      end;
  108.  
  109.         {QUITTER}
  110.         if clickobjet(130,400,220,425) = 1
  111.         then begin
  112.           efface;
  113.           cachesouris;
  114.           finmodegraphique;
  115.           halt;
  116.         end;
  117.  
  118.         {CHARGER}
  119.          {on demande le nom du fichier}
  120.          if clickobjet(230,400,320,425) = 1
  121.          then begin
  122.             cadre3d(10,315,110,360,1);
  123.             choisirpolice(2,2);
  124.             texte(20,320,11,'FICHIER :');
  125.             fichier := SaisieChaine3din(8,20,328,16,14);
  126.             remplissage(10,315,110,360,9);
  127.             {CHARGE IMAGE A PARTIR DU FICHIER DISQUE}
  128.             {$I-}
  129.             assign(F,fichier+'.XGR');
  130.             reset(F,1);
  131.             if ioresult = 0
  132.             then begin
  133.             size := FileSize(F);
  134.             Getmem(Img,Size);
  135.             Blockread(F,img^,size);
  136.             close(F);
  137.             Putimage(191,51,img^,normalput);
  138.             Freemem(Img,size);
  139.             end;
  140.  
  141.             {Remplissage de la grille}
  142.             b := 0;
  143.             while b < 25
  144.             do begin
  145.                b := b + 1;
  146.                c := 0;
  147.                while c < 25
  148.                do begin
  149.                  c := c + 1;
  150.                  Pixelcolor := getpixel(190 + b,50 + c);
  151.                  colorepointgrille(181 + (10 * b),91 + (10 * c),181 + (10 * b) + 9,91 + (10 * c) + 9,pixelcolor);
  152.                end;
  153.             end;
  154.             dessmatrice;
  155.          end;
  156.  
  157.  
  158.         {SAUVER}
  159.          {on demande le nom du fichier}
  160.          if clickobjet(330,400,420,425) = 1
  161.          then begin
  162.             cadre3d(10,315,110,360,1);
  163.             choisirpolice(2,2);
  164.             texte(20,320,11,'FICHIER :');
  165.             fichier := SaisieChaine3din(8,20,328,16,14);
  166.             remplissage(10,315,110,360,9);
  167.             {SAUVEGARDE IMAGE SUR FICHIER DISQUE}
  168.             size := ImageSize(191,51,215,75);
  169.             Getmem(Img,Size);
  170.             Getimage(191,51,215,75,img^);
  171.             assign(F,fichier+'.XGR');
  172.             rewrite(F,1);
  173.             Blockwrite(F,img^,size);
  174.             close(F);
  175.             Freemem(Img,size);
  176.          end;
  177.  
  178.         {NEW}
  179.           {On efface la grille et le panneau correspondant}
  180.           if clickobjetxgr(430,400) = 1
  181.           then begin
  182.             remplissage(190,100,440,350,16);
  183.             dessmatrice;
  184.             panneau3din(190,50,216,76,16);
  185.           end;
  186.  
  187.         {CLICK_COULEUR}
  188.         if clickobjet(585,75,605,95) = 1
  189.         then begin
  190.             coulcour := 1;
  191.             dessclcour(coulcour);
  192.         end;
  193.  
  194.         if clickobjet(585,100,605,120) = 1
  195.         then begin
  196.             coulcour := 2;
  197.             dessclcour(coulcour);
  198.         end;
  199.  
  200.         if clickobjet(585,125,605,145) = 1
  201.         then begin
  202.             coulcour := 3;
  203.             dessclcour(coulcour);
  204.         end;
  205.  
  206.         if clickobjet(585,150,605,170) = 1
  207.         then begin
  208.             coulcour := 4;
  209.             dessclcour(coulcour);
  210.         end;
  211.  
  212.         if clickobjet(585,175,605,195) = 1
  213.         then begin
  214.             coulcour := 5;
  215.             dessclcour(coulcour);
  216.         end;
  217.  
  218.         if clickobjet(585,200,605,220) = 1
  219.         then begin
  220.             coulcour := 6;
  221.             dessclcour(coulcour);
  222.         end;
  223.  
  224.         if clickobjet(585,225,605,245) = 1
  225.         then begin
  226.             coulcour := 7;
  227.             dessclcour(coulcour);
  228.         end;
  229.  
  230.         if clickobjet(585,250,605,270) = 1
  231.         then begin
  232.             coulcour := 8;
  233.             dessclcour(coulcour);
  234.         end;
  235.  
  236.         if clickobjet(585,275,605,295) = 1
  237.         then begin
  238.             coulcour := 9;
  239.             dessclcour(coulcour);
  240.         end;
  241.  
  242.         if clickobjet(585,300,605,320) = 1
  243.         then begin
  244.             coulcour := 10;
  245.             dessclcour(coulcour);
  246.         end;
  247.  
  248.         if clickobjet(585,325,605,345) = 1
  249.         then begin
  250.             coulcour := 11;
  251.             dessclcour(coulcour);
  252.         end;
  253.  
  254.         if clickobjet(585,350,605,370) = 1
  255.         then begin
  256.             coulcour := 12;
  257.             dessclcour(coulcour);
  258.         end;
  259.  
  260.         if clickobjet(585,375,605,395) = 1
  261.         then begin
  262.             coulcour := 13;
  263.             dessclcour(coulcour);
  264.         end;
  265.  
  266.         if clickobjet(585,400,605,420) = 1
  267.         then begin
  268.             coulcour := 14;
  269.             dessclcour(coulcour);
  270.         end;
  271.  
  272.         if clickobjet(585,425,605,445) = 1
  273.         then begin
  274.             coulcour := 15;
  275.             dessclcour(coulcour);
  276.         end;
  277.  
  278.         if clickobjet(585,450,605,470) = 1
  279.         then begin
  280.             coulcour := 16;
  281.             dessclcour(coulcour);
  282.         end;
  283.  
  284.  
  285.  
  286.         {CLICK_SUR_LA_GRILLE}
  287.         b := 0;
  288.         while b < 25
  289.         do begin
  290.            b := b + 1;
  291.            c := 0;
  292.            while c < 25
  293.            do begin
  294.               c := c + 1;
  295.  
  296.              if clickobjet(181 + (10 * b),91 + (10 * c),181 + (10 * b) + 9,91 + (10 * c) + 9) = 1
  297.              then begin
  298.                 cachesouris;
  299.                 colorepointgrille(181 + (10 * b),91 + (10 * c),181 + (10 * b) + 9,91 + (10 * c) + 9,coulcour);
  300.                 putpixel(190 +  b,50 + c,coulcour);
  301.                 dessmatrice;
  302.                 affichesouris;
  303.              end;
  304.            end;
  305.         end;
  306.  
  307.  
  308.     end;
  309. END.
  310.  
  311.