Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TP_ADV.ZIP/LIST1102.PAS

Pascal/Delphi Source File | 1989-11-21 | 6.4 KB | 234 lines

Program ExmplEMS;

Uses
  CRT,
  EMS32,
  Graph;

Type
  HandleRec = Record
                H     : Word;
                P     : Pointer;
              End;
  HandleArr = Array [1..10] of HandleRec;

Var
  gDriver,
  gMode   : Integer;
  loop1,
  loop2   : Integer;
  storage : HandleArr; { Used to store the screen data in }

Procedure DoDrawing;
{ This procedure will draw an image on the screen using all of the }
{ available colors. If the graphics display has no colors (ie HGC  }
{ or CGA), then space out the lines that are being drawn so as to  }
{ make a pattern on the screen.                                    }
Var
  x1,y1    : Word;
  delta,
  maxColor : Byte;
Begin
  maxColor := GetMaxColor;  { Store the value to cut down on function calls }
  y1 := 0;  { First, draw the X coordinates lines }
  x1 := 0;
  If ( maxColor = 1 ) Then
    delta := 3              { So a pattern will be drawn on the screen }
  Else
    delta := 1;
  While ( x1 <= GetMaxX ) Do
  Begin
    If ( maxColor > 1 ) Then { Don't change colors if there are no others }
      SetColor ( x1 mod maxColor );
    Line ( x1, y1, GetMaxX - x1, GetMaxY );
    Inc ( x1, delta );
  End;
  x1 := 0;  { Now draw the Y coordinates lines }
  y1 := 0;
  While ( y1 <= GetmaxY ) Do
  Begin
    If ( maxColor > 1 ) Then { Don't change colors if there are no others }
      SetColor ( y1 mod maxColor );
    Line ( x1, GetMaxY - y1, GetMaxX, y1 );
    Inc ( y1, delta );
  End;
End;

Function LargestBlock : Word;
{ This function will return the largest size block that the }
{ GetImageSize will grab based on the current display type. }
Var
  y : Word;
Begin
  y := 0;
  While ( y < GetMaxY ) Do
  Begin
    If ( ImageSize ( 0, 0, GetMaxX, y ) = $FFFF ) Then
    Begin       { $FFFF indicates that the max size has been reached }
      LargestBlock := ( y - 1 );
      Exit;
    End;
    Inc ( y );
  End;
  LargestBlock := y;
End;


Procedure SwapGraph ( toMem : Boolean );
{ This procedure will allocate memory in EMS or the heap to  }
{ store the graphcs screen in if TOMEM is set to TRUE. If    }
{ not, then the image in TOMEM is restored to the screen and }
{ the allocated memory is released.                          }
{   Nested procedures are used to do the actual grunt work   }
{ to make the code more readable.                            }
Var
  blocks,
  size   : Word;

(************************)
(*** NESTED PROCEDURE ***)
(************************)
  Procedure SwapToEms;
  { This is a nested procedure that will allocate memory and }
  { copy the graphics image on the screen to this memory.    }
  Begin
    AllocateHandleAndPages ( ( blocks * 4 ), storage [1].H );
    If ( EmmError ) Then
      Halt;
    storage [1].P := Ptr ( EmmSeg, 0 );
    For loop1 := 1 to blocks Do
    Begin
      For loop2 := 0 to 3 do
      Begin
        MapPage ( loop2, ( ( loop1 - 1 ) * 4 ) + loop2, storage [1].H );
        If ( EmmError ) Then
          Halt;
      End;
      GetImage ( 0, ( loop1 - 1 ) * size, GetMaxX, loop1 * size, storage [1].p^);
    End;
  End;

(************************)
(*** NESTED PROCEDURE ***)
(************************)
  Procedure SwapFromEms;
  { This nested procedure will undue what the SwapToEms procedure }
  { has done. It will copy the information in the EMS handle back }
  { to the screen and deallocate the EMS handle.                  }
  Begin
    storage [1].P := Ptr ( EmmSeg, 0 );
    For loop1 := 1 to blocks Do
    Begin
      For loop2 := 0 to 3 do
      Begin
        MapPage ( loop2, ( ( loop1 - 1 ) * 4 ) + loop2, storage [1].H );
        If ( EmmError ) Then
          Halt;
      End;
      PutImage ( 0, ( loop1 - 1 ) * size, storage [1].p^, normalPut );
    End;
    ReleaseHandle ( storage [1].H );
    If ( EmmError ) Then
      Halt;
  End;

(************************)
(*** NESTED PROCEDURE ***)
(************************)
  Procedure SwapToRam;
  { This nested procedure will allocate memory on the heap and }
  { copy the information on the screen to this memory.         }
  Begin
    For loop1 := 1 to blocks Do
    Begin
      GetMem ( storage [loop1].P, $FFFF );
      storage [loop1].H := $FFFF; { to denote RAM usage, not EMS }
      GetImage ( 0, ( loop1-1 )*size, GetMaxX, loop1*size, storage [loop1].P^ );
    End;
  End;

(************************)
(*** NESTED PROCEDURE ***)
(************************)
  Procedure SwapFromRam;
  { This nested procedure will undue what the SwapToRam procedure   }
  { did. It will copy the information in the various pointers back  }
  { to the video display and deallocate the pointers from the heap. }
  Begin
    For loop1 := 1 to blocks Do
    Begin
      PutImage ( 0, ( loop1 - 1 ) * size, storage [loop1].P^, normalPut );
      FreeMem ( storage [loop1].P, $FFFF );
    End;
  End;

(*************************)
(** SwapGraph Procedure **)
(*************************)
Begin
  size := LargestBlock;
  blocks := GetMaxY div size;
  If ( ( GetMaxY mod size ) > 0 ) Then
    Inc ( blocks );

  If ( EmmInstalled ) and ( EmmMaxAvail >= ( blocks * 4 ) ) Then
    If ( toMem ) Then
      SwapToEms
    Else
      SwapFromEms
  Else
    If ( toMem ) Then
      SwapToRam
    Else
      SwapFromRam;
End;

Procedure DisplayEmmInfo;
{ This procedure is called after the swapping has been done  }
{ and displays how many EMS pages are available and how many }
{ EMS pages were used to store the graphics image.           }
Var
  tmpTotal,
  tmpUnAlloc : Word;
Begin
  GetNumberOfPages ( tmpTotal, tmpUnAlloc );
  WriteLn ( 'The graphics image has been swapped to memory.' );
  If ( EmmInstalled ) Then
    WriteLn ( 'There are ',tmpUnAlloc,' pages of EMS left.' );
  If ( storage [1].H <> $FFFF ) Then
  Begin
    GetHandlePages ( storage [1].H, tmpTotal );
    Write ( 'There were ', tmpTotal,' pages allocated to' );
    WriteLn ( 'store the screen with.' );
  End;
End;

Begin
  ClrScr;
  If ( EmmInstalled ) Then
  Begin
    WriteLn ( LongInt ( EmmTotal )*16,'k  of EMS total on this system.' );
    WriteLn ( EmmMaxAvail,' pages available. ( ',LongInt ( EmmMaxAvail )*16,'k).' );
    ReadLn;
  End;

  gDriver := Detect;

  InitGraph ( gDriver, gMode, '' );
  If ( GraphResult <> grOk ) Then
    Halt;
  DoDrawing;
  SwapGraph ( TRUE );
  ReadLn;

  RestoreCrtMode;
  DisplayEmmInfo;
  ReadLn;

  SetGraphMode ( gMode );
  SwapGraph ( FALSE );
  ReadLn;

  CloseGraph;
End.