home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / cw / kamrtty / makimage.pas < prev    next >
Pascal/Delphi Source File  |  1988-03-31  |  3KB  |  156 lines
  1. program makehelp;
  2. uses crt,dos;
  3.  
  4. const version = '4.00';
  5.  
  6. type attribute = shortint;
  7.      screen = array[0..1999] of record
  8.                                   c : char;
  9.                                   a : attribute;
  10.                                 end;
  11.  
  12. var  help_scr, param_scr, Q_scr, rst_scr : screen;
  13.      monovideo : screen absolute $0B000:$0000;
  14.      colorvideo : screen absolute $0B800:$0000;
  15.      helpfile : file of screen;
  16.      key : char;
  17.      vid_type : shortint;
  18.  
  19. procedure check_video;
  20. var regs : registers;
  21. begin
  22.   regs.AX := $0F00;
  23.   Intr($10, regs);
  24.   case regs.AL of
  25.     2,3 : vid_type := 1;
  26.       7 : vid_type := 0;
  27.   end;
  28. end;
  29.  
  30. procedure read_screen1;
  31. var  scrntext : text;
  32.      hlpline : string[80];
  33.      i : integer;
  34. begin
  35.   {$I-}
  36.   textcolor(7);           { bright white }
  37.   textbackground(0);       { black        }
  38.   clrscr;
  39.   assign(scrntext,'HLP-SCRN');
  40.   reset(scrntext);
  41.   if (IOresult = 0) then
  42.   for i := 0 to 23 do
  43.   begin
  44.     readln(scrntext,hlpline);
  45.     if (i = 23) then write(hlpline)
  46.                 else writeln(hlpline);
  47.   end;
  48.   case vid_type of
  49.     0 : help_scr := monovideo;
  50.     1 : help_scr := colorvideo;
  51.   end;
  52.   close(scrntext);
  53. end;
  54.  
  55. procedure read_qsignals;
  56. var  scrntext : text;
  57.      hlpline : string[80];
  58.      i : integer;
  59. begin
  60.   {$I-}
  61.   textcolor(7);           { bright white }
  62.   textbackground(0);       { black        }
  63.   clrscr;
  64.   assign(scrntext,'QSG-SCRN');
  65.   reset(scrntext);
  66.   if (IOresult = 0) then
  67.   for i := 0 to 23 do
  68.   begin
  69.     readln(scrntext,hlpline);
  70.     if (i = 23) then write(hlpline)
  71.                 else writeln(hlpline);
  72.   end;
  73.   case vid_type of
  74.     0 : q_scr := monovideo;
  75.     1 : q_scr := colorvideo;
  76.   end;
  77.   close(scrntext);
  78. end;
  79.  
  80. procedure read_rst;
  81. var  scrntext : text;
  82.      hlpline : string[80];
  83.      i : integer;
  84. begin
  85.   {$I-}
  86.   textcolor(7);           { bright white }
  87.   textbackground(0);       { black        }
  88.   clrscr;
  89.   assign(scrntext,'RST-SCRN');
  90.   reset(scrntext);
  91.   if (IOresult = 0) then
  92.   i := 0;
  93.   while (NOT Eof(scrntext)) do
  94.   begin
  95.     i := i + 1;
  96.     readln(scrntext,hlpline);
  97.     if (i < 24) then
  98.       writeln(hlpline)
  99.     else
  100.       write(hlpline);
  101.   end;
  102.   case vid_type of
  103.     0 : rst_scr := monovideo;
  104.     1 : rst_scr := colorvideo;
  105.   end;
  106.   close(scrntext);
  107. end;
  108.  
  109. procedure read_param;
  110. var  scrntext : text;
  111.      hlpline : string[80];
  112.      i : integer;
  113. begin
  114.   {$I-}
  115.   textcolor(7);           { bright white }
  116.   textbackground(0);       { black        }
  117.   clrscr;
  118.   assign(scrntext,'PRM-SCRN');
  119.   reset(scrntext);
  120.   if (IOresult = 0) then
  121.   for i := 1 to 25 do
  122.   begin
  123.     readln(scrntext,hlpline);
  124.     gotoxy(1,i);
  125.     write(hlpline);
  126.   end;
  127.   case vid_type of
  128.     0 : param_scr := monovideo;
  129.     1 : param_scr := colorvideo;
  130.   end;
  131. end;
  132.  
  133.  
  134. begin
  135.  
  136.   check_video;
  137.   read_screen1;
  138.   read_qsignals;
  139.   read_rst;
  140.   read_param;
  141.   assign(helpfile,'KAM.IMG');
  142.   {$I-}
  143.   rewrite(helpfile);
  144.   if (IOresult = 0) then
  145.   begin
  146.     write(helpfile, help_scr);
  147.     write(helpfile, q_scr);
  148.     write(helpfile, rst_scr);
  149.     write(helpfile, param_scr);
  150.     close(helpfile);
  151.   end;
  152.  
  153. end.
  154.  
  155.  
  156.