{********************************************************************}
{   Turbo Pascal V.7.0 by Borland International Copyright (c) 1992   }
{                                                                    }
{       * * * Speiser`s Windows-Tool-Unit for everybody * * *        }
{                                                                    }
{            by Dipl.-Ing. Thomas Speiser Copyright 1998             }
{********************************************************************}

{$O+,F+}
Unit Windows;

Interface

Uses Crt, Dos;

Const
  Copyright = 'Windows-Tool-Unit by Dipl.-Ing. Thomas Speiser Software-Programmer Copyright 1998';
  Center: Boolean = False;
  CenterX: Boolean = False;

  CurBIG    = 5;
  CurNormal = 3342;
  CurNill   = $2000;

  big       = CO40;
  middle    = Font8x8;
  small     = 300;
  normal    = CO80;

{ »Tastenkombination [Ctrl] + [Break] gedrückt« }

  SaveInt09:  Pointer = nil;
  SysErrorFunc: Boolean = False;
  CtrlBreakHit: Boolean = False;
  SaveCtrlBreak: Boolean = False;
  SysErrActive: Boolean = False;

Var I,Star: Integer;
    Out: String;
    color: word;
    BK: boolean;

PROCEDURE Win(x1,y1,x2,y2: Integer;textback: byte);
PROCEDURE WinRec(x1,y1,x2,y2: Integer;Info:string);
PROCEDURE TextInWin(x1,y1: Integer;textcol: byte;Text:string);
PROCEDURE BeginWin(textback,textcol: byte;Wort: Word);
PROCEDURE WinLine(x1,y1,x2: Integer;text: string);
PROCEDURE StarShow(x1,y1: Integer);
PROCEDURE PointShow(x1,y1,Count,Time: Integer;Wort: char);
PROCEDURE IAtRight(x1,y1,Count,Time: Integer;Info: string);
PROCEDURE IAtLeft(x1,y1,Count,Time: Integer;Info: string);
PROCEDURE Desktop(Info: char);
PROCEDURE IAtDown(x1,y1,Count,Time: Integer;Info: string);
PROCEDURE IAtUp(x1,y1,Count,Time: Integer;Info: string);
PROCEDURE Wait;
PROCEDURE Move(x1,y1,x2,y2,Time: Integer;Info: string);
PROCEDURE SetCursor(NewCursor : Integer);
FUNCTION C(i:word;S:string):string;
PROCEDURE InitSysError;
PROCEDURE DoneSysError;
FUNCTION Keyboard(Info: string; var taste:char): boolean;
FUNCTION Splitl(Info: string;var st:string):boolean;

Implementation

{$L SYSINT.OBJ}

PROCEDURE InitSysError; external;
PROCEDURE DoneSysError; external;

PROCEDURE CLEAR;
BEGIN
  MEM[$0040:$001A]:=MEM[$0040:$001C];
END;

PROCEDURE WriteCharXY(col, row : INTEGER;num: INTEGER);
TYPE CrtChar  = RECORD
           CH : Char;
           at : BYTE; END;

     CrtPage  = ARRAY [1..25, 1..80] OF CrtChar;

VAR  Screen   : CrtPage ABSOLUTE $B800:$0000;
            i : INTEGER;
BEGIN

FOR i := 0 TO num-1 DO BEGIN screen[row, col + i].at := lightgray; END;

END;

PROCEDURE Shadow(x1, y1, x2, y2 : INTEGER);
VAR i : INTEGER;
BEGIN
 FOR i := y1+1 TO y2+1 DO BEGIN
 WriteCharXY(x2, i, 3); END;
 WriteCharXY(x1+1, y2+1, x2-x1);
END;

PROCEDURE SetCursor(NewCursor : Integer);
var
  Reg : Registers;
begin
  with Reg do
  begin
    AH := 1;
    BH := 0;
    CX := NewCursor;
    Intr($10, Reg);
  end;
end;

PROCEDURE Win(x1,y1,x2,y2: Integer;textback: byte);

BEGIN
 IF Center = true then begin
 x1:=(80-x2) div 2; y1:=(26-y2) div 2;
 x2:=x1+x2; y2:=y1+y2; end;
 IF CenterX = true then begin
 x1:=(80-x2) div 2; x2:=x1+x2; end;
 Shadow(x1+1, y1, x2, y2);

 Window(X1,Y1,X2,Y2);

 TextBackground(textback);
 TextColor(WHITE);
 Clrscr;
 TextBackground(textback);
 TextColor(WHITE);

gotoxy(1,1);
Color:=textback;
Center:=false;
CenterX:=false;
end;

PROCEDURE WinRec(x1,y1,x2,y2: Integer;Info:string);
var x3,y3 :integer;
    n,n2,a,b: integer;

BEGIN
 IF Center = true then begin
 x1:=(80-x2) div 2; y1:=(26-y2) div 2;
 x2:=x1+x2; y2:=y1+y2; end;

 IF CenterX = true then begin
 x1:=(80-x2) div 2; x2:=x1+x2; end;

 Shadow(x1+1, y1, x2, y2);

 Window(X1,Y1,X2,Y2);

 TextBackground(LIGHTGRAY);
 TextColor(BLACK);
 Clrscr;
 TextBackground(LIGHTGRAY);
 TextColor(BLACK);

 x3:=x2-x1;
 y3:=y2-y1;

 gotoxy(1,1);write('┌');
 gotoxy(2,1);
 for I:=1 to x3-1 do begin write('─'); end;
 write('┐');

if Info <> '' then begin
 gotoxy(2,1);write('┤ ',Info,' ├');
end;

 gotoxy(1,3);
 N:=1;
 repeat inc(n); gotoxy(1,n);write('│'); until n=(y3);

 TextColor(WHITE);

 gotoxy(x3+1,5);
 N2:=1;
 repeat inc(n2); gotoxy(x3+1,n2);write('│'); until n2=(y3);


 write('└');
 for I:=1 to x3-1 do begin write('─'); end;

 gotoxy(x3+1,y3+1); a:=WindMax; b:=WindMin;
 WindMax:=Lo(WindMax)+1; write('┘');
 WindMax:=a; WindMin:=b;
gotoxy(1,1);
Center:=false;
CenterX:=false;
Color:=lightgray;
end;

PROCEDURE TextInWin(x1,y1: Integer;textcol: byte;Text:string);

BEGIN
TextColor(textcol);
gotoxy(x1,y1);write(Text);
end;

PROCEDURE BeginWin(textback,textcol: byte;Wort: Word);

BEGIN
clrscr;
TextMode(wort);
TextBackground(textback);
TextColor(textcol);
clrscr;
TextBackground(textback);
TextColor(textcol);
SetCursor(CurNill);
end;

PROCEDURE WinLine(x1,y1,x2: Integer;text: string);
var taste:char;
    zeichen : String;
    I,x3,x: integer;
    laenge,l2,posi: byte;
    Done: Boolean;
BEGIN
CLEAR;
SetCursor(CurNormal);

TextBackground(color);
TextColor(White);

gotoxy(x1,y1);
Write('[');
gotoxy(x2,y1);
Write(']');

x3:=x2-x1;

  TextBackground(BLACK);

gotoxy(x1+1,y1);
FOR i:=1 TO x3-1 DO begin
write('˙');
end;

x:=x1;
Done:=False;
laenge:=0;

if text = 'code' then begin end else
begin l2:=length(text);
FOR i:=1 TO l2 DO begin
Inc(laenge);
zeichen[laenge]:=text[i]; end;

for i:=1 to l2 do begin
inc(x1);
gotoxy(x1,y1);
write(zeichen[i]); end; end;

if BK = false then begin
gotoxy(x1+1,y1);

posi:=laenge;
repeat
taste:=Readkey;
case taste of

#0:
begin
taste:=Readkey;
case taste of
#77: begin {RIGHT}
If x1 < x+laenge THEN BEGIN
Inc(x1);
Inc(posi);
gotoxy(x1+1,y1); end;
end;

#75: begin {LEFT}
If x1 <> x THEN BEGIN
Dec(x1);
Dec(posi);
gotoxy(x1+1,y1); end;
end;

#71: begin x1:=x; gotoxy(x1+1,y1); posi:=0; end; {POS 1}
#79: begin x1:=x+laenge; gotoxy(x1+1,y1); posi:=laenge; end; {ENDE}
end;
end;

'a'..'z','A'..'Z','0'..'9','!'..'?','\','_','ä','ö','ü','Ä','Ü','Ö','ß':

BEGIN
If x1 < x2-1 THEN BEGIN
Inc(x1);
Inc(posi);
if x1 > x+laenge then Inc(laenge);
zeichen[posi]:=taste;
gotoxy(x1,y1);
if text = 'code' then begin write('*'); end
else begin write(taste); end;
end; end;

#8:
Begin {BACK}
If x1 <> x THEN BEGIN
zeichen[posi]:=' ';
Dec(posi);
if x1 >= x+laenge then dec(laenge);
gotoxy(x1,y1);write('˙');
Dec(x1);
gotoxy(x1+1,y1);
end;
END;

#32: begin {SPACE}
If x1 < x2-1 THEN BEGIN
Inc(x1);
inc(posi);
if x1 > x+laenge then Inc(laenge);
zeichen[posi]:=' ';
gotoxy(x1,y1);write(' '); end;
end;

#13: begin done:=true end;
end;
until Done;

Text:='';

FOR i:=1 TO laenge DO
text:=text+zeichen[i];
Out:=text;
SetCursor(CurNill);
end;
end;

PROCEDURE StarShow(x1,y1: Integer);

BEGIN
 inc(star);
 gotoxy(x1,y1);
 if Star > 8 then Star:=1;
 if Star = 1 then write('│');
 if Star = 2 then write('/');
 if Star = 3 then write('-');
 if Star = 4 then write('\');
 if Star = 5 then write('│');
 if Star = 6 then write('/');
 if Star = 7 then write('-');
 if Star = 8 then write('\');
end;

PROCEDURE PointShow(x1,y1,Count,Time: Integer;Wort: char);

BEGIN
gotoxy(x1,y1);

for I:=1 to Count do begin
 write(wort);delay(Time); end;
end;

PROCEDURE IAtRight(x1,y1,Count,Time: Integer;Info: string);

BEGIN
for I:=1 to Count do begin
inc(x1);
gotoxy(x1,y1);
 write(' ',info);delay(Time); end;
end;

PROCEDURE IAtLeft(x1,y1,Count,Time: Integer;Info: string);

BEGIN
for I:=1 to Count do begin
dec(x1);
gotoxy(x1,y1);
 write(info,' ');delay(Time); end;
end;

PROCEDURE Desktop(Info: char);

begin
gotoxy(1,2);
  for I:=1 to 1840 do begin
    Write(info); end;
end;

PROCEDURE IAtDown(x1,y1,Count,Time: Integer;Info: string);
var
 n2: integer;
 G: string;
BEGIN
g:='';
n2:=Length(Info);
for I:=1 to n2 do begin
G:=g+' '; end;

for I:=1 to Count do begin
Inc(y1);
gotoxy(x1,y1);
 write(info);delay(Time);
gotoxy(x1,y1);
 write(G);
 end;
gotoxy(x1,y1);
 write(info);
end;

PROCEDURE IAtUp(x1,y1,Count,Time: Integer;Info: string);
var
 n2: integer;
 G: string;
BEGIN
g:='';
n2:=Length(Info);
for I:=1 to n2 do begin
G:=g+' '; end;

for I:=1 to Count do begin
Dec(y1);
gotoxy(x1,y1);
 write(info);delay(Time);
gotoxy(x1,y1);
 write(G);
 end;
gotoxy(x1,y1);
 write(info);
end;

PROCEDURE Wait;
BEGIN
Repeat
Until Keypressed;
ReadKey;
end;

PROCEDURE Move(x1,y1,x2,y2,Time: Integer;Info: string);
var
 n2: integer;
 G: string;
BEGIN
gotoxy(x1,y1);
g:='';
n2:=Length(Info);
for I:=1 to n2 do begin
G:=g+' '; end;

if y1 < y2 then begin
for y1:=y1 to y2-1 do begin
gotoxy(x1,y1);
 write(info);delay(Time);
gotoxy(x1,y1);
 write(G);end;gotoxy(x1,y1);write(info);end;

if y1 > y2 then begin
for y1:=y1 downto y2+1 do begin
gotoxy(x1,y1);
 write(info);delay(Time);
gotoxy(x1,y1);
 write(G);end;gotoxy(x1,y1);write(info);end;

if x1 < x2 then begin
for x1:=x1 to x2 do begin
gotoxy(x1,y1);
write(' ',info);delay(Time); end;end;

if x1 > x2 then begin
for x1:=x1 downto x2+1 do begin
gotoxy(x1,y1);
write(info,' ');delay(Time); end;end;
end;

function C(i:word;S:string):string;
begin
Textcolor(i);
Write(s);
c:='';
end;

FUNCTION Keyboard(Info: string; var taste:char): boolean;
var i: integer;
begin
Keyboard:=false;
if taste <> info[1] then exit;
for i:=2 to length(info) do begin
taste:=readkey;
if (taste <> info[i]) then exit end;
Keyboard:=true;
end;

FUNCTION Splitl(Info: string;var st:string):boolean;
var i:integer;
    st2: string;
begin
Splitl:=false;
i:=pos('=',st);
st2:=copy(st,1,i-1);
if st2 = info then begin st:=copy(st,i+1,length(st)); Splitl:=true; end;
end;

end.