Power-Programmierung/CD1.mdf/pascal/library/dos/window/fxwindow/fxwindow.pas

Pascal/Delphi Source File | 1988-12-21 | 7.1 KB | 243 lines

Unit FXWindow;

Interface

   Uses DOS,CRT;

   Type ScreenType = Record
                        Pos : Array[1..2000] Of Record
                                                   Ch : Char;
                                                   Attrib : Byte;
                                                End;
                     End;

   Var Screen : ScreenType Absolute $B800:0000;
       SaveScreen : Array[0..9] Of ScreenType;
       CurrentWindow : Integer;
       WindowCursor : Array[0..9] Of Record
                                        CursorX : Integer;
                                        CursorY : Integer;
                                     End;
       WindowPos : Array[0..9] Of Record
                                      PosX1 : Integer;
                                      PosY1 : Integer;
                                      PosX2 : Integer;
                                      PosY2 : Integer;
                                   End;

   Procedure Cursor(OnOff : Boolean);
   Procedure Color(FG,BG : Integer);
   Procedure DrawWindow(X1,Y1,X2,Y2,FG,BG : Integer;Shadow : Boolean);
   Procedure MoveWindow(X,Y : Integer;Shadow : Boolean);
   Procedure RemoveWindow;
   Procedure SaveStartUpWindow;
   Procedure UnInitWindow;

Implementation

   Function XYValue(X,Y : Integer) : Integer;

      Begin
         XYValue := (((Y-1)*80)+X);
      End;

   Procedure Cursor(OnOff : Boolean);

   Var Regs : Registers;

      Begin
         If OnOff Then
            Begin
               If Mem[0:$449] = 7 Then
                  Regs.CX := $0C0D
               Else
                  Regs.CX := $0607
            End
         Else
            Begin
               Regs.CX := $2000;
            End;
         Regs.AX := $0100;
         Intr($10,Regs);
      End;

   Procedure Color(FG,BG : Integer);

      Begin
         TextColor(FG);
         TextBackGround(BG);
      End;

   Procedure ClearBlock(X1,Y1,X2,Y2,FG,BG : Integer);

      Begin
         Color(FG,BG);
         Window(X1,Y1,X2,Y2);
         ClrScr;
         Window(1,1,80,25);
      End;

   Procedure DrawWindow(X1,Y1,X2,Y2,FG,BG : Integer;Shadow : Boolean);

   Var I : Integer;

      Begin
         CurrentWindow := CurrentWindow + 1;
         If CurrentWindow = 11 Then
            Begin
               Color(15,4);
               Write  (#7,'Error 1: Too Many Windows!');
               CurrentWindow := 10;
               Exit;
            End;
         SaveScreen[CurrentWindow] := Screen;
         With WindowCursor[CurrentWindow] Do
            Begin
               CursorX := WhereX;
               CursorY := WhereY;
            End;
         ClearBlock(X1,Y1,X2,Y2,FG,BG);
         For I := X1+1 To X2-1 Do
            Begin
               Screen.Pos[XYValue(I,Y1)].Ch := '═';
               Screen.Pos[XYValue(I,Y2)].Ch := '═';
            End;
         For I := Y1+1 To Y2-1 Do
            Begin
               Screen.Pos[XYValue(X1,I)].Ch := '║';
               Screen.Pos[XYValue(X2,I)].Ch := '║';
            End;
         Screen.Pos[XYValue(X1,Y1)].Ch := '╔';
         Screen.Pos[XYValue(X2,Y1)].Ch := '╗';
         Screen.Pos[XYValue(X1,Y2)].Ch := '╚';
         Screen.Pos[XYValue(X2,Y2)].Ch := '╝';
         Window(X1+1,Y1+1,X2-1,Y2-1);
         GotoXY(1,1);
         With WindowPos[CurrentWindow] Do
            Begin
               PosX1 := X1+1;
               PosY1 := Y1+1;
               PosX2 := X2-1;
               PosY2 := Y2-1;
            End;
         If Shadow Then
            Begin
               For I := X1+2 To X2+2 Do Screen.Pos[XYValue(I,Y2+1)].Attrib := 8;
               For I := Y1+1 To Y2+1 Do
                  Begin
                     Screen.Pos[XYValue(X2+1,I)].Attrib := 8;
                     Screen.Pos[XYValue(X2+2,I)].Attrib := 8;
                  End;
            End;
      End;

   Procedure MoveWindow(X,Y : Integer;Shadow : Boolean);

   Var I,J,K,M,N,O : Integer;
       HoldScreen : ScreenType;

      Begin
         If CurrentWindow = 0 Then
            Begin
               Color(15,4);
               Write  (#7,'Error 3: No Windows To Move!');
               Exit;
            End;
         HoldScreen := SaveScreen[CurrentWindow];
         K := (WindowPos[CurrentWindow].PosX2 - WindowPos[CurrentWindow].PosX1)+2;
         M := (WindowPos[CurrentWindow].PosY2 - WindowPos[CurrentWindow].PosY1)+2;
         N := WindowPos[CurrentWindow].PosX1-1;
         O := WindowPos[CurrentWindow].PosY1-1;
         For J := 0 To M Do
            Begin
               For I := 0 To K Do
                  Begin
                     HoldScreen.Pos[XYValue(X+I,Y+J)].Ch := Screen.Pos[XYValue(N+I,O+J)].Ch;
                     HoldScreen.Pos[XYValue(X+I,Y+J)].Attrib := Screen.Pos[XYValue(N+I,O+J)].Attrib;
                  End;
            End;
         If Shadow Then
            Begin
               For I := X+2 To X+K+2 Do HoldScreen.Pos[XYValue(I,Y+M+1)].Attrib := 8;
               For I := Y+1 To Y+M+1 Do
                  Begin
                     HoldScreen.Pos[XYValue(X+K+1,I)].Attrib := 8;
                     HoldScreen.Pos[XYValue(X+K+2,I)].Attrib := 8;
                  End;
            End;
         With WindowPos[CurrentWindow] Do
            Begin
               PosX1 := X+1;
               PosY1 := Y+1;
               PosX2 := X+K-1;
               PosY2 := Y+M-1;
               Window(PosX1,PosY1,PosX2,PosY2);
            End;
         GotoXY(WindowCursor[CurrentWindow].CursorX,WindowCursor[CurrentWindow].CursorY);
         Screen := HoldScreen;
      End;

   Procedure RemoveWindow;

      Begin
         CurrentWindow := CurrentWindow - 1;
         If CurrentWindow = - 1 Then
            Begin
               Color(15,4);
               Write  (#7,'Error 2: No Windows To Remove!');
               CurrentWindow := 0;
               Exit;
            End;
         With WindowPos[CurrentWindow] Do
            Begin
               Window(PosX1,PosY1,PosX2,PosY2);
            End;
         Screen := SaveScreen[CurrentWindow+1];
         With WindowCursor[CurrentWindow] Do
            Begin
               GotoXY(CursorX,CursorY);
            End;
      End;

   Procedure SaveStartUpWindow;

      Begin
         SaveScreen[0] := Screen;
         With WindowCursor[0] Do
            Begin
               CursorX := WhereX;
               CursorY := WhereY;
            End;
      End;

   Procedure UnInitWindow;

      Begin
         With WindowPos[0] Do
            Begin
               Window(PosX1,PosY1,PosX2,PosY2);
            End;
         Screen := SaveScreen[0];
         With WindowCursor[0] Do
            Begin
               GotoXY(CursorX,CursorY);
            End;
      End;

Begin
   CurrentWindow := 0;
   SaveScreen[0] := Screen;
   With WindowCursor[0] Do
      Begin
         CursorX := WhereX;
         CursorY := WhereY;
      End;
   With WindowPos[0] Do
      Begin
         PosX1 := 1;
         PosY1 := 1;
         PosX2 := 80;
         PosY2 := 25;
      End;
End.