home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / ITPFEB90.ZIP / OOPS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-02-06  |  4.1 KB  |  169 lines
  1. PROGRAM DynamicObjectDemo;
  2.  
  3.  { DYNDEMO.PAS }
  4.  
  5. USES Crt, Dos;
  6.  
  7. TYPE
  8.    ScrPtr = ^SaveScreen;
  9.    BoxPtr = ^ReportBox;
  10.    SaveScreen = ARRAY[1..80,1..25] OF Word;
  11.    ReportBox = OBJECT
  12.       SavPtr: ScrPtr;  FColor, BColor: Byte;
  13.       WPosX, WPosY, WSizeX, WSizeY: Integer;
  14.       CONSTRUCTOR Init( PtX, PtY, Width, Height,
  15.                          C1, C2 : Integer );
  16.       DESTRUCTOR  Done;
  17.       PROCEDURE   Draw;
  18.       PROCEDURE   Erase;
  19.    END;
  20.  
  21. {==========================================}
  22. { implementation for object type ReportBox }
  23. {==========================================}
  24.  
  25. CONSTRUCTOR ReportBox.Init;
  26. VAR
  27.    I, J: Integer;
  28.    Regs: Registers;
  29. BEGIN
  30.    WPosX  := PtX;
  31.    WPosY  := PtY;
  32.    WSizeX := Width;
  33.    WSizeY := Height;
  34.    FColor := C1;
  35.    BColor := C2;
  36.    New( SavPtr ); { allocate memory for array }
  37.    Window( WPosX, WPosY, WPosX+WSizeX-1,
  38.                          WPosY+WSizeY-1 );
  39.  
  40.   {read character and attribute on video page 0}
  41.  
  42.    FOR I := 1 TO WSizeX DO
  43.       FOR J := 1 TO WSizeY DO
  44.       BEGIN
  45.          GotoXY(I,J);
  46.          Regs.AH := 08;
  47.          Regs.BH := 00;
  48.          intr( $10, Regs );
  49.          SavPtr^[I,J] := Regs.AX;
  50.       END;
  51.    Draw;
  52. END;
  53.  
  54. DESTRUCTOR ReportBox.Done;
  55. BEGIN
  56.    Erase;
  57.    Dispose( SavPtr );
  58. END;
  59.  
  60. PROCEDURE ReportBox.Erase;
  61. VAR
  62.    I, J : Integer;
  63.    Regs : Registers;
  64. BEGIN
  65.    Window( WPosX, WPosY,
  66.            WPosX+WSizeX-1, WPosY+WSizeY-1 );
  67.    ClrScr;   { inner window }
  68.  
  69. { Write character and attr on video page 0 }
  70.  
  71. { AL stores the character value }
  72. { BL stores the attribute value }
  73. { CL stores the repetitions value (1) }
  74.  
  75.    FOR I := 1 TO WSizeX DO
  76.       FOR J := 1 TO WSizeY DO
  77.       BEGIN
  78.          GotoXY(I,J);
  79.          Regs.AH := 09;
  80.          Regs.BH := 00;
  81.          Regs.AL := Lo( SavPtr^[I,J] );
  82.          Regs.BL := Hi( SavPtr^[I,J] );
  83.          Regs.CL := 1;
  84.          Intr( $10, Regs );
  85.       END;
  86.    Window( 1, 1, 80, 25 );
  87. END;
  88.  
  89. PROCEDURE ReportBox.Draw;
  90. VAR
  91.    BoxStr : STRING[6];
  92.    I : Integer;
  93.    MemSize : LongInt;
  94. BEGIN
  95.    TextColor( FColor );
  96.    TextBackground( BColor );
  97.    BoxStr := #$C9 + #$CD + #$BB +
  98.              #$BA +#$BC + #$C8;
  99.    Window( WPosX, WPosY,
  100.            WPosX+WSizeX-1, WPosY+WSizeY-1 );
  101.    ClrScr;
  102.    GotoXY( 1, 1 );           Write( BoxStr[1] );
  103.    FOR I := 1 TO WSizeX-2 DO Write( BoxStr[2] );
  104.                              Write( BoxStr[3] );
  105.    GotoXY( 1, WSizeY-1 );    Write( BoxStr[6] );
  106.    FOR I := 1 TO WSizeX-2 DO Write( BoxStr[2] );
  107.                              Write( BoxStr[5] );
  108.    GotoXY( 1, 2 );
  109.    InsLine;
  110.    FOR I := 2 TO WSizeY-1 DO
  111.    BEGIN
  112.       GotoXY( 1, I );      Write( BoxStr[4] );
  113.       GotoXY( WSizeX, I ); Write( BoxStr[4] );
  114.    END;
  115.    Window( WPosX+1, WPosY+1,
  116.            WPosX+WSizeX-2, WPosY+WSizeY-2 );
  117.    ClrScr;
  118.    MemSize := MemAvail;
  119.    FOR I := 1 TO 30 DO
  120.       Write('Memory now = ',MemSize,' bytes! ');
  121.    Window( 1, 1, 80, 25 );
  122. END;
  123.  
  124. { **** end of methods **** }
  125.  
  126. VAR
  127.    Box : ARRAY[1..5] OF BoxPtr;
  128.    MemSize : LongInt;
  129.    I : Integer;
  130.  
  131. PROCEDURE Prompt;
  132. BEGIN
  133.    GotoXY( 1, 1 ); ClrEol;
  134.    Write('Memory now = ', MemAvail,
  135.          '. Press ENTER to continue ');
  136.    ReadLn;
  137. END;
  138.  
  139. BEGIN
  140.    ClrScr;
  141.    TextColor( White );
  142.    TextBackground( Black );
  143.    MemSize := MemAvail;
  144.    FOR I := 1 TO 100 DO
  145.       Write(' Initial memory available = ',
  146.               MemSize, ' bytes! ' );
  147.    GotoXY( 1, 1 ); ClrEol;
  148.    Write('Press ENTER to continue ');
  149.    ReadLn;
  150.    Box[1] := New( BoxPtr, Init(  5, 12, 30, 10,
  151.                   LightRed, Black ) );
  152.    GotoXY( 1, 1 ); ClrEol;
  153.    Write('Memory now = ', MemAvail,
  154.          '. Press ENTER to continue ');
  155.    ReadLn;
  156.    Box[2] := New( BoxPtr, Init( 40,  5, 30, 10,
  157.                   LightGreen, Blue ) );
  158.    GotoXY( 1, 1 ); ClrEol;
  159.    Write('Memory now = ', MemAvail,
  160.          '. Press ENTER to continue ');
  161.    ReadLn;
  162.    Dispose( Box[1], Done );
  163.    Dispose( Box[2], Done );
  164.    GotoXY( 1, 1 ); ClrEol;
  165.    Write( 'Final memory (after release) = ',
  166.            MemAvail, ' bytes...');
  167.    ReadLn;
  168. END.
  169.