home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / misc / hmgrm102 / hamgram.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1989-09-01  |  28.2 KB  |  845 lines
  1. { **************************************************************************
  2.   *                                                                        *
  3.   *    HAMGRAM - A message generator for standard ARRL NTS Traffic         *
  4.   *              Uses dBase compatible file structures for storing all     *
  5.   *              elements of the message.  Automatically creates a plain   *
  6.   *              text message with the proper preamble.  Word count in     *
  7.   *              the text of the message is generated by the program.      *
  8.   *                                                                        *
  9.   *              Includes ON-LINE help and PICK-MENUS for certain data     *
  10.   *              elements.                                                 *
  11.   *                                                                        *
  12.   *              This program uses UNITS from TOPAZ a product sold by      *
  13.   *                  The Research Group                                    *
  14.   *                  100 Valley Drive                                      *
  15.   *                  Brisbane, CA 94005                                    *
  16.   *                  (800) HOTWARE                                         *
  17.   *                                                                        *
  18.   *    Author    W1HKJ  Dave Freese                                        *
  19.   *                     29 N. Ravenwood Drive                              *
  20.   *                     Cape May Court House, NJ 08210                     *
  21.   *                     (609)624-0076                                      *
  22.   *                                                                        *
  23.   *    THIS PROGRAM IS PUBLIC DOMAIN SOFTWARE, USE AND DISTRIBUTE FREELY   *
  24.   *    IF YOU MODIFY THE SOURCE CODE PLEASE DO NOT DISTRIBUTE UNDER THE    *
  25.   *    NAME 'HAMGRAM'.                                                     *
  26.   *                                                                        *
  27.   *    Version 1.02    1 September 1989  corrected word count problem      *
  28.   *                                      increased STATION size to 10      *
  29.   *                                      deleted HX in text output if not  *
  30.   *                                      specified in data base            *
  31.   ************************************************************************** }
  32. PROGRAM AmateurRadioGram;
  33.  
  34. USES CRT,DBF4,SAYGET4,BROWSE4,PICK,VIDPOP,TIMEDATE;
  35.  
  36. CONST Version = '1.02';
  37. TYPE
  38.     HamGram_record = RECORD
  39.       Deleted     : Boolean;
  40.       _MSG_NBR    : String[ 4];
  41.       _PRECEDENCE : String[ 1];
  42.       _HANDLING   : String[ 1];
  43.       _HANDL_EXT  : String[ 5];
  44.       _STATION    : String[10];
  45.       _ORIGIN     : String[15];
  46.       _FILE_TIME  : String[ 4];
  47.       _FILE_MONTH : String[ 3];
  48.       _FILE_DAY   : String[ 2];
  49.       _ADDRESSEE  : String[25];
  50.       _ADDR1      : String[25];
  51.       _ADDR2      : String[25];
  52.       _CITY       : String[25];
  53.       _STATE      : String[ 2];
  54.       _ZIP        : String[ 5];
  55.       _PHONE      : String[13];
  56.       _TEXT_1     : String[65];
  57.       _TEXT_2     : String[65];
  58.       _TEXT_3     : String[65];
  59.       _SIGN       : String[25];
  60.       _SIGN_ADR1  : String[25];
  61.       _SIGN_ADR2  : String[25];
  62.       _SIGN_CITY  : String[25];
  63.       _SIGN_ST    : String[ 2];
  64.       _SIGN_ZIP   : String[ 5];
  65.       _SIGN_PHN   : String[13];
  66.     END;
  67.  
  68. VAR
  69.     HamGram : HamGram_record;
  70.     m_MSG_NBR : String[4];
  71.     m_Found : Boolean;
  72.     Choice : Char;
  73.     AddMode : Boolean;
  74.     EditMode : Boolean;
  75.     MRecNo : LongInt;
  76.     OurWorkArea : Byte;
  77.     BrowseFields : String[100];
  78.     dBaseFile : String[64];
  79.     Extension : String[3];
  80.     WordCount : integer;
  81.     OldColors : Byte;
  82.     VidBuffer : array[1..4000] of byte;
  83.     VidX, VidY : byte;
  84.  
  85. PROCEDURE SayGetColors;
  86. begin
  87.   Set_Color_To(Yellow,Blue,Red,LightGray);
  88. end;
  89.  
  90. PROCEDURE SaveEntryScreen;
  91. begin
  92.   Writeln('HAMGRAM version  ',version,'  Public Domain Software');
  93.   Writeln('        by W1HKJ Dave Freese');
  94.   Writeln('                 29 N. Ravenwood Drive');
  95.   Writeln('                 Cape May Court House, NJ  08210');
  96.   Writeln('                 (609) 624 0076');
  97.   FillPage(@VidBuffer);
  98.   VidX := WhereX;
  99.   VidY := WhereY;
  100.   OldColors := TextAttr;
  101. end;
  102.  
  103. PROCEDURE RestoreEntryScreen;
  104. begin
  105.   DisplayPage(@VidBuffer);
  106.   GotoXY(VidX,VidY);
  107.   TextAttr := OldColors;
  108. end;
  109.  
  110. {$F+} PROCEDURE AutoHelp;
  111. begin
  112.   ClearEOL(10,24);
  113.   case SGFieldCode of
  114.        1 : AT(10,24,'Enter message number');
  115.        2 : AT(10,24,'Precedence : Routine, Priority, Welfare, Emergency');
  116.        3 : AT(10,24,'Handling Instructions: A, B, C, D, E, F, G <F10> for list');
  117.        4 : AT(10,24,'Extension required for A, B, and F handling instructions');
  118.        5 : AT(10,24,'Originating station');
  119.        6 : AT(10,24,'Place of origin ie: Cape May NJ');
  120.        7 : AT(10,24,'File time ... <F10> for system time');
  121.        8 : AT(10,24,'File month');
  122.        9 : AT(10,24,'File day  1..31');
  123.        10: AT(10,24,'Addressee name');
  124.        11: AT(10,24,'Addressee address #1');
  125.        12: AT(10,24,'Addressee address #2');
  126.        13: AT(10,24,'Addressee city');
  127.        14: AT(10,24,'Addressee State  <F10> for list');
  128.        15: AT(10,24,'Addressee Zip Code');
  129.        16: AT(10,24,'Addressee phone number');
  130.        17: AT(10,24,'HamGram line #1');
  131.        18: AT(10,24,'HamGram line #2');
  132.        19: AT(10,24,'HamGram line #3');
  133.        20: AT(10,24,'Sendee name');
  134.        21: AT(10,24,'Sendee address #1');
  135.        22: AT(10,24,'Sendee address #2');
  136.        23: AT(10,24,'Sendee city');
  137.        24: AT(10,24,'Sendee State <F10> for list');
  138.        25: AT(10,24,'Sendee Zip Code');
  139.        26: AT(10,24,'Sendee phone number');
  140.    end;
  141. end;
  142. {$F-}
  143.  
  144. {$F+} FUNCTION StateName(Var n : integer): String;
  145. begin
  146.   case n of
  147.     1 : StateName := 'Alabama';
  148.     2 : StateName := 'Alaska';
  149.     3 : StateName := 'Arizona';
  150.     4 : StateName := 'Arkansas';
  151.     5 : StateName := 'California';
  152.     6 : StateName := 'Colorado';
  153.     7 : StateName := 'Connecticut';
  154.     8 : StateName := 'Delaware';
  155.     9 : StateName := 'Dist. of Col.';
  156.    10 : StateName := 'Florida';
  157.    11 : StateName := 'Georgia';
  158.    12 : StateName := 'Hawaii';
  159.    13 : StateName := 'Idaho';
  160.    14 : StateName := 'Illinois';
  161.    15 : StateName := 'Indiania';
  162.    16 : StateName := 'Iowa';
  163.    17 : StateName := 'Kansas';
  164.    18 : StateName := 'Kentucky';
  165.    19 : StateName := 'Louisiana';
  166.    20 : StateName := 'Maine';
  167.    21 : StateName := 'Maryland';
  168.    22 : StateName := 'Mass.';
  169.    23 : StateName := 'Michigan';
  170.    24 : StateName := 'Minnesota';
  171.    25 : StateName := 'Mississippi';
  172.    26 : StateName := 'Missouri';
  173.    27 : StateName := 'Montana';
  174.    28 : StateName := 'Nebraska';
  175.    29 : StateName := 'Nevada';
  176.    30 : StateName := 'New Hampshire';
  177.    31 : StateName := 'New Jersey';
  178.    32 : StateName := 'New Mexico';
  179.    33 : StateName := 'New York';
  180.    34 : StateName := 'North Carolina';
  181.    35 : StateName := 'North Dakota';
  182.    36 : StateName := 'Ohio';
  183.    37 : StateName := 'Oklahoma';
  184.    38 : StateName := 'Oregon';
  185.    39 : StateName := 'Pennsylvania';
  186.    40 : StateName := 'Rhode Island';
  187.    41 : StateName := 'South Carolina';
  188.    42 : StateName := 'South Dakota';
  189.    43 : StateName := 'Tennessee';
  190.    44 : StateName := 'Texas';
  191.    45 : StateName := 'Utah';
  192.    46 : StateName := 'Vermont';
  193.    47 : StateName := 'Virginia';
  194.    48 : StateName := 'Washington';
  195.    49 : StateName := 'West Virginia';
  196.    50 : StateName := 'Wisconsin';
  197.    51 : StateName := 'Wyoming';
  198.    52 : StateName := 'Puerto Rico';
  199.   end;
  200. end;
  201. {$F-}
  202.  
  203. {$F+} PROCEDURE StatePickList;
  204. var i : integer;
  205. begin
  206.   Set_PickWindow_To(60,4,79,22,2,'Select State');
  207.   i := PickList(@StateName,1,51,1);
  208.   case i of
  209.     0 : ;
  210.     1 : SGBuffer^ := 'AL';
  211.     2 : SGBuffer^ := 'AK';
  212.     3 : SGBuffer^ := 'AZ';
  213.     4 : SGBuffer^ := 'AR';
  214.     5 : SGBuffer^ := 'CA';
  215.     6 : SGBuffer^ := 'CO';
  216.     7 : SGBuffer^ := 'CT';
  217.     8 : SGBuffer^ := 'DE';
  218.     9 : SGBuffer^ := 'DC';
  219.    10 : SGBuffer^ := 'FL';
  220.    11 : SGBuffer^ := 'GA';
  221.    12 : SGBuffer^ := 'HA';
  222.    13 : SGBuffer^ := 'ID';
  223.    14 : SGBuffer^ := 'IL';
  224.    15 : SGBuffer^ := 'IN';
  225.    16 : SGBuffer^ := 'IO';
  226.    17 : SGBuffer^ := 'KA';
  227.    18 : SGBuffer^ := 'KY';
  228.    19 : SGBuffer^ := 'LA';
  229.    20 : SGBuffer^ := 'ME';
  230.    21 : SGBuffer^ := 'MD';
  231.    22 : SGBuffer^ := 'MA';
  232.    23 : SGBuffer^ := 'MI';
  233.    24 : SGBuffer^ := 'MN';
  234.    25 : SGBuffer^ := 'MS';
  235.    26 : SGBuffer^ := 'MO';
  236.    27 : SGBuffer^ := 'MN';
  237.    28 : SGBuffer^ := 'NE';
  238.    29 : SGBuffer^ := 'NV';
  239.    30 : SGBuffer^ := 'NH';
  240.    31 : SGBuffer^ := 'NJ';
  241.    32 : SGBuffer^ := 'NM';
  242.    33 : SGBuffer^ := 'NY';
  243.    34 : SGBuffer^ := 'NC';
  244.    35 : SGBuffer^ := 'ND';
  245.    36 : SGBuffer^ := 'OH';
  246.    37 : SGBuffer^ := 'OK';
  247.    38 : SGBuffer^ := 'OR';
  248.    39 : SGBuffer^ := 'PA';
  249.    40 : SGBuffer^ := 'RI';
  250.    41 : SGBuffer^ := 'SC';
  251.    42 : SGBuffer^ := 'SD';
  252.    43 : SGBuffer^ := 'TN';
  253.    44 : SGBuffer^ := 'TX';
  254.    45 : SGBuffer^ := 'UT';
  255.    46 : SGBuffer^ := 'VT';
  256.    47 : SGBuffer^ := 'VI';
  257.    48 : SGBuffer^ := 'WA';
  258.    49 : SGBuffer^ := 'WV';
  259.    50 : SGBuffer^ := 'WI';
  260.    51 : SGBuffer^ := 'WY';
  261.    52 : SGBuffer^ := 'PR';
  262.   end;
  263. end;
  264.  
  265. {$F+} FUNCTION HandlingInst(var n: integer): String;
  266. begin
  267.   case n of
  268.    1 : HandlingInst := 'A - Collect landline delivery authorized ... miles';
  269.    2 : HandlingInst := 'B - Cancel if not delivered with ... hrs of filing';
  270.    3 : HandlingInst := 'C - Report date & time of delivery to originator';
  271.    4 : HandlingInst := 'D - Report receiver, relay, date, time & method';
  272.    5 : HandlingInst := 'E - Get reply & originate message back';
  273.    6 : HandlingInst := 'F - Hold delivery until .... date';
  274.    7 : HandlingInst := 'G - Delivery by mail or toll not required';
  275.   end;
  276. end;
  277. {$F-}
  278.  
  279. {$F+} PROCEDURE HandlingPickList;
  280. var i : integer;
  281. begin
  282.   Set_PickWindow_To(15,10,67,18,2,'Valid Handling Instructions');
  283.   i := PickList(@HandlingInst,1,7,1);
  284.   case i of
  285.     0 : ;
  286.     1 : SGBuffer^ := 'A';
  287.     2 : SGBuffer^ := 'B';
  288.     3 : SGBuffer^ := 'C';
  289.     4 : SGBuffer^ := 'D';
  290.     5 : SGBuffer^ := 'E';
  291.     6 : SGBuffer^ := 'F';
  292.     7 : SGBuffer^ := 'G';
  293.   end;
  294. end;
  295. {$F-}
  296.  
  297. {$F+} PROCEDURE EnterSystemTime;
  298. var TimeStr : string[8];
  299. begin
  300.   TimeStr := SystemTime;
  301.   TimeStr[3] := TimeStr[4];
  302.   TimeStr[4] := TimeStr[5];
  303.   TimeStr[0] := chr(4);
  304.   SGBuffer^ := TimeStr;
  305. end;
  306. {$F-}
  307.  
  308. {$F+} PROCEDURE F10Help;
  309. begin
  310.   case SGFieldCode of
  311.     3 : HandlingPickList;
  312.     7 : EnterSystemTime;
  313.     14, 24 : StatePickList;
  314.   end;
  315. end;
  316. {$F-}
  317.  
  318. {$F+} PROCEDURE CountWords;
  319. var i, wds : integer;
  320.     wrdend : boolean;
  321. begin
  322.   wds := 0;
  323.   with HamGram do
  324.     begin
  325.       wrdend := TRUE;
  326.       for i := 1 to Length(_TEXT_1) do
  327.       begin
  328.         if (wrdend = TRUE) AND
  329.            (_TEXT_1[i] in ['A'..'z','0'..'9']) then
  330.           begin
  331.             inc(wds);
  332.             wrdend := FALSE;
  333.           end;
  334.         if _TEXT_1[i] = ' ' then
  335.             wrdend := TRUE;
  336.       end;
  337.       wrdend := TRUE;
  338.       for i := 1 to Length(_TEXT_2) do
  339.       begin
  340.         if (wrdend = TRUE) AND
  341.            (_TEXT_2[i] in ['A'..'z','0'..'9']) then
  342.           begin
  343.             inc(wds);
  344.             wrdend := FALSE;
  345.           end;
  346.         if _TEXT_2[i] = ' ' then
  347.             wrdend := TRUE;
  348.       end;
  349.       wrdend := TRUE;
  350.       for i := 1 to Length(_TEXT_3) do
  351.       begin
  352.         if (wrdend = TRUE) AND
  353.            (_TEXT_3[i] in ['A'..'z','0'..'9']) then
  354.           begin
  355.             inc(wds);
  356.             wrdend := FALSE;
  357.           end;
  358.         if _TEXT_3[i] = ' ' then
  359.             wrdend := TRUE;
  360.       end;
  361.     end;
  362.   gotoxy(67,21);
  363.   WordCount := wds;
  364.   write(WordCount:3);
  365. end;
  366. {$F-}
  367.  
  368. {$F+} PROCEDURE HelpScreen;
  369. { Displays a list of menu commands when <F1> or "H" is pressed }
  370. VAR ScreenBuffer : Array[1..2000] OF Word;
  371. BEGIN
  372.   FillPage(@ScreenBuffer); { save contents of current screen }
  373.   Window(5,4,75,23);
  374.   Set_Color_To(Black,LightGray,Black,LightGray);
  375.   ClrScr;
  376.   WriteLn('                         Menu Commands');
  377.   WriteLn;
  378.   WriteLn('  N - Next      Skips to and displays next record in file');
  379.   WriteLn('  P - Prev      Skips back one and displays prior record');
  380.   WriteLn('  T - Top       Displays first record in file');
  381.   WriteLn('  O - Bottom    Displays last record in file');
  382.   WriteLn('  G - Go        Positions database on selected record by number');
  383.   WriteLn('  S - Search    Allows searching for imbedded string in key field');
  384.   WriteLn('  E - Edit      Allows modification of currently displayed record');
  385.   WriteLn('  A - Add       Allows input and appends a new record into database');
  386.   WriteLn('  D - Delete    Marks or unmarks current record for deletion by Pack');
  387.   WriteLn('  B - Browse    Spreadsheet-like view of database');
  388.   WriteLn('  C - Pack      Purges database of all records marked for deletion');
  389.   WriteLn('  W - Write     Write standard ARRL HamGram Format for this record');
  390.   WriteLn('  Q - Quit      Quit viewing of database');
  391.   WriteLn;
  392.   Wait('                        Press any key to return...');
  393.   Window(1,1,80,25);
  394.   DisplayPage(@ScreenBuffer); { restore prior screen }
  395.   SayGetColors;
  396. END;   { HelpScreen }
  397. {$F-}
  398.  
  399. {$F+} PROCEDURE EditHelp; { called by SAYGET4.TPU }
  400. { Displays a help screen when <F1> is pressed while editing }
  401. VAR ScreenBuffer : Array[1..2000] OF Word;
  402. BEGIN
  403.   FillPage(@ScreenBuffer); { save contents of current screen }
  404.   Set_Color_To(Black,LightGray,Black,LightGray);
  405.   Window(5,3,75,23);
  406.   ClrScr;
  407.   WriteLn('                          Editing Commands');
  408.   WriteLn;
  409.   WriteLn('      <Ctrl-R> or <PgUp>  Move to beginning of first field');
  410.   WriteLn('      <Ctrl-C>  Move to beginning of last field');
  411.   WriteLn('      <Ctrl-E> or <Up Arrow> Move to beginning of prior field');
  412.   WriteLn('      <Ctrl-X> or <Dn Arrow> Move to beginning of next field');
  413.   WriteLn('      <Ctrl-V> or <Ins>  Toggle insert/overwrite mode');
  414.   WriteLn('      <Ctrl-G> or <Del>  Delete character at cursor');
  415.   WriteLn('      <Ctrl-T>  Delete word to right of cursor ');
  416.   WriteLn('      <Ctrl-Y>  Delete all characters to right of cursor');
  417.   WriteLn('      <Ctrl-U>  Restore prior data (Undo)');
  418.   WriteLn('      <Ctrl-S> or <Lft Arrow> Move cursor left one character');
  419.   WriteLn('      <Ctrl-D> or <Rt Arrow> Move cursor right one character');
  420.   WriteLn('      <Ctrl-W> or <PgDn> Exit edit session');
  421.   WriteLn('      <Esc>     Abandon edit');
  422.   WriteLn('      <Home>    Move cursor to first character in field');
  423.   WriteLn('      <End>     Move cursor to last charcter in field');
  424.   WriteLn;
  425.   Wait('                        Press any key to return...');
  426.   Window(1,1,80,25);
  427.   DisplayPage(@ScreenBuffer); { restore prior screen }
  428.   SayGetColors;
  429. END;   { EditHelp }
  430. {$F-}
  431.  
  432. PROCEDURE Search_MSG_NBR;
  433.  { Sequential search of entire file to find m_MSG_NBR in MSG_NBR }
  434.  { Searches faster if no index is active. }
  435. BEGIN
  436.   SayGet(1,25,' Enter MSG_NBR to locate: ',m_MSG_NBR,_S,4,0);
  437.     Picture('@!');
  438.   Set_Repaint_Off;  { leave field in reverse video on screen }
  439.   ReadGets;
  440.   Set_Repaint_On;   { restore default setting }
  441.   IF EditResult > 0 THEN
  442.     BEGIN
  443.       ClearEOL(1,25);
  444.       Exit;
  445.     END;
  446.   IF M_MSG_NBR <> '' THEN
  447.     BEGIN
  448.       MRecNo := RecNo; { save current position }
  449.       m_Found := False;
  450.       GoTop;            { start at top of file (omit as desired) }
  451.       REPEAT
  452.         IF m_MSG_NBR = HamGram._MSG_NBR THEN
  453.            m_Found := True
  454.         ELSE Skip(1);
  455.         AT(75,25,SInteger(RecNo,0));
  456.       UNTIL m_Found OR dEOF;
  457.       IF Not m_Found THEN
  458.         BEGIN
  459.           GO(MRecNo); { re-position file }
  460.           ClearEOL(1,25);
  461.           Wait(M_MSG_NBR + ' not found.  Press any key...');
  462.         END;
  463.     END;
  464.   ClearEOL(1,25);
  465. END;   { Search_MSG_NBR }
  466.  
  467.  
  468. PROCEDURE WriteStatusLine;
  469. BEGIN
  470.   IF AddMode THEN
  471.   AT(2,2,'Record # '+SInteger(RecNo+1,4)+' of '+SInteger(RecCount+1,4)+'      File: '+DBF+'      Last Update: '+LUpdate)
  472.   ELSE
  473.   AT(2,2,'Record # '+SInteger(RecNo,4)+' of '+SInteger(RecCount,4)+'      File: '+DBF+'      Last Update: '+LUpdate);
  474.   IF dBOF OR dEOF THEN RingBell;
  475. END;   { WriteStatusLine }
  476.  
  477. PROCEDURE HamGramFormat;
  478. begin
  479.   At(6, 4,'╔════════════════════════╡ HAMGRAM VER '+Version+' ╞═══════════════════════╗');
  480.   At(6, 5,'║  Nbr  P  Handling Inst  OrigSta   Place of Origin    Time Mon Day ║');
  481.   At(6, 6,'╟───────────────────────────────────────────────────────────────────╢');
  482.   At(6, 7,'║           HX                                                      ║');
  483.   At(6, 8,'╠═══════════════════════════════════════════════════════════════════╣');
  484.   At(6, 9,'║   To:                                Phone # (   )   -            ║');
  485.   At(6,10,'║                                                                   ║');
  486.   At(6,11,'║                                                                   ║');
  487.   At(6,12,'║                                                                   ║');
  488.   At(6,13,'╟───────────────────────────────────────────────────────────────────╢');
  489.   At(6,14,'║                                                                   ║');
  490.   At(6,15,'║                                                                   ║');
  491.   At(6,16,'║                                                                   ║');
  492.   At(6,17,'╟───────────────────────────────────────────────────────────────────╢');
  493.   At(6,18,'║ From:                                Phone # (   )   -            ║');
  494.   At(6,19,'║                                                                   ║');
  495.   At(6,20,'║                                              ┌────────────────────╢');
  496.   At(6,21,'║                                              │Word Count :        ║');
  497.   At(6,22,'╚═══════════════════════════╡ W 1 H K J ╞══════╧════════════════════╝');
  498. end;
  499.  
  500. PROCEDURE DoGetsWith_HamGram;
  501. BEGIN
  502.   ClrScr;
  503.   WriteStatusLine;
  504.   CountWords;
  505.   IF EditMode OR AddMode THEN ClearEOL(1,23);
  506.   IF AddMode THEN ClearRecord;
  507.   HamGramFormat;
  508.   WITH HamGram DO
  509.     BEGIN
  510.       IF deleted THEN AT(10,3,'DELETED')
  511.       ELSE AT(10,3,'       ');
  512.  
  513.       Set_FKEY(F10, @F10Help);
  514.  
  515.       SayGet( 8, 7,'', _MSG_NBR,    _S, 4, 0);
  516.         Set_AutoHelp_To(@AutoHelp);
  517.       SayGet(14, 7,'', _PRECEDENCE, _S, 1, 0);
  518.         Picture('!');
  519.         Set_AutoHelp_To(@AutoHelp);
  520.       SayGet(20, 7,'', _HANDLING,   _S, 1, 0);
  521.         Picture('!');
  522.         Set_AutoHelp_To(@AutoHelp);
  523.       SayGet(23, 7,'', _HANDL_EXT,  _S, 5, 0);
  524.         Set_AutoHelp_To(@AutoHelp);
  525.       SayGet(30, 7,'', _STATION,    _S,10, 0);
  526.         Picture('@!');
  527.         Set_AutoHelp_To(@AutoHelp);
  528.       SayGet(42, 7,'', _ORIGIN,     _S, 15, 0);
  529.         Set_AutoHelp_To(@AutoHelp);
  530.       SayGet(61, 7,'', _FILE_TIME,  _S, 4, 0);
  531.         Set_AutoHelp_To(@AutoHelp);
  532.       SayGet(66, 7,'', _FILE_MONTH, _S, 3, 0);
  533.         Picture('@!');
  534.         Set_AutoHelp_To(@AutoHelp);
  535.       SayGet(70, 7,'', _FILE_DAY,   _S, 2, 0);
  536.         Set_AutoHelp_To(@AutoHelp);
  537.  
  538.       SayGet(14, 9,'', _ADDRESSEE, _S, 25, 0);
  539.         Set_AutoHelp_To(@AutoHelp);
  540.       SayGet(14,10,'', _ADDR1,     _S, 25, 0);
  541.         Set_AutoHelp_To(@AutoHelp);
  542.       SayGet(14,11,'', _ADDR2,     _S, 25, 0);
  543.         Set_AutoHelp_To(@AutoHelp);
  544.       SayGet(14,12,'', _CITY,      _S, 25, 0);
  545.         Set_AutoHelp_To(@AutoHelp);
  546.       SayGet(41,12,'', _STATE,     _S, 2, 0);
  547.         Picture('AA');
  548.         Set_AutoHelp_To(@AutoHelp);
  549.       SayGet(45,12,'', _ZIP,       _S, 5, 0);
  550.         Picture('99999');
  551.         Set_AutoHelp_To(@AutoHelp);
  552.       SayGet(53, 9,'', _PHONE,     _S, 13, 0);
  553.         Picture('(999)999-9999');
  554.         Set_AutoHelp_To(@AutoHelp);
  555.  
  556.       SayGet(8,14,'', _TEXT_1, _S, 65, 0);
  557.         Set_AutoHelp_To(@AutoHelp);
  558.       SayGet(8,15,'', _TEXT_2, _S, 65, 0);
  559.         Set_AutoHelp_To(@AutoHelp);
  560.       SayGet(8,16,'', _TEXT_3, _S, 65, 0);
  561.         Set_AutoHelp_To(@AutoHelp);
  562.  
  563.       SayGet(14,18,'', _SIGN,      _S, 25, 0);
  564.         Set_AutoHelp_To(@AutoHelp);
  565.       SayGet(14,19,'', _SIGN_ADR1, _S, 25, 0);
  566.         Set_AutoHelp_To(@AutoHelp);
  567.       SayGet(14,20,'', _SIGN_ADR2, _S, 25, 0);
  568.         Set_AutoHelp_To(@AutoHelp);
  569.       SayGet(14,21,'', _SIGN_CITY, _S, 25, 0);
  570.         Set_AutoHelp_To(@AutoHelp);
  571.       SayGet(41,21,'', _SIGN_ST,   _S, 2, 0);
  572.         Picture('AA');
  573.         Set_AutoHelp_To(@AutoHelp);
  574.       SayGet(45,21,'', _SIGN_ZIP,  _S, 5, 0);
  575.         Picture('99999');
  576.         Set_AutoHelp_To(@AutoHelp);
  577.       SayGet(53,18,'', _SIGN_PHN,  _S, 13, 0);
  578.         Picture('(999)999-9999');
  579.         Set_AutoHelp_To(@AutoHelp);
  580.  
  581.       IF EditMode OR AddMode THEN
  582.         BEGIN
  583.           ReadGets;  { edit the fields defined with SayGet() }
  584.           IF EditResult <= 0 THEN
  585.             BEGIN
  586.               IF AddMode THEN
  587.                 BEGIN
  588.                   Append;
  589.                   AddMode := False;
  590.                   WriteStatusLine;
  591.                 END
  592.               ELSE Replace;
  593.             END
  594.         END
  595.       ELSE ClearGets; { just display the fields }
  596.     END;
  597.     CountWords;
  598.   ClearEOL(1,24);
  599. END;       { DoGetsWith_HamGram }
  600.  
  601.  
  602. PROCEDURE MakeFile(NewFile : String);
  603. VAR
  604.     DataBase  : DbfRecord;
  605.     FieldList : FieldArray;
  606. BEGIN
  607.   WriteLn('Creating '+NewFile+'...');
  608.   FillChar(FieldList,SizeOf(FieldList), 0);
  609.   FieldList[1].Name := 'MSG_NBR';
  610.   FieldList[1].Typ  := 'C';
  611.   FieldList[1].Len  := 4;
  612.   FieldList[2].Name := 'PRECEDENCE';
  613.   FieldList[2].Typ  := 'C';
  614.   FieldList[2].Len  := 1;
  615.   FieldList[3].Name := 'HANDLING';
  616.   FieldList[3].Typ  := 'C';
  617.   FieldList[3].Len  := 1;
  618.   FieldList[4].Name := 'HANDL_EXT';
  619.   FieldList[4].Typ  := 'C';
  620.   FieldList[4].Len  := 5;
  621.   FieldList[5].Name := 'STATION';
  622.   FieldList[5].Typ  := 'C';
  623.   FieldList[5].Len  := 10;
  624.   FieldList[6].Name := 'ORIGIN';
  625.   FieldList[6].Typ  := 'C';
  626.   FieldList[6].Len  := 15;
  627.   FieldList[7].Name := 'FILE_TIME';
  628.   FieldList[7].Typ  := 'C';
  629.   FieldList[7].Len  := 4;
  630.   FieldList[8].Name := 'FILE_MONTH';
  631.   FieldList[8].Typ  := 'C';
  632.   FieldList[8].Len  := 3;
  633.   FieldList[9].Name := 'FILE_DAY';
  634.   FieldList[9].Typ  := 'C';
  635.   FieldList[9].Len  := 2;
  636.   FieldList[10].Name := 'ADDRESSEE';
  637.   FieldList[10].Typ  := 'C';
  638.   FieldList[10].Len  := 25;
  639.   FieldList[11].Name := 'ADDR1';
  640.   FieldList[11].Typ  := 'C';
  641.   FieldList[11].Len  := 25;
  642.   FieldList[12].Name := 'ADDR2';
  643.   FieldList[12].Typ  := 'C';
  644.   FieldList[12].Len  := 25;
  645.   FieldList[13].Name := 'CITY';
  646.   FieldList[13].Typ  := 'C';
  647.   FieldList[13].Len  := 25;
  648.   FieldList[14].Name := 'STATE';
  649.   FieldList[14].Typ  := 'C';
  650.   FieldList[14].Len  := 2;
  651.   FieldList[15].Name := 'ZIP';
  652.   FieldList[15].Typ  := 'C';
  653.   FieldList[15].Len  := 5;
  654.   FieldList[16].Name := 'PHONE';
  655.   FieldList[16].Typ  := 'C';
  656.   FieldList[16].Len  := 13;
  657.   FieldList[17].Name := 'TEXT_1';
  658.   FieldList[17].Typ  := 'C';
  659.   FieldList[17].Len  := 65;
  660.   FieldList[18].Name := 'TEXT_2';
  661.   FieldList[18].Typ  := 'C';
  662.   FieldList[18].Len  := 65;
  663.   FieldList[19].Name := 'TEXT_3';
  664.   FieldList[19].Typ  := 'C';
  665.   FieldList[19].Len  := 65;
  666.   FieldList[20].Name := 'SIGN';
  667.   FieldList[20].Typ  := 'C';
  668.   FieldList[20].Len  := 25;
  669.   FieldList[21].Name := 'SIGN_ADR1';
  670.   FieldList[21].Typ  := 'C';
  671.   FieldList[21].Len  := 25;
  672.   FieldList[22].Name := 'SIGN_ADR2';
  673.   FieldList[22].Typ  := 'C';
  674.   FieldList[22].Len  := 25;
  675.   FieldList[23].Name := 'SIGN_CITY';
  676.   FieldList[23].Typ  := 'C';
  677.   FieldList[23].Len  := 25;
  678.   FieldList[24].Name := 'SIGN_ST';
  679.   FieldList[24].Typ  := 'C';
  680.   FieldList[24].Len  :=  2;
  681.   FieldList[25].Name := 'SIGN_ZIP';
  682.   FieldList[25].Typ  := 'C';
  683.   FieldList[25].Len  :=  5;
  684.   FieldList[26].Name := 'SIGN_PHN';
  685.   FieldList[26].Typ  := 'C';
  686.   FieldList[26].Len  := 13;
  687.   CreateDBF(DataBase, NewFile, 26, @FieldList);
  688. END;
  689.  
  690. PROCEDURE WriteHamGram;
  691. var txt : text;
  692. begin
  693.   Assign(txt,'MSG'+TRIM(HamGram._MSG_NBR)+'.'+Extension);
  694.   ReWrite(txt);
  695.   with HamGram do
  696.   begin
  697.     write(txt,_MSG_NBR:4,
  698.               _PRECEDENCE:2);
  699.     if TRIM(_HANDL_EXT) <> '' then
  700.       write(txt,' HX', _HANDLING:1);
  701.     if TRIM(_HANDL_EXT) <> '' then
  702.       write(txt,_HANDL_EXT:6);
  703.     writeln(txt,_STATION:11,
  704.                 WordCount:4,
  705.                 _ORIGIN:16,
  706.                 _FILE_TIME:5,
  707.                 _FILE_MONTH:4,
  708.                 _FILE_DAY:3);
  709.     writeln(txt);
  710.     writeln(txt,_ADDRESSEE);
  711.     if TRIM(_ADDR1) <> '' then
  712.       writeln(txt,_ADDR1);
  713.     if TRIM(_ADDR2) <> '' then
  714.       writeln(txt,_ADDR2);
  715.     if TRIM(_CITY) <> '' then
  716.       write(txt,_CITY);
  717.     if TRIM(_STATE) <> '' then
  718.       write(txt,' ',_STATE);
  719.     if TRIM(_ZIP) <> '' then
  720.       write(txt,' ',_ZIP);
  721.     writeln(txt);
  722.     if TRIM(_PHONE) <> '' then
  723.       writeln(txt,_PHONE);
  724.     writeln(txt);
  725.     if TRIM(_TEXT_1) <> '' then
  726.       writeln(txt,_TEXT_1);
  727.     if TRIM(_TEXT_2) <> '' then
  728.       writeln(txt,_TEXT_2);
  729.     if TRIM(_TEXT_3) <> '' then
  730.       writeln(txt,_TEXT_3);
  731.     writeln(txt);
  732.     writeln(txt,_SIGN);
  733.     if TRIM(_SIGN_ADR1) <> '' then
  734.       writeln(txt,_SIGN_ADR1);
  735.     if TRIM(_SIGN_ADR2) <> '' then
  736.       writeln(txt,_SIGN_ADR2);
  737.     if TRIM(_SIGN_CITY) <> '' then
  738.       write(txt,_SIGN_CITY);
  739.     if TRIM(_SIGN_ST) <> '' then
  740.       write(txt,' ',_SIGN_ST);
  741.     if TRIM(_SIGN_ZIP) <> '' then
  742.       write(txt,' ',_SIGN_ZIP);
  743.     writeln(txt);
  744.     if TRIM(_SIGN_PHN) <> '' then
  745.       writeln(txt,_SIGN_PHN);
  746.     close(txt);
  747.   end;
  748. end;
  749.  
  750. PROCEDURE INITIALIZE;
  751. BEGIN
  752.   Set_Escape_On;   { affects SayGet commands }
  753.   Set_Safety_Off;  { affects Pack command }
  754.   Set_BrowseWindow_TO(15,5,75,19,2,'');
  755.   SayGetColors;
  756.   ClrScr;
  757.   Select(0);       { choose first available work area }
  758.   OurWorkArea := CurrentArea;
  759.   IF NOT FileExists(dBaseFile)
  760.      THEN MakeFile(dBaseFile);
  761.   USE(dBaseFile, @HamGram, SizeOf(HamGram)); { open the file }
  762.   IF RecCount = 0 THEN Append; { don't allow an empty database }
  763.   EditMode := False;
  764.   AddMode  := False;
  765.   m_MSG_NBR := '';
  766. END;  { Initialize }
  767.  
  768. BEGIN
  769.   SaveEntryScreen;
  770.   if ParamCount < 1
  771.     then Extension := 'DBF'
  772.     else if Length(ParamStr(1)) > 3
  773.             then Extension := 'DBF'
  774.             else Extension := Upper(ParamStr(1));
  775.   dBaseFile := 'HAMGRAM.'+Extension;
  776.   Initialize;
  777.   Select(OurWorkArea);
  778.   Set_FKey(F1,@EditHelp);
  779.   ClrScr;
  780.   Set_Cursor_Off;
  781.   REPEAT
  782.     DoGetsWith_HamGram;  { display (or edit) the current record }
  783.     AT(3,23,'N)ext P)rev T)op B(O)t G)o S)rch E)dit A)dd D)el B)row Pa(C)k W)rite Q)uit');
  784.     AT(34,24,'<F1> for HELP');
  785.     REPEAT
  786.       Choice := ReadKey;       { get user request }
  787.       IF Choice = CHR(0) THEN  { user pressed a special key }
  788.         BEGIN
  789.           Choice := ReadKey;
  790.           Case Choice Of
  791.             'P' : Choice := 'N';  { map down-arrow to "Next"   }
  792.             'H' : Choice := 'P';  { map up-arrow to "Previous" }
  793.             ';' : Choice := 'H';  { map F1 to "Help" }
  794.             ELSE Choice := ' ';   { ignore other special keys  }
  795.           END;
  796.         END;
  797.       Choice := UpCase(Choice);
  798.     UNTIL POS(Choice,'ABCDEGNOPQSTHW') > 0;
  799.     EditMode := False;
  800.     AddMode  := False;
  801.     CASE Choice OF
  802.       'N' : BEGIN
  803.               Skip(1);
  804.               IF dEOF THEN GoBottom;
  805.             END;
  806.       'P' : Skip(-1);
  807.       'E' : EditMode := True;
  808.       'A' : AddMode  := True;
  809.       'H' : HelpScreen;
  810.       'D' : { toggle the "Deleted" flag }
  811.             IF HamGram.Deleted THEN RecallRec ELSE DeleteRec;
  812.       'T' : GoTop;     { position database at first record }
  813.       'O' : GoBottom;  { position database at last record }
  814.       'B' : BEGIN
  815.               Browse(
  816.                 'FIELDS [MSG_NBR "Nbr", ADDRESSEE "To", SIGN "From"] NOMODIFY');
  817.               ClrScr;
  818.             END;
  819.       'S' : Search_MSG_NBR;
  820.       'G' : BEGIN  { GO }
  821.               MRecNO := 1;
  822.               SayGet(1,25,' Enter record number: ',MRecNo,_LI,6,0);
  823.               Range('1',SInteger(RecCount,0));
  824.               Set_Repaint_Off;
  825.               ReadGets;
  826.               Set_Repaint_On;
  827.               IF EditResult <= 0 THEN GO(MRecNo);
  828.               AT(1,25,Space(78));
  829.              END;
  830.       'C' : BEGIN  { Pack }
  831.               ClrScr;
  832.               WriteLn('Removing deleted records...');
  833.               Set_Talk_On;
  834.               Pack;
  835.               GoTop;
  836.               ClrScr;
  837.              END;
  838.       'W' : WriteHamGram;
  839.     END; { Case }
  840.   UNTIL choice = 'Q';
  841.   Set_Cursor_On;
  842.   CloseDatabases;
  843.   RestoreEntryScreen;
  844. END.
  845.