DP Tool Club 19/CD_ASCQ_19_010295.iso/dos/prg/pas/ktools/source/utextscr.pas

Pascal/Delphi Source File | 1994-11-11 | 7KB | 371 lines

Unit UTextScr;
{ gestion de l'écran en mode texte }
{ K.B. octobre 1994 }

INTERFACE

Uses Dos;

Const
 { Constantes définissant le curseur texte }
 BlankCursor  = $2000;
 NormalCursor = $0607;
 CarreCursor  = $0407;
 RectCursor   = $0107;

Const
 { Constantes pour cadres }
 HGS='┌'; HGD='╔'; HGM='╒';
 THS='─'; THD='═';
 TVS='│'; TVD='║';
 HDS='┐'; HDD='╗'; HDM='╕';
 BGS='└'; BGD='╚'; BGM='╘';
 BDS='┘'; BDD='╝'; BDM='╛';
 SDS='├'; SDD='╠'; SDM='╞';
 SGS='┤'; SGD='╣'; SGM='╡';
 CrS='┼'; CrD='╬'; CrM='╪';
 TTS='┬'; TTD='╦'; TTM='╤';
 TIS='┴'; TID='╩'; TIM='╧';

Type
 TCursorState=record
  Typ: Word;
  x,y:Byte;
  End;

 PWordBuffer=^TWordBuffer;
 TWordBuffer=Array[0..2047] of Word;    { type mémoire écran }

Var
 { tableau pointant sur 4 pages de la mémoire écran }
 Screen  : array[0..3] of TWordBuffer Absolute $B800:0000;
 PageCourante : Byte;   { Page écran utilisée }

{ Couleurs }

Procedure ToggleBlink(OnOff:boolean);

{ Ecran texte }

Procedure SetActivePage(Page:Byte);

Procedure ScrollWindowUp(NoLines,Attrib,ColUL,RowUL,ColLR,RowLR:Byte);

Procedure ScrollWindowDn(NoLines,Attrib,ColUL,RowUL,ColLR,RowLR:Byte);

Function  GetCharAttrib:Word;
{ renvoie le caractère et la couleur de la position courante }

Procedure PutCharAttrib(CharAttrib:Word; NbChar:Word);
{ écrit NbChar caractères Char avec la couleur Attrib }

Procedure WriteXY(attrib,X,Y:Byte;S:String);
{ écrit S à la position (X,Y) avec la couleur attrib }

Procedure WriteXYCh(attrib,X,Y,c:Byte);

Procedure FillScreen(CharAttrib:Word);
{ remplit l'écran }

Procedure CopyPage(n1,n2:Byte);
{ copie de la page écran n1 dans la page écran n2 }

{ Fenêtres }

Procedure Frame(X1,Y1,X2,Y2,c:Byte;Title:String);

Procedure Shadow (X1,Y1,X2,Y2,cc:Byte);
{ ombre d'une fenêtre }

Procedure ScreenToBuf(x1,y1,x2,y2:Byte;Var B:TWordBuffer);
{ sauve le contenu d'un rectangle }

Procedure BufToScreen(x1,y1,x2,y2:Byte;B:TWordBuffer);
{ restitue le contenu d'un rectangle }

{ Curseur }

Procedure SetCursorPos(Column, Row: Byte);
{ fixe la position du curseur texte, remplace gotoxy }

Procedure GetCursorPos(Var Column, Row: Byte);
{ renvoie la position du curseur texte }

Procedure SetCursorType(ctype: Word);
{ fixe le type du curseur texte }

Function  GetCursorType:Word;
{ renvoie le type du curseur texte }

Procedure GetCursorState(Var C:TCursorState);

Procedure SetCursorState(C:TCursorState);

IMPLEMENTATION

Const
{ numéros d'interruptions BIOS }
 VIO = $10;  (* BIOS Video *)

Var
 Reg : Registers;

{ activation/désactivation du clignotement du fond }
Procedure ToggleBlink(OnOff:boolean); assembler;
Asm
 mov ax,1003h
 mov bl,OnOff
 int 10h
End;

{ Curseur }
Procedure GetCursorPos (Var Column, Row: Byte);
Var p, X, Y: Byte;
Begin
 p := PageCourante;
 Asm
   MOV AH, $03
   MOV BH, p
   Int VIO
   MOV X, DL
   MOV Y, DH
 End;
 Column := X;
 Row := Y;
End;

Function GetCursorType : Word;
Begin
  Asm
    MOV AH, $03;
    MOV BH, PageCourante
    Int VIO
    MOV @Result, CX
  End;
End;

Procedure SetCursorPos (Column, Row: Byte);
Begin
  Asm
    MOV AH, $02
    MOV BH, PageCourante
    MOV DH, Row
    MOV DL, Column
    Int VIO
  End;
End;

Procedure SetCursorType(ctype: Word);
Begin
 Reg.AX:=$0100;
 Reg.CX:=ctype;
 intr(VIO,Reg);
End;

Procedure GetCursorState(Var C:TCursorState);
Begin
 with C do
  begin
   Typ:=GetCursorType;
   GetCursorPos(x,y);
  end;
End;

Procedure SetCursorState(C:TCursorState);
Begin
 with C do
  begin
   SetCursorType(Typ);
   SetCursorPos(x,y);
  end;
End;

{ Ecran }
Function x80(y:word):word;
{ utilitaire de calcul d'adresse }
Begin
  asm
    MOV AX,y
    MOV BX,AX
    MOV CL,4
    SHL BX,CL
    MOV CL,6
    SHL AX,CL
    ADD AX,BX
    MOV @Result, AX
  end
End;

Function x80p(y,x: word):word;
{ utilitaire de calcul d'adresse }
Begin
  asm
    MOV AX,y
    MOV BX,AX
    MOV CL,4
    SHL BX,CL
    MOV CL,6
    SHL AX,CL
    ADD AX,BX
    ADD AX,x
    MOV @Result, AX
  end
End;

Procedure PutCharAttrib (CharAttrib: Word; NbChar: Word);
Begin
  Asm
    MOV AX, CharAttrib
    MOV BL, AH
    MOV AH, $09
    MOV BH, PageCourante
    MOV CX, NbChar
    Int VIO
  End;
End;

Procedure FillScreen(CharAttrib:Word);
Begin
 SetCursorPos(0,0);
 PutCharAttrib(CharAttrib,25*80);
End;

Function GetCharAttrib : Word;
Begin
  Asm
    MOV AH, $08
    MOV BH, PageCourante
    Int VIO
    MOV @Result, AX
  End;
End;

Function GetCharAttribXY(X, Y:Byte):Word;
Begin
 GetCharAttribXY:=Screen[PageCourante][x80p(Y,X)];
End;

Procedure ScrollWindowUp(NoLines, Attrib, ColUL, RowUL, ColLR, RowLR: Byte);
  Assembler;
Asm
  MOV AH, $06
  MOV AL, NoLines
  MOV BH, Attrib
  MOV CH, RowUL
  MOV CL, ColUL
  MOV DH, RowLR
  MOV DL, ColLR
  Int VIO
End;

Procedure ScrollWindowDn(NoLines, Attrib, ColUL, RowUL, ColLR, RowLR: Byte);
Begin
  Asm
    MOV AH, $07
    MOV AL, NoLines
    MOV BH, Attrib
    MOV CH, RowUL
    MOV CL, ColUL
    MOV DH, RowLR
    MOV DL, ColLR
    Int VIO
  End;
End;

Procedure SetActivePage(Page: Byte);
Begin
 Reg.AH:=$05;
 Reg.AL:=Page;
 intr(VIO,Reg);
 PageCourante:=Page;
End;

Procedure WriteXYCh(attrib,X,Y,c:Byte);
Begin
 Screen[PageCourante][x80p(Y,X)]:=(attrib ShL 8)+c;
End;

Procedure WriteXY(attrib,X,Y:Byte; S:String);
Var i: byte;
Begin
 if S[0]<>#0
    then begin
          for i:=1 to length(S)
           do Screen[PageCourante][x80p(Y,X+Pred(i))]:=
              (attrib shl 8)+Ord(S[i]);
         end;
End;

Procedure CopyPage(n1,n2:Byte);
{ copie de la page écran n1 dans la page écran n2 }
Begin
 move(Screen[n1],Screen[n2],4000);
End;

{ Fenêtres }
Procedure Frame(X1,Y1,X2,Y2,c:Byte; Title:String);
Var x,y:Byte;
Begin
 ScrollWindowUP(0,c,X1,Y1,X2,Y2);
 for x:=X1 To X2
  do begin
      WriteXYCh(c,X,Y1,196);
      WriteXYCh(c,X,Y2,196);
     end;
 for y:=Y1 To Y2
  do begin
      WriteXYCh(c,X1,Y,179);
      WriteXYCh(c,X2,Y,179);
     end;
 WriteXYCh(c,X1,Y1,218);
 WriteXYCh(c,X2,Y1,191);
 WriteXYCh(c,X1,Y2,192);
 WriteXYCh(c,X2,Y2,217);
 If title <> ''
    then WriteXY(c,X1+(X2-X1-length(Title)) div 2, Y1, Title);
End;

Procedure Shadow(X1,Y1,X2,Y2,cc:Byte);
Var x,y,xmax,ymax:Byte;
    w:Word;
Begin
 xmax:=succ(x2);
 if xmax>79 then xmax:=79;
 ymax:=succ(y2);
 if ymax>24 then ymax:=24;
 For y:=succ(y1) to ymax
  do begin
      SetCursorPos(succ(X2),y);
      W:=GetCharAttrib;
      W:=W mod 256 + 256*cc;
      PutCharAttrib(W,1);
     end;
 For x:=succ(x1) to xmax
  do begin
      SetCursorPos(x,succ(Y2));
      W:=GetCharAttrib;
      W:=W mod 256 + 256*cc;
      PutCharAttrib(W,1);
     end;
End;

Procedure ScreenToBuf(x1,y1,x2,y2:Byte; Var B:TWordBuffer);
Var y:Word;
Begin
 for y:=y1 to y2 do
  Move(Screen[PageCourante][y*80+x1],
       B[(y-y1)*(x2-x1+1)],2*(x2-x1+1));
End;

Procedure BufToScreen(x1,y1,x2,y2:Byte; B:TWordBuffer);
Var y:Word;
Begin
 for y:=y1 to y2 do
  Move(B[(y-y1)*(x2-x1+1)],
       Screen[PageCourante][y*80+x1],2*(x2-x1+1));
End;

END.

{                        Fin du fichier UTextScr.Pas                        }