home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / EGATOOLS.ZIP / SETPAL.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-12-02  |  1.2 KB  |  46 lines
  1. {Set palette program:  Call with arguments NN:MM where NN=palette number
  2.                        and MM=value.  setpal 0:1 whould set the normal
  3.                        backgrpund color to blue.  Multiple arguments
  4.                        are accepted.
  5.  
  6. author: Frank Guenther  (compuserve 76545,666)
  7. date  : Dec 2 1985
  8. contact at "The Programmers Toolbox"
  9.             (301) 540-7230 (data)
  10.  
  11.                                                                         }
  12. program setpal;
  13.  
  14. type
  15.   regpak=
  16.      record AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS:INTeger END;
  17.   str80=string[80];
  18.  
  19. var stemp,stemp2:str80;
  20.     x,y,len,pal,palval,code1,code2:integer;
  21.  
  22. procedure setpalette(spalnum,spalcolor:byte);
  23. var sr:regpak;
  24. begin
  25.   sr.AX:=$1000;
  26.   sr.BX:=(spalcolor shl 8)+spalnum;
  27.   intr(16,sr);
  28. end;
  29.  
  30. begin
  31.   for x:=1 to paramcount do begin
  32.     y:=pos(':',paramstr(x));
  33.     len:=length(paramstr(x));
  34.     if (y>1) and (len>y) then begin
  35.       stemp:=copy(paramstr(x),1,y-1);
  36.       stemp2:=copy(paramstr(x),y+1,len);
  37.       val(stemp,pal,code1);
  38.       val(stemp2,palval,code2);
  39.       if (code1=0) and (code2=0) then begin
  40.         setpalette(pal,palval);
  41.         writeln('Palette number ',pal,' set to ',palval,'.');
  42.       end;
  43.     end;
  44.   end;
  45. end.
  46.