home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MCGA#05.ZIP / TEST05.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-06-12  |  2.0 KB  |  102 lines
  1. Program MCGATest;
  2.  
  3. uses
  4.   Crt,Dos,MCGALib;
  5.  
  6. var
  7.   Stop,
  8.   Start       :  LongInt;
  9.   Regs        :  Registers;
  10.   PicBuf,
  11.   StorageBuf  :  Pointer;
  12. const
  13.   NumTimes    = 1000;
  14.  
  15. Procedure LoadBuffer (S:String;Buf:Pointer);
  16. var
  17.   F           :  File;
  18.   BlocksRead  :  Word;
  19. begin
  20.   Assign (F,S);
  21.   Reset (F,1);
  22.   BlockRead (F,Buf^,65000,BlocksRead);
  23.   Close (F);
  24. end;
  25.  
  26. Function Tick : LongInt;
  27. begin
  28.   Regs.ah := 0;
  29.   Intr ($1A,regs);
  30.   Tick := Regs.cx shl 16 + Regs.dx;
  31. end;
  32.  
  33. Procedure ShowAndTell;
  34. var
  35.   Ch               :  Char;
  36.   NumSecs,
  37.   NumTicks,
  38.   SecsPerIter,
  39.   TicksPerSec,
  40.   TicksPerIter     :  Real;
  41. begin
  42.   TextMode (3);
  43.   NumTicks     := Stop - Start;
  44.   NumSecs      := NumTicks / 18.2;
  45.   TicksPerIter := NumTicks / NumTimes;
  46.   SecsPerIter  := NumSecs  / NumTimes;
  47.   TicksPerSec  := 18.2     / TicksPerIter;
  48.  
  49.   Write   ('After ',NumTimes,' iterations ');
  50.   WriteLn ('and ',NumSecs:6:4,' seconds...');
  51.   Write   ('  Each iteration took ',TicksPerIter:6:4,' ticks or ');
  52.   WriteLn (SecsPerIter:4:3,' seconds!');
  53.   WriteLn ('  That''s about ',TicksPerSec:6:4,' times per second.');
  54.   Repeat Until Keypressed;
  55.   While Keypressed do Ch := Readkey;
  56. end;
  57.  
  58. Procedure Control;
  59. var
  60.   I,X,Y :  Integer;
  61.   Size  :  Word;
  62. begin
  63.   SetGraphMode ($13);
  64.   LoadBuffer ('E:\NAVAJO.PCX',PicBuf);
  65.  
  66.   DisplayPCX (0,0,PicBuf);
  67.  
  68.   Size := ImageSize (40,60,140,160);
  69.   GetMem (StorageBuf,Size);
  70.   GetImagePas (40,60,140,160,StorageBuf);
  71.  
  72.   ClearScreen (0);
  73.  
  74.   Start := Tick;
  75.   For I := 1 to NumTimes do begin
  76.     X := Random (220);
  77.     Y := Random (100);
  78.     PutImagePas (X,Y,StorageBuf);
  79.     end;
  80.   Stop := Tick;
  81.   ShowAndTell;
  82.  
  83.   SetGraphMode ($13);
  84.   Start := Tick;
  85.   For I := 1 to NumTimes do begin
  86.     X := Random (220);
  87.     Y := Random (100);
  88.     PutImageAsm (X,Y,StorageBuf);
  89.     end;
  90.   Stop := Tick;
  91.   ShowAndTell;
  92. end;
  93.  
  94. Procedure Init;
  95. begin
  96.   GetMem (PicBuf,65500);
  97. end;
  98.  
  99. Begin
  100.   Init;
  101.   Control;
  102. End.