home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programming
/
powerprogramming1994.iso
/
progtool
/
microcrn
/
issue_44.arc
/
OR4.ARC
/
PC_BOX.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-07-31
|
6KB
|
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}
{----------------------------------------------------------------------------}