home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 November / Chip_1998-11_cd.bin / zkuste / pascal / RT / RT.ARJ / RTE05SRC.ZIP / 2FONTS.PAS < prev    next >
Pascal/Delphi Source File  |  1997-04-27  |  1KB  |  59 lines
  1. uses crt,dos;
  2.  
  3. procedure loadfont(pole:array of byte;num:byte);
  4. var r:registers;
  5. begin
  6.   r.ax:=$1100;          {sluzba pro zavedeni uzivatelskeho fontu}
  7.   r.bx:=$1000+num;      {ktery blok fontu zavadime (bud 0 nebo 1)}
  8.   r.cx:=$100;           {kolik bytu}
  9.   r.dx:=0;              {offset znaku}
  10.   r.es:=seg(pole);      {ukazatel na font}
  11.   r.bp:=ofs(pole);
  12.   intr($10,r);          {zavedeni}
  13. end;
  14.  
  15. var font1,font2:array[1..4096]of byte;
  16.     f1:file;
  17.     w:integer;
  18.  
  19. begin
  20.   clrscr;
  21.   assign(f1,'ambassad.fnt');
  22.   reset(f1,1);
  23.   blockread(f1,font1,sizeof(font1),w);
  24.   close(f1);
  25.   assign(f1,'bauhaus.fnt');
  26.   reset(f1,1);
  27.   blockread(f1,font2,sizeof(font2),w);
  28.   close(f1);
  29.  
  30.   loadfont(font1,0);    {nacteme 1. font do prvniho bloku pameti}
  31.   loadfont(font2,1);    {nacteme 2. font do druheho bloku pameti}
  32.  
  33.   asm
  34.     mov dx,3c4h         {zapis do sekvenceru}
  35.     mov al,3            {vyber dvou fontu}
  36.     mov ah,4
  37.     out dx,ax
  38.   end;
  39.  
  40.   writeln('paulsoft/no!future presents');
  41.   highvideo;             {mezi fonty se prepina zmenou intenzity}
  42.   writeln('multifont demo');
  43.   lowvideo;
  44.   writeln('(x)1997 no!future');
  45.  
  46.   repeat until keypressed; readkey;
  47.   clrscr;
  48.  
  49.   asm                   {prepnuti zpet do normalu}
  50.     mov dx,3c4h
  51.     mov al,3
  52.     mov ah,0
  53.     out dx,ax
  54.  
  55.     mov ax,3h           {nastavime normalni font}
  56.     int 10h
  57.  
  58.   end;
  59. end.