home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / turbo5 / mcdisply.pas < prev    next >
Pascal/Delphi Source File  |  1988-10-09  |  8KB  |  357 lines

  1.  
  2. { Copyright (c) 1985, 88 by Borland International, Inc. }
  3.  
  4. unit MCDISPLY;
  5.  
  6. interface
  7.  
  8. uses Crt, Dos, MCVars, MCUtil;
  9.  
  10. var
  11.   InsCursor, ULCursor, NoCursor, OldCursor : Word;
  12.  
  13. procedure MoveToScreen(var Source, Dest; Len : Word);
  14. { Moves memory to screen memory }
  15.  
  16. procedure MoveFromScreen(var Source, Dest; Len : Word);
  17. { Moves memory from screen memory }
  18.  
  19. procedure WriteXY(S : String; Col, Row : Word);
  20. { Writes text in a particular location }
  21.  
  22. procedure MoveText(OldX1, OldY1, OldX2, OldY2, NewX1, NewY1 : Word);
  23. { Moves text from one location to another }
  24.  
  25. procedure Scroll(Direction, Lines, X1, Y1, X2, Y2, Attrib : Word);
  26. { Scrolls an area of the screen }
  27.  
  28. function GetCursor : Word;
  29. { Returns the current cursor }
  30.  
  31. procedure SetCursor(NewCursor : Word);
  32. { Sets a new cursor }
  33.  
  34. function GetSetCursor(NewCursor : Word) : Word;
  35. { Sets a new cursor and returns the current one }
  36.  
  37. procedure SetColor(Color : Word);
  38. { Sets the foreground and background color based on a single color }
  39.  
  40. procedure PrintCol;
  41. { Prints the column headings }
  42.  
  43. procedure PrintRow;
  44. { Prints the row headings }
  45.  
  46. procedure ClearInput;
  47. { Clears the input line }
  48.  
  49. procedure ChangeCursor(InsMode : Boolean);
  50. { Changes the cursor shape based on the current insert mode }
  51.  
  52. procedure ShowCellType;
  53. { Prints the type of cell and what is in it }
  54.  
  55. procedure PrintFreeMem;
  56. { Prints the amount of free memory }
  57.  
  58. procedure ErrorMsg(S : String);
  59. { Prints an error message at the bottom of the screen }
  60.  
  61. procedure WritePrompt(Prompt : String);
  62. { Prints a prompt on the screen }
  63.  
  64. function EGAInstalled : Boolean;
  65. { Tests for the presence of an EGA }
  66.  
  67. implementation
  68.  
  69. const
  70.   MaxLines = 43;
  71.  
  72. type
  73.   ScreenType = array[1..MaxLines, 1..80] of Word;
  74.   ScreenPtr = ^ScreenType;
  75.  
  76. var
  77.   DisplayPtr : ScreenPtr;
  78.  
  79. procedure MoveToScreen; external;
  80.  
  81. procedure MoveFromScreen; external;
  82.  
  83. {$L MCMVSMEM.OBJ}
  84.  
  85. procedure WriteXY;
  86. begin
  87.   GotoXY(Col, Row);
  88.   Write(S);
  89. end; { WriteXY }
  90.  
  91. procedure MoveText;
  92. var
  93.   Counter, Len : Word;
  94. begin
  95.   Len := Succ(OldX2 - OldX1) shl 1;
  96.   if NewY1 < OldY1 then
  97.   begin
  98.     for Counter := 0 to OldY2 - OldY1 do
  99.       MoveFromScreen(DisplayPtr^[OldY1 + Counter, OldX1],
  100.                      DisplayPtr^[NewY1 + Counter, NewX1], Len)
  101.   end
  102.   else begin
  103.     for Counter := OldY2 - OldY1 downto 0 do
  104.       MoveFromScreen(DisplayPtr^[OldY1 + Counter, OldX1],
  105.                      DisplayPtr^[NewY1 + Counter, NewX1], Len)
  106.   end;
  107. end; { MoveText }
  108.  
  109. procedure Scroll;
  110. begin
  111.   if Lines = 0 then
  112.     Window(X1, Y1, X2, Y2)
  113.   else begin
  114.     case Direction of
  115.       UP : begin
  116.         MoveText(X1, Y1 + Lines, X2, Y2, X1, Y1);
  117.         Window(X1, Succ(Y2 - Lines), X2, Y2);
  118.       end;
  119.       DOWN : begin
  120.         MoveText(X1, Y1, X2, Y2 - Lines, X1, Y1 + Lines);
  121.         Window(X1, Y1, X2, Pred(Y1 + Lines));
  122.       end;
  123.       LEFT : begin
  124.         MoveText(X1 + Lines, Y1, X2, Y2, X1, Y1);
  125.         Window(Succ(X2 - Lines), Y1, X2, Y2);
  126.       end;
  127.       RIGHT : begin
  128.         MoveText(X1, Y1, X2 - Lines, Y2, X1 + Lines, Y1);
  129.         Window(X1, Y1, Pred(X1 + Lines), Y2);
  130.       end;
  131.     end; { case }
  132.   end;
  133.   SetColor(Attrib);
  134.   ClrScr;
  135.   Window(1, 1, 80, ScreenRows + 5);
  136. end; { Scroll }
  137.  
  138. function GetCursor;
  139. var
  140.   Reg : Registers;
  141. begin
  142.   with Reg do
  143.   begin
  144.     AH := 3;
  145.     BH := 0;
  146.     Intr($10, Reg);
  147.     GetCursor := CX;
  148.   end; { Reg }
  149. end; { GetCursor }
  150.  
  151. procedure SetCursor;
  152. var
  153.   Reg : Registers;
  154. begin
  155.   with Reg do
  156.   begin
  157.     AH := 1;
  158.     BH := 0;
  159.     CX := NewCursor;
  160.     Intr($10, Reg);
  161.   end; { with }
  162. end; { SetCursor }
  163.  
  164. function GetSetCursor;
  165. begin
  166.   GetSetCursor := GetCursor;
  167.   SetCursor(NewCursor);
  168. end; { GetSetCursor }
  169.  
  170. procedure SetColor;
  171. begin
  172.   TextAttr := ColorTable[Color];
  173. end; { SetColor }
  174.  
  175. procedure InitColorTable(BlackWhite : Boolean);
  176. { Sets up the color table }
  177. var
  178.   Color, FG, BG, FColor, BColor : Word;
  179. begin
  180.   if not BlackWhite then
  181.   begin
  182.     for Color := 0 to 255 do
  183.       ColorTable[Color] := Color;
  184.   end
  185.   else begin
  186.     for FG := Black to White do
  187.     begin
  188.       case FG of
  189.         Black : FColor := Black;
  190.         Blue..LightGray : FColor := LightGray;
  191.         DarkGray..White : FColor := White;
  192.       end; { case }
  193.       for BG := Black to LightGray do
  194.       begin
  195.         if BG = Black then
  196.           BColor := Black
  197.         else begin
  198.           if FColor = White then
  199.             FColor := Black;
  200.           BColor := LightGray;
  201.         end;
  202.         ColorTable[FG + (BG shl 4)] := FColor + (BColor shl 4);
  203.       end;
  204.     end;
  205.     for FG := 128 to 255 do
  206.       ColorTable[FG] := ColorTable[FG - 128] or $80;
  207.   end;
  208. end; { InitColorTable }
  209.  
  210. procedure PrintCol;
  211. var
  212.   Col : Word;
  213. begin
  214.   Scroll(UP, 0, 1, 2, 80, 2, HEADERCOLOR);
  215.   for Col := LeftCol to RightCol do
  216.     WriteXY(CenterColString(Col), ColStart[Succ(Col - LeftCol)], 2);
  217. end; { PrintCol }
  218.  
  219. procedure PrintRow;
  220. var
  221.   Row : Word;
  222. begin
  223.   SetColor(HEADERCOLOR);
  224.   for Row := 0 to Pred(ScreenRows) do
  225.     WriteXY(Pad(WordToString(Row + TopRow, 1), LEFTMARGIN), 1, Row + 3);
  226. end; { PrintRow }
  227.  
  228. procedure ClearInput;
  229. begin
  230.   SetColor(TXTCOLOR);
  231.   GotoXY(1, ScreenRows + 5);
  232.   ClrEol;
  233. end; { ClearInput }
  234.  
  235. procedure ChangeCursor;
  236. begin
  237.   if InsMode then
  238.     SetCursor(InsCursor)
  239.   else
  240.     SetCursor(ULCursor);
  241. end; { ChangeCursor }
  242.  
  243. procedure ShowCellType;
  244. var
  245.   ColStr : String[2];
  246.   S : IString;
  247.   Color : Word;
  248. begin
  249.   FormDisplay := not FormDisplay;
  250.   S := CellString(CurCol, CurRow, Color, NOFORMAT);
  251.   ColStr := ColString(CurCol);
  252.   SetColor(CELLTYPECOLOR);
  253.   GotoXY(1, ScreenRows + 3);
  254.   if CurCell = Nil then
  255.     Write(ColStr, CurRow, ' ', MSGEMPTY, ' ':10)
  256.   else begin
  257.     case CurCell^.Attrib of
  258.     TXT :
  259.       Write(ColStr, CurRow, ' ', MSGTEXT, ' ':10);
  260.     VALUE :
  261.       Write(ColStr, CurRow, ' ', MSGVALUE, ' ':10);
  262.     FORMULA :
  263.       Write(ColStr, CurRow, ' ', MSGFORMULA, ' ':10);
  264.     end; { case }
  265.   end;
  266.   SetColor(CELLCONTENTSCOLOR);
  267.   WriteXY(Pad(S, 80), 1, ScreenRows + 4);
  268.   FormDisplay := not FormDisplay;
  269. end; { ShowCellType }
  270.  
  271. procedure PrintFreeMem;
  272. begin
  273.   SetColor(MEMORYCOLOR);
  274.   GotoXY(Length(MSGMEMORY) + 2, 1);
  275.   Write(MemAvail:6);
  276. end; { PrintFreeMem }
  277.  
  278. procedure ErrorMsg;
  279. var
  280.   Ch : Char;
  281. begin
  282.   Sound(1000);    { Beeps the speaker }
  283.   Delay(500);
  284.   NoSound;
  285.   SetColor(ERRORCOLOR);
  286.   WriteXY(S + '  ' + MSGKEYPRESS, 1, ScreenRows + 5);
  287.   GotoXY(Length(S) + Length(MSGKEYPRESS) + 3, ScreenRows + 5);
  288.   Ch := ReadKey;
  289.   ClearInput;
  290. end; { ErrorMsg }
  291.  
  292. procedure WritePrompt;
  293. begin
  294.   SetColor(PROMPTCOLOR);
  295.   GotoXY(1, ScreenRows + 4);
  296.   ClrEol;
  297.   Write(Prompt);
  298. end; { WritePrompt }
  299.  
  300. procedure InitDisplay;
  301. { Initializes various global variables - must be called before using the
  302.   above procedures and functions.
  303. }
  304. var
  305.   Reg : Registers;
  306. begin
  307.   Reg.AH := 15;
  308.   Intr($10, Reg);
  309.   ColorCard := Reg.AL <> 7;
  310.   if ColorCard then
  311.     DisplayPtr := Ptr($B800, 0)
  312.   else
  313.     DisplayPtr := Ptr($B000, 0);
  314.   InitColorTable((not ColorCard) or (Reg.AL = 0) or (Reg.AL = 2));
  315. end; { InitDisplay }
  316.  
  317. function EGAInstalled;
  318. var
  319.   Reg : Registers;
  320. begin
  321.   Reg.AX := $1200;
  322.   Reg.BX := $0010;
  323.   Reg.CX := $FFFF;
  324.   Intr($10, Reg);
  325.   EGAInstalled := Reg.CX <> $FFFF;
  326. end; { EGAInstalled }
  327.  
  328. begin
  329.   InitDisplay;
  330.   NoCursor := $2000;
  331.   OldCursor := GetSetCursor(NoCursor);
  332.   OldMode := LastMode;
  333.   if (LastMode and Font8x8) <> 0 then
  334.     ScreenRows := 38
  335.   else
  336.     ScreenRows := 20;
  337.   Window(1, 1, 80, ScreenRows + 5);
  338.   if ColorCard then
  339.   begin
  340.     ULCursor := $0607;
  341.     InsCursor := $0507;
  342.   end
  343.   else begin
  344.     ULCursor := $0B0C;
  345.     InsCursor := $090C;
  346.   end;
  347.   if EGAInstalled then
  348.   begin
  349.     UCommandString := UCOMMAND;
  350.     UMenuString := UMNU;
  351.   end
  352.   else begin
  353.     UCommandString := Copy(UCOMMAND, 1, 2);
  354.     UMenuString := Copy(UMNU, 1, 23);
  355.   end;
  356. end.
  357.