home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1
/
HamRadio.cdr
/
cw
/
kam-car
/
kam-log.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-03-02
|
14KB
|
450 lines
TYPE
ROUTELIST = RECORD
Deleted : boolean;
name : string[10];
routing : string[30];
comment : string[30];
END;
TYPE
HAMLOG_record = RECORD
Deleted : Boolean;
_CALLSIGN : String[ 9];
_NAME : String[10];
_DATE : String[10]; { Date field }
_TIME : String[ 5];
_FREQ : Real; { width= 10 decimals= 5 }
_POWER : LongInt; { width= 4 }
_MODE : String[ 3];
_RST_OUT : String[ 3];
_RST_IN : String[ 3];
_COMMENT : String[30];
_QSL_SENT : String[10]; { Date field }
_QSL_RCVD : String[10]; { Date field }
END;
IndxTyp = (CALLSIGN,DATETIME);
VAR
HAMLOG : HAMLOG_record;
CallList : ROUTELIST;
m_CALLSIGN : String;
FilterValue : String;
m_Found : Boolean;
Choice : Char;
AddMode : Boolean;
EditMode : Boolean;
MRecNo : LongInt;
IndexOn : IndxTyp;
PROCEDURE SayGetColors;
begin
Set_Color_To(14,1,4,7);
Set_Highlight_To(7,4);
end;
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(' F - Find Finds the first record with matching 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(' I - Index Toggle CALLSIGN Index On/Off');
WriteLn(' Q - Quit Quit viewing of database');
WriteLn;
Wait(' Press any key to return...');
full_window;
DisplayPage(@ScreenBuffer); { restore prior screen }
SayGetColors;
END; { HelpScreen }
{$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...');
full_window;
DisplayPage(@ScreenBuffer); { restore prior screen }
SayGetColors;
END; { EditHelp }
{$F-}
{$F+}
FUNCTION CallKey : String; { called by INDEX4.TPU }
BEGIN
CallKey := Upper(HAMLOG._CALLSIGN);
END; { CallKey }
FUNCTION DateTimeKey : String;
BEGIN
WITH HAMLOG do
DateTimeKey := _DATE[7] + _DATE[8] +
_DATE[1] + _DATE[2] +
_DATE[4] + _DATE[5] + _TIME;
END;
{$F-}
PROCEDURE Find_CALLSIGN; { Direct access via index }
BEGIN
SayGet(20,25,' Enter CALLSIGN : ',m_CALLSIGN,_S,9,1);
Picture('@!');
ReadGets;
AT(20,25,'═════════════════════════════════════════════');
IF EditResult > 0 THEN Exit;
IF Length(M_CALLSIGN) > 0 THEN
BEGIN
if IndexOn = DATETIME then Set_Order_To(2);
Find(m_CALLSIGN);
IF NOT Found THEN
BEGIN
GoToXY(20,25);
Wait(' ' + m_CALLSIGN + ' not found. Press any key... ');
AT(20,25,'═════════════════════════════════════════════');
GoBottom;
END;
END;
if IndexOn = DATETIME then Set_Order_To(1);
END; { Find_CALLSIGN }
PROCEDURE HamForm;
begin
AT(1,15,'╔╣Index [ callsign ] ╠═════════════════════════════════════════════════════════╗');
AT(1,16,'║Record # of File Last Update : ║');
AT(1,17,'╠════════════════════╤═════════════════════╤═════════════════╤═════════════════╣');
AT(1,18,'║Callsign │Name │Date │Time ║');
AT(1,19,'╟────────────────────┼───────────┬─────────┼─────────────────┼─────────────────╢');
AT(1,20,'║Freq │Power │Mode │RSTout │RSTin ║');
AT(1,21,'╟────────────────────┴───────────┴─────────┼─────────────────┼─────────────────╢');
AT(1,22,'║Comment │QSLsent │QSLrcvd ║');
AT(1,23,'╠══════════════════════════════════════════╧═════════════════╧═════════════════╣');
AT(1,24,'║Next Prev Top bOttom Go Find Edit Add Del Browse paCk Index Quit ║');
AT(1,25,'╚╣<F1> = Help╠═════════════════════════════════════════════════════════════════╝');
AT(37,16,DBF);
AT(69,16,LUpdate);
end;
PROCEDURE DoGetsWith_HAMLOG;
BEGIN
WITH HAMLOG DO
BEGIN
IF AddMode THEN
BEGIN
ClearRecord;
_DATE := SystemDate;
_TIME := SystemTime;
AT(11,16,SInteger(RecCount+1,4));
AT(21,16,SInteger(RecCount+1,4));
END
ELSE
BEGIN
AT(11,16,SInteger(RecNo,4));
AT(21,16,SInteger(RecCount,4));
END;
IF dBOF OR dEOF THEN RingBell;
SayGet(12,18, '', _CALLSIGN, _S, 9, 0);
Picture('@!');
SayGet(29,18, '', _NAME, _S, 10, 0);
SayGet(51,18, '', _DATE, _D, 8, 0);
SayGet(68,18, '', _TIME, _S, 5, 0);
Picture('99:99');
SayGet( 8,20, '', _FREQ, _R, 10, 5);
SayGet(29,20, '', _POWER, _LI, 4, 0);
SayGet(40,20, '', _MODE, _S, 3, 0);
Picture('@!');
SayGet(52,20, '', _RST_OUT, _S, 3, 0);
SayGet(69,20, '', _RST_IN, _S, 3, 0);
SayGet(12,22, '', _COMMENT, _S, 30, 0);
SayGet(53,22, '', _QSL_SENT, _D, 8, 0);
SayGet(71,22, '', _QSL_RCVD, _D, 8, 0);
IF deleted THEN AT(65,25,'╣ DELETED ╠')
ELSE AT(65,25,'═══════════');
IF EditMode OR AddMode THEN
BEGIN
ReadGets; { edit the fields defined with SayGet() }
IF EditResult <= 0 THEN
IF AddMode
THEN Append
ELSE Replace;
END
ELSE ClearGets; { just display the fields }
END;
END; { DoGetsWith_HAMLOG }
procedure makedatabase;
var FieldList : FieldArray;
database : dbfRECORD;
begin
FillChar(FieldList,SizeOf(FieldList), 0);
FieldList[1].Name := 'CALLSIGN'; { field Name }
FieldList[1].Typ := 'C'; { field Type }
FieldList[1].Len := 9; { field Width }
FieldList[2].Name := 'NAME';
FieldList[2].Typ := 'C';
FieldList[2].Len := 10;
FieldList[3].Name := 'DATE';
FieldList[3].Typ := 'D';
FieldList[4].Name := 'TIME';
FieldList[4].Typ := 'C';
FieldList[4].Len := 5;
FieldList[5].Name := 'FREQ';
FieldList[5].Typ := 'N';
FieldList[5].Len := 10;
FieldList[5].Dec := 5;
FieldList[6].Name := 'POWER';
FieldList[6].Typ := 'N';
FieldList[6].Len := 4;
FieldList[7].Name := 'MODE';
FieldList[7].Typ := 'C';
FieldList[7].Len := 3;
FieldList[8].Name := 'RST_OUT';
FieldList[8].Typ := 'C';
FieldList[8].Len := 3;
FieldList[9].Name := 'RST_IN';
FieldList[9].Typ := 'C';
FieldList[9].Len := 3;
FieldList[10].Name := 'COMMENT';
FieldList[10].Typ := 'C';
FieldList[10].Len := 30;
FieldList[11].Name := 'QSL_SENT';
FieldList[11].Typ := 'D';
FieldList[12].Name := 'QSL_RCVD';
FieldList[12].Typ := 'D';
CreateDBF(database,kam_log_file+'.DBF',12,@FieldList);
USE(kam_log_file+'.DBF', @HAMLOG, SizeOf(HAMLOG)); { open the file }
ClearRecord;
Append;
end;
procedure MakeCallList;
var FieldList : FieldArray;
database : dbfRECORD;
begin
FillChar(FieldList,SizeOf(FieldList), 0);
FieldList[1].Name := 'NAME'; { field Name }
FieldList[1].Typ := 'C'; { field Type }
FieldList[1].Len := 10; { field Width }
FieldList[2].Name := 'ROUTING';
FieldList[2].Typ := 'C';
FieldList[2].Len := 30;
FieldList[3].Name := 'COMMENT';
FieldList[3].Typ := 'C';
FieldList[3].Len := 30;
CreateDBF(database,'CALLLIST.DBF',3,@FieldList);
USE('CALLLIST.DBF', @CALLLIST, SizeOf(CALLLIST)); { open the file }
ClearRecord;
Append;
end;
PROCEDURE OpenIndexes;
begin
Set_Index_To(@DateTimeKey,kam_log_file+'.DTM',1);
Set_Index_To(@CallKey,kam_log_file+ '.CLL',2);
IndexOn := DATETIME;
Set_Order_To(1);
end;
PROCEDURE MakeIndexes;
begin
WriteLn('Indexing HAMLOG on date/time ...');
Index_On(@DateTimeKey, kam_log_file+'.DTM');
CloseIndexes;
WriteLn('Indexing HAMLOG on callsign ...');
Index_On(@CallKey, kam_log_file+'.CLL');
CloseIndexes;
end;
PROCEDURE InitializeDataBase;
BEGIN
Set_Escape_On; { affects SayGet commands }
Set_Safety_Off; { affects Pack command }
SayGetColors;
Select(1); { choose a work area in which to open the database }
IF NOT FileExists(kam_log_file+'.DBF')
THEN makedatabase
ELSE USE(kam_log_file+'.DBF', @HAMLOG, SizeOf(HAMLOG)); { open the file }
IF NOT FileExists(kam_log_file+'.DTM') THEN
MakeIndexes;
Select(1);
OpenIndexes;
EditMode := False;
AddMode := False;
m_CALLSIGN := '';
Select(2);
If NOT FileExists('CALLLIST.DBF')
then MakeCallList
else USE('CALLLIST.DBF',@CALLLIST,SizeOf(CALLLIST));
END; { Initialization }
procedure ToggleIndex;
begin
case IndexOn of
CALLSIGN : begin
Set_Order_To(1);
IndexOn := DATETIME;
end;
DATETIME : begin
Set_Order_To(2);
IndexOn := CALLSIGN;
end;
end;
end;
procedure HAMLOG_MENU;
var MainScreenBuffer : Array[1..2000] OF Word;
begin
Select(1);
Set_FKey(F1, @EditHelp);
Set_Cursor_Off;
HamForm;
REPEAT
DoGetsWith_HAMLOG; { display (or edit) the current record }
case IndexOn of
CALLSIGN : AT(10,15,' CALLSIGN ');
DATETIME : AT(10,15,' DATETIME ');
end;
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,'NPTOGFEADHBCIQ') > 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 HAMLOG.Deleted THEN RecallRec ELSE DeleteRec;
'T' : GoTop; { position database at first record according to index }
'O' : GoBottom; { position database at last record according to index }
'B' : begin
FillPage(@MainScreenBuffer);
Set_BrowseWindow_To(1,1,80,14,0,'');
Browse('NOMODIFY');
DisplayPage(@MainScreenBuffer);
end;
'F' : Find_CALLSIGN; { user defined }
'G' : BEGIN { GO }
MRecNO := 1;
SayGet(10,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(10,25,'═════════════════════════════');
END;
'C' : BEGIN { Pack }
FillPage(@MainScreenBuffer);
ClrScr;
WriteLn('Removing deleted records...');
Set_Talk_On;
Pack;
MakeIndexes;
OpenIndexes;
GoTop;
DisplayPage(@MainScreenBuffer);
END;
'I' : ToggleIndex;
END; { Case }
UNTIL choice = 'Q';
Set_Cursor_On;
end;
procedure log_qso;
begin
halt_xmt;
save_screen;
HAMLOG_MENU;
restore_screen;
end;
procedure MaintainCallList;
var MainScreenBuffer : Array[1..2000] OF Word;
begin
Select(2);
FillPage(@MainScreenBuffer);
Set_BrowseWindow_To(1,1,80,15,2,'');
Browse('');
DisplayPage(@MainScreenBuffer);
PKCall := CALLLIST.ROUTING;
end;