home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / getput / getput.pas
Encoding:
Pascal/Delphi Source File  |  1988-03-21  |  4.0 KB  |  125 lines
  1. Unit GetPut;
  2.  
  3.  
  4. Interface
  5.  
  6. uses DOS;
  7.  
  8. Function TextImageSize( X1, Y1, X2, Y2 : byte ): word;
  9.    (******************************************************************)
  10.    (*  Syntax: Word := TextImageSize( X1, Y1, X2, Y2 );              *)
  11.    (*     Returns the Size needed for the Buffer for Get/Put_Text    *)
  12.    (******************************************************************)
  13.  
  14. Procedure Get_Text( Var Buffer; X1, Y1, X2, Y2: byte );
  15.    (******************************************************************)
  16.    (*  Syntax: Get_Text( Buffer, X1, Y1, X2, Y2 );                   *)
  17.    (*     Copies the contents of a rectangular area defined by the   *)
  18.    (*     byte expressions X1, Y1, X2, Y2 into the variable Buffer,  *)
  19.    (*     which may be of any type.                                  *)
  20.    (*     The minimum buffer size in bytes required to store the     *)
  21.    (*     area is calculated as:                                     *)
  22.    (*     Size = ((Y2-Y1+1)*(X2-X1+1)+1)*2                           *)
  23.    (*        Y1 = Upper Left Row                                     *)
  24.    (*        X1 = Upper Left Column                                  *)
  25.    (*        Y2 = Lower Right Row                                    *)
  26.    (*        X2 = Lower Right Column                                 *)
  27.    (******************************************************************)
  28.  
  29.  
  30.  
  31. Procedure Put_Text( Var Buffer; X1, Y1: byte );
  32.    (******************************************************************)
  33.    (*  Syntax: Put_Text( Buffer, X1, Y1 );                           *)
  34.    (*     Copies the contents of the variable onto a rectangular     *)
  35.    (*     area of the screen. the byte expressions Y1, X1 define the *)
  36.    (*     Upper Left corner of the region. Buffer is a variable of   *)
  37.    (*     any type, in which an area of the screen has been          *)
  38.    (*     previously stored.                                         *)
  39.    (******************************************************************)
  40.  
  41.  
  42.  
  43. Implementation
  44.  
  45. Type
  46.   BufTyp  = Array[0..32767] of byte;
  47.   BufPtr  = ^BufTyp;
  48.  
  49. Function TextImageSize( X1, Y1, X2, Y2 : byte ): word;
  50. Begin
  51.   TextImageSize := ((Y2-Y1+1)*(X2-X1+1)+1)*2
  52. end;
  53.  
  54.  
  55. Procedure CurrentVideo( Var Width: Word; Var Address: BufPtr );
  56.    (******************************************************************)
  57.    (*  Syntax: CurrentVideo( Width, ScreenAddress );                 *)
  58.    (*     Polls the BIOS and returns the width of the screen and     *)
  59.    (*     the address of the beginning of screen memory.             *)
  60.    (******************************************************************)
  61.  Var
  62.    R : Registers;
  63. Begin
  64.   R.AH := $0F;
  65.   Intr( $10, R );
  66.   Width := R.AH*2;
  67.   if (R.AL = 7) or (R.AL=15) then
  68.     Address := Ptr( $B000, 0000 )       {Monochrome Screen}
  69.    else
  70.     if (R.AL >-1) and (R.AL < 4 ) then
  71.       Address := Ptr( $B800, 0000 )     {CGA}
  72.      else
  73.        Begin
  74.          Writeln( 'Bad Mode' );
  75.          halt(1);
  76.        End;
  77. end;
  78.  
  79.  
  80. Procedure Get_Text( Var Buffer; X1, Y1, X2, Y2: byte );
  81. Var
  82.   VBuff   : BufTyp absolute Buffer;
  83.   Screen  : BufPtr;
  84.   Width   : Word;
  85.   K,Yoff  : Word;
  86.   I       : Byte;
  87.  
  88. Begin
  89.   CurrentVideo( Width, Screen );
  90.   VBuff[0] := ((X2-X1)*2)+2;
  91.   VBuff[1] := Y2-Y1+1;
  92.   K := 2;
  93.   if ( Y1 > Y2 ) or ( X1 > X2 ) then Writeln( 'Parameters in wrong order' );
  94.   Yoff := ((Y1-1) * Width) + ((X1-1) * 2);
  95.   for I := Y1 to Y2 do
  96.     begin
  97.       Move( Screen^[Yoff],VBuff[K], VBuff[0] );
  98.       inc(K,Vbuff[0]);
  99.       inc(Yoff,Width);
  100.     end;
  101. End;
  102.  
  103.  
  104. Procedure Put_Text( Var Buffer; X1, Y1: byte );
  105. Var
  106.   VBuff   : BufTyp absolute Buffer;
  107.   Screen  : BufPtr;
  108.   Width   : Word;
  109.   K,Yoff  : integer;
  110.   I       : Byte;
  111.  
  112. Begin
  113.   CurrentVideo( Width, Screen );
  114.   K := 2;
  115.   Yoff := ((Y1-1) * Width) + ((X1-1) * 2);
  116.   for I := 0 to VBuff[1]-1 do
  117.       begin
  118.         Move( VBuff[K], Screen^[Yoff] , VBuff[0] );
  119.         K := K + VBuff[0];
  120.         inc( Yoff, Width );
  121.       end;
  122. end;
  123.  
  124. end.
  125.