home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SOURCE.DAT / SOURCE / RTL / WINCRT.PAS < prev   
Pascal/Delphi Source File  |  1997-11-09  |  45KB  |  1,598 lines
  1. UNIT WinCrt;
  2.  
  3. INTERFACE
  4.  
  5. {$H-}
  6.  
  7. {$IFDEF OS2}
  8. USES Os2Def,PmWin,PmGpi,BseDos,BseTib;
  9.  
  10. CONST
  11.   {Foreground and background color constants}
  12.   Black         = 0;
  13.   Blue          = 1;
  14.   Green         = 2;
  15.   Cyan          = 3;
  16.   Red           = 4;
  17.   Magenta       = 5;
  18.   Brown         = 6;
  19.   LightGray     = 7;
  20.  
  21.   {Foreground color constants}
  22.   DarkGray      = 8;
  23.   LightBlue     = 9;
  24.   LightGreen    = 10;
  25.   LightCyan     = 11;
  26.   LightRed      = 12;
  27.   LightMagenta  = 13;
  28.   Yellow        = 14;
  29.   White         = 15;
  30.  
  31.   {Add-in for blinking}
  32.   Blink         = 128;
  33.  
  34. VAR
  35.   CheckBreak: BOOLEAN;          { Ctrl-Break check }
  36.   CheckEOF: BOOLEAN;            { Ctrl-Z for EOF?  }
  37.   NormAttr:WORD;                { Normal text attribute}
  38.  
  39. PROCEDURE ClrScr;
  40. PROCEDURE GotoXY(X,Y:BYTE);
  41. PROCEDURE Window(X1,Y1,X2,Y2:BYTE);
  42. PROCEDURE TextColor(Color:BYTE);
  43. PROCEDURE TextBackground(Color:BYTE);
  44. FUNCTION WhereX: Byte;
  45. FUNCTION WhereY: WORD;
  46. PROCEDURE ClrEol;
  47. PROCEDURE InsLine;
  48. PROCEDURE DelLine;
  49. PROCEDURE LowVideo;
  50. PROCEDURE NormVideo;
  51. PROCEDURE HighVideo;
  52. FUNCTION KeyPressed: BOOLEAN;
  53. FUNCTION ReadKey: CHAR;
  54. PROCEDURE TextMode(Mode: Integer);
  55. PROCEDURE Delay(ms:LONGWORD);
  56. {Sound/NoSound are not implemented, they are replaced by beep}
  57. PROCEDURE Beep(Freq,duration:LONGWORD);
  58.  
  59. TYPE
  60.     PScreenBuffer=^TScreenBuffer;
  61.     TScreenBuffer=ARRAY[1..50,1..80] OF CHAR;
  62.  
  63.     PColorBuffer=^TColorBuffer;
  64.     TColorBuffer=ARRAY[1..51,1..81] OF BYTE;
  65.  
  66. TYPE
  67.     TWinCrtScreenInOutClass=CLASS
  68.          PRIVATE
  69.                 ScreenBuffer:PScreenBuffer;
  70.                 ColorBuffer:PColorBuffer;
  71.                 BufferSize:WORD;
  72.                 xPos,yPos:WORD;
  73.                 MaxX,MaxY:WORD;
  74.                 Handle,FrameHandle:HWND;
  75.          PUBLIC
  76.               PROCEDURE WriteStr(CONST s:STRING);VIRTUAL;
  77.               PROCEDURE WriteCStr(CONST s:CSTRING);VIRTUAL;
  78.               PROCEDURE WriteLF;VIRTUAL;
  79.               PROCEDURE ReadLF(VAR s:STRING);VIRTUAL;
  80.               PROCEDURE GotoXY(x,y:BYTE);VIRTUAL;
  81.               CONSTRUCTOR Create;
  82.  
  83.               PROCEDURE SetupScreenBuffer(x,y:WORD);
  84.               PROCEDURE CreateWindow;
  85.               PROCEDURE RedrawAll;
  86.               PROCEDURE Redraw(_hps:HPS;rc:RECTL);
  87.               PROCEDURE DrawLine(_hps:HPS;y:BYTE;createfont:BOOLEAN);
  88.               PROCEDURE SetCursor(x,y:BYTE);
  89.      END;
  90.  
  91.  
  92. IMPLEMENTATION
  93.  
  94.  
  95. PROCEDURE WinCrtError;
  96. BEGIN
  97.      Writeln('Textmode Linker mode does not support PM screen IO.');
  98.      Writeln('Use the unit Crt if you wish to use text');
  99.      Writeln('screen IO inside textmode applications.');
  100.      Halt(0);
  101. END;
  102.  
  103. FUNCTION ConvertColor(c:BYTE):LONGINT;
  104. BEGIN
  105.      CASE c OF
  106.         Black         : ConvertColor:= CLR_BLACK;
  107.         Blue          : ConvertColor:= CLR_DARKBLUE;
  108.         Green         : ConvertColor:= CLR_DARKGREEN;
  109.         Cyan          : ConvertColor:= CLR_DARKCYAN;
  110.         Red           : ConvertColor:= CLR_DARKRED;
  111.         Magenta       : ConvertColor:= CLR_DARKPINK;
  112.         Brown         : ConvertColor:= CLR_BROWN;
  113.         LightGray     : ConvertColor:= CLR_PALEGRAY;
  114.         DarkGray      : ConvertColor:= CLR_DARKGRAY;
  115.         LightBlue     : ConvertColor:= CLR_BLUE;
  116.         LightGreen    : ConvertColor:= CLR_GREEN;
  117.         LightCyan     : ConvertColor:= CLR_CYAN;
  118.         LightRed      : ConvertColor:= CLR_RED;
  119.         LightMagenta  : ConvertColor:= CLR_PINK;
  120.         Yellow        : ConvertColor:= CLR_YELLOW;
  121.         White         : ConvertColor:= CLR_WHITE;
  122.      END; {case}
  123. END;
  124.  
  125. PROCEDURE ClrScr;
  126. VAR Win:TWinCrtScreenInOutClass;
  127.     Color:LONGINT;
  128. BEGIN
  129.      IF ApplicationType<>1 THEN WinCrtError;
  130.  
  131.      Win:=TWinCrtScreenInOutClass(ScreenInOut);
  132.      IF Win.Handle=0 THEN Win.CreateWindow;
  133.  
  134.      Color:=ConvertColor(TextAttr AND 15);
  135.      WinSetPresParam(Win.Handle,PP_FOREGROUNDCOLORINDEX,4,Color);
  136.      Color:=ConvertColor((TextAttr SHR 4) AND 15);
  137.      WinSetPresParam(Win.Handle,PP_BACKGROUNDCOLORINDEX,4,Color);
  138.      FillChar(Win.ScreenBuffer^,Win.BufferSize,32);
  139.      FillChar(Win.ColorBuffer^,Win.BufferSize,TextAttr);
  140.      Win.RedrawAll;
  141. END;
  142.  
  143. PROCEDURE GotoXY(X,Y:BYTE);
  144. VAR Win:TWinCrtScreenInOutClass;
  145. BEGIN
  146.      IF ApplicationType<>1 THEN WinCrtError;
  147.  
  148.      Win:=TWinCrtScreenInOutClass(ScreenInOut);
  149.      IF Win.Handle=0 THEN Win.CreateWindow;
  150.  
  151.      Win.SetCursor(X,Y);
  152. END;
  153.  
  154. {Define a text window}
  155. PROCEDURE Window(X1,Y1,X2,Y2: BYTE);
  156. VAR MWindMax:WORD;
  157. begin
  158.   ASM
  159.      MOV AX,SYSTEM.MaxWindMax
  160.      MOV MWindMax,AX
  161.   END;
  162.   IF X1<=X2 THEN IF Y1<=Y2 THEN
  163.   BEGIN
  164.       Dec(X1);
  165.       Dec(Y1);
  166.       IF X1>=0 THEN IF Y1>=0 THEN
  167.       BEGIN
  168.            Dec(Y2);
  169.            Dec(X2);
  170.            IF X2<lo(MWindMax)+1 THEN IF Y2<Hi(MWindMax)+1 THEN
  171.            BEGIN
  172.                WindMin := X1 + WORD(Y1) SHL 8;
  173.                WindMax := X2 + WORD(Y2) SHL 8;
  174.                GotoXY(1,1);
  175.            END;
  176.       END;
  177.   END;
  178. END;
  179.  
  180.  
  181. PROCEDURE TextColor(Color:BYTE);
  182. BEGIN
  183.      TextAttr := (TextAttr AND 240) OR Color;
  184. END;
  185.  
  186. PROCEDURE TextBackground(Color:BYTE);
  187. BEGIN
  188.      TextAttr := (TextAttr AND 7) OR ((Color AND 15) SHL 4);
  189. END;
  190.  
  191. FUNCTION WhereX: Byte;
  192. VAR Win:TWinCrtScreenInOutClass;
  193. BEGIN
  194.      IF ApplicationType<>1 THEN WinCrtError;
  195.  
  196.      Win:=TWinCrtScreenInOutClass(ScreenInOut);
  197.      IF Win.Handle=0 THEN Win.CreateWindow;
  198.  
  199.      WhereX:=Win.xPos-lo(WindMin);
  200. END;
  201.  
  202. FUNCTION WhereY: WORD;
  203. VAR Win:TWinCrtScreenInOutClass;
  204. BEGIN
  205.      IF ApplicationType<>1 THEN WinCrtError;
  206.  
  207.      Win:=TWinCrtScreenInOutClass(ScreenInOut);
  208.      IF Win.Handle=0 THEN Win.CreateWindow;
  209.  
  210.      WhereY:=Win.yPos-hi(WindMin);
  211. END;
  212.  
  213. PROCEDURE ClrEol;
  214. VAR Win:TWinCrtScreenInOutClass;
  215. BEGIN
  216.      IF ApplicationType<>1 THEN WinCrtError;
  217.  
  218.      Win:=TWinCrtScreenInOutClass(ScreenInOut);
  219.      IF Win.Handle=0 THEN Win.CreateWindow;
  220.  
  221.      WinShowCursor(Win.Handle,FALSE);
  222.      fillchar(Win.ScreenBuffer^[Win.yPos][Win.xPos],(lo(WindMax)-Win.xPos)+2,32);
  223.      fillchar(Win.ColorBuffer^[Win.yPos,Win.xPos],(lo(WindMax)-Win.xpos)+2,textattr);
  224.      Win.DrawLine(0,Win.yPos,TRUE);
  225.      WinShowCursor(Win.Handle,TRUE);
  226. END;
  227.  
  228. PROCEDURE InsLine;
  229. VAR t:BYTE;
  230.     Win:TWinCrtScreenInOutClass;
  231. BEGIN
  232.      IF ApplicationType<>1 THEN WinCrtError;
  233.  
  234.      Win:=TWinCrtScreenInOutClass(ScreenInOut);
  235.      IF Win.Handle=0 THEN Win.CreateWindow;
  236.  
  237.      FOR t:=hi(WindMax)+1 DOWNTO Win.yPos+1 DO
  238.      BEGIN
  239.           move(Win.ScreenBuffer^[t-1][lo(WindMin)],
  240.                Win.ScreenBuffer^[t][lo(WindMin)],
  241.                (lo(WindMax)-lo(WindMin))+2);
  242.           move(Win.ColorBuffer^[t-1][lo(WindMin)],
  243.                Win.ColorBuffer^[t][lo(WindMin)],
  244.                (lo(WindMax)-lo(WindMin))+2);
  245.      END;
  246.      fillchar(Win.ScreenBuffer^[Win.yPos][lo(WindMin)],(lo(WindMax)-lo(WindMin))+2,32);
  247.      fillchar(Win.ColorBuffer^[Win.yPos][lo(WindMin)],(lo(WindMax)-lo(WindMin))+2,TextAttr);
  248.      Win.RedrawAll;
  249. END;
  250.  
  251. PROCEDURE DelLine;
  252. VAR t:BYTE;
  253.     Win:TWinCrtScreenInOutClass;
  254. BEGIN
  255.      IF ApplicationType<>1 THEN WinCrtError;
  256.  
  257.      Win:=TWinCrtScreenInOutClass(ScreenInOut);
  258.      IF Win.Handle=0 THEN Win.CreateWindow;
  259.  
  260.      FOR t:=Win.yPos TO hi(WindMax) DO
  261.      BEGIN
  262.           move(Win.ScreenBuffer^[t+1][lo(WindMin)],
  263.                Win.ScreenBuffer^[t][lo(WindMin)],
  264.                (lo(WindMax)-lo(WindMin))+2);
  265.           move(Win.ColorBuffer^[t+1][lo(WindMin)],
  266.                Win.ColorBuffer^[t][lo(WindMin)],
  267.                (lo(WindMax)-lo(WindMin))+2);
  268.      END;
  269.      fillchar(Win.ScreenBuffer^[hi(WindMax)+1][lo(WindMin)],(lo(WindMax)-lo(WindMin))+2,32);
  270.      fillchar(Win.ColorBuffer^[hi(WindMax)+1][lo(WindMin)],(lo(WindMax)-lo(WindMin))+2,TextAttr);
  271.      Win.RedrawAll;
  272. END;
  273.  
  274. PROCEDURE LowVideo;
  275. BEGIN
  276.      TextAttr := TextAttr AND $F7;
  277. END;
  278.  
  279. PROCEDURE NormVideo;
  280. BEGIN
  281.      TextAttr := NormAttr;
  282. END;
  283.  
  284. PROCEDURE HighVideo;
  285. BEGIN
  286.      TextAttr := TextAttr OR $08;
  287. END;
  288.  
  289. CONST CrtKeyCount:BYTE=0;
  290.  
  291. VAR
  292.    CrtKeyBuffer:ARRAY[0..40] OF BYTE;
  293.  
  294. FUNCTION KeyPressed: BOOLEAN;
  295. VAR _qmsg:QMSG;
  296.     Win:TWinCrtScreenInOutClass;
  297. BEGIN
  298.      IF ApplicationType<>1 THEN WinCrtError;
  299.  
  300.      Win:=TWinCrtScreenInOutClass(ScreenInOut);
  301.      IF Win.Handle=0 THEN Win.CreateWindow;
  302.  
  303.      IF CrtKeyCount=0 THEN
  304.      BEGIN
  305.           IF WinPeekMsg(AppHandle,_qmsg,0,0,0,PM_NOREMOVE) THEN
  306.           BEGIN
  307.                IF not WinGetMsg(AppHandle,_qmsg,0,0,0) THEN Halt; {WM_QUIT}
  308.                WinDispatchMsg(AppHandle,_qmsg);
  309.           END;
  310.      END;
  311.      IF CrtKeyCount>0 THEN KeyPressed:=TRUE
  312.      ELSE KeyPressed:=FALSE;
  313.      DosSleep(10);
  314. END;
  315.  
  316. FUNCTION ReadKey: CHAR;
  317. VAR t:BYTE;
  318. BEGIN
  319.      IF ApplicationType<>1 THEN WinCrtError;
  320.  
  321.      REPEAT
  322.            Delay(20);
  323.      UNTIL KeyPressed;
  324.  
  325.      ReadKey:=CHAR(CrtKeyBuffer[0]);
  326.      Dec(CrtKeyCount);
  327.      FOR t:=0 to CrtKeyCount do CrtKeyBuffer[t]:=CrtKeybuffer[t+1];
  328. END;
  329.  
  330. PROCEDURE TextMode(Mode: Integer);
  331. BEGIN
  332. END;
  333.  
  334.  
  335. PROCEDURE Delay(ms:LONGWORD);
  336. VAR  Queue: QMSG;                  { Message-Queue }
  337.      Win:TWinCrtScreenInOutClass;
  338.      THandle: HTIMER;
  339.      tib:PTIB;
  340.      pib:PPIB;
  341. BEGIN
  342.      IF ApplicationType<>1 THEN WinCrtError;
  343.      Win:=TWinCrtScreenInOutClass(ScreenInOut);
  344.      IF Win.Handle=0 THEN Win.CreateWindow;
  345.      DosGetInfoBlocks(tib,pib);
  346.      IF ((tib<>NIL)AND(tib^.tib_ptib2<>NIL)) THEN
  347.      THandle:=tib^.tib_ptib2^.tib2_ultid
  348.      ELSE raise EProcessTerm.Create('Can''t retrieve thread-id');
  349.      THandle:=(THandle)MOD(TID_DELAY_END-TID_DELAY_START);
  350.      THandle:=WinStartTimer(AppHandle,Win.Handle,TID_DELAY_START+THandle,ms);
  351.      IF THandle=0 THEN raise EProcessTerm.Create('No more timers');
  352.      WHILE WinGetMsg(AppHandle,Queue,0,0,0) DO
  353.      BEGIN
  354.        If LO(Queue.mp1) = THandle THEN Break;
  355.        WinDispatchMsg(AppHandle,Queue);
  356.      END;
  357.      If not WinStopTimer(AppHandle,Win.Handle,THandle) then writeln('Error');
  358. (*
  359.      ASM
  360.         PUSHL $ms
  361.         MOV AL,1
  362.         CALLDLL DosCalls,229  //DosSleep
  363.         ADD ESP,4
  364.      END;
  365. *)
  366. END;
  367.  
  368. {Sound/NoSound are not implemented, they are replaced by beep}
  369. PROCEDURE Beep(Freq,duration:LONGWORD);
  370. BEGIN
  371.      ASM
  372.          PUSH DWORD PTR duration
  373.          PUSH DWORD PTR freq
  374.          MOV AL,2
  375.          CALLDLL DOSCALLS,286  //DosBeep
  376.          ADD ESP,8
  377.      END;
  378. END;
  379.  
  380. PROCEDURE TWinCrtScreenInOutClass.WriteStr(CONST s:STRING);
  381. VAR
  382.    ps:^STRING;
  383.    by,by1:BYTE;
  384. LABEL l;
  385. BEGIN
  386.      IF Handle=0 THEN CreateWindow;
  387.      WinShowCursor(Handle,FALSE);
  388.      ps:=@s;
  389.  
  390.      IF length(ps^)>(Lo(WindMax)-Lo(WindMin)-WhereX)+1 THEN
  391.      BEGIN
  392.           by:=(Lo(WindMax)-Lo(WindMin)-WhereX)+2;
  393.           by1:=length(s)-by;
  394. l:
  395.           move(ps^[1],ScreenBuffer^[yPos][xPos],by);
  396.           fillchar(ColorBuffer^[yPos,xPos],by,textattr);
  397.           DrawLine(0,yPos,TRUE);
  398.  
  399.           inc(ps,by);
  400.  
  401.           WriteLF;
  402.           WinShowCursor(Handle,FALSE);
  403.  
  404.           IF by1>by THEN
  405.           BEGIN
  406.                by:=(Lo(WindMax)-Lo(WindMin)-WhereX)+2;
  407.                dec(by1,by);
  408.                goto l;
  409.           END;
  410.  
  411.           move(ps^[1],ScreenBuffer^[yPos][xPos],by1);
  412.           fillchar(ColorBuffer^[yPos,xPos],by1,textattr);
  413.           DrawLine(0,yPos,TRUE);
  414.  
  415.           WinShowCursor(Handle,TRUE);
  416.           GotoXY(WhereX+by1,WhereY);
  417.  
  418.           exit;
  419.      END;
  420.  
  421.      move(ps^[1],ScreenBuffer^[yPos][xPos],length(ps^));
  422.      fillchar(ColorBuffer^[yPos,xPos],length(ps^),textattr);
  423.      DrawLine(0,yPos,TRUE);
  424.      WinShowCursor(Handle,TRUE);
  425.      GotoXY(WhereX+length(s),WhereY);
  426. END;
  427.  
  428. PROCEDURE TWinCrtScreenInOutClass.WriteCStr(CONST s:CSTRING);
  429. VAR s1:STRING;
  430. BEGIN
  431.      IF Handle=0 THEN CreateWindow;
  432.      s1:=s;
  433.      WriteStr(s1);
  434. END;
  435.  
  436. PROCEDURE TWinCrtScreenInOutClass.WriteLF;
  437. VAR t,Start:BYTE;
  438. BEGIN
  439.      IF Handle=0 THEN CreateWindow;
  440.      IF ypos>hi(WindMax) THEN
  441.      BEGIN
  442.           Start:=hi(WindMin)+1;
  443.           FOR t:=Start TO hi(WindMax) DO
  444.           BEGIN
  445.                Move(ScreenBuffer^[t+1,lo(WindMin)],
  446.                     ScreenBuffer^[t,lo(WindMin)],(lo(WindMax)-lo(WindMin))+2);
  447.                Move(ColorBuffer^[t+1,lo(WindMin)],
  448.                     ColorBuffer^[t,lo(WindMin)],(lo(WindMax)-lo(WindMin))+2);
  449.           END;
  450.           FillChar(ScreenBuffer^[hi(WindMax)+1,lo(WindMin)],
  451.                    (lo(WindMax)-lo(WindMin))+2,32);
  452.           FillChar(ColorBuffer^[hi(WindMax)+1,lo(WindMin)],
  453.                    (lo(WindMax)-lo(WindMin))+2,TextAttr);
  454.           GotoXY(1,WhereY);
  455.           RedrawAll;
  456.      END
  457.      ELSE GotoXY(1,WhereY+1);
  458. END;
  459.  
  460. PROCEDURE TWinCrtScreenInOutClass.ReadLF(VAR s:STRING);
  461. VAR ch:CHAR;
  462. BEGIN
  463.      IF Handle=0 THEN CreateWindow;
  464.  
  465.      ch:=Readkey;
  466.      s:='';
  467.      WHILE ch<>#13 DO
  468.      BEGIN
  469.           IF ch=#0 THEN
  470.           BEGIN
  471.                IF CrtKeyCount>0 THEN dec(CrtKeyCount);
  472.           END
  473.           ELSE
  474.           BEGIN
  475.                IF ch=#8 THEN
  476.                BEGIN
  477.                     IF length(s)>0 THEN
  478.                     BEGIN
  479.                          dec(s[0]);
  480.                          IF WhereX=1 THEN GotoXY(lo(WindMax)-lo(WindMin)+1,WhereY-1)
  481.                          ELSE GotoXY(WhereX-1,WhereY);
  482.                          WriteStr(' ');
  483.                          IF WhereX=1 THEN GotoXY(lo(WindMax)-lo(WindMin)+1,WhereY-1)
  484.                          ELSE GotoXY(WhereX-1,WhereY);
  485.                     END;
  486.                END
  487.                ELSE
  488.                BEGIN
  489.                     IF length(s)<255 THEN s:=s+ch;
  490.                     WriteStr(ch);
  491.                END;
  492.           END;
  493.           ch:=readkey;
  494.      END;
  495.      WriteLF;
  496. END;
  497.  
  498. PROCEDURE TWinCrtScreenInOutClass.GotoXY(x,y:BYTE);
  499. BEGIN
  500.      IF Handle=0 THEN CreateWindow;
  501.      SetCursor(x,y);
  502. END;
  503.  
  504. PROCEDURE CreateLogFont(_HPS:HPS;CONST facename:CSTRING;hei,len,
  505.                         SelAttr:LONGWORD);
  506. VAR fat:FATTRS;
  507. BEGIN
  508.      fat.szFaceName:=facename;
  509.      fat.usRecordLength:=sizeof(FATTRS);
  510.      fat.fsSelection:=SelAttr;
  511.      fat.lMatch:=1;
  512.      fat.idRegistry:=0;
  513.      fat.usCodePage:=0; {default}
  514.      fat.lMaxbaseLineExt:=hei;
  515.      fat.lAveCharWidth:=len;
  516.      fat.fsType:=0;
  517.      fat.fsFontUse:=0;
  518.      GpiCreateLogFont(_hps,@facename,1,fat);
  519.      GpiSetCharSet(_hps,1);
  520. END;
  521.  
  522.  
  523. FUNCTION WinCrtHandler(Win:HWND;msg,para1,para2:ULONG):ULONG;CDECL;
  524. VAR _hps:HPS;
  525.     rc:RECTL;
  526.     Objekt:TWinCrtScreenInOutClass;
  527.     Color:LONGINT;
  528. BEGIN
  529.      Objekt:=TWinCrtScreenInOutClass(ScreenInOut);
  530.      CASE Msg OF
  531.           WM_CLOSE:
  532.           BEGIN
  533.                Halt;
  534.           END;
  535.           WM_PAINT:
  536.           BEGIN
  537.                _hps:=WinBeginPaint(Win,0,rc);
  538.                Objekt.Redraw(_hps,rc);
  539.                WinEndPaint(_hps);
  540.           END;
  541.           WM_SETFOCUS:  {EingabeFocus neu setzen}
  542.           BEGIN
  543.                IF para2=0 THEN
  544.                BEGIN  //Window is loosing focus
  545.                     WinDestroyCursor(Win);
  546.                END
  547.                ELSE  //Window is getting focus
  548.                BEGIN
  549.                     WinCreateCursor(Win,40,40,8,3,CURSOR_SOLID OR CURSOR_FLASH,NIL);
  550.                     Objekt.SetCursor(Objekt.xPos,Objekt.yPos);
  551.                END;
  552.           END;
  553.           WM_ERASEBACKGROUND:
  554.           BEGIN
  555.                _hps:=HPS(para1);
  556.                rc:=PRECTL(Para2)^;
  557.                Color:=ConvertColor((TextAttr SHR 4) AND 15);
  558.                WinFillRect(_hps,rc,Color);
  559.                WinCrtHandler:=0;
  560.           END;
  561.           WM_CHAR:
  562.           BEGIN
  563.               if CrtKeyCount < 33 then
  564.               begin
  565.                    IF lo(Para1) AND KC_KEYUP=KC_KEYUP THEN
  566.                    BEGIN
  567.                         IF lo(lo(para2))=224 THEN
  568.                         BEGIN
  569.                              CrtKeyBuffer[CrtKeyCount]:=0;
  570.                              CrtKeyBuffer[CrtKeyCount+1]:=hi(lo(para2));
  571.                              inc(CrtKeyCount,2);    {RANGE ERROR?}
  572.                         END
  573.                         ELSE
  574.                         BEGIN
  575.                              CrtKeyBuffer[CrtKeyCount]:=lo(para2);
  576.                              inc(CrtKeyCount);
  577.                         END;
  578.                    END;
  579.               end;
  580.               WinCrtHandler:=0;
  581.           END;
  582.           ELSE WinCrtHandler:=WinDefWindowProc(Win,msg,para1,para2);
  583.      END; {case}
  584. END;
  585.  
  586.  
  587. PROCEDURE TWinCrtScreenInOutClass.CreateWindow;
  588. VAR
  589.    ClassName:CSTRING;
  590.    ClassStyle:LONGWORD;
  591.    FrameFlags:LONGWORD;
  592.    Title:CSTRING;
  593.    ScreenCX,ScreenCY:LONGWORD;
  594.    WX,WY:LONGINT;
  595.    Color:LONGINT;
  596. BEGIN
  597.      IF Handle<>0 THEN exit;
  598.  
  599.      InitPM;
  600.      Title:=ParamStr(0);
  601.      ClassName:='SP/2 WinCrt Window';
  602.      ClassStyle:=CS_SIZEREDRAW OR CS_MOVENOTIFY;
  603.      FrameFlags:=FCF_TASKLIST OR FCF_DLGBORDER OR FCF_TITLEBAR
  604.                  OR FCF_SYSMENU;
  605.      WinRegisterClass(AppHandle,ClassName,@WinCrtHandler,ClassStyle,0);
  606.      FrameHandle:=WinCreateStdWindow(HWND_DESKTOP,0,FrameFlags,
  607.                                      ClassName,Title,
  608.                                      0,0,0,Handle);
  609.      ScreenCX:=WinQuerySysValue(HWND_DESKTOP,SV_CXSCREEN);
  610.      ScreenCY:=WinQuerySysValue(HWND_DESKTOP,SV_CYSCREEN);
  611.      WX:=((ScreenCX-80*8) DIV 2);
  612.      WY:=((ScreenCY-25*16) DIV 2);
  613.      Color:=ConvertColor(TextAttr AND 15);
  614.      WinSetPresParam(Handle,PP_FOREGROUNDCOLORINDEX,4,Color);
  615.      Color:=ConvertColor((TextAttr SHR 4) AND 15);
  616.      WinSetPresParam(Handle,PP_BACKGROUNDCOLORINDEX,4,Color);
  617.      WinSetWindowPos(FrameHandle,0,WX,WY,80*8,((25+2)*16)-4,
  618.                      SWP_SHOW OR SWP_SIZE OR SWP_MOVE OR SWP_ACTIVATE OR
  619.                      SWP_FOCUSACTIVATE);
  620.      ClrScr;
  621. END;
  622.  
  623. PROCEDURE InitWinCrt;
  624. VAR ScreenInOutPM:TWinCrtScreenInOutClass;
  625. BEGIN
  626.      ScreenInOutPM.Create;
  627.      ScreenInOut:=TScreenInOutClass(ScreenInOutPM);
  628. END;
  629.  
  630.  
  631. PROCEDURE TWinCrtScreenInOutClass.Redraw(_hps:HPS;rc:RECTL);
  632. VAR rc1:RECTL;
  633.     loy,hiy:WORD;
  634.     t:BYTE;
  635. BEGIN
  636.      CreateLogFont(_hps,'System VIO',16,8,0);
  637.      WinQueryWindowRect(Handle,rc1);
  638.      loy:=rc1.yTop-rc.yTop;
  639.      loy:=loy DIV 16;
  640.      hiy:=rc1.yTop-rc.yBottom;
  641.      hiy:=hiy DIV 16;
  642.      IF loy=0 THEN loy:=1;
  643.      WinShowCursor(Handle,FALSE);
  644.      FOR t:=loy-1 TO hiy+1 DO DrawLine(_hps,t,false);
  645.      WinShowCursor(Handle,TRUE);
  646. END;
  647.  
  648.  
  649.  
  650. PROCEDURE TWinCrtScreenInOutClass.DrawLine(_hps:HPS;y:BYTE;createfont:BOOLEAN);
  651. VAR
  652.    PSCreated:BOOLEAN;
  653.    pt:POINTL;
  654.    rc,rc1:RECTL;
  655.    Actual,Start:LONGWORD;
  656.    xpos:LONGWORD;
  657.    Len:LONGWORD;
  658.    Color:LONGINT;
  659. BEGIN
  660.      WinQueryWindowRect(Handle,rc);
  661.      IF _hps=0 THEN
  662.      BEGIN
  663.           PSCreated:=TRUE;
  664.           _hps:=WinGetPS(Handle);
  665.      END
  666.      ELSE PSCreated:=FALSE;
  667.  
  668.      IF CreateFont THEN CreateLogFont(_hps,'System VIO',16,8,0);
  669.  
  670.      IF ((y=0)OR(y>MaxY)) THEN exit;
  671.  
  672.      IF y=MaxY THEN
  673.      BEGIN
  674.           Color:=ConvertColor((TextAttr SHR 4) AND 15);
  675.           rc1.xleft:=0;
  676.           rc1.xright:=MaxX*8;
  677.           rc1.yBottom:=0;
  678.           rc1.yTop:=10;
  679.           WinFillRect(_hps,rc1,Color);
  680.      END;
  681.  
  682.      pt.y:=(rc.yTop-(y*16))+4;
  683.      Actual:=1;
  684.      xPos:=0;
  685.      GpiSetBackMix(_hps,BM_OVERPAINT);
  686.      Color:=ColorBuffer^[y][Actual];
  687.      Len:=0;
  688.      Start:=1;
  689.      WHILE Actual<=MaxX DO
  690.      BEGIN
  691.           IF ((Color<>ColorBuffer^[y][Actual])OR(Actual=MaxX)) THEN
  692.           BEGIN
  693.                GpiSetColor(_hps,ConvertColor(Color AND 15));
  694.                GpiSetBackColor(_hps,ConvertColor((Color SHR 4) AND 15));
  695.                pt.x:=xpos;
  696.                GpiCharStringAt(_hps,pt,len,ScreenBuffer^[y][Start]);
  697.                Color:=ColorBuffer^[y][Actual];
  698.                inc(xpos,len*8);
  699.                Len:=0;
  700.                Start:=Actual;
  701.                IF Actual=MaxX THEN inc(Actual); //terminate
  702.           END
  703.           ELSE
  704.           BEGIN
  705.                inc(Len);
  706.                inc(Actual);
  707.           END;
  708.      END;
  709.  
  710.      IF PSCreated THEN WinReleasePS(_hps);
  711. END;
  712.  
  713.  
  714. PROCEDURE TWinCrtScreenInOutClass.RedrawAll;
  715. VAR t:BYTE;
  716.     _hps:HPS;
  717. BEGIN
  718.      WinShowCursor(Handle,FALSE);
  719.      _hps:=WinGetPS(Handle);
  720.      CreateLogFont(_hps,'System VIO',16,8,0);
  721.      FOR t:=1 TO Hi(WindMax)+1 DO DrawLine(_hps,t,false);
  722.      WinReleasePS(_hps);
  723.      WinShowCursor(Handle,TRUE);
  724. END;
  725.  
  726. PROCEDURE TWinCrtScreenInOutClass.SetCursor(X,Y:BYTE);
  727. VAR tx,ty:LONGWORD;
  728.     rc:RECTL;
  729. BEGIN
  730.      IF Handle=0 THEN CreateWindow;
  731.  
  732.      inc(X,lo(WindMin));
  733.      inc(Y,hi(WindMin));
  734.      IF X>lo(WindMax)+1 THEN X:=1;
  735.      IF Y>hi(WindMax)+1 THEN Y:=hi(WindMax)+1;
  736.      IF X<lo(WindMin)+1 THEN X:=lo(WindMin)+1;
  737.      IF Y<hi(WindMin)+1 THEN Y:=hi(WindMin)+1;
  738.      xPos:=X;
  739.      yPos:=Y;
  740.      WinQueryWindowRect(Handle,rc);
  741.      tx:=(xPos-1)*8;
  742.      ty:=rc.yTop-yPos*16;
  743.      WinCreateCursor(Handle,tx,ty-2,8,3,CURSOR_SETPOS OR CURSOR_FLASH,NIL);
  744.      WinShowCursor(Handle,TRUE);
  745. END;
  746.  
  747.  
  748. PROCEDURE TWinCrtScreenInOutClass.SetupScreenBuffer(x,y:WORD);
  749. BEGIN
  750.      TextAttr:=(White SHL 4)+Black;  {Black on White}
  751.      NormAttr:=TextAttr;
  752.      CheckBreak:=FALSE;
  753.      xPos:=1;
  754.      yPos:=1;
  755.  
  756.      IF BufferSize<>0 THEN
  757.      BEGIN
  758.           FreeMem(ScreenBuffer,BufferSize);
  759.           FreeMem(ColorBuffer,BufferSize);
  760.      END;
  761.  
  762.      BufferSize:=(x+1)*(y+1);
  763.      GetMem(ScreenBuffer,BufferSize);
  764.      GetMem(ColorBuffer,BufferSize);
  765.      FillChar(ScreenBuffer^,x*y,32);      {Space}
  766.      FillChar(ColorBuffer^,x*y,TextAttr); {LightGray on black}
  767.  
  768.      WindMin:=0;
  769.      WindMax:=x+y SHL 8;
  770.      MaxX:=x;
  771.      MaxY:=y;
  772. END;
  773.  
  774. CONSTRUCTOR TWinCrtScreenInOutClass.Create;
  775. BEGIN
  776.      Inherited Create;
  777.  
  778.      ScreenInOut:=TScreenInOutClass(SELF);
  779.  
  780.      LastMode:=CO80;
  781.      WindMin:=0;
  782.      WindMax:=80+WORD(25) SHL 8;
  783.      MaxX:=80;
  784.      MaxY:=25;
  785.      ScreenBuffer:=NIL;
  786.      ColorBuffer:=NIL;
  787.      Handle:=0;
  788.      BufferSize:=0;
  789.      SetupScreenBuffer(lo(WindMax),hi(WindMax));
  790.      SetCursor(xpos,yPos);
  791. END;
  792.  
  793. BEGIN
  794.      IF ApplicationType=1 THEN  {nur für PM Modus}
  795.      BEGIN
  796.           ScreenInOut.Destroy;  {delete old}
  797.           InitWinCrt;
  798.      END;
  799. END.
  800. {$ENDIF}
  801.  
  802. {$IFDEF WIN32}
  803. CONST
  804.      { CRT modes }
  805.      BW40          = 0;            { 40x25 B/W on Color Adapter   }
  806.      CO40          = 1;            { 40x25 Color on Color Adapter }
  807.      BW80          = 2;            { 80x25 B/W on Color Adapter   }
  808.      CO80          = 3;            { 80x25 Color on Color Adapter }
  809.      Mono          = 7;            { 80x25 on Monochrome Adapter  }
  810.      Font8x8       = 256;          { Add-in for 8x8 font          }
  811.  
  812.  
  813. VAR
  814.    WindMin: WORD;    { Window upper left coordinates  }
  815.    WindMax: WORD;    { Window lower right coordinates }
  816.    LastMode: Word;   { Current text mode              }
  817.    TextAttr: BYTE;   { Current text attribute         }
  818.  
  819. CONST
  820.   {Foreground and background color constants}
  821.   Black         = 0;
  822.   Blue          = 1;
  823.   Green         = 2;
  824.   Cyan          = 3;
  825.   Red           = 4;
  826.   Magenta       = 5;
  827.   Brown         = 6;
  828.   LightGray     = 7;
  829.  
  830.   {Foreground color constants}
  831.   DarkGray      = 8;
  832.   LightBlue     = 9;
  833.   LightGreen    = 10;
  834.   LightCyan     = 11;
  835.   LightRed      = 12;
  836.   LightMagenta  = 13;
  837.   Yellow        = 14;
  838.   White         = 15;
  839.  
  840.   {Add-in for blinking}
  841.   Blink         = 128;
  842.  
  843. VAR
  844.   CheckBreak: BOOLEAN;          { Ctrl-Break check }
  845.   CheckEOF: BOOLEAN;            { Ctrl-Z for EOF?  }
  846.   NormAttr:WORD;                { Normal text attribute}
  847.  
  848. PROCEDURE ClrScr;
  849. PROCEDURE GotoXY(X,Y:BYTE);
  850. PROCEDURE Window(X1,Y1,X2,Y2:BYTE);
  851. PROCEDURE TextColor(Color:BYTE);
  852. PROCEDURE TextBackground(Color:BYTE);
  853. FUNCTION WhereX: Byte;
  854. FUNCTION WhereY: WORD;
  855. PROCEDURE ClrEol;
  856. PROCEDURE InsLine;
  857. PROCEDURE DelLine;
  858. PROCEDURE LowVideo;
  859. PROCEDURE NormVideo;
  860. PROCEDURE HighVideo;
  861. FUNCTION KeyPressed: BOOLEAN;
  862. FUNCTION ReadKey: CHAR;
  863. PROCEDURE TextMode(Mode: Integer);
  864. PROCEDURE Delay(ms:LONGWORD);
  865. {Sound/NoSound are not implemented, they are replaced by beep}
  866. //PROCEDURE Beep(Freq,duration:LONGWORD);
  867.  
  868. IMPLEMENTATION
  869.  
  870. USES WinUser,WinGdi,WinBase,WinDef;
  871.  
  872. TYPE
  873.     PScreenBuffer=^TScreenBuffer;
  874.     TScreenBuffer=ARRAY[1..50,1..80] OF CHAR;
  875.  
  876.     PColorBuffer=^TColorBuffer;
  877.     TColorBuffer=ARRAY[1..51,1..81] OF BYTE;
  878.  
  879. TYPE
  880.     TWinCrtScreenInOutClass=CLASS
  881.          PRIVATE
  882.                 ScreenBuffer:PScreenBuffer;
  883.                 ColorBuffer:PColorBuffer;
  884.                 BufferSize:WORD;
  885.                 xPos,yPos:WORD;
  886.                 MaxX,MaxY:WORD;
  887.                 Handle,FrameHandle:HWND;
  888.                 cxChar,cyChar:LONGINT;
  889.          PUBLIC
  890.               PROCEDURE WriteStr(CONST s:STRING);VIRTUAL;
  891.               PROCEDURE WriteCStr(CONST s:CSTRING);VIRTUAL;
  892.               PROCEDURE WriteLF;VIRTUAL;
  893.               PROCEDURE ReadLF(VAR s:STRING);VIRTUAL;
  894.               PROCEDURE GotoXY(x,y:BYTE);VIRTUAL;
  895.               CONSTRUCTOR Create;
  896.  
  897.               PROCEDURE SetupScreenBuffer(x,y:WORD);
  898.               PROCEDURE CreateWindow;
  899.               PROCEDURE RedrawAll;
  900.               PROCEDURE Redraw(_hps:HDC;rc:RECTL);
  901.               PROCEDURE DrawLine(_hps:HDC;y:BYTE;createfont:BOOLEAN);
  902.               PROCEDURE SetCursor(x,y:BYTE);
  903.      END;
  904.  
  905. FUNCTION ConvertColor(c:BYTE):LONGINT;
  906. BEGIN
  907.      CASE c OF
  908.         Black         : ConvertColor:= $00000000;
  909.         Blue          : ConvertColor:= $00FF0000;
  910.         Green         : ConvertColor:= $00008000;
  911.         Cyan          : ConvertColor:= $00FFFF00;
  912.         Red           : ConvertColor:= $000000FF;
  913.         Magenta       : ConvertColor:= $00800080;
  914.         Brown         : ConvertColor:= $00FF00FF;
  915.         LightGray     : ConvertColor:= $00C0C0C0;
  916.         DarkGray      : ConvertColor:= $00808080;
  917.         LightBlue     : ConvertColor:= $00FF0000;
  918.         LightGreen    : ConvertColor:= $00008000;
  919.         LightCyan     : ConvertColor:= $00FFFF00;
  920.         LightRed      : ConvertColor:= $000000FF;
  921.         LightMagenta  : ConvertColor:= $00800080;
  922.         Yellow        : ConvertColor:= $0000FFFF;
  923.         White         : ConvertColor:= $00FFFFFF;
  924.      END; {case}
  925. END;
  926.  
  927. PROCEDURE ClrScr;
  928. VAR Win:TWinCrtScreenInOutClass;
  929. BEGIN
  930.      Win:=TWinCrtScreenInOutClass(ScreenInOut);
  931.      IF Win.Handle=0 THEN Win.CreateWindow;
  932.  
  933.      FillChar(Win.ScreenBuffer^,Win.BufferSize,32);
  934.      FillChar(Win.ColorBuffer^,Win.BufferSize,TextAttr);
  935.      Win.RedrawAll;
  936. END;
  937.  
  938. PROCEDURE GotoXY(X,Y:BYTE);
  939. VAR Win:TWinCrtScreenInOutClass;
  940. BEGIN
  941.      Win:=TWinCrtScreenInOutClass(ScreenInOut);
  942.      IF Win.Handle=0 THEN Win.CreateWindow;
  943.  
  944.      Win.SetCursor(X,Y);
  945. END;
  946.  
  947. PROCEDURE Window(X1,Y1,X2,Y2:BYTE);
  948. BEGIN
  949.   IF X1<=X2 THEN IF Y1<=Y2 THEN
  950.   BEGIN
  951.       Dec(X1);
  952.       Dec(Y1);
  953.       IF X1>=0 THEN IF Y1>=0 THEN
  954.       BEGIN
  955.            Dec(Y2);
  956.            Dec(X2);
  957.            IF X2<lo(WindMax)+1 THEN IF Y2<Hi(WindMax)+1 THEN
  958.            BEGIN
  959.                WindMin := X1 + WORD(Y1) SHL 8;
  960.                WindMax := X2 + WORD(Y2) SHL 8;
  961.                GotoXY(1,1);
  962.            END;
  963.       END;
  964.   END;
  965. END;
  966.  
  967. PROCEDURE TextColor(Color:BYTE);
  968. BEGIN
  969.      TextAttr := (TextAttr AND 240) OR Color;
  970. END;
  971.  
  972. PROCEDURE TextBackground(Color:BYTE);
  973. BEGIN
  974.      TextAttr := (TextAttr AND 7) OR ((Color AND 15) SHL 4);
  975. END;
  976.  
  977. FUNCTION WhereX: Byte;
  978. VAR Win:TWinCrtScreenInOutClass;
  979. BEGIN
  980.      Win:=TWinCrtScreenInOutClass(ScreenInOut);
  981.      IF Win.Handle=0 THEN Win.CreateWindow;
  982.  
  983.      WhereX:=Win.xPos-lo(WindMin);
  984. END;
  985.  
  986. FUNCTION WhereY: WORD;
  987. VAR Win:TWinCrtScreenInOutClass;
  988. BEGIN
  989.      Win:=TWinCrtScreenInOutClass(ScreenInOut);
  990.      IF Win.Handle=0 THEN Win.CreateWindow;
  991.  
  992.      WhereY:=Win.yPos-hi(WindMin);
  993. END;
  994.  
  995. PROCEDURE ClrEol;
  996. VAR Win:TWinCrtScreenInOutClass;
  997. BEGIN
  998.      Win:=TWinCrtScreenInOutClass(ScreenInOut);
  999.      IF Win.Handle=0 THEN Win.CreateWindow;
  1000.  
  1001.      HideCaret(Win.Handle);
  1002.      fillchar(Win.ScreenBuffer^[Win.yPos][Win.xPos],(lo(WindMax)-Win.xPos)+2,32);
  1003.      fillchar(Win.ColorBuffer^[Win.yPos,Win.xPos],(lo(WindMax)-Win.xpos)+2,textattr);
  1004.      Win.DrawLine(0,Win.yPos,TRUE);
  1005.      ShowCaret(Win.Handle);
  1006. END;
  1007.  
  1008. PROCEDURE InsLine;
  1009. VAR t:BYTE;
  1010.     Win:TWinCrtScreenInOutClass;
  1011. BEGIN
  1012.      Win:=TWinCrtScreenInOutClass(ScreenInOut);
  1013.      IF Win.Handle=0 THEN Win.CreateWindow;
  1014.  
  1015.      FOR t:=hi(WindMax)+1 DOWNTO Win.yPos+1 DO
  1016.      BEGIN
  1017.           move(Win.ScreenBuffer^[t-1][lo(WindMin)],
  1018.                Win.ScreenBuffer^[t][lo(WindMin)],
  1019.                (lo(WindMax)-lo(WindMin))+2);
  1020.           move(Win.ColorBuffer^[t-1][lo(WindMin)],
  1021.                Win.ColorBuffer^[t][lo(WindMin)],
  1022.                (lo(WindMax)-lo(WindMin))+2);
  1023.      END;
  1024.      fillchar(Win.ScreenBuffer^[Win.yPos][lo(WindMin)],(lo(WindMax)-lo(WindMin))+2,32);
  1025.      fillchar(Win.ColorBuffer^[Win.yPos][lo(WindMin)],(lo(WindMax)-lo(WindMin))+2,TextAttr);
  1026.      Win.RedrawAll;
  1027. END;
  1028.  
  1029. PROCEDURE DelLine;
  1030. VAR t:BYTE;
  1031.     Win:TWinCrtScreenInOutClass;
  1032. BEGIN
  1033.      Win:=TWinCrtScreenInOutClass(ScreenInOut);
  1034.      IF Win.Handle=0 THEN Win.CreateWindow;
  1035.  
  1036.      FOR t:=Win.yPos TO hi(WindMax) DO
  1037.      BEGIN
  1038.           move(Win.ScreenBuffer^[t+1][lo(WindMin)],
  1039.                Win.ScreenBuffer^[t][lo(WindMin)],
  1040.                (lo(WindMax)-lo(WindMin))+2);
  1041.           move(Win.ColorBuffer^[t+1][lo(WindMin)],
  1042.                Win.ColorBuffer^[t][lo(WindMin)],
  1043.                (lo(WindMax)-lo(WindMin))+2);
  1044.      END;
  1045.      fillchar(Win.ScreenBuffer^[hi(WindMax)+1][lo(WindMin)],(lo(WindMax)-lo(WindMin))+2,32);
  1046.      fillchar(Win.ColorBuffer^[hi(WindMax)+1][lo(WindMin)],(lo(WindMax)-lo(WindMin))+2,TextAttr);
  1047.      Win.RedrawAll;
  1048. END;
  1049.  
  1050. PROCEDURE LowVideo;
  1051. BEGIN
  1052.      TextAttr := TextAttr AND $F7;
  1053. END;
  1054.  
  1055. PROCEDURE NormVideo;
  1056. BEGIN
  1057.      TextAttr := NormAttr;
  1058. END;
  1059.  
  1060. PROCEDURE HighVideo;
  1061. BEGIN
  1062.      TextAttr := TextAttr OR $08;
  1063. END;
  1064.  
  1065. CONST CrtKeyCount:BYTE=0;
  1066.  
  1067. VAR
  1068.    CrtKeyBuffer:ARRAY[0..40] OF BYTE;
  1069.  
  1070. FUNCTION KeyPressed: BOOLEAN;
  1071. VAR
  1072.     Win:TWinCrtScreenInOutClass;
  1073.     aMsg:MSG;
  1074. BEGIN
  1075.      Win:=TWinCrtScreenInOutClass(ScreenInOut);
  1076.      IF Win.Handle=0 THEN Win.CreateWindow;
  1077.  
  1078.      IF CrtKeyCount=0 THEN
  1079.      BEGIN
  1080.           IF PeekMessage(aMsg,0,0,0,PM_NOREMOVE) THEN
  1081.           BEGIN
  1082.                IF not GetMessage (amsg, 0, 0, 0) THEN Halt; {WM_QUIT}
  1083.                TranslateMessage(amsg);
  1084.                DispatchMessage (amsg);
  1085.           END;
  1086.      END;
  1087.      IF CrtKeyCount>0 THEN KeyPressed:=TRUE
  1088.      ELSE KeyPressed:=FALSE;
  1089. END;
  1090.  
  1091. FUNCTION ReadKey: CHAR;
  1092. VAR t:BYTE;
  1093. BEGIN
  1094.      REPEAT UNTIL KeyPressed;
  1095.      ReadKey:=CHAR(CrtKeyBuffer[0]);
  1096.      Dec(CrtKeyCount);
  1097.      FOR t:=0 to CrtKeyCount do CrtKeyBuffer[t]:=CrtKeybuffer[t+1];
  1098. END;
  1099.  
  1100. PROCEDURE TextMode(Mode: Integer);
  1101. BEGIN
  1102. END;
  1103.  
  1104. PROCEDURE Delay(ms:LONGWORD);
  1105. BEGIN
  1106.      Sleep(ms);
  1107. END;
  1108.  
  1109. {Sound/NoSound are not implemented, they are replaced by beep}
  1110. {
  1111. PROCEDURE Beep(Freq,duration:LONGWORD);
  1112. BEGIN
  1113.      SYSTEM.Beep(Freq,Duration);
  1114. END;
  1115. }
  1116.  
  1117. PROCEDURE TWinCrtScreenInOutClass.WriteStr(CONST s:STRING);
  1118. VAR
  1119.    ps:^STRING;
  1120.    by,by1:BYTE;
  1121. LABEL l;
  1122. BEGIN
  1123.      IF Handle=0 THEN CreateWindow;
  1124.      HideCaret(Handle);
  1125.      ps:=@s;
  1126.  
  1127.      IF length(ps^)>(Lo(WindMax)-Lo(WindMin)-WhereX)+1 THEN
  1128.      BEGIN
  1129.           by:=(Lo(WindMax)-Lo(WindMin)-WhereX)+2;
  1130.           by1:=length(s)-by;
  1131. l:
  1132.           move(ps^[1],ScreenBuffer^[yPos][xPos],by);
  1133.           fillchar(ColorBuffer^[yPos,xPos],by,textattr);
  1134.           DrawLine(0,yPos,TRUE);
  1135.  
  1136.           inc(ps,by);
  1137.  
  1138.           WriteLF;
  1139.           HideCaret(Handle);
  1140.  
  1141.           IF by1>by THEN
  1142.           BEGIN
  1143.                by:=(Lo(WindMax)-Lo(WindMin)-WhereX)+2;
  1144.                dec(by1,by);
  1145.                goto l;
  1146.           END;
  1147.  
  1148.           move(ps^[1],ScreenBuffer^[yPos][xPos],by1);
  1149.           fillchar(ColorBuffer^[yPos,xPos],by1,textattr);
  1150.           DrawLine(0,yPos,TRUE);
  1151.  
  1152.           ShowCaret(HANDLE);
  1153.           GotoXY(WhereX+by1,WhereY);
  1154.  
  1155.           exit;
  1156.      END;
  1157.  
  1158.      move(ps^[1],ScreenBuffer^[yPos][xPos],length(ps^));
  1159.      fillchar(ColorBuffer^[yPos,xPos],length(ps^),textattr);
  1160.      DrawLine(0,yPos,TRUE);
  1161.      ShowCaret(HANDLE);
  1162.      GotoXY(WhereX+length(s),WhereY);
  1163. END;
  1164.  
  1165. PROCEDURE TWinCrtScreenInOutClass.WriteCStr(CONST s:CSTRING);
  1166. VAR s1:STRING;
  1167. BEGIN
  1168.      IF Handle=0 THEN CreateWindow;
  1169.      s1:=s;
  1170.      WriteStr(s1);
  1171. END;
  1172.  
  1173. PROCEDURE TWinCrtScreenInOutClass.WriteLF;
  1174. VAR t,Start:BYTE;
  1175. BEGIN
  1176.      IF Handle=0 THEN CreateWindow;
  1177.      IF ypos>hi(WindMax)-1 THEN
  1178.      BEGIN
  1179.           Start:=hi(WindMin)+1;
  1180.           FOR t:=Start TO hi(WindMax) DO
  1181.           BEGIN
  1182.                Move(ScreenBuffer^[t+1,lo(WindMin)],
  1183.                     ScreenBuffer^[t,lo(WindMin)],(lo(WindMax)-lo(WindMin))+2);
  1184.                Move(ColorBuffer^[t+1,lo(WindMin)],
  1185.                     ColorBuffer^[t,lo(WindMin)],(lo(WindMax)-lo(WindMin))+2);
  1186.           END;
  1187.           FillChar(ScreenBuffer^[hi(WindMax)+1,lo(WindMin)],
  1188.                    (lo(WindMax)-lo(WindMin))+2,32);
  1189.           FillChar(ColorBuffer^[hi(WindMax)+1,lo(WindMin)],
  1190.                    (lo(WindMax)-lo(WindMin))+2,TextAttr);
  1191.           GotoXY(1,WhereY);
  1192.           RedrawAll;
  1193.      END
  1194.      ELSE GotoXY(1,WhereY+1);
  1195. END;
  1196.  
  1197. PROCEDURE TWinCrtScreenInOutClass.ReadLF(VAR s:STRING);
  1198. VAR ch:CHAR;
  1199. BEGIN
  1200.      IF Handle=0 THEN CreateWindow;
  1201.  
  1202.      ch:=Readkey;
  1203.      s:='';
  1204.      WHILE ch<>#13 DO
  1205.      BEGIN
  1206.           IF ch=#0 THEN
  1207.           BEGIN
  1208.                IF CrtKeyCount>0 THEN dec(CrtKeyCount);
  1209.           END
  1210.           ELSE
  1211.           BEGIN
  1212.                IF ch=#8 THEN
  1213.                BEGIN
  1214.                     IF length(s)>0 THEN
  1215.                     BEGIN
  1216.                          dec(s[0]);
  1217.                          IF WhereX=1 THEN GotoXY(lo(WindMax)-lo(WindMin)+1,WhereY-1)
  1218.                          ELSE GotoXY(WhereX-1,WhereY);
  1219.                          WriteStr(' ');
  1220.                          IF WhereX=1 THEN GotoXY(lo(WindMax)-lo(WindMin)+1,WhereY-1)
  1221.                          ELSE GotoXY(WhereX-1,WhereY);
  1222.                     END;
  1223.                END
  1224.                ELSE
  1225.                BEGIN
  1226.                     IF length(s)<255 THEN s:=s+ch;
  1227.                     WriteStr(ch);
  1228.                END;
  1229.           END;
  1230.           ch:=readkey;
  1231.      END;
  1232.      WriteLF;
  1233. END;
  1234.  
  1235. PROCEDURE TWinCrtScreenInOutClass.GotoXY(x,y:BYTE);
  1236. BEGIN
  1237.      IF Handle=0 THEN CreateWindow;
  1238.      SetCursor(x,y);
  1239. END;
  1240.  
  1241. FUNCTION CreateLogFont(_HPS:HDC):HFONT;
  1242. BEGIN
  1243.      CreateLogFont:=SelectObject(_HPS,GetStockObject(SYSTEM_FIXED_FONT));
  1244. END;
  1245.  
  1246.  
  1247. FUNCTION WndProc(ahwnd:HWND;amsg:ULONG;awParam:WPARAM;alParam:LPARAM):LRESULT;APIENTRY;
  1248. VAR Win:TWinCrtScreenInOutClass;
  1249.     rc:RECT;
  1250.     ScanCode:BYTE;
  1251. BEGIN
  1252.      Win:=TWinCrtScreenInOutClass(ScreenInOut);
  1253.      CASE amsg OF
  1254.         WM_DESTROY:
  1255.         BEGIN
  1256.              PostQuitMessage(0);
  1257.              WndProc:=0;
  1258.         END;
  1259.         WM_SETFOCUS:  //Window is getting focus
  1260.         BEGIN
  1261.                CreateCaret(Win.Handle,0,8,3);
  1262.                Win.SetCursor(Win.xPos,Win.yPos);
  1263.                WndProc:=0;
  1264.         END;
  1265.         WM_KEYUP:
  1266.         BEGIN
  1267.              IF CrtKeyCount<32 THEN
  1268.              BEGIN
  1269.                  CASE awParam OF
  1270.                    VK_CLEAR,VK_PAUSE,VK_CAPITAL,VK_END,VK_HOME,
  1271.                    VK_LEFT,VK_UP,VK_RIGHT,VK_DOWN,VK_INSERT,VK_DELETE,
  1272.                    VK_PRIOR,VK_NEXT,VK_F1,VK_F2,VK_F3,VK_F4,VK_F5,
  1273.                    VK_F6,VK_F7,VK_F8,VK_F9,VK_F10,VK_F11,VK_F12,VK_F13,
  1274.                    VK_F14,VK_F15,VK_F16,VK_F17,VK_F18,VK_F19,VK_F20,
  1275.                    VK_F21,VK_F22,VK_F23,VK_F24:
  1276.                    BEGIN
  1277.                        ScanCode:=alParam SHR 16;
  1278.                        CrtKeyBuffer[CrtKeyCount]:=0;
  1279.                        CrtKeyBuffer[CrtKeyCount+1]:=ScanCode;
  1280.                        inc(CrtKeyCount,2);
  1281.                    END;
  1282.                 END; {case}
  1283.              END;
  1284.              WndProc:=0;
  1285.         END;
  1286.         WM_CHAR:
  1287.         BEGIN
  1288.               if CrtKeyCount < 33 then
  1289.               begin
  1290.                    CrtKeyBuffer[CrtKeyCount]:=awParam;
  1291.                    inc(CrtKeyCount);
  1292.               end;
  1293.               WndProc:=0;
  1294.         END;
  1295.         WM_KILLFOCUS: //Window is loosing focus
  1296.         BEGIN
  1297.              DestroyCaret;
  1298.              WndProc:=0;
  1299.         END;
  1300.         ELSE WndProc:=DefWindowProc(ahwnd,amsg,awParam,alParam);
  1301.      END; {case}
  1302. END;
  1303.  
  1304.  
  1305. FUNCTION WinCrtHandler(Win:HWND;amsg:ULONG;awParam:WPARAM;alParam:LPARAM):LRESULT;APIENTRY;
  1306. VAR _hps:HDC;
  1307.     rc:RECTL;
  1308.     Objekt:TWinCrtScreenInOutClass;
  1309.     Color:LONGINT;
  1310.     ps:PAINTSTRUCT;
  1311.     ahFont:HFONT;
  1312.     tm:TEXTMETRIC;
  1313. BEGIN
  1314.      Objekt:=TWinCrtScreenInOutClass(ScreenInOut);
  1315.      CASE aMsg OF
  1316.           WM_CREATE:
  1317.           BEGIN
  1318.                _hps:=GetDC(Win);
  1319.  
  1320.                ahFont:=CreateLogFont(_hps);
  1321.                GetTextMetrics(_hps,tm);
  1322.                Objekt.cxChar:=tm.tmAveCharWidth;
  1323.                Objekt.cyChar:=tm.tmHeight+tm.tmExternalLeading;
  1324.  
  1325.                DeleteObject(SelectObject(_hps,ahFont));
  1326.  
  1327.                ReleaseDC(Win,_hps);
  1328.  
  1329.                WinCrtHandler:=0;
  1330.           END;
  1331.           WM_PAINT:
  1332.           BEGIN
  1333.                IF GetUpdateRect(Win,NIL,FALSE) THEN
  1334.                BEGIN
  1335.                    _hps:=BeginPaint(Win,ps);
  1336.                    GetUpdateRect(Win,rc,FALSE);
  1337.                    Objekt.Redraw(_hps,rc);
  1338.                    EndPaint(Win,ps);
  1339.                END;
  1340.                WinCrtHandler:=0;
  1341.           END;
  1342.           WM_ERASEBKGND:
  1343.           BEGIN
  1344.                WinCrtHandler:=1;
  1345.           END;
  1346.           ELSE WinCrtHandler:=DefWindowProc(Win,amsg,awParam,alParam);
  1347.      END; {case}
  1348. END;
  1349.  
  1350.  
  1351. PROCEDURE TWinCrtScreenInOutClass.CreateWindow;
  1352. VAR
  1353.    ClassName,ChildClassName:CSTRING;
  1354.    ClassStyle:LONGWORD;
  1355.    FrameFlags:LONGWORD;
  1356.    Title:CSTRING;
  1357.    ScreenCX,ScreenCY:LONGWORD;
  1358.    WX,WY:LONGINT;
  1359.    Color:LONGINT;
  1360.    windowclass:WNDCLASS;
  1361.    rc,rc1:RECT;
  1362. BEGIN
  1363.      IF Handle<>0 THEN exit;
  1364.  
  1365.      ClassName:='SP/2 WinCrt Window';
  1366.      windowclass.style         := CS_HREDRAW OR CS_VREDRAW OR CS_SAVEBITS;
  1367.      windowclass.lpfnWndProc   := @WndProc;
  1368.      windowclass.cbClsExtra    := 0;
  1369.      windowclass.cbWndExtra    := 0;
  1370.      windowclass.hInstance     := DllModule;
  1371.      windowclass.hIcon         := 0;
  1372.      windowclass.hCursor       := LoadCursor(0,IDC_ARROW);
  1373.      windowclass.hbrBackground := COLOR_APPWORKSPACE+1;
  1374.      windowclass.lpszMenuName  := NIL;
  1375.      windowclass.lpszClassName := @ClassName;
  1376.  
  1377.      RegisterClass(windowclass);
  1378.  
  1379.      ChildClassName:='SP/2 WinCrt Child Window';
  1380.      windowclass.lpfnWndProc   := @WinCrtHandler;
  1381.      windowclass.hbrBackground := COLOR_WINDOW+1;
  1382.      windowclass.lpszMenuName  := NIL;
  1383.      windowclass.lpszClassName := @ChildClassName;
  1384.  
  1385.      RegisterClass(windowclass);
  1386.  
  1387.      Title:=ParamStr(0);
  1388.      ScreenCX:=GetSystemMetrics(SM_CXSCREEN);
  1389.      ScreenCY:=GetSystemMetrics(SM_CYSCREEN);
  1390.      WX:=((ScreenCX-80*8) DIV 2);
  1391.      WY:=((ScreenCY-25*12) DIV 2);
  1392.      FrameHandle:= WinUser.CreateWindow (ClassName, Title,
  1393.                   WS_OVERLAPPED OR WS_CAPTION OR WS_SYSMENU OR
  1394.                   WS_CLIPCHILDREN OR WS_DLGFRAME,
  1395.                   WX, WY,80*8,(25)*16,
  1396.                   0, 0, DllModule, NIL);
  1397.      GetClientRect(FrameHandle,rc);
  1398.      Handle:= WinUser.CreateWindow (ChildClassName,ChildClassName,
  1399.                   WS_CHILD OR WS_CLIPSIBLINGS OR WS_VISIBLE,
  1400.                   0,0,rc.Right-rc.Left,rc.Bottom-rc.Top,
  1401.                   FrameHandle,0, DllModule , NIL);
  1402.  
  1403.      ShowWindow (FrameHandle,10);
  1404.      ShowWindow (Handle,10);
  1405.      UpdateWindow(FrameHandle);
  1406.      UpdateWindow(Handle);
  1407.  
  1408.      ClrScr;
  1409. END;
  1410.  
  1411. PROCEDURE InitWinCrt;
  1412. VAR ScreenInOutPM:TWinCrtScreenInOutClass;
  1413. BEGIN
  1414.      ScreenInOutPM.Create;
  1415.      ScreenInOut:=TScreenInOutClass(ScreenInOutPM);
  1416. END;
  1417.  
  1418.  
  1419. PROCEDURE TWinCrtScreenInOutClass.Redraw(_hps:HDC;rc:RECT);
  1420. VAR
  1421.     loy,hiy:WORD;
  1422.     t:BYTE;
  1423.     ahFont:HFONT;
  1424. BEGIN
  1425.      ahFont:=CreateLogFont(_hps);
  1426.      loy:=rc.Bottom;
  1427.      loy:=1{loy DIV cyChar};
  1428.      hiy:=rc.Top;
  1429.      hiy:=25{hiy DIV cyChar};
  1430.      IF loy=0 THEN loy:=1;
  1431.      HideCaret(Handle);
  1432.      FOR t:=loy-1 TO hiy+1 DO DrawLine(_hps,t,false);
  1433.      DeleteObject(SelectObject(_hps,ahFont));
  1434.      ShowCaret(Handle);
  1435. END;
  1436.  
  1437.  
  1438.  
  1439. PROCEDURE TWinCrtScreenInOutClass.DrawLine(_hps:HDC;y:BYTE;createfont:BOOLEAN);
  1440. VAR rc:RECT;
  1441.     PSCreated:BOOLEAN;
  1442.     Color:LONGINT;
  1443.     pt:POINT;
  1444.     Actual,Start,xPos:LONGINT;
  1445.     Len:LONGINT;
  1446.     ahFont:HFONT;
  1447.     ahBrush:HBRUSH;
  1448.     s:STRING;
  1449.     c:CSTRING;
  1450. BEGIN
  1451.      IF ((y=0)OR(y>MaxY)) THEN exit;
  1452.  
  1453.      GetWindowRect(Handle,rc);
  1454.      IF _hps=0 THEN
  1455.      BEGIN
  1456.           PSCreated:=TRUE;
  1457.           _hps:=GetDC(Handle);
  1458.      END
  1459.      ELSE PSCreated:=FALSE;
  1460.  
  1461.      IF CreateFont THEN ahFont:=CreateLogFont(_hps);
  1462.  
  1463.      IF y=MaxY THEN
  1464.      BEGIN
  1465.           Color:=ConvertColor((TextAttr SHR 4) AND 15);
  1466.           ahBrush:=CreateSolidBrush(Color);
  1467.           SelectObject(_hps,ahBrush);
  1468.           SetBkMode(_hps,OPAQUE);
  1469.           Rectangle(_hps,0,(rc.Bottom-rc.Top)-12,MaxX*cxChar,
  1470.                     rc.Bottom-rc.Top);
  1471.           DeleteObject(SelectObject(_hps,ahBrush));
  1472.      END;
  1473.  
  1474.      pt.y:=(y-1)*cyChar;
  1475.      Actual:=1;
  1476.      xPos:=0;
  1477.      SetBkMode(_hps,OPAQUE);
  1478.      Color:=ColorBuffer^[y][Actual];
  1479.      Len:=0;
  1480.      Start:=1;
  1481.      WHILE Actual<=MaxX DO
  1482.      BEGIN
  1483.           IF ((Color<>ColorBuffer^[y][Actual])OR(Actual=MaxX)) THEN
  1484.           BEGIN
  1485.                SetTextColor(_hps,ConvertColor(Color AND 15));
  1486.                SetBkColor(_hps,ConvertColor((Color SHR 4) AND 15));
  1487.                pt.x:=xpos;
  1488.                TextOut(_hps,pt.x,pt.y,CSTRING(ScreenBuffer^[y][Start]),len+1);
  1489.                SetTextAlign(_hps,TA_LEFT OR TA_TOP);
  1490.                Color:=ColorBuffer^[y][Actual];
  1491.                inc(xpos,len*cxChar);
  1492.                Len:=0;
  1493.                Start:=Actual;
  1494.                IF Actual=MaxX THEN inc(Actual); //terminate
  1495.           END
  1496.           ELSE
  1497.           BEGIN
  1498.                inc(Len);
  1499.                inc(Actual);
  1500.           END;
  1501.      END;
  1502.  
  1503.      IF PSCreated THEN ReleaseDC(Handle,_hps);
  1504.      IF CreateFont THEN DeleteObject(SelectObject(_hps,ahFont));
  1505. END;
  1506.  
  1507.  
  1508. PROCEDURE TWinCrtScreenInOutClass.RedrawAll;
  1509. VAR t:BYTE;
  1510.     _hps:HDC;
  1511.     ahfont:HFONT;
  1512. BEGIN
  1513.      HideCaret(Handle);
  1514.      _hps:=GetDC(Handle);
  1515.      ahFont:=CreateLogFont(_hps);
  1516.      FOR t:=1 TO Hi(WindMax)+1 DO DrawLine(_hps,t,false);
  1517.      DeleteObject(SelectObject(_hps,ahFont));
  1518.      ReleaseDC(Handle,_hps);
  1519.      ShowCaret(Handle);
  1520. END;
  1521.  
  1522. PROCEDURE TWinCrtScreenInOutClass.SetCursor(X,Y:BYTE);
  1523. VAR tx,ty:LONGWORD;
  1524.     rc:RECT;
  1525. BEGIN
  1526.      IF Handle=0 THEN CreateWindow;
  1527.  
  1528.      inc(X,lo(WindMin));
  1529.      inc(Y,hi(WindMin));
  1530.      IF X>lo(WindMax)+1 THEN X:=1;
  1531.      IF Y>hi(WindMax)+1 THEN Y:=hi(WindMax)+1;
  1532.      IF X<lo(WindMin)+1 THEN X:=lo(WindMin)+1;
  1533.      IF Y<hi(WindMin)+1 THEN Y:=hi(WindMin)+1;
  1534.      xPos:=X;
  1535.      yPos:=Y;
  1536.      GetWindowRect(Handle,rc);
  1537.      tx:=(xPos-1)*cxChar;
  1538.      ty:=yPos*cyChar;
  1539.      CreateCaret(Handle,0,8,3);
  1540.      SetCaretPos(tx,ty-2);
  1541.      ShowCaret(Handle);
  1542. END;
  1543.  
  1544.  
  1545. PROCEDURE TWinCrtScreenInOutClass.SetupScreenBuffer(x,y:WORD);
  1546. BEGIN
  1547.      TextAttr:=(White SHL 4)+Black;  {Black on White}
  1548.      NormAttr:=TextAttr;
  1549.      CheckBreak:=FALSE;
  1550.      xPos:=1;
  1551.      yPos:=1;
  1552.  
  1553.      IF BufferSize<>0 THEN
  1554.      BEGIN
  1555.           FreeMem(ScreenBuffer,BufferSize);
  1556.           FreeMem(ColorBuffer,BufferSize);
  1557.      END;
  1558.  
  1559.      BufferSize:=(x+1)*(y+1);
  1560.      GetMem(ScreenBuffer,BufferSize);
  1561.      GetMem(ColorBuffer,BufferSize);
  1562.      FillChar(ScreenBuffer^,x*y,32);      {Space}
  1563.      FillChar(ColorBuffer^,x*y,TextAttr); {LightGray on black}
  1564.  
  1565.      WindMin:=0;
  1566.      WindMax:=x+y SHL 8;
  1567.      MaxX:=x;
  1568.      MaxY:=y;
  1569. END;
  1570.  
  1571. CONSTRUCTOR TWinCrtScreenInOutClass.Create;
  1572. BEGIN
  1573.      Inherited Create;
  1574.  
  1575.      ScreenInOut:=TScreenInOutClass(SELF);
  1576.  
  1577.      LastMode:=CO80;
  1578.      WindMin:=0;
  1579.      WindMax:=80+WORD(25) SHL 8;
  1580.      MaxX:=80;
  1581.      MaxY:=25;
  1582.      ScreenBuffer:=NIL;
  1583.      ColorBuffer:=NIL;
  1584.      Handle:=0;
  1585.      BufferSize:=0;
  1586.      cxChar:=8;
  1587.      cyChar:=12;
  1588.      SetupScreenBuffer(lo(WindMax),hi(WindMax));
  1589.      SetCursor(xpos,yPos);
  1590. END;
  1591.  
  1592. BEGIN
  1593.      ScreenInOut.Destroy;  {delete old}
  1594.      InitWinCrt;
  1595. END.
  1596.  
  1597. {$ENDIF}
  1598.