home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / modem / suncom.zip / TPZVIDBK.PAS < prev    next >
Pascal/Delphi Source File  |  1990-01-19  |  7KB  |  295 lines
  1. UNIT TpzVideo;
  2. (* Status window routines for Turbo Pascal Zmodem *)
  3. (* (c)1988 by J.R.Louvau                          *)
  4. INTERFACE
  5. USES Crt;
  6.  
  7. PROCEDURE Z_OpenWindow(title: STRING);
  8. (* Setup the area of the screen for transfer status window *)
  9. PROCEDURE Z_CloseWindow;
  10. (* Restore the original window *)
  11. PROCEDURE Z_ShowName(filename: STRING);
  12. (* Display the file name *)
  13. PROCEDURE Z_ShowSize(l: LONGINT);
  14. (* Display the file size in blocks and bytes *)
  15. PROCEDURE Z_ShowCheck(is32: BOOLEAN);
  16. (* Display CRC16 or CRC32 block checking *)
  17. PROCEDURE Z_ShowTransferTime(fsize, zbaud: LONGINT);
  18. (* Show estimated transfer time in minutes *)
  19. PROCEDURE Z_Message(s: STRING);
  20. (* Show miscelaneous messages *)
  21. PROCEDURE Z_Frame(n: INTEGER);
  22. (* Show current ZMODEM frame type *)
  23. PROCEDURE Z_ShowLoc(l: LONGINT);
  24. (* Show byte position of file in blocks and bytes *)
  25. PROCEDURE Z_Errors(w: WORD);
  26. (* Show total error count *)
  27.  
  28.  
  29. IMPLEMENTATION
  30.  
  31. CONST
  32.    x1: BYTE = 20;
  33.    x2: BYTE = 59;
  34.    y1: BYTE = 5;
  35.    y2: BYTE = 17;
  36.    fore: BYTE = black;
  37.    back: BYTE = white;
  38.    bfore: BYTE = yellow;
  39.    bback: BYTE = blue;
  40.  
  41. {$F+}
  42. {$L \turbo5\util\mcmvsmem.obj }
  43. PROCEDURE MoveToScreen(var Source, Dest; Len: WORD);external;
  44. PROCEDURE MoveFromScreen(var Source, Dest; Len: WORD);external;
  45. {$F-}
  46.  
  47.  
  48.  
  49. VAR
  50.    vmode: BYTE absolute $0040:$0049;
  51.    vcols: WORD absolute $0040:$004A;
  52.    oldx, oldy, oldattr: BYTE;
  53.    oldmin, oldmax, cols, rows, size, vseg, vofs: WORD;
  54.    buffer: POINTER;
  55.  
  56. FUNCTION RtoS(r: REAL; width, decimals: WORD): STRING;
  57. VAR
  58.    s: STRING;
  59. BEGIN
  60.    {$I-}
  61.    Str(r:width:decimals,s);
  62.    {$I+}
  63.    IF (IoResult <> 0) THEN
  64.       s := ''
  65.    ELSE
  66.       WHILE (Length(s) > 0) AND (s[1] = ' ') DO
  67.          Delete(s,1,1);
  68.    RtoS := s
  69. END;
  70.  
  71.  
  72.  
  73. FUNCTION ItoS(r: LONGINT; width: WORD): STRING;
  74. VAR
  75.    s: STRING;
  76. BEGIN
  77.    {$I-}
  78.    Str(r:width,s);
  79.    {$I+}
  80.    IF (IoResult <> 0) THEN
  81.       s := ''
  82.    ELSE
  83.       WHILE (Length(s) > 0) AND (s[1] = ' ') DO
  84.          Delete(s,1,1);
  85.    ItoS := s
  86. END;
  87.  
  88.  
  89. PROCEDURE Z_OpenWindow(title: STRING);
  90. VAR
  91.    p, q: POINTER;
  92.    n, pads, bytes: WORD;
  93. BEGIN
  94.    DirectVideo := TRUE;
  95.    CheckSnow := FALSE;
  96.    oldx := WhereX;
  97.    oldy := WhereY;
  98.    oldattr := TextAttr;
  99.    oldmin := WindMin;
  100.    oldmax := WindMax;
  101.    Window(x1,y1,x2,y2);
  102.    TextColor(bfore);
  103.    TextBackground(bback);
  104.    cols := Lo(WindMax) - Lo(WindMin) + 1;
  105.    rows := Hi(WindMax) - Hi(WindMin) + 1;
  106.    IF vmode = 7 THEN
  107.       vseg := $B000
  108.    ELSE
  109.       vseg := $B800;
  110.    vofs := ((Hi(WindMin) * vcols) + Lo(WindMin)) * 2;
  111.    size := (rows * cols) * 2;
  112.    bytes := cols * 2;
  113.    pads := (vcols * 2) - bytes;
  114.    GetMem(buffer,size);
  115.    p := Ptr(vseg,vofs);
  116.    q := buffer;
  117.    FOR n := 1 TO rows DO
  118.    BEGIN
  119.       MoveFromScreen(p^,q^,cols * 2);
  120.       Inc(LONGINT(p),vcols * 2);
  121.       Inc(LONGINT(q),cols * 2)
  122.    END;
  123.    ClrScr;
  124.    IF (Length(title) > (cols - 2)) THEN
  125.       title[0] := Chr(cols-2);
  126.    GotoXY((cols - Length(title) - 2) DIV 2 + 1,1);
  127.    WRITE(title);
  128.    title := ' ESCape to abort';
  129.    GotoXY((cols - Length(title) - 2) DIV 2 + 1,rows);
  130.    WRITE(title);
  131.    Window(x1+1,y1+1,x2-1,y2-1);
  132.    TextColor(fore);
  133.    TextBackground(back);
  134.    ClrScr;
  135.    GotoXY(1,1);
  136.    WRITELN(' File name.....:');
  137.    WRITELN(' File size.....:');
  138.    WRITELN(' File blocks...:');
  139.    WRITELN(' Block check...:');
  140.    WRITELN(' Transfer time.:');
  141.    WRITELN(' Current BYTE..:');
  142.    WRITELN(' Current BLOCK.:');
  143.    WRITELN(' Error count...:');
  144.    WRITELN(' Last frame....:');
  145.    TextColor(bfore);
  146.    TextBackground(bback);
  147.    GotoXY(1,10);
  148.    ClrEol;
  149.    title := #$19+'Last Message'+#$19;
  150.    GotoXY((cols - Length(title) - 2) DIV 2 + 1,10);
  151.    writeln;
  152.    WRITE(title);
  153.    TextColor(red);
  154.    TextBackground(back)
  155. END;
  156.  
  157.  
  158.  
  159. PROCEDURE Z_CloseWindow;
  160. VAR
  161.    p, q: POINTER;
  162.    n: WORD;
  163. BEGIN
  164.    TextAttr := oldattr;
  165.    WindMax := oldmax;
  166.    WindMin := oldmin;
  167.    GotoXY(oldx,oldy);
  168.    q := buffer;
  169.    p := Ptr(vseg,vofs);
  170.    FOR n := 1 TO rows DO
  171.    BEGIN
  172.       MoveToScreen(q^,p^,cols * 2);
  173.       Inc(LONGINT(p),vcols * 2);
  174.       Inc(LONGINT(q),cols * 2)
  175.    END;
  176.    FreeMem(buffer,size)
  177. END;
  178.  
  179. PROCEDURE Z_ShowName(filename: STRING);
  180. BEGIN
  181.    IF (Length(filename) > 14) THEN
  182.       filename[0] := #14;
  183.    GotoXY(18,1);
  184.    WRITE(filename);
  185.    GotoXY(1,11)
  186. END;
  187.  
  188.  
  189. PROCEDURE Z_ShowSize(l: LONGINT);
  190. BEGIN
  191.    GotoXY(18,2);
  192.    WRITE(ItoS(l,14));
  193.    IF (l MOD 128 <> 0) THEN
  194.       l := (l DIV 128) + 1
  195.    ELSE
  196.       l := (l DIV 128);
  197.    GotoXY(18,3);
  198.    WRITE(ItoS(l,14));
  199.    GotoXY(1,11);
  200. END;
  201.  
  202.  
  203. PROCEDURE Z_ShowCheck(is32: BOOLEAN);
  204. BEGIN
  205.    GotoXY(18,4);
  206.    IF (is32) THEN
  207.       WRITE('CRC32')
  208.    ELSE
  209.       WRITE('CRC16');
  210.    GotoXY(1,11)
  211. END;
  212.  
  213. PROCEDURE Z_ShowTransferTime(fsize, zbaud: LONGINT);
  214. VAR
  215.    bits: REAL;
  216. BEGIN
  217.    bits := fsize * 10.0;
  218.    GotoXY(18,5);
  219.    IF (bits <> 0.0) THEN
  220.       WRITE(RtoS(((bits / zbaud) / 60),10,2),'min.')
  221.    ELSE
  222.       WRITE('0min.');
  223.    GotoXY(1,11)
  224. END;
  225.  
  226.  
  227. PROCEDURE Z_Message(s: STRING);
  228. BEGIN
  229.    IF (Length(s) > 31) THEN
  230.       s[0] := #31;
  231.    GotoXY(1,11);
  232.    WRITE(s,#13)
  233. END;
  234.  
  235. PROCEDURE Z_Frame(n: INTEGER);
  236. VAR Num : Byte;
  237. BEGIN
  238.    IF (n < -3) OR (n > 20) THEN
  239.       n := 20;
  240.    GotoXY(18,9);
  241.    Num := Lo(n);
  242.    if Num = -3
  243.       then WRITE('ZNOCARRIER')
  244.       else if Num = -2
  245.               then WRITE('ZTIMEOUT  ')
  246.               else if Num = -1
  247.                       then  WRITE('ZERROR    ')
  248.                       else
  249.    CASE Lo(n) OF
  250.       0  : WRITE('ZRQINIT   ');
  251.       1  : WRITE('ZRINIT    ');
  252.       2  : WRITE('ZSINIT    ');
  253.       3  : WRITE('ZACK      ');
  254.       4  : WRITE('ZFILE     ');
  255.       5  : WRITE('ZSKIP     ');
  256.       6  : WRITE('ZNAK      ');
  257.       7  : WRITE('ZABORT    ');
  258.       8  : WRITE('ZFIN      ');
  259.       9  : WRITE('ZRPOS     ');
  260.       10 : WRITE('ZDATA     ');
  261.       11 : WRITE('ZEOF      ');
  262.       12 : WRITE('ZFERR     ');
  263.       13 : WRITE('ZCRC      ');
  264.       14 : WRITE('ZCHALLENGE');
  265.       15 : WRITE('ZCOMPL    ');
  266.       16 : WRITE('ZCAN      ');
  267.       17 : WRITE('ZFREECNT  ');
  268.       18 : WRITE('ZCOMMAND  ');
  269.       19 : WRITE('ZSTDERR   ');
  270.       20 : WRITE('ZUNKNOWN  ')
  271.    END;
  272.    GotoXY(1,11)
  273. END;
  274.  
  275. PROCEDURE Z_ShowLoc(l: LONGINT);
  276. BEGIN
  277.    GotoXY(18,6);
  278.    WRITE(ItoS(l,14));
  279.    IF (l MOD 128 <> 0) THEN
  280.       l := (l DIV 128) + 1
  281.    ELSE
  282.       l := (l DIV 128);
  283.    GotoXY(18,7);
  284.    WRITE(ItoS(l,14));
  285.    GotoXY(1,11)
  286. END;
  287.  
  288. PROCEDURE Z_Errors(w: WORD);
  289. BEGIN
  290.    GotoXY(18,8);
  291.    WRITE(ItoS(w,14));
  292.    GotoXY(1,11)
  293. END;
  294.  
  295. END.