home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / MKMSG104 / MKMSGCVT / MKSCRN.PAS < prev   
Pascal/Delphi Source File  |  1994-01-09  |  8KB  |  389 lines
  1. Unit MKScrn;
  2. {$I MKB.Def}
  3.  
  4. Interface
  5.  
  6. {
  7.      MKScrn - Copyright 1993 by Mark May - MK Software
  8.      You are free to use this code in your programs, however
  9.      it may not be included in Source/TPU function libraries
  10.      without my permission.
  11.  
  12.      Mythical Kingom Tech BBS (513)237-7737 HST/v32
  13.      FidoNet: 1:110/290
  14.      Rime: ->MYTHKING
  15.      You may also reach me at maym@dmapub.dma.org
  16. }
  17.  
  18.  
  19. Type ScrnItemType = Record
  20.   Ch: Char;
  21.   Attr: Byte;
  22.   End;
  23.  
  24.  
  25. Type ScreenType = Record
  26.   Case Boolean Of
  27.     True:  (ScrnWord: Array[0..10000] of Word);
  28.     False: (ScrnItem: Array[0..10000] of ScrnItemType);
  29.   End;
  30.  
  31.  
  32. Var
  33.   AdapterType: Byte;    {0=none 1=mono 2=CGA 4=EGA-C 5=EGA-M}
  34.                         {7=VGA-M 8=VGA-C 10=MCGA-C 11=MCGA-M}
  35.   ScrnWidth: Byte;
  36.   ScrnHeight: Byte;
  37.   ScrnPtr: ^ScreenType;
  38.   FontHeight: Byte;
  39.  
  40.  
  41. Function  SaveScrnRegion(xl,yl,xh,yh: Byte; Var Pt: Pointer):Boolean;
  42. Procedure RestoreScrnRegion(xl,yl,xh,yh: Byte; Var Pt: Pointer);
  43. Procedure ScrollScrnRegionUp(xl,yl,xh,yh, count: Byte);
  44. Procedure ScrollScrnRegionDown(xl,yl,xh,yh, count: Byte);
  45. Procedure PutScrnWord (SX: Byte; SY: Byte; CA: Word);
  46. Function  GetScrnWord(SX: Byte; SY: Byte): Word;
  47. Procedure SetCursorPosition(Sx: Byte; Sy: Byte);
  48. Procedure GetCursorPosition(Var Sx: Byte; Var Sy: Byte);
  49. Procedure DelCharInLine(Sx: Byte; Sy: Byte);
  50. Procedure InsCharInLine(Sx: Byte; Sy: Byte; Ch: Char);
  51. Procedure InitializeScrnRegion(xl,yl,xh,yh: Byte; Ch: Char);
  52.  
  53.  
  54. Implementation
  55.  
  56.  
  57. Uses MKString,
  58.   {$IFDEF WINDOWS}
  59.   WinDos, MKWCrt;
  60.   {$ELSE}
  61.      Dos,
  62.     {$IFDEF OPRO}
  63.     OPCrt;
  64.     {$ELSE}
  65.     Crt;
  66.     {$ENDIF}
  67.   {$ENDIF}
  68.  
  69. Type WordArray = Array[0..9999] of Word;
  70.  
  71. Type WordArrayPtr = ^WordArray;
  72.  
  73.  
  74. Var Regs: Registers;
  75.  
  76.  
  77. Function SaveScrnRegion(xl,yl,xh,yh: Byte; Var Pt: Pointer):Boolean;
  78.   Var
  79.     Tx: Byte;
  80.     Ty: Byte;
  81.     Ctr: Word;
  82.  
  83.   Begin
  84.   GetMem(Pt, ((xh + 1 - xl) * (yh +1 - yl) * 2));
  85.   If Pt = nil Then
  86.     SaveScrnRegion := False
  87.   Else
  88.     Begin
  89.     SaveScrnRegion := True;
  90.     Ctr := 0;
  91.     For Tx := xl to xh Do
  92.       Begin
  93.       For Ty := yl to yh Do
  94.         Begin
  95.         WordArrayPtr(PT)^[Ctr] := GetScrnWord(Tx, Ty);
  96.         Inc(Ctr);
  97.         End;
  98.       End;
  99.     End;
  100.   End;
  101.  
  102.  
  103. Procedure RestoreScrnRegion(xl,yl,xh,yh: Byte; Var Pt: Pointer);
  104.   Var
  105.     Tx: Byte;
  106.     Ty: Byte;
  107.     Ctr: Word;
  108.  
  109.   Begin
  110.   If Pt <> nil Then
  111.     Begin
  112.     Ctr := 0;
  113.     For Tx := xl to xh Do
  114.       Begin
  115.       For Ty := yl to yh Do
  116.         Begin
  117.         PutScrnWord(Tx, Ty, WordArrayPtr(PT)^[Ctr]);
  118.         Inc(Ctr);
  119.         End;
  120.       End;
  121.     FreeMem(Pt, ((xh + 1 - xl) * (yh +1 - yl) * 2));
  122.     End;
  123.   End;
  124.  
  125.  
  126. Procedure ScrollScrnRegionUp(xl,yl,xh,yh, count: Byte);
  127.   Begin
  128.   xl := xl + (WindMin and $ff);
  129.   yl := yl + (WindMin shr 8);
  130.   xh := xh + (WindMin and $ff);
  131.   yh := yh + (WindMin shr 8);
  132.   If yh > ((WindMax shr 8) + 1) Then
  133.     yh := ((WindMax shr 8) + 1);
  134.   If xh > ((WindMax and $ff) + 1) Then
  135.     xh := ((WindMax and $ff) + 1);
  136.   Regs.ah := 6;
  137.   Regs.al := count;
  138.   Regs.ch := yl - 1;
  139.   Regs.cl := xl - 1;
  140.   Regs.dh := yh - 1;
  141.   Regs.dl := xh - 1;
  142.   Regs.bh := TextAttr;
  143.   Intr($10, Regs);
  144.   End;
  145.  
  146.  
  147. Procedure ScrollScrnRegionDown(xl,yl,xh,yh, count: Byte);
  148.   Begin
  149.   Regs.ah := 7;
  150.   xl := xl + (WindMin and $ff);
  151.   yl := yl + (WindMin shr 8);
  152.   xh := xh + (WindMin and $ff);
  153.   yh := yh + (WindMin shr 8);
  154.   If yh > ((WindMax shr 8) + 1) Then
  155.     yh := ((WindMax shr 8) + 1);
  156.   If xh > ((WindMax and $ff) + 1) Then
  157.     xh := ((WindMax and $ff) + 1);
  158.   Regs.al := count;
  159.   Regs.ch := yl - 1;
  160.   Regs.cl := xl - 1;
  161.   Regs.dh := yh - 1;
  162.   Regs.dl := xh - 1;
  163.   Regs.bh := TextAttr;
  164.   Intr($10, Regs);
  165.   End;
  166.  
  167.  
  168. Procedure SetCursorPosition(Sx: Byte; Sy: Byte);
  169.   Begin
  170.   Regs.ah := 2;
  171.   Regs.dh := sy - 1;
  172.   Regs.dl := sx - 1;
  173.   Regs.bh := 0;
  174.   Intr($10, Regs);
  175.   End;
  176.  
  177.  
  178. Procedure GetCursorPosition(Var Sx: Byte; Var Sy: Byte);
  179.   Begin
  180.   Regs.ah := 3;
  181.   Regs.bh := 0;
  182.   Intr($10, Regs);
  183.   Sx := Regs.dl + 1;
  184.   Sy := Regs.dh + 1;
  185.   End;
  186.  
  187.  
  188. Function GetScrnWord(SX: Byte; SY: Byte): Word;
  189.   Var
  190.     Cx: Byte;
  191.     Cy: Byte;
  192.  
  193.   Begin
  194.   If (DirectVideo  And (Not CheckSnow)) Then
  195.     GetScrnWord := ScrnPtr^.ScrnWord[((SY - 1) * ScrnWidth) + (SX - 1)]
  196.   Else
  197.     Begin
  198.     GetCursorPosition(Cx,Cy);
  199.     SetCursorPosition(Sx,Sy);
  200.     Regs.Ah := 8;
  201.     Regs.Bh := 0;
  202.     Intr($10, Regs);
  203.     GetScrnWord := Regs.Ax;
  204.     SetCursorPosition(Cx,Cy);
  205.     End;
  206.   End;
  207.  
  208.  
  209. Procedure PutScrnWord (SX: Byte; SY: Byte; CA: Word);
  210.   Var
  211.     Cx: Byte;
  212.     Cy: Byte;
  213.  
  214.   Begin
  215.   If (DirectVideo And (Not CheckSnow)) Then
  216.     ScrnPtr^.ScrnWord[((SY - 1) * ScrnWidth) + (SX - 1)] := CA
  217.   Else
  218.     Begin
  219.     GetCursorPosition(Cx, Cy);
  220.     SetCursorPosition(Sx, Sy);
  221.     Regs.Ah := 9;
  222.     Regs.Bh := 0;
  223.     Regs.Al := Lo(Ca);
  224.     Regs.Bl := Hi(Ca);
  225.     Regs.Cx := 1;
  226.     Intr($10, Regs);
  227.     SetCursorPosition(Cx, Cy);
  228.     End;
  229.   End;
  230.  
  231. Procedure SetScreenParams;
  232.   Var
  233.     Regs: Registers;
  234.  
  235.   Begin
  236.   Regs.Ah := $1a;
  237.   Regs.AL := $00;
  238.   Intr($10, Regs);
  239.   If Regs.AL = $1a Then
  240.     Begin
  241.     AdapterType := Regs.Bl;
  242.     If AdapterType = 12 Then
  243.       AdapterType := 10;
  244.     If AdapterType > 11 Then
  245.       AdapterType := 2;
  246.     End
  247.   Else
  248.     Begin
  249.     Regs.Ah := $12;
  250.     Regs.Bx := $10;
  251.     Intr($10, Regs);
  252.     If Regs.BX <> $10 Then
  253.       Begin
  254.       Regs.Ah := $12;
  255.       Regs.BL := $10;
  256.       Intr($10, Regs);
  257.       If (Regs.Bh = 0) Then
  258.         AdapterType := 4
  259.       Else
  260.         AdapterType := 5
  261.       End
  262.     Else
  263.       Begin
  264.       Intr($11, Regs);
  265.       If (((Regs.Al and $30) shr 4) = 3) Then
  266.          AdapterType := 1
  267.       Else
  268.         AdapterType := 2;
  269.       End
  270.     End;
  271.   Case AdapterType of
  272.     0: Begin
  273.        ScrnHeight := 25;
  274.        FontHeight := 8;
  275.        End;
  276.     1: Begin
  277.        ScrnHeight := 25;
  278.        FontHeight := 14;
  279.        End;
  280.     2: Begin
  281.        ScrnHeight := 25;
  282.        FontHeight := 8;
  283.        End;
  284.     10..11: Begin
  285.        ScrnHeight := 25;
  286.        FontHeight := 16;
  287.        End;
  288.     Else
  289.        Begin
  290.        Regs.Ah := $11;
  291.        Regs.Al := $30;
  292.        Regs.Bl := $00;
  293.        Intr($10, Regs);
  294.        FontHeight := Regs.Cx;
  295.        Case AdapterType of
  296.          4..5: ScrnHeight := 350 Div FontHeight;
  297.          7..8: ScrnHeight := 400 Div FontHeight;
  298.          Else
  299.            ScrnHeight := 25;
  300.          End;
  301.        End;
  302.     End;
  303.   If ScrnHeight = 44 Then
  304.     ScrnHeight := 43;
  305.   Regs.Ah := $0f;
  306.   Intr($10, Regs);
  307.   ScrnWidth := Regs.Ah;
  308.   Case AdapterType of
  309.     1,5,7,11: ScrnPtr := Ptr($B000, 0);
  310.     Else
  311.       ScrnPtr := Ptr($B800, 0);
  312.     End;
  313.   ScrnHeight := Mem[$0040:$0084] + 1;
  314.   If ScrnHeight < 8 Then
  315.     ScrnHeight := 25;
  316.   If ScrnWidth < 40 Then
  317.     ScrnWidth := 80;
  318.   If ScrnWidth > 132 Then
  319.     ScrnWidth := 80;
  320.   If ScrnHeight > 66 Then
  321.     ScrnHeight := 25;
  322.   End;
  323.  
  324.  
  325. Procedure DelCharInLine(Sx: Byte; Sy: Byte);
  326.   Var
  327.     Ex: Byte;
  328.     Cx: Byte;
  329.  
  330.   Begin
  331.   Ex := Lo(WindMax) + 1;
  332.   Cx := Sx;
  333.   While (Cx < Ex) Do
  334.     Begin
  335.     PutScrnWord(Cx, Sy, GetScrnWord(Cx + 1, Sy));
  336.     Inc(Cx);
  337.     End;
  338.   PutScrnWord(Ex, Sy, 32 + (TextAttr shl 8));
  339.   End;
  340.  
  341.  
  342. Procedure InsCharInLine(Sx: Byte; Sy: Byte; Ch: Char);
  343.   Var
  344.     Ex: Byte;
  345.     Cx: Byte;
  346.  
  347.   Begin
  348.   Ex := Lo(WindMax) + 1;
  349.   Cx := Ex;
  350.   While (Cx > Sx) Do
  351.     Begin
  352.     PutScrnWord(Cx, Sy, GetScrnWord(Cx - 1, Sy));
  353.     Dec(Cx);
  354.     End;
  355.   PutScrnWord(Sx, Sy, Ord(Ch) + (TextAttr shl 8));
  356.   End;
  357.  
  358.  
  359. Procedure InitializeScrnRegion(xl,yl,xh,yh: Byte; Ch: Char);
  360.   Var
  361.     Cx, Cy: Byte;
  362.  
  363.   Begin
  364.   xl := xl + (WindMin and $ff);
  365.   yl := yl + (WindMin shr 8);
  366.   xh := xh + (WindMin and $ff);
  367.   yh := yh + (WindMin shr 8);
  368.   If yh > ((WindMax shr 8) + 1) Then
  369.     yh := ((WindMax shr 8) + 1);
  370.   If xh > ((WindMax and $ff) + 1) Then
  371.     xh := ((WindMax and $ff) + 1);
  372.   Cx := xl;
  373.   Cy := yl;
  374.   While (cy <= yh) Do
  375.     Begin
  376.     While (Cx <= xh) Do
  377.       Begin
  378.       PutScrnWord(Cx, Cy, Ord(ch) + (TextAttr shl 8));
  379.       Inc(Cx);
  380.       End;
  381.     Inc(Cy);
  382.     End;
  383.   End;
  384.  
  385.  
  386. Begin
  387. SetScreenParams;
  388. End.
  389.