source: trunk/Sibyl/RTL/WINCRT.PAS@ 433

Last change on this file since 433 was 8, checked in by RBRi, 19 years ago

+ rest of sibyl stuff
  • Property svn:eol-style set to native
File size: 42.2 KB
Line 
1UNIT WinCrt;
2
3INTERFACE
4
5{$H-}
6
7{$IFDEF OS2}
8USES Os2Def,PmWin,PmGpi,BseDos,BseTib;
9
10CONST
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
34VAR
35 CheckBreak: BOOLEAN; { Ctrl-Break check }
36 CheckEOF: BOOLEAN; { Ctrl-Z for EOF? }
37 NormAttr:WORD; { Normal text attribute}
38
39PROCEDURE ClrScr;
40PROCEDURE GotoXY(X,Y:BYTE);
41PROCEDURE Window(X1,Y1,X2,Y2:BYTE);
42PROCEDURE TextColor(Color:BYTE);
43PROCEDURE TextBackground(Color:BYTE);
44FUNCTION WhereX: Byte;
45FUNCTION WhereY: WORD;
46PROCEDURE ClrEol;
47PROCEDURE InsLine;
48PROCEDURE DelLine;
49PROCEDURE LowVideo;
50PROCEDURE NormVideo;
51PROCEDURE HighVideo;
52FUNCTION KeyPressed: BOOLEAN;
53FUNCTION ReadKey: CHAR;
54PROCEDURE TextMode(Mode: Integer);
55PROCEDURE Delay(ms:LONGWORD);
56{Sound/NoSound are not implemented, they are replaced by beep}
57PROCEDURE Beep(Freq,duration:LONGWORD);
58
59TYPE
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
66TYPE
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
92IMPLEMENTATION
93
94
95PROCEDURE WinCrtError;
96BEGIN
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);
101END;
102
103FUNCTION ConvertColor(c:BYTE):LONGINT;
104BEGIN
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}
123END;
124
125PROCEDURE ClrScr;
126VAR Win:TWinCrtScreenInOutClass;
127 Color:LONGINT;
128BEGIN
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;
141END;
142
143PROCEDURE GotoXY(X,Y:BYTE);
144VAR Win:TWinCrtScreenInOutClass;
145BEGIN
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);
152END;
153
154{Define a text window}
155PROCEDURE Window(X1,Y1,X2,Y2: BYTE);
156VAR MWindMax:WORD;
157begin
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;
178END;
179
180
181PROCEDURE TextColor(Color:BYTE);
182BEGIN
183 TextAttr := (TextAttr AND 240) OR Color;
184END;
185
186PROCEDURE TextBackground(Color:BYTE);
187BEGIN
188 TextAttr := (TextAttr AND 7) OR ((Color AND 15) SHL 4);
189END;
190
191FUNCTION WhereX: Byte;
192VAR Win:TWinCrtScreenInOutClass;
193BEGIN
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);
200END;
201
202FUNCTION WhereY: WORD;
203VAR Win:TWinCrtScreenInOutClass;
204BEGIN
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);
211END;
212
213PROCEDURE ClrEol;
214VAR Win:TWinCrtScreenInOutClass;
215BEGIN
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);
226END;
227
228PROCEDURE InsLine;
229VAR t:BYTE;
230 Win:TWinCrtScreenInOutClass;
231BEGIN
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;
249END;
250
251PROCEDURE DelLine;
252VAR t:BYTE;
253 Win:TWinCrtScreenInOutClass;
254BEGIN
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;
272END;
273
274PROCEDURE LowVideo;
275BEGIN
276 TextAttr := TextAttr AND $F7;
277END;
278
279PROCEDURE NormVideo;
280BEGIN
281 TextAttr := NormAttr;
282END;
283
284PROCEDURE HighVideo;
285BEGIN
286 TextAttr := TextAttr OR $08;
287END;
288
289CONST CrtKeyCount:BYTE=0;
290
291VAR
292 CrtKeyBuffer:ARRAY[0..40] OF BYTE;
293
294FUNCTION KeyPressed: BOOLEAN;
295VAR _qmsg:QMSG;
296 Win:TWinCrtScreenInOutClass;
297BEGIN
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);
314END;
315
316FUNCTION ReadKey: CHAR;
317VAR t:BYTE;
318BEGIN
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];
328END;
329
330PROCEDURE TextMode(Mode: Integer);
331BEGIN
332END;
333
334
335PROCEDURE Delay(ms:LONGWORD);
336VAR Queue: QMSG; { Message-Queue }
337 Win:TWinCrtScreenInOutClass;
338 THandle: HTIMER;
339 tib:PTIB;
340 pib:PPIB;
341BEGIN
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*)
366END;
367
368{Sound/NoSound are not implemented, they are replaced by beep}
369PROCEDURE Beep(Freq,duration:LONGWORD);
370BEGIN
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;
378END;
379
380PROCEDURE TWinCrtScreenInOutClass.WriteStr(CONST s:STRING);
381VAR
382 ps:^STRING;
383 by,by1:BYTE;
384LABEL l;
385BEGIN
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;
394l:
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);
426END;
427
428PROCEDURE TWinCrtScreenInOutClass.WriteCStr(CONST s:CSTRING);
429VAR s1:STRING;
430BEGIN
431 IF Handle=0 THEN CreateWindow;
432 s1:=s;
433 WriteStr(s1);
434END;
435
436PROCEDURE TWinCrtScreenInOutClass.WriteLF;
437VAR t,Start:BYTE;
438BEGIN
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);
458END;
459
460PROCEDURE TWinCrtScreenInOutClass.ReadLF(VAR s:STRING);
461VAR ch:CHAR;
462BEGIN
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;
496END;
497
498PROCEDURE TWinCrtScreenInOutClass.GotoXY(x,y:BYTE);
499BEGIN
500 IF Handle=0 THEN CreateWindow;
501 SetCursor(x,y);
502END;
503
504PROCEDURE CreateLogFont(_HPS:HPS;CONST facename:CSTRING;hei,len,
505 SelAttr:LONGWORD);
506VAR fat:FATTRS;
507BEGIN
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);
520END;
521
522
523FUNCTION WinCrtHandler(Win:HWND;msg,para1,para2:ULONG):ULONG;CDECL;
524VAR _hps:HPS;
525 rc:RECTL;
526 Objekt:TWinCrtScreenInOutClass;
527 Color:LONGINT;
528BEGIN
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}
584END;
585
586
587PROCEDURE TWinCrtScreenInOutClass.CreateWindow;
588VAR
589 ClassName:CSTRING;
590 ClassStyle:LONGWORD;
591 FrameFlags:LONGWORD;
592 Title:CSTRING;
593 ScreenCX,ScreenCY:LONGWORD;
594 WX,WY:LONGINT;
595 Color:LONGINT;
596BEGIN
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;
621END;
622
623PROCEDURE InitWinCrt;
624VAR ScreenInOutPM:TWinCrtScreenInOutClass;
625BEGIN
626 ScreenInOutPM.Create;
627 ScreenInOut:=TScreenInOutClass(ScreenInOutPM);
628END;
629
630
631PROCEDURE TWinCrtScreenInOutClass.Redraw(_hps:HPS;rc:RECTL);
632VAR rc1:RECTL;
633 loy,hiy:WORD;
634 t:BYTE;
635BEGIN
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);
646END;
647
648
649
650PROCEDURE TWinCrtScreenInOutClass.DrawLine(_hps:HPS;y:BYTE;createfont:BOOLEAN);
651VAR
652 PSCreated:BOOLEAN;
653 pt:POINTL;
654 rc,rc1:RECTL;
655 Actual,Start:LONGWORD;
656 xpos:LONGWORD;
657 Len:LONGWORD;
658 Color:LONGINT;
659BEGIN
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);
711END;
712
713
714PROCEDURE TWinCrtScreenInOutClass.RedrawAll;
715VAR t:BYTE;
716 _hps:HPS;
717BEGIN
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);
724END;
725
726PROCEDURE TWinCrtScreenInOutClass.SetCursor(X,Y:BYTE);
727VAR tx,ty:LONGWORD;
728 rc:RECTL;
729BEGIN
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);
745END;
746
747
748PROCEDURE TWinCrtScreenInOutClass.SetupScreenBuffer(x,y:WORD);
749BEGIN
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;
772END;
773
774CONSTRUCTOR TWinCrtScreenInOutClass.Create;
775BEGIN
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);
791END;
792
793BEGIN
794 IF ApplicationType=1 THEN {nur fr PM Modus}
795 BEGIN
796 ScreenInOut.Destroy; {delete old}
797 InitWinCrt;
798 END;
799END.
800{$ENDIF}
801
802{$IFDEF WIN32}
803CONST
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
813VAR
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
819CONST
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
843VAR
844 CheckBreak: BOOLEAN; { Ctrl-Break check }
845 CheckEOF: BOOLEAN; { Ctrl-Z for EOF? }
846 NormAttr:WORD; { Normal text attribute}
847
848PROCEDURE ClrScr;
849PROCEDURE GotoXY(X,Y:BYTE);
850PROCEDURE Window(X1,Y1,X2,Y2:BYTE);
851PROCEDURE TextColor(Color:BYTE);
852PROCEDURE TextBackground(Color:BYTE);
853FUNCTION WhereX: Byte;
854FUNCTION WhereY: WORD;
855PROCEDURE ClrEol;
856PROCEDURE InsLine;
857PROCEDURE DelLine;
858PROCEDURE LowVideo;
859PROCEDURE NormVideo;
860PROCEDURE HighVideo;
861FUNCTION KeyPressed: BOOLEAN;
862FUNCTION ReadKey: CHAR;
863PROCEDURE TextMode(Mode: Integer);
864PROCEDURE Delay(ms:LONGWORD);
865{Sound/NoSound are not implemented, they are replaced by beep}
866//PROCEDURE Beep(Freq,duration:LONGWORD);
867
868IMPLEMENTATION
869
870USES WinUser,WinGdi,WinBase,WinDef;
871
872TYPE
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
879TYPE
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
905FUNCTION ConvertColor(c:BYTE):LONGINT;
906BEGIN
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}
925END;
926
927PROCEDURE ClrScr;
928VAR Win:TWinCrtScreenInOutClass;
929BEGIN
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;
936END;
937
938PROCEDURE GotoXY(X,Y:BYTE);
939VAR Win:TWinCrtScreenInOutClass;
940BEGIN
941 Win:=TWinCrtScreenInOutClass(ScreenInOut);
942 IF Win.Handle=0 THEN Win.CreateWindow;
943
944 Win.SetCursor(X,Y);
945END;
946
947PROCEDURE Window(X1,Y1,X2,Y2:BYTE);
948BEGIN
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;
965END;
966
967PROCEDURE TextColor(Color:BYTE);
968BEGIN
969 TextAttr := (TextAttr AND 240) OR Color;
970END;
971
972PROCEDURE TextBackground(Color:BYTE);
973BEGIN
974 TextAttr := (TextAttr AND 7) OR ((Color AND 15) SHL 4);
975END;
976
977FUNCTION WhereX: Byte;
978VAR Win:TWinCrtScreenInOutClass;
979BEGIN
980 Win:=TWinCrtScreenInOutClass(ScreenInOut);
981 IF Win.Handle=0 THEN Win.CreateWindow;
982
983 WhereX:=Win.xPos-lo(WindMin);
984END;
985
986FUNCTION WhereY: WORD;
987VAR Win:TWinCrtScreenInOutClass;
988BEGIN
989 Win:=TWinCrtScreenInOutClass(ScreenInOut);
990 IF Win.Handle=0 THEN Win.CreateWindow;
991
992 WhereY:=Win.yPos-hi(WindMin);
993END;
994
995PROCEDURE ClrEol;
996VAR Win:TWinCrtScreenInOutClass;
997BEGIN
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);
1006END;
1007
1008PROCEDURE InsLine;
1009VAR t:BYTE;
1010 Win:TWinCrtScreenInOutClass;
1011BEGIN
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;
1027END;
1028
1029PROCEDURE DelLine;
1030VAR t:BYTE;
1031 Win:TWinCrtScreenInOutClass;
1032BEGIN
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;
1048END;
1049
1050PROCEDURE LowVideo;
1051BEGIN
1052 TextAttr := TextAttr AND $F7;
1053END;
1054
1055PROCEDURE NormVideo;
1056BEGIN
1057 TextAttr := NormAttr;
1058END;
1059
1060PROCEDURE HighVideo;
1061BEGIN
1062 TextAttr := TextAttr OR $08;
1063END;
1064
1065CONST CrtKeyCount:BYTE=0;
1066
1067VAR
1068 CrtKeyBuffer:ARRAY[0..40] OF BYTE;
1069
1070FUNCTION KeyPressed: BOOLEAN;
1071VAR
1072 Win:TWinCrtScreenInOutClass;
1073 aMsg:MSG;
1074BEGIN
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;
1089END;
1090
1091FUNCTION ReadKey: CHAR;
1092VAR t:BYTE;
1093BEGIN
1094 REPEAT UNTIL KeyPressed;
1095 ReadKey:=CHAR(CrtKeyBuffer[0]);
1096 Dec(CrtKeyCount);
1097 FOR t:=0 to CrtKeyCount do CrtKeyBuffer[t]:=CrtKeybuffer[t+1];
1098END;
1099
1100PROCEDURE TextMode(Mode: Integer);
1101BEGIN
1102END;
1103
1104PROCEDURE Delay(ms:LONGWORD);
1105BEGIN
1106 Sleep(ms);
1107END;
1108
1109{Sound/NoSound are not implemented, they are replaced by beep}
1110{
1111PROCEDURE Beep(Freq,duration:LONGWORD);
1112BEGIN
1113 SYSTEM.Beep(Freq,Duration);
1114END;
1115}
1116
1117PROCEDURE TWinCrtScreenInOutClass.WriteStr(CONST s:STRING);
1118VAR
1119 ps:^STRING;
1120 by,by1:BYTE;
1121LABEL l;
1122BEGIN
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;
1131l:
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);
1163END;
1164
1165PROCEDURE TWinCrtScreenInOutClass.WriteCStr(CONST s:CSTRING);
1166VAR s1:STRING;
1167BEGIN
1168 IF Handle=0 THEN CreateWindow;
1169 s1:=s;
1170 WriteStr(s1);
1171END;
1172
1173PROCEDURE TWinCrtScreenInOutClass.WriteLF;
1174VAR t,Start:BYTE;
1175BEGIN
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);
1195END;
1196
1197PROCEDURE TWinCrtScreenInOutClass.ReadLF(VAR s:STRING);
1198VAR ch:CHAR;
1199BEGIN
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;
1233END;
1234
1235PROCEDURE TWinCrtScreenInOutClass.GotoXY(x,y:BYTE);
1236BEGIN
1237 IF Handle=0 THEN CreateWindow;
1238 SetCursor(x,y);
1239END;
1240
1241FUNCTION CreateLogFont(_HPS:HDC):HFONT;
1242BEGIN
1243 CreateLogFont:=SelectObject(_HPS,GetStockObject(SYSTEM_FIXED_FONT));
1244END;
1245
1246
1247FUNCTION WndProc(ahwnd:HWND;amsg:ULONG;awParam:WPARAM;alParam:LPARAM):LRESULT;APIENTRY;
1248VAR Win:TWinCrtScreenInOutClass;
1249 rc:RECT;
1250 ScanCode:BYTE;
1251BEGIN
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}
1302END;
1303
1304
1305FUNCTION WinCrtHandler(Win:HWND;amsg:ULONG;awParam:WPARAM;alParam:LPARAM):LRESULT;APIENTRY;
1306VAR _hps:HDC;
1307 rc:RECTL;
1308 Objekt:TWinCrtScreenInOutClass;
1309 Color:LONGINT;
1310 ps:PAINTSTRUCT;
1311 ahFont:HFONT;
1312 tm:TEXTMETRIC;
1313BEGIN
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}
1348END;
1349
1350
1351PROCEDURE TWinCrtScreenInOutClass.CreateWindow;
1352VAR
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;
1362BEGIN
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;
1409END;
1410
1411PROCEDURE InitWinCrt;
1412VAR ScreenInOutPM:TWinCrtScreenInOutClass;
1413BEGIN
1414 ScreenInOutPM.Create;
1415 ScreenInOut:=TScreenInOutClass(ScreenInOutPM);
1416END;
1417
1418
1419PROCEDURE TWinCrtScreenInOutClass.Redraw(_hps:HDC;rc:RECT);
1420VAR
1421 loy,hiy:WORD;
1422 t:BYTE;
1423 ahFont:HFONT;
1424BEGIN
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);
1435END;
1436
1437
1438
1439PROCEDURE TWinCrtScreenInOutClass.DrawLine(_hps:HDC;y:BYTE;createfont:BOOLEAN);
1440VAR 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;
1450BEGIN
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));
1505END;
1506
1507
1508PROCEDURE TWinCrtScreenInOutClass.RedrawAll;
1509VAR t:BYTE;
1510 _hps:HDC;
1511 ahfont:HFONT;
1512BEGIN
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);
1520END;
1521
1522PROCEDURE TWinCrtScreenInOutClass.SetCursor(X,Y:BYTE);
1523VAR tx,ty:LONGWORD;
1524 rc:RECT;
1525BEGIN
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);
1542END;
1543
1544
1545PROCEDURE TWinCrtScreenInOutClass.SetupScreenBuffer(x,y:WORD);
1546BEGIN
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;
1569END;
1570
1571CONSTRUCTOR TWinCrtScreenInOutClass.Create;
1572BEGIN
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);
1590END;
1591
1592BEGIN
1593 ScreenInOut.Destroy; {delete old}
1594 InitWinCrt;
1595END.
1596
1597{$ENDIF}
Note: See TracBrowser for help on using the repository browser.