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