home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / TP-Z / TPZVIDEO.PAS < prev   
Pascal/Delphi Source File  |  1988-09-18  |  6KB  |  288 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 = LightGray;
  37.    back: BYTE = Black;
  38.    bfore: BYTE = Black;
  39.    bback: BYTE = Green;
  40.  
  41. {$F+}
  42. {$L \pascal\screen\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.    WRITE(title);
  152.    TextColor(White);
  153.    TextBackground(back)
  154. END;
  155.  
  156.  
  157.  
  158. PROCEDURE Z_CloseWindow;
  159. VAR
  160.    p, q: POINTER;
  161.    n: WORD;
  162. BEGIN
  163.    TextAttr := oldattr;
  164.    WindMax := oldmax;
  165.    WindMin := oldmin;
  166.    GotoXY(oldx,oldy);
  167.    q := buffer;
  168.    p := Ptr(vseg,vofs);
  169.    FOR n := 1 TO rows DO
  170.    BEGIN
  171.       MoveToScreen(q^,p^,cols * 2);
  172.       Inc(LONGINT(p),vcols * 2);
  173.       Inc(LONGINT(q),cols * 2)
  174.    END;
  175.    FreeMem(buffer,size)
  176. END;
  177.  
  178. PROCEDURE Z_ShowName(filename: STRING);
  179. BEGIN
  180.    IF (Length(filename) > 14) THEN
  181.       filename[0] := #14;
  182.    GotoXY(18,1);
  183.    WRITE(filename);
  184.    GotoXY(1,11)
  185. END;
  186.  
  187.  
  188. PROCEDURE Z_ShowSize(l: LONGINT);
  189. BEGIN
  190.    GotoXY(18,2);
  191.    WRITE(ItoS(l,14));
  192.    IF (l MOD 128 <> 0) THEN
  193.       l := (l DIV 128) + 1
  194.    ELSE
  195.       l := (l DIV 128);
  196.    GotoXY(18,3);
  197.    WRITE(ItoS(l,14));
  198.    GotoXY(1,11);
  199. END;
  200.  
  201.  
  202. PROCEDURE Z_ShowCheck(is32: BOOLEAN);
  203. BEGIN
  204.    GotoXY(18,4);
  205.    IF (is32) THEN
  206.       WRITE('CRC32')
  207.    ELSE
  208.       WRITE('CRC16');
  209.    GotoXY(1,11)
  210. END;
  211.  
  212. PROCEDURE Z_ShowTransferTime(fsize, zbaud: LONGINT);
  213. VAR
  214.    bits: REAL;
  215. BEGIN
  216.    bits := fsize * 10.0;
  217.    GotoXY(18,5);
  218.    IF (bits <> 0.0) THEN
  219.       WRITE(RtoS(((bits / zbaud) / 60),10,2),'min.')
  220.    ELSE
  221.       WRITE('0min.');
  222.    GotoXY(1,11)
  223. END;
  224.  
  225.  
  226. PROCEDURE Z_Message(s: STRING);
  227. BEGIN
  228.    IF (Length(s) > 31) THEN
  229.       s[0] := #31;
  230.    GotoXY(1,11);
  231.    WRITE(s,#13)
  232. END;
  233.  
  234. PROCEDURE Z_Frame(n: INTEGER);
  235. BEGIN
  236.    IF (n < -3) OR (n > 20) THEN
  237.       n := 20;
  238.    GotoXY(18,9);
  239.    CASE Lo(n) OF
  240.       -3 : WRITE('ZNOCARRIER');
  241.       -2 : WRITE('ZTIMEOUT  ');
  242.       -1 : WRITE('ZERROR    ');
  243.       0  : WRITE('ZRQINIT   ');
  244.       1  : WRITE('ZRINIT    ');
  245.       2  : WRITE('ZSINIT    ');
  246.       3  : WRITE('ZACK      ');
  247.       4  : WRITE('ZFILE     ');
  248.       5  : WRITE('ZSKIP     ');
  249.       6  : WRITE('ZNAK      ');
  250.       7  : WRITE('ZABORT    ');
  251.       8  : WRITE('ZFIN      ');
  252.       9  : WRITE('ZRPOS     ');
  253.       10 : WRITE('ZDATA     ');
  254.       11 : WRITE('ZEOF      ');
  255.       12 : WRITE('ZFERR     ');
  256.       13 : WRITE('ZCRC      ');
  257.       14 : WRITE('ZCHALLENGE');
  258.       15 : WRITE('ZCOMPL    ');
  259.       16 : WRITE('ZCAN      ');
  260.       17 : WRITE('ZFREECNT  ');
  261.       18 : WRITE('ZCOMMAND  ');
  262.       19 : WRITE('ZSTDERR   ');
  263.       20 : WRITE('ZUNKNOWN  ')
  264.    END;
  265.    GotoXY(1,11)
  266. END;
  267.  
  268. PROCEDURE Z_ShowLoc(l: LONGINT);
  269. BEGIN
  270.    GotoXY(18,6);
  271.    WRITE(ItoS(l,14));
  272.    IF (l MOD 128 <> 0) THEN
  273.       l := (l DIV 128) + 1
  274.    ELSE
  275.       l := (l DIV 128);
  276.    GotoXY(18,7);
  277.    WRITE(ItoS(l,14));
  278.    GotoXY(1,11)
  279. END;
  280.  
  281. PROCEDURE Z_Errors(w: WORD);
  282. BEGIN
  283.    GotoXY(18,8);
  284.    WRITE(ItoS(w,14));
  285.    GotoXY(1,11)
  286. END;
  287.  
  288. END.