home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS 1992 June
/
SIMTEL_0692.cdr
/
msdos
/
turbopas
/
tpzsfz.arc
/
TPZVIDEO.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1988-09-18
|
6KB
|
288 lines
UNIT TpzVideo;
(* Status window routines for Turbo Pascal Zmodem *)
(* (c)1988 by J.R.Louvau *)
INTERFACE
USES Crt;
PROCEDURE Z_OpenWindow(title: STRING);
(* Setup the area of the screen for transfer status window *)
PROCEDURE Z_CloseWindow;
(* Restore the original window *)
PROCEDURE Z_ShowName(filename: STRING);
(* Display the file name *)
PROCEDURE Z_ShowSize(l: LONGINT);
(* Display the file size in blocks and bytes *)
PROCEDURE Z_ShowCheck(is32: BOOLEAN);
(* Display CRC16 or CRC32 block checking *)
PROCEDURE Z_ShowTransferTime(fsize, zbaud: LONGINT);
(* Show estimated transfer time in minutes *)
PROCEDURE Z_Message(s: STRING);
(* Show miscelaneous messages *)
PROCEDURE Z_Frame(n: INTEGER);
(* Show current ZMODEM frame type *)
PROCEDURE Z_ShowLoc(l: LONGINT);
(* Show byte position of file in blocks and bytes *)
PROCEDURE Z_Errors(w: WORD);
(* Show total error count *)
IMPLEMENTATION
CONST
x1: BYTE = 20;
x2: BYTE = 59;
y1: BYTE = 5;
y2: BYTE = 17;
fore: BYTE = LightGray;
back: BYTE = Black;
bfore: BYTE = Black;
bback: BYTE = Green;
{$F+}
{$L \pascal\screen\mcmvsmem.obj }
PROCEDURE MoveToScreen(var Source, Dest; Len: WORD);external;
PROCEDURE MoveFromScreen(var Source, Dest; Len: WORD);external;
{$F-}
VAR
vmode: BYTE absolute $0040:$0049;
vcols: WORD absolute $0040:$004A;
oldx, oldy, oldattr: BYTE;
oldmin, oldmax, cols, rows, size, vseg, vofs: WORD;
buffer: POINTER;
FUNCTION RtoS(r: REAL; width, decimals: WORD): STRING;
VAR
s: STRING;
BEGIN
{$I-}
Str(r:width:decimals,s);
{$I+}
IF (IoResult <> 0) THEN
s := ''
ELSE
WHILE (Length(s) > 0) AND (s[1] = ' ') DO
Delete(s,1,1);
RtoS := s
END;
FUNCTION ItoS(r: LONGINT; width: WORD): STRING;
VAR
s: STRING;
BEGIN
{$I-}
Str(r:width,s);
{$I+}
IF (IoResult <> 0) THEN
s := ''
ELSE
WHILE (Length(s) > 0) AND (s[1] = ' ') DO
Delete(s,1,1);
ItoS := s
END;
PROCEDURE Z_OpenWindow(title: STRING);
VAR
p, q: POINTER;
n, pads, bytes: WORD;
BEGIN
DirectVideo := TRUE;
CheckSnow := FALSE;
oldx := WhereX;
oldy := WhereY;
oldattr := TextAttr;
oldmin := WindMin;
oldmax := WindMax;
Window(x1,y1,x2,y2);
TextColor(bfore);
TextBackground(bback);
cols := Lo(WindMax) - Lo(WindMin) + 1;
rows := Hi(WindMax) - Hi(WindMin) + 1;
IF vmode = 7 THEN
vseg := $B000
ELSE
vseg := $B800;
vofs := ((Hi(WindMin) * vcols) + Lo(WindMin)) * 2;
size := (rows * cols) * 2;
bytes := cols * 2;
pads := (vcols * 2) - bytes;
GetMem(buffer,size);
p := Ptr(vseg,vofs);
q := buffer;
FOR n := 1 TO rows DO
BEGIN
MoveFromScreen(p^,q^,cols * 2);
Inc(LONGINT(p),vcols * 2);
Inc(LONGINT(q),cols * 2)
END;
ClrScr;
IF (Length(title) > (cols - 2)) THEN
title[0] := Chr(cols-2);
GotoXY((cols - Length(title) - 2) DIV 2 + 1,1);
WRITE(title);
title := ' ESCape to abort';
GotoXY((cols - Length(title) - 2) DIV 2 + 1,rows);
WRITE(title);
Window(x1+1,y1+1,x2-1,y2-1);
TextColor(fore);
TextBackground(back);
ClrScr;
GotoXY(1,1);
WRITELN(' File name.....:');
WRITELN(' File size.....:');
WRITELN(' File blocks...:');
WRITELN(' Block check...:');
WRITELN(' Transfer time.:');
WRITELN(' Current BYTE..:');
WRITELN(' Current BLOCK.:');
WRITELN(' Error count...:');
WRITELN(' Last frame....:');
TextColor(bfore);
TextBackground(bback);
GotoXY(1,10);
ClrEol;
title := #$19+'Last Message'+#$19;
GotoXY((cols - Length(title) - 2) DIV 2 + 1,10);
WRITE(title);
TextColor(White);
TextBackground(back)
END;
PROCEDURE Z_CloseWindow;
VAR
p, q: POINTER;
n: WORD;
BEGIN
TextAttr := oldattr;
WindMax := oldmax;
WindMin := oldmin;
GotoXY(oldx,oldy);
q := buffer;
p := Ptr(vseg,vofs);
FOR n := 1 TO rows DO
BEGIN
MoveToScreen(q^,p^,cols * 2);
Inc(LONGINT(p),vcols * 2);
Inc(LONGINT(q),cols * 2)
END;
FreeMem(buffer,size)
END;
PROCEDURE Z_ShowName(filename: STRING);
BEGIN
IF (Length(filename) > 14) THEN
filename[0] := #14;
GotoXY(18,1);
WRITE(filename);
GotoXY(1,11)
END;
PROCEDURE Z_ShowSize(l: LONGINT);
BEGIN
GotoXY(18,2);
WRITE(ItoS(l,14));
IF (l MOD 128 <> 0) THEN
l := (l DIV 128) + 1
ELSE
l := (l DIV 128);
GotoXY(18,3);
WRITE(ItoS(l,14));
GotoXY(1,11);
END;
PROCEDURE Z_ShowCheck(is32: BOOLEAN);
BEGIN
GotoXY(18,4);
IF (is32) THEN
WRITE('CRC32')
ELSE
WRITE('CRC16');
GotoXY(1,11)
END;
PROCEDURE Z_ShowTransferTime(fsize, zbaud: LONGINT);
VAR
bits: REAL;
BEGIN
bits := fsize * 10.0;
GotoXY(18,5);
IF (bits <> 0.0) THEN
WRITE(RtoS(((bits / zbaud) / 60),10,2),'min.')
ELSE
WRITE('0min.');
GotoXY(1,11)
END;
PROCEDURE Z_Message(s: STRING);
BEGIN
IF (Length(s) > 31) THEN
s[0] := #31;
GotoXY(1,11);
WRITE(s,#13)
END;
PROCEDURE Z_Frame(n: INTEGER);
BEGIN
IF (n < -3) OR (n > 20) THEN
n := 20;
GotoXY(18,9);
CASE Lo(n) OF
-3 : WRITE('ZNOCARRIER');
-2 : WRITE('ZTIMEOUT ');
-1 : WRITE('ZERROR ');
0 : WRITE('ZRQINIT ');
1 : WRITE('ZRINIT ');
2 : WRITE('ZSINIT ');
3 : WRITE('ZACK ');
4 : WRITE('ZFILE ');
5 : WRITE('ZSKIP ');
6 : WRITE('ZNAK ');
7 : WRITE('ZABORT ');
8 : WRITE('ZFIN ');
9 : WRITE('ZRPOS ');
10 : WRITE('ZDATA ');
11 : WRITE('ZEOF ');
12 : WRITE('ZFERR ');
13 : WRITE('ZCRC ');
14 : WRITE('ZCHALLENGE');
15 : WRITE('ZCOMPL ');
16 : WRITE('ZCAN ');
17 : WRITE('ZFREECNT ');
18 : WRITE('ZCOMMAND ');
19 : WRITE('ZSTDERR ');
20 : WRITE('ZUNKNOWN ')
END;
GotoXY(1,11)
END;
PROCEDURE Z_ShowLoc(l: LONGINT);
BEGIN
GotoXY(18,6);
WRITE(ItoS(l,14));
IF (l MOD 128 <> 0) THEN
l := (l DIV 128) + 1
ELSE
l := (l DIV 128);
GotoXY(18,7);
WRITE(ItoS(l,14));
GotoXY(1,11)
END;
PROCEDURE Z_Errors(w: WORD);
BEGIN
GotoXY(18,8);
WRITE(ItoS(w,14));
GotoXY(1,11)
END;
END.