home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / HTMIX20.ZIP / FE.ZIP / FEUNIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-19  |  2.7 KB  |  86 lines
  1. unit FEUnit;
  2. {$O+,F+}
  3. {┌─────────────────────────────────────────────────────────────────┐}
  4. {│                                                                 │}
  5. {│   File    : FEUNIT.PAS                                          │}
  6. {│   Author  : Harald Thunem                                       │}
  7. {│   Purpose : Routines to use your own screen fonts               │}
  8. {│   Updated : February 16 1992                                    │}
  9. {│                                                                 │}
  10. {└─────────────────────────────────────────────────────────────────┘}
  11.  
  12.  
  13. {───────────────────────────────────────────────────────────────────}
  14. interface
  15. {───────────────────────────────────────────────────────────────────}
  16.  
  17. uses  Dos;
  18.  
  19. const BytesPerChar = 16;
  20.  
  21. type  OneChar      = array[1..BytesPerChar] of byte;
  22.       FontType     = array[0..255] of OneChar;
  23.  
  24. var   Regs         : registers;
  25.       Font         : FontType;
  26.       FontFile     : file of FontType;
  27.  
  28.  
  29. procedure LoadOneChar(Number: byte;  var C: OneChar);
  30. procedure LoadUserFont;
  31. function ReadFontFile(FontFileName: string): boolean;
  32.  
  33.  
  34. {───────────────────────────────────────────────────────────────────}
  35. implementation
  36. {───────────────────────────────────────────────────────────────────}
  37.  
  38.  
  39. procedure LoadOneChar(Number: byte;  var C: OneChar);
  40. begin
  41.   Font[Number] := C;
  42.   FillChar(Regs,SizeOf(Regs),0);
  43.   Regs.AH := $11;
  44.   Regs.AL := $00;
  45.   Regs.BL := 0;
  46.   Regs.BH := BytesPerChar;                   { bytes pr character            }
  47.   Regs.ES := Seg(Font);                      { segment address of font table }
  48.   Regs.BP := Ofs(Font)+BytesPerChar*Number;  { offset address of font table  }
  49.   Regs.CX := 1;                              { number of characters to load  }
  50.   Regs.DX := Number;                         { table character offset        }
  51.   Intr($10,Regs);
  52. end;
  53.  
  54.  
  55. procedure LoadUserFont;
  56. begin
  57.   FillChar(Regs,SizeOf(Regs),0);
  58.   Regs.AH := $11;
  59.   Regs.AL := $00;
  60.   Regs.BL := 0;
  61.   Regs.BH := BytesPerChar;                   { bytes pr character            }
  62.   Regs.ES := Seg(Font);                      { segment address of font table }
  63.   Regs.BP := Ofs(Font);                      { offset address of font table  }
  64.   Regs.CX := 255;                            { number of characters to load  }
  65.   Regs.DX := 0;                              { table character offset        }
  66.   Intr($10,Regs);
  67. end;
  68.  
  69.  
  70. function ReadFontFile(FontFileName: string): boolean;
  71. begin
  72.   {$I-}
  73.   Assign(FontFile,FontFileName);
  74.   ReSet(FontFile);
  75.   {$I+}
  76.   if IOResult=0 then
  77.   begin
  78.     Read(FontFile,Font);
  79.     Close(FontFile);
  80.     ReadFontFile := true;
  81.   end
  82.   else ReadFontFile := false;
  83. end;
  84.  
  85. end.
  86.