Programmer Power Tools/Programmer Power Tools.iso/microcrn/issue_44.arc/OR4.ARC/PC_BOX.PAS

Pascal/Delphi Source File | 1988-07-31 | 5.8 KB | 198 lines

{----------------------------------------------------------------------------}
type
   Screen_Buf_ad = array [1..25] of array [1..80] of integer;

var
   Screen_Buf_Mono      : Screen_Buf_ad absolute $B000:$0000;
   Screen_Buf_Color     : Screen_Buf_ad absolute $B800:$0000;
   Save_Screen_Buf_1    : Screen_Buf_ad;
   Save_Screen_Buf_2    : Screen_Buf_ad;
   Screen_Mono_Color_Sw : integer;  {0=mono; 1=color}

{----------------------------------------------------------------------------}
const
   Char_Points : integer = 14;  {= char height in pixels - 8 ro 14}

{----------------------------------------------------------------------------}
function  IsEGA : boolean;

{returns a boolean TRUE if EGA, FALSE of NOT EGA.  Trick consists of a video }
{call that is not defined for the MDA & CGA;  a well-behaved BIOS will not   }
{alter any registers when an undefined service request is made.              }

var
   Regs : Registers;
begin
   Regs.AH := $12;   {select Alternate Function service}
   Regs.BX := $10;   {BL=$10 means return EGA information}
   Intr($10,Regs);          {Call BIOS VIDEO}
   if (Regs.BX = $10)
      then IsEGA := FALSE
      else IsEGA := TRUE;   {... anything else means EGA!}
end;  {IsEGA}

{----------------------------------------------------------------------------}
type
   Adapter_Type         = ( MDA, CGA, EGA_MONO, EGA_COLOR);

{----------------------------------------------------------------------------}
function Query_Adapter_Type : Adapter_Type;

{returns MDA, CGA, EGA_MONO, or EGA_COLOR}

var
   Regs : Registers;
   Code : byte;

begin
   if (IsEGA) then  begin
      Regs.AH := $12;
      Regs.BL := $10;
      Intr($10,Regs);
      if (Regs.BH = 0)
         then Query_Adapter_Type := EGA_COLOR
         else Query_Adapter_Type := EGA_MONO;
   end
   else begin
      Intr($11,Regs);  {equip determination service}
      Code := (Regs.AL and $30) shr 4;
      case Code of
         1: Query_Adapter_Type := CGA;
         2: Query_Adapter_Type := CGA;
         3: Query_Adapter_Type := MDA;
      else  Query_Adapter_Type := CGA;
      end;  {end case}
   end;
end;  {Query_Adapter_Type}

{----------------------------------------------------------------------------}
procedure  SetMode(ModeNumber : integer);

{sets video mode}

var
   Regs : Registers;
begin
   Regs.AH := 0;
   Regs.AL := ModeNumber;
   Intr($10,Regs);
end;  {SetMode}

{----------------------------------------------------------------------------}
procedure  CursorOff;

{turns off hardware cursor}

var
   Regs : Registers;
begin
   Regs.AX := $0100;
   Regs.CX := $2000;
   intr($10,Regs);
end;  {CursorOff}

{----------------------------------------------------------------------------}
procedure  CursorOn;
{turns cursor on - Char_Points = pixel ht of current cursor in use: 14 or 8   }
var
   Regs : Registers;
begin
   Regs.AX := $0100;
   Regs.CH := Char_Points-2;
   Regs.CL := Char_Points-1;
   intr($10,Regs);
end;  {CursorOn}

{----------------------------------------------------------------------------}
procedure  Init_Screen_Buffers;
var
   Adapter : Adapter_Type;
begin
   Adapter := Query_Adapter_Type;

   case Adapter of
   MDA:       begin
                 Screen_Mono_Color_Sw := 0;
                 SetMode(7);
                 Char_Points := 14;
              end;
   CGA:       begin
                 Screen_Mono_Color_Sw := 1;
                 SetMode(3);
                 Char_Points := 8;
              end;
   EGA_MONO:  begin
                 Screen_Mono_Color_Sw := 0;
                 SetMode(7);
                 Char_Points := 14;
              end;
   EGA_COLOR: begin
                 Screen_Mono_Color_Sw := 1;
                 SetMode(3);
                 Char_Points := 14;
              end;
   end;  {end case}
   CursorOff;

end;  {Init_Screen_Buffers}

{----------------------------------------------------------------------------}
procedure  Save_Screen_1;
begin
   if (Screen_Mono_Color_Sw = 0)
      then Save_Screen_Buf_1 := Screen_Buf_Mono
      else Save_Screen_Buf_1 := Screen_Buf_Color;
end;  {Save_Screen_1}

{----------------------------------------------------------------------------}
procedure  Restore_Screen_1;
begin
   if (Screen_Mono_Color_Sw = 0)
      then Screen_Buf_Mono  := Save_Screen_Buf_1
      else Screen_Buf_Color := Save_Screen_Buf_1;
end;  {Restore_Screen_1}

{----------------------------------------------------------------------------}
procedure  Save_Screen_2;
begin
   if (Screen_Mono_Color_Sw = 0)
      then Save_Screen_Buf_2 := Screen_Buf_Mono
      else Save_Screen_Buf_2 := Screen_Buf_Color;
end;  {Save_Screen_2}

{----------------------------------------------------------------------------}
procedure  Restore_Screen_2;
begin
   if (Screen_Mono_Color_Sw = 0)
      then Screen_Buf_Mono  := Save_Screen_Buf_2
      else Screen_Buf_Color := Save_Screen_Buf_2;
end;  {Restore_Screen_2}

{----------------------------------------------------------------------------}
type
   TimeRec = record
                TimeStamp : word;  {DTA time stamp}
                Hours,Minutes,Seconds,Hundredths : word;
                SODdiv4 : word;
             end;  {end record def}

{----------------------------------------------------------------------------}
procedure Calc_Time (var TimeNow:TimeRec);
var
   Regs : Registers;
begin
   with TimeNow do begin
      GetTime(Hours,Minutes,Seconds,Hundredths);

      {calculate Time-Stamp that DOS uses for comparing files:}
      TimeStamp := (Hours shl 11) or (Minutes shl 5) or (Seconds shr 1);

      {calculate seconds of day div 4:}
      SODdiv4 := (Hours*900) + (Minutes*15) + (Seconds div 4);
   end;
end;  {Calc_Time}

{----------------------------------------------------------------------------}