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