home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1
/
HamRadio.cdr
/
misc
/
hmgrm102
/
hamgram.pas
< prev
Wrap
Pascal/Delphi Source File
|
1989-08-31
|
29KB
|
845 lines
{ **************************************************************************
* *
* HAMGRAM - A message generator for standard ARRL NTS Traffic *
* Uses dBase compatible file structures for storing all *
* elements of the message. Automatically creates a plain *
* text message with the proper preamble. Word count in *
* the text of the message is generated by the program. *
* *
* Includes ON-LINE help and PICK-MENUS for certain data *
* elements. *
* *
* This program uses UNITS from TOPAZ a product sold by *
* The Research Group *
* 100 Valley Drive *
* Brisbane, CA 94005 *
* (800) HOTWARE *
* *
* Author W1HKJ Dave Freese *
* 29 N. Ravenwood Drive *
* Cape May Court House, NJ 08210 *
* (609)624-0076 *
* *
* THIS PROGRAM IS PUBLIC DOMAIN SOFTWARE, USE AND DISTRIBUTE FREELY *
* IF YOU MODIFY THE SOURCE CODE PLEASE DO NOT DISTRIBUTE UNDER THE *
* NAME 'HAMGRAM'. *
* *
* Version 1.02 1 September 1989 corrected word count problem *
* increased STATION size to 10 *
* deleted HX in text output if not *
* specified in data base *
************************************************************************** }
PROGRAM AmateurRadioGram;
USES CRT,DBF4,SAYGET4,BROWSE4,PICK,VIDPOP,TIMEDATE;
CONST Version = '1.02';
TYPE
HamGram_record = RECORD
Deleted : Boolean;
_MSG_NBR : String[ 4];
_PRECEDENCE : String[ 1];
_HANDLING : String[ 1];
_HANDL_EXT : String[ 5];
_STATION : String[10];
_ORIGIN : String[15];
_FILE_TIME : String[ 4];
_FILE_MONTH : String[ 3];
_FILE_DAY : String[ 2];
_ADDRESSEE : String[25];
_ADDR1 : String[25];
_ADDR2 : String[25];
_CITY : String[25];
_STATE : String[ 2];
_ZIP : String[ 5];
_PHONE : String[13];
_TEXT_1 : String[65];
_TEXT_2 : String[65];
_TEXT_3 : String[65];
_SIGN : String[25];
_SIGN_ADR1 : String[25];
_SIGN_ADR2 : String[25];
_SIGN_CITY : String[25];
_SIGN_ST : String[ 2];
_SIGN_ZIP : String[ 5];
_SIGN_PHN : String[13];
END;
VAR
HamGram : HamGram_record;
m_MSG_NBR : String[4];
m_Found : Boolean;
Choice : Char;
AddMode : Boolean;
EditMode : Boolean;
MRecNo : LongInt;
OurWorkArea : Byte;
BrowseFields : String[100];
dBaseFile : String[64];
Extension : String[3];
WordCount : integer;
OldColors : Byte;
VidBuffer : array[1..4000] of byte;
VidX, VidY : byte;
PROCEDURE SayGetColors;
begin
Set_Color_To(Yellow,Blue,Red,LightGray);
end;
PROCEDURE SaveEntryScreen;
begin
Writeln('HAMGRAM version ',version,' Public Domain Software');
Writeln(' by W1HKJ Dave Freese');
Writeln(' 29 N. Ravenwood Drive');
Writeln(' Cape May Court House, NJ 08210');
Writeln(' (609) 624 0076');
FillPage(@VidBuffer);
VidX := WhereX;
VidY := WhereY;
OldColors := TextAttr;
end;
PROCEDURE RestoreEntryScreen;
begin
DisplayPage(@VidBuffer);
GotoXY(VidX,VidY);
TextAttr := OldColors;
end;
{$F+} PROCEDURE AutoHelp;
begin
ClearEOL(10,24);
case SGFieldCode of
1 : AT(10,24,'Enter message number');
2 : AT(10,24,'Precedence : Routine, Priority, Welfare, Emergency');
3 : AT(10,24,'Handling Instructions: A, B, C, D, E, F, G <F10> for list');
4 : AT(10,24,'Extension required for A, B, and F handling instructions');
5 : AT(10,24,'Originating station');
6 : AT(10,24,'Place of origin ie: Cape May NJ');
7 : AT(10,24,'File time ... <F10> for system time');
8 : AT(10,24,'File month');
9 : AT(10,24,'File day 1..31');
10: AT(10,24,'Addressee name');
11: AT(10,24,'Addressee address #1');
12: AT(10,24,'Addressee address #2');
13: AT(10,24,'Addressee city');
14: AT(10,24,'Addressee State <F10> for list');
15: AT(10,24,'Addressee Zip Code');
16: AT(10,24,'Addressee phone number');
17: AT(10,24,'HamGram line #1');
18: AT(10,24,'HamGram line #2');
19: AT(10,24,'HamGram line #3');
20: AT(10,24,'Sendee name');
21: AT(10,24,'Sendee address #1');
22: AT(10,24,'Sendee address #2');
23: AT(10,24,'Sendee city');
24: AT(10,24,'Sendee State <F10> for list');
25: AT(10,24,'Sendee Zip Code');
26: AT(10,24,'Sendee phone number');
end;
end;
{$F-}
{$F+} FUNCTION StateName(Var n : integer): String;
begin
case n of
1 : StateName := 'Alabama';
2 : StateName := 'Alaska';
3 : StateName := 'Arizona';
4 : StateName := 'Arkansas';
5 : StateName := 'California';
6 : StateName := 'Colorado';
7 : StateName := 'Connecticut';
8 : StateName := 'Delaware';
9 : StateName := 'Dist. of Col.';
10 : StateName := 'Florida';
11 : StateName := 'Georgia';
12 : StateName := 'Hawaii';
13 : StateName := 'Idaho';
14 : StateName := 'Illinois';
15 : StateName := 'Indiania';
16 : StateName := 'Iowa';
17 : StateName := 'Kansas';
18 : StateName := 'Kentucky';
19 : StateName := 'Louisiana';
20 : StateName := 'Maine';
21 : StateName := 'Maryland';
22 : StateName := 'Mass.';
23 : StateName := 'Michigan';
24 : StateName := 'Minnesota';
25 : StateName := 'Mississippi';
26 : StateName := 'Missouri';
27 : StateName := 'Montana';
28 : StateName := 'Nebraska';
29 : StateName := 'Nevada';
30 : StateName := 'New Hampshire';
31 : StateName := 'New Jersey';
32 : StateName := 'New Mexico';
33 : StateName := 'New York';
34 : StateName := 'North Carolina';
35 : StateName := 'North Dakota';
36 : StateName := 'Ohio';
37 : StateName := 'Oklahoma';
38 : StateName := 'Oregon';
39 : StateName := 'Pennsylvania';
40 : StateName := 'Rhode Island';
41 : StateName := 'South Carolina';
42 : StateName := 'South Dakota';
43 : StateName := 'Tennessee';
44 : StateName := 'Texas';
45 : StateName := 'Utah';
46 : StateName := 'Vermont';
47 : StateName := 'Virginia';
48 : StateName := 'Washington';
49 : StateName := 'West Virginia';
50 : StateName := 'Wisconsin';
51 : StateName := 'Wyoming';
52 : StateName := 'Puerto Rico';
end;
end;
{$F-}
{$F+} PROCEDURE StatePickList;
var i : integer;
begin
Set_PickWindow_To(60,4,79,22,2,'Select State');
i := PickList(@StateName,1,51,1);
case i of
0 : ;
1 : SGBuffer^ := 'AL';
2 : SGBuffer^ := 'AK';
3 : SGBuffer^ := 'AZ';
4 : SGBuffer^ := 'AR';
5 : SGBuffer^ := 'CA';
6 : SGBuffer^ := 'CO';
7 : SGBuffer^ := 'CT';
8 : SGBuffer^ := 'DE';
9 : SGBuffer^ := 'DC';
10 : SGBuffer^ := 'FL';
11 : SGBuffer^ := 'GA';
12 : SGBuffer^ := 'HA';
13 : SGBuffer^ := 'ID';
14 : SGBuffer^ := 'IL';
15 : SGBuffer^ := 'IN';
16 : SGBuffer^ := 'IO';
17 : SGBuffer^ := 'KA';
18 : SGBuffer^ := 'KY';
19 : SGBuffer^ := 'LA';
20 : SGBuffer^ := 'ME';
21 : SGBuffer^ := 'MD';
22 : SGBuffer^ := 'MA';
23 : SGBuffer^ := 'MI';
24 : SGBuffer^ := 'MN';
25 : SGBuffer^ := 'MS';
26 : SGBuffer^ := 'MO';
27 : SGBuffer^ := 'MN';
28 : SGBuffer^ := 'NE';
29 : SGBuffer^ := 'NV';
30 : SGBuffer^ := 'NH';
31 : SGBuffer^ := 'NJ';
32 : SGBuffer^ := 'NM';
33 : SGBuffer^ := 'NY';
34 : SGBuffer^ := 'NC';
35 : SGBuffer^ := 'ND';
36 : SGBuffer^ := 'OH';
37 : SGBuffer^ := 'OK';
38 : SGBuffer^ := 'OR';
39 : SGBuffer^ := 'PA';
40 : SGBuffer^ := 'RI';
41 : SGBuffer^ := 'SC';
42 : SGBuffer^ := 'SD';
43 : SGBuffer^ := 'TN';
44 : SGBuffer^ := 'TX';
45 : SGBuffer^ := 'UT';
46 : SGBuffer^ := 'VT';
47 : SGBuffer^ := 'VI';
48 : SGBuffer^ := 'WA';
49 : SGBuffer^ := 'WV';
50 : SGBuffer^ := 'WI';
51 : SGBuffer^ := 'WY';
52 : SGBuffer^ := 'PR';
end;
end;
{$F+} FUNCTION HandlingInst(var n: integer): String;
begin
case n of
1 : HandlingInst := 'A - Collect landline delivery authorized ... miles';
2 : HandlingInst := 'B - Cancel if not delivered with ... hrs of filing';
3 : HandlingInst := 'C - Report date & time of delivery to originator';
4 : HandlingInst := 'D - Report receiver, relay, date, time & method';
5 : HandlingInst := 'E - Get reply & originate message back';
6 : HandlingInst := 'F - Hold delivery until .... date';
7 : HandlingInst := 'G - Delivery by mail or toll not required';
end;
end;
{$F-}
{$F+} PROCEDURE HandlingPickList;
var i : integer;
begin
Set_PickWindow_To(15,10,67,18,2,'Valid Handling Instructions');
i := PickList(@HandlingInst,1,7,1);
case i of
0 : ;
1 : SGBuffer^ := 'A';
2 : SGBuffer^ := 'B';
3 : SGBuffer^ := 'C';
4 : SGBuffer^ := 'D';
5 : SGBuffer^ := 'E';
6 : SGBuffer^ := 'F';
7 : SGBuffer^ := 'G';
end;
end;
{$F-}
{$F+} PROCEDURE EnterSystemTime;
var TimeStr : string[8];
begin
TimeStr := SystemTime;
TimeStr[3] := TimeStr[4];
TimeStr[4] := TimeStr[5];
TimeStr[0] := chr(4);
SGBuffer^ := TimeStr;
end;
{$F-}
{$F+} PROCEDURE F10Help;
begin
case SGFieldCode of
3 : HandlingPickList;
7 : EnterSystemTime;
14, 24 : StatePickList;
end;
end;
{$F-}
{$F+} PROCEDURE CountWords;
var i, wds : integer;
wrdend : boolean;
begin
wds := 0;
with HamGram do
begin
wrdend := TRUE;
for i := 1 to Length(_TEXT_1) do
begin
if (wrdend = TRUE) AND
(_TEXT_1[i] in ['A'..'z','0'..'9']) then
begin
inc(wds);
wrdend := FALSE;
end;
if _TEXT_1[i] = ' ' then
wrdend := TRUE;
end;
wrdend := TRUE;
for i := 1 to Length(_TEXT_2) do
begin
if (wrdend = TRUE) AND
(_TEXT_2[i] in ['A'..'z','0'..'9']) then
begin
inc(wds);
wrdend := FALSE;
end;
if _TEXT_2[i] = ' ' then
wrdend := TRUE;
end;
wrdend := TRUE;
for i := 1 to Length(_TEXT_3) do
begin
if (wrdend = TRUE) AND
(_TEXT_3[i] in ['A'..'z','0'..'9']) then
begin
inc(wds);
wrdend := FALSE;
end;
if _TEXT_3[i] = ' ' then
wrdend := TRUE;
end;
end;
gotoxy(67,21);
WordCount := wds;
write(WordCount:3);
end;
{$F-}
{$F+} PROCEDURE HelpScreen;
{ Displays a list of menu commands when <F1> or "H" is pressed }
VAR ScreenBuffer : Array[1..2000] OF Word;
BEGIN
FillPage(@ScreenBuffer); { save contents of current screen }
Window(5,4,75,23);
Set_Color_To(Black,LightGray,Black,LightGray);
ClrScr;
WriteLn(' Menu Commands');
WriteLn;
WriteLn(' N - Next Skips to and displays next record in file');
WriteLn(' P - Prev Skips back one and displays prior record');
WriteLn(' T - Top Displays first record in file');
WriteLn(' O - Bottom Displays last record in file');
WriteLn(' G - Go Positions database on selected record by number');
WriteLn(' S - Search Allows searching for imbedded string in key field');
WriteLn(' E - Edit Allows modification of currently displayed record');
WriteLn(' A - Add Allows input and appends a new record into database');
WriteLn(' D - Delete Marks or unmarks current record for deletion by Pack');
WriteLn(' B - Browse Spreadsheet-like view of database');
WriteLn(' C - Pack Purges database of all records marked for deletion');
WriteLn(' W - Write Write standard ARRL HamGram Format for this record');
WriteLn(' Q - Quit Quit viewing of database');
WriteLn;
Wait(' Press any key to return...');
Window(1,1,80,25);
DisplayPage(@ScreenBuffer); { restore prior screen }
SayGetColors;
END; { HelpScreen }
{$F-}
{$F+} PROCEDURE EditHelp; { called by SAYGET4.TPU }
{ Displays a help screen when <F1> is pressed while editing }
VAR ScreenBuffer : Array[1..2000] OF Word;
BEGIN
FillPage(@ScreenBuffer); { save contents of current screen }
Set_Color_To(Black,LightGray,Black,LightGray);
Window(5,3,75,23);
ClrScr;
WriteLn(' Editing Commands');
WriteLn;
WriteLn(' <Ctrl-R> or <PgUp> Move to beginning of first field');
WriteLn(' <Ctrl-C> Move to beginning of last field');
WriteLn(' <Ctrl-E> or <Up Arrow> Move to beginning of prior field');
WriteLn(' <Ctrl-X> or <Dn Arrow> Move to beginning of next field');
WriteLn(' <Ctrl-V> or <Ins> Toggle insert/overwrite mode');
WriteLn(' <Ctrl-G> or <Del> Delete character at cursor');
WriteLn(' <Ctrl-T> Delete word to right of cursor ');
WriteLn(' <Ctrl-Y> Delete all characters to right of cursor');
WriteLn(' <Ctrl-U> Restore prior data (Undo)');
WriteLn(' <Ctrl-S> or <Lft Arrow> Move cursor left one character');
WriteLn(' <Ctrl-D> or <Rt Arrow> Move cursor right one character');
WriteLn(' <Ctrl-W> or <PgDn> Exit edit session');
WriteLn(' <Esc> Abandon edit');
WriteLn(' <Home> Move cursor to first character in field');
WriteLn(' <End> Move cursor to last charcter in field');
WriteLn;
Wait(' Press any key to return...');
Window(1,1,80,25);
DisplayPage(@ScreenBuffer); { restore prior screen }
SayGetColors;
END; { EditHelp }
{$F-}
PROCEDURE Search_MSG_NBR;
{ Sequential search of entire file to find m_MSG_NBR in MSG_NBR }
{ Searches faster if no index is active. }
BEGIN
SayGet(1,25,' Enter MSG_NBR to locate: ',m_MSG_NBR,_S,4,0);
Picture('@!');
Set_Repaint_Off; { leave field in reverse video on screen }
ReadGets;
Set_Repaint_On; { restore default setting }
IF EditResult > 0 THEN
BEGIN
ClearEOL(1,25);
Exit;
END;
IF M_MSG_NBR <> '' THEN
BEGIN
MRecNo := RecNo; { save current position }
m_Found := False;
GoTop; { start at top of file (omit as desired) }
REPEAT
IF m_MSG_NBR = HamGram._MSG_NBR THEN
m_Found := True
ELSE Skip(1);
AT(75,25,SInteger(RecNo,0));
UNTIL m_Found OR dEOF;
IF Not m_Found THEN
BEGIN
GO(MRecNo); { re-position file }
ClearEOL(1,25);
Wait(M_MSG_NBR + ' not found. Press any key...');
END;
END;
ClearEOL(1,25);
END; { Search_MSG_NBR }
PROCEDURE WriteStatusLine;
BEGIN
IF AddMode THEN
AT(2,2,'Record # '+SInteger(RecNo+1,4)+' of '+SInteger(RecCount+1,4)+' File: '+DBF+' Last Update: '+LUpdate)
ELSE
AT(2,2,'Record # '+SInteger(RecNo,4)+' of '+SInteger(RecCount,4)+' File: '+DBF+' Last Update: '+LUpdate);
IF dBOF OR dEOF THEN RingBell;
END; { WriteStatusLine }
PROCEDURE HamGramFormat;
begin
At(6, 4,'╔════════════════════════╡ HAMGRAM VER '+Version+' ╞═══════════════════════╗');
At(6, 5,'║ Nbr P Handling Inst OrigSta Place of Origin Time Mon Day ║');
At(6, 6,'╟───────────────────────────────────────────────────────────────────╢');
At(6, 7,'║ HX ║');
At(6, 8,'╠═══════════════════════════════════════════════════════════════════╣');
At(6, 9,'║ To: Phone # ( ) - ║');
At(6,10,'║ ║');
At(6,11,'║ ║');
At(6,12,'║ ║');
At(6,13,'╟───────────────────────────────────────────────────────────────────╢');
At(6,14,'║ ║');
At(6,15,'║ ║');
At(6,16,'║ ║');
At(6,17,'╟───────────────────────────────────────────────────────────────────╢');
At(6,18,'║ From: Phone # ( ) - ║');
At(6,19,'║ ║');
At(6,20,'║ ┌────────────────────╢');
At(6,21,'║ │Word Count : ║');
At(6,22,'╚═══════════════════════════╡ W 1 H K J ╞══════╧════════════════════╝');
end;
PROCEDURE DoGetsWith_HamGram;
BEGIN
ClrScr;
WriteStatusLine;
CountWords;
IF EditMode OR AddMode THEN ClearEOL(1,23);
IF AddMode THEN ClearRecord;
HamGramFormat;
WITH HamGram DO
BEGIN
IF deleted THEN AT(10,3,'DELETED')
ELSE AT(10,3,' ');
Set_FKEY(F10, @F10Help);
SayGet( 8, 7,'', _MSG_NBR, _S, 4, 0);
Set_AutoHelp_To(@AutoHelp);
SayGet(14, 7,'', _PRECEDENCE, _S, 1, 0);
Picture('!');
Set_AutoHelp_To(@AutoHelp);
SayGet(20, 7,'', _HANDLING, _S, 1, 0);
Picture('!');
Set_AutoHelp_To(@AutoHelp);
SayGet(23, 7,'', _HANDL_EXT, _S, 5, 0);
Set_AutoHelp_To(@AutoHelp);
SayGet(30, 7,'', _STATION, _S,10, 0);
Picture('@!');
Set_AutoHelp_To(@AutoHelp);
SayGet(42, 7,'', _ORIGIN, _S, 15, 0);
Set_AutoHelp_To(@AutoHelp);
SayGet(61, 7,'', _FILE_TIME, _S, 4, 0);
Set_AutoHelp_To(@AutoHelp);
SayGet(66, 7,'', _FILE_MONTH, _S, 3, 0);
Picture('@!');
Set_AutoHelp_To(@AutoHelp);
SayGet(70, 7,'', _FILE_DAY, _S, 2, 0);
Set_AutoHelp_To(@AutoHelp);
SayGet(14, 9,'', _ADDRESSEE, _S, 25, 0);
Set_AutoHelp_To(@AutoHelp);
SayGet(14,10,'', _ADDR1, _S, 25, 0);
Set_AutoHelp_To(@AutoHelp);
SayGet(14,11,'', _ADDR2, _S, 25, 0);
Set_AutoHelp_To(@AutoHelp);
SayGet(14,12,'', _CITY, _S, 25, 0);
Set_AutoHelp_To(@AutoHelp);
SayGet(41,12,'', _STATE, _S, 2, 0);
Picture('AA');
Set_AutoHelp_To(@AutoHelp);
SayGet(45,12,'', _ZIP, _S, 5, 0);
Picture('99999');
Set_AutoHelp_To(@AutoHelp);
SayGet(53, 9,'', _PHONE, _S, 13, 0);
Picture('(999)999-9999');
Set_AutoHelp_To(@AutoHelp);
SayGet(8,14,'', _TEXT_1, _S, 65, 0);
Set_AutoHelp_To(@AutoHelp);
SayGet(8,15,'', _TEXT_2, _S, 65, 0);
Set_AutoHelp_To(@AutoHelp);
SayGet(8,16,'', _TEXT_3, _S, 65, 0);
Set_AutoHelp_To(@AutoHelp);
SayGet(14,18,'', _SIGN, _S, 25, 0);
Set_AutoHelp_To(@AutoHelp);
SayGet(14,19,'', _SIGN_ADR1, _S, 25, 0);
Set_AutoHelp_To(@AutoHelp);
SayGet(14,20,'', _SIGN_ADR2, _S, 25, 0);
Set_AutoHelp_To(@AutoHelp);
SayGet(14,21,'', _SIGN_CITY, _S, 25, 0);
Set_AutoHelp_To(@AutoHelp);
SayGet(41,21,'', _SIGN_ST, _S, 2, 0);
Picture('AA');
Set_AutoHelp_To(@AutoHelp);
SayGet(45,21,'', _SIGN_ZIP, _S, 5, 0);
Picture('99999');
Set_AutoHelp_To(@AutoHelp);
SayGet(53,18,'', _SIGN_PHN, _S, 13, 0);
Picture('(999)999-9999');
Set_AutoHelp_To(@AutoHelp);
IF EditMode OR AddMode THEN
BEGIN
ReadGets; { edit the fields defined with SayGet() }
IF EditResult <= 0 THEN
BEGIN
IF AddMode THEN
BEGIN
Append;
AddMode := False;
WriteStatusLine;
END
ELSE Replace;
END
END
ELSE ClearGets; { just display the fields }
END;
CountWords;
ClearEOL(1,24);
END; { DoGetsWith_HamGram }
PROCEDURE MakeFile(NewFile : String);
VAR
DataBase : DbfRecord;
FieldList : FieldArray;
BEGIN
WriteLn('Creating '+NewFile+'...');
FillChar(FieldList,SizeOf(FieldList), 0);
FieldList[1].Name := 'MSG_NBR';
FieldList[1].Typ := 'C';
FieldList[1].Len := 4;
FieldList[2].Name := 'PRECEDENCE';
FieldList[2].Typ := 'C';
FieldList[2].Len := 1;
FieldList[3].Name := 'HANDLING';
FieldList[3].Typ := 'C';
FieldList[3].Len := 1;
FieldList[4].Name := 'HANDL_EXT';
FieldList[4].Typ := 'C';
FieldList[4].Len := 5;
FieldList[5].Name := 'STATION';
FieldList[5].Typ := 'C';
FieldList[5].Len := 10;
FieldList[6].Name := 'ORIGIN';
FieldList[6].Typ := 'C';
FieldList[6].Len := 15;
FieldList[7].Name := 'FILE_TIME';
FieldList[7].Typ := 'C';
FieldList[7].Len := 4;
FieldList[8].Name := 'FILE_MONTH';
FieldList[8].Typ := 'C';
FieldList[8].Len := 3;
FieldList[9].Name := 'FILE_DAY';
FieldList[9].Typ := 'C';
FieldList[9].Len := 2;
FieldList[10].Name := 'ADDRESSEE';
FieldList[10].Typ := 'C';
FieldList[10].Len := 25;
FieldList[11].Name := 'ADDR1';
FieldList[11].Typ := 'C';
FieldList[11].Len := 25;
FieldList[12].Name := 'ADDR2';
FieldList[12].Typ := 'C';
FieldList[12].Len := 25;
FieldList[13].Name := 'CITY';
FieldList[13].Typ := 'C';
FieldList[13].Len := 25;
FieldList[14].Name := 'STATE';
FieldList[14].Typ := 'C';
FieldList[14].Len := 2;
FieldList[15].Name := 'ZIP';
FieldList[15].Typ := 'C';
FieldList[15].Len := 5;
FieldList[16].Name := 'PHONE';
FieldList[16].Typ := 'C';
FieldList[16].Len := 13;
FieldList[17].Name := 'TEXT_1';
FieldList[17].Typ := 'C';
FieldList[17].Len := 65;
FieldList[18].Name := 'TEXT_2';
FieldList[18].Typ := 'C';
FieldList[18].Len := 65;
FieldList[19].Name := 'TEXT_3';
FieldList[19].Typ := 'C';
FieldList[19].Len := 65;
FieldList[20].Name := 'SIGN';
FieldList[20].Typ := 'C';
FieldList[20].Len := 25;
FieldList[21].Name := 'SIGN_ADR1';
FieldList[21].Typ := 'C';
FieldList[21].Len := 25;
FieldList[22].Name := 'SIGN_ADR2';
FieldList[22].Typ := 'C';
FieldList[22].Len := 25;
FieldList[23].Name := 'SIGN_CITY';
FieldList[23].Typ := 'C';
FieldList[23].Len := 25;
FieldList[24].Name := 'SIGN_ST';
FieldList[24].Typ := 'C';
FieldList[24].Len := 2;
FieldList[25].Name := 'SIGN_ZIP';
FieldList[25].Typ := 'C';
FieldList[25].Len := 5;
FieldList[26].Name := 'SIGN_PHN';
FieldList[26].Typ := 'C';
FieldList[26].Len := 13;
CreateDBF(DataBase, NewFile, 26, @FieldList);
END;
PROCEDURE WriteHamGram;
var txt : text;
begin
Assign(txt,'MSG'+TRIM(HamGram._MSG_NBR)+'.'+Extension);
ReWrite(txt);
with HamGram do
begin
write(txt,_MSG_NBR:4,
_PRECEDENCE:2);
if TRIM(_HANDL_EXT) <> '' then
write(txt,' HX', _HANDLING:1);
if TRIM(_HANDL_EXT) <> '' then
write(txt,_HANDL_EXT:6);
writeln(txt,_STATION:11,
WordCount:4,
_ORIGIN:16,
_FILE_TIME:5,
_FILE_MONTH:4,
_FILE_DAY:3);
writeln(txt);
writeln(txt,_ADDRESSEE);
if TRIM(_ADDR1) <> '' then
writeln(txt,_ADDR1);
if TRIM(_ADDR2) <> '' then
writeln(txt,_ADDR2);
if TRIM(_CITY) <> '' then
write(txt,_CITY);
if TRIM(_STATE) <> '' then
write(txt,' ',_STATE);
if TRIM(_ZIP) <> '' then
write(txt,' ',_ZIP);
writeln(txt);
if TRIM(_PHONE) <> '' then
writeln(txt,_PHONE);
writeln(txt);
if TRIM(_TEXT_1) <> '' then
writeln(txt,_TEXT_1);
if TRIM(_TEXT_2) <> '' then
writeln(txt,_TEXT_2);
if TRIM(_TEXT_3) <> '' then
writeln(txt,_TEXT_3);
writeln(txt);
writeln(txt,_SIGN);
if TRIM(_SIGN_ADR1) <> '' then
writeln(txt,_SIGN_ADR1);
if TRIM(_SIGN_ADR2) <> '' then
writeln(txt,_SIGN_ADR2);
if TRIM(_SIGN_CITY) <> '' then
write(txt,_SIGN_CITY);
if TRIM(_SIGN_ST) <> '' then
write(txt,' ',_SIGN_ST);
if TRIM(_SIGN_ZIP) <> '' then
write(txt,' ',_SIGN_ZIP);
writeln(txt);
if TRIM(_SIGN_PHN) <> '' then
writeln(txt,_SIGN_PHN);
close(txt);
end;
end;
PROCEDURE INITIALIZE;
BEGIN
Set_Escape_On; { affects SayGet commands }
Set_Safety_Off; { affects Pack command }
Set_BrowseWindow_TO(15,5,75,19,2,'');
SayGetColors;
ClrScr;
Select(0); { choose first available work area }
OurWorkArea := CurrentArea;
IF NOT FileExists(dBaseFile)
THEN MakeFile(dBaseFile);
USE(dBaseFile, @HamGram, SizeOf(HamGram)); { open the file }
IF RecCount = 0 THEN Append; { don't allow an empty database }
EditMode := False;
AddMode := False;
m_MSG_NBR := '';
END; { Initialize }
BEGIN
SaveEntryScreen;
if ParamCount < 1
then Extension := 'DBF'
else if Length(ParamStr(1)) > 3
then Extension := 'DBF'
else Extension := Upper(ParamStr(1));
dBaseFile := 'HAMGRAM.'+Extension;
Initialize;
Select(OurWorkArea);
Set_FKey(F1,@EditHelp);
ClrScr;
Set_Cursor_Off;
REPEAT
DoGetsWith_HamGram; { display (or edit) the current record }
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');
AT(34,24,'<F1> for HELP');
REPEAT
Choice := ReadKey; { get user request }
IF Choice = CHR(0) THEN { user pressed a special key }
BEGIN
Choice := ReadKey;
Case Choice Of
'P' : Choice := 'N'; { map down-arrow to "Next" }
'H' : Choice := 'P'; { map up-arrow to "Previous" }
';' : Choice := 'H'; { map F1 to "Help" }
ELSE Choice := ' '; { ignore other special keys }
END;
END;
Choice := UpCase(Choice);
UNTIL POS(Choice,'ABCDEGNOPQSTHW') > 0;
EditMode := False;
AddMode := False;
CASE Choice OF
'N' : BEGIN
Skip(1);
IF dEOF THEN GoBottom;
END;
'P' : Skip(-1);
'E' : EditMode := True;
'A' : AddMode := True;
'H' : HelpScreen;
'D' : { toggle the "Deleted" flag }
IF HamGram.Deleted THEN RecallRec ELSE DeleteRec;
'T' : GoTop; { position database at first record }
'O' : GoBottom; { position database at last record }
'B' : BEGIN
Browse(
'FIELDS [MSG_NBR "Nbr", ADDRESSEE "To", SIGN "From"] NOMODIFY');
ClrScr;
END;
'S' : Search_MSG_NBR;
'G' : BEGIN { GO }
MRecNO := 1;
SayGet(1,25,' Enter record number: ',MRecNo,_LI,6,0);
Range('1',SInteger(RecCount,0));
Set_Repaint_Off;
ReadGets;
Set_Repaint_On;
IF EditResult <= 0 THEN GO(MRecNo);
AT(1,25,Space(78));
END;
'C' : BEGIN { Pack }
ClrScr;
WriteLn('Removing deleted records...');
Set_Talk_On;
Pack;
GoTop;
ClrScr;
END;
'W' : WriteHamGram;
END; { Case }
UNTIL choice = 'Q';
Set_Cursor_On;
CloseDatabases;
RestoreEntryScreen;
END.