| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259 |
- MODULE PMIdbms; (* * REPERTOIRE * Release 1.6 * By Charles Bradford and
- Cole Brecheen * (c) Copyright 1985-1991 PMI * Green Bay Wisconsin * All
- rights reserved * (414) 468-6040 * * $Header:
- D:/logfiles/demos/pmidbms.mov 1.3 09 Dec 1990 11:18:22 coleb $ * * A
- program to illustrate use of REPERTOIRE's screen * and NdxFile system.
- This is the advanced example; * programmers new to REPERTOIRE should begin
- with DEMO1. *)
- (*
- IMPORT EMS;
- EMS is part of PMI's EmsStorage, a product separate from
- Repertoire. It allows Repertoire applications automatically
- to use expanded memory. If you don't have it, just comment
- out the IMPORT EMS from any program modules in which it
- appears.*)
- IMPORT BuildLst;
- IMPORT ByteFiddler;
- IMPORT ControlUtils;
- IMPORT DateFunctions;
- IMPORT DirManager;
- IMPORT Drectory;
- IMPORT DspFiles;
- IMPORT EnvironUtils;
- IMPORT ErrorManager;
- IMPORT ErrStrgs;
- IMPORT HandleIO;
- IMPORT FrameManager;
- IMPORT FramePainter;
- IMPORT GenLists;
- IMPORT InitCompilerMods;
- IMPORT InputManager;
- IMPORT KbdInput;
- IMPORT ListUtils;
- IMPORT NdxUtils;
- IMPORT MsgBox2;
- IMPORT NdxBones;
- IMPORT NdxFiles;
- IMPORT NdxTypes;
- IMPORT NumTypes;
- IMPORT PosUtils;
- IMPORT PrtFrame;
- IMPORT Scrn2Ndx;
- IMPORT ScrnTypes;
- IMPORT ScrnUtl1;
- IMPORT ScrnUtl2;
- IMPORT SmartScreen;
- IMPORT StrConv;
- IMPORT StrEdit;
- IMPORT StringIO;
- IMPORT M2Strings;
- IMPORT UserOps;
- IMPORT VEditor;
- IMPORT VWindows;
- IMPORT WindowPrims;
- VAR
- NdxFile: NdxTypes.NdxFileType;
- ScreenFile: ScrnTypes.DisplayFile;
- EntryFrame: ScrnTypes.DisplayFrame;
- NdxFileName, RecName: ARRAY [0..79] OF CHAR;
- dumbool: BOOLEAN;
- PrnHandle, SavedCursorHeight : CARDINAL;
- PROCEDURE PrintMenu();
- VAR
- TmpName: ScrnTypes.AFrameName;
- thestr: ARRAY [0..79] OF CHAR;
- ff: ARRAY [0..0] OF CHAR;
- FormFeeding, dumbool: BOOLEAN;
- TmpList: GenLists.GenList;
- chkey: CARDINAL;
- LeftMargin : INTEGER;
- InvoiceFrame, DialogBox: ScrnTypes.DisplayFrame;
- PROCEDURE WriteInvoice();
- VAR
- NewEd: GenLists.GenList;
- month, day, year, AcctBalance: CARDINAL;
- date, name, tmpstr : ARRAY [0..50] OF CHAR;
- BEGIN
- ControlUtils.ReadInput( EntryFrame, tmpstr, 'ACCTBAL' );
- (* get account balance string from record entry frame *)
- IF NOT StrConv.StrToCardinal(tmpstr, 0, AcctBalance) THEN
- AcctBalance := 0;
- END;
- IF AcctBalance > 0 THEN
- StrEdit.MakeCurrency( '$', tmpstr );
- ControlUtils.ChangeField( InvoiceFrame, tmpstr,
- 'AMTDUE', TRUE );
- ControlUtils.ChangeField( InvoiceFrame, '$0.00',
- 'AMTPAID', TRUE );
- ELSE
- ControlUtils.ChangeField( InvoiceFrame, 'prepaid',
- 'TERMS', TRUE );
- END;
- EnvironUtils.GetDate( month, day, year, name, date );
- (* get the system date *)
- ControlUtils.ChangeField( InvoiceFrame, date, 'DATE', TRUE );
- (*Insert the current date.*)
- ControlUtils.ChangeField( InvoiceFrame, date, 'SHIPDATE', TRUE);
- (* fill in default dates *)
- ControlUtils.ReadInput( EntryFrame, name, 'NAME');
- (* get the name of the customer out of the record entry frame*)
- ScrnUtl2.CopyEdField( EntryFrame, 'ADDRESS',
- InvoiceFrame, 'SOLDTO');
- ScrnUtl2.GetEdField( InvoiceFrame, 'SOLDTO', NewEd );
- GenLists.ListInsert( name, GenLists.StrCode, NewEd, 1);
- (* put name and address in sold to field; notice that
- we don't have to do a PutEdField here because
- ScrnUtl2.GetEdField returns the real list, not a copy of it. *)
- ScrnUtl2.CopyEdField( InvoiceFrame, 'SOLDTO', InvoiceFrame,
- 'SHIPTO');
- FramePainter.ShowDisplayFrame( InvoiceFrame, 0, 0, 0, 0 );
- InputManager.ControlFrame( InvoiceFrame, 0, '', FALSE, TmpName );
- (* now let user change screen if desired *)
- IF NOT PosUtils.Equal( TmpName, InvoiceFrame^.normlnext ) THEN
- RETURN
- END;
- IF AcctBalance > 0 THEN
- PrtFrame.PrintDisplayFrame( InvoiceFrame,
- PrnHandle, LeftMargin );
- StringIO.WriteStr( PrnHandle, 14C);
- (* send a page feed to the printer *)
- END;
- ControlUtils.ChangeField( InvoiceFrame,
- ' This Copy For Your Records.', 'TITLE', FALSE );
- PrtFrame.PrintDisplayFrame( InvoiceFrame,
- PrnHandle, LeftMargin );
- END WriteInvoice;
- BEGIN
- (*PrintMenu*)
- ScrnTypes.InitDisplayFrame( DialogBox, VWindows.CurrentWindow );
- ScrnTypes.InitDisplayFrame( InvoiceFrame, VWindows.CurrentWindow );
- DspFiles.ReadDisplayFrame( ScreenFile, InvoiceFrame, '28' );
- (* now fill screen with input data *)
- PrnHandle := StringIO.StdPrn;
- ff[0] := CHR(12);
- LOOP
- TmpName := 'PrintDialog'; (*The print menu screen.*)
- ControlUtils.ReadShowAndCntrl( ScreenFile, DialogBox, TmpName );
- IF PosUtils.Equal( TmpName, '5' ) THEN
- (* User pressed Cancel or Escape *)
- EXIT;
- END;
- chkey := ScrnUtl1.WhichChoiceKey( DialogBox,
- ScrnUtl1.FieldNum(DialogBox, 'file') );
- CASE CHR(chkey) OF
- 'f':
- HandleIO.OpenForAppending( "PRINTER.TXT", PrnHandle);
- | 'p':
- StringIO.PrintMessage(HandleIO.OpenFile(PrnHandle,'PRN'));
- END;
- FormFeeding := ScrnUtl1.WhichChoiceKey( DialogBox,
- ScrnUtl1.FieldNum(DialogBox, 'ff') ) = ORD('Y');
- ScrnUtl1.GetIntField( DialogBox,
- ScrnUtl1.FieldNum(DialogBox, 'margin'), LeftMargin );
- chkey := ScrnUtl1.WhichChoiceKey( DialogBox,
- ScrnUtl1.FieldNum(DialogBox, 'label') );
- CASE CHR(chkey) OF
- 'A':
- ControlUtils.ReadInput( EntryFrame, thestr, 'NAME');
- StringIO.PrintMessage( HandleIO.FillFile( PrnHandle,
- LeftMargin, ' ' ) );
- StrEdit.CrunchBlanks(thestr);
- StringIO.WriteEol( PrnHandle, thestr );
- IF NOT ScrnUtl1.ListFromEdField(
- EntryFrame,
- ScrnUtl1.FieldNum( EntryFrame, 'ADDRESS' ),
- TmpList ) THEN
- HALT();
- END;
- ListUtils.PrintList( PrnHandle, TmpList, LeftMargin,
- StringIO.CrLf );
- | 'I':
- WriteInvoice();
- | 'T':
- PrtFrame.PrintFrameData( EntryFrame, PrnHandle, LeftMargin );
- END;
- IF FormFeeding THEN
- StringIO.WriteEol( PrnHandle, ff );
- END;
- END;
- StringIO.PrintMessage( HandleIO.CloseHandle( PrnHandle));
- ScrnUtl2.CloseDisplayFrame( InvoiceFrame );
- ScrnUtl2.CloseDisplayFrame( DialogBox );
- END PrintMenu;
- PROCEDURE DoOneRecord( RecName: ARRAY OF CHAR );
- VAR
- KeyHit, month, day, year: CARDINAL;
- DateStr, dumstr: ARRAY [0..15] OF CHAR;
- ch: CHAR;
- NextName: ScrnTypes.AFrameName;
- TmpFrame: ScrnTypes.DisplayFrame;
- BEGIN
- ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow );
- DspFiles.ReadFrame( ScreenFile, EntryFrame, '3' );
- (*Frame 3 is the entry form.*)
- IF NOT Scrn2Ndx.FillScrFast( NdxFile, EntryFrame,
- RecName, '') THEN
- (*FillScr says we're creating a new record, so fill the
- screen with some default values to save the user
- some typing.*)
- ControlUtils.ChangeField( EntryFrame, RecName, 'name', TRUE );
- (*Insert the RecName they've selected.*)
- EnvironUtils.GetDate( month, day, year, dumstr, DateStr );
- ControlUtils.ChangeField( EntryFrame, DateStr, 'date', TRUE );
- (*Insert the current date.*)
- END;
- FramePainter.ShowDisplayFrame( EntryFrame, 0, 0, 0, 0 );
- (*Displays the entry form.*)
- REPEAT
- NextName := '5';
- (*The menu at the top of the screen.*)
- ControlUtils.ReadShowAndCntrl( ScreenFile, TmpFrame, NextName );
- IF PosUtils.Equal( NextName, '2' ) THEN
- (* User pressed Escape *)
- IF EntryFrame^.FrameChanged THEN
- IF MsgBox2.MsgOkay( TmpFrame, VWindows.SE,
- "Changes made will be lost. Please confirm." ) THEN
- ScrnUtl2.CloseDisplayFrame( TmpFrame );
- RETURN;
- ELSE
- ch := 0C;
- NextName := '5';
- END;
- ELSE
- ScrnUtl2.CloseDisplayFrame( TmpFrame );
- RETURN;
- END;
- ELSE
- ch := CAP( ScrnUtl1.SelectedChar( TmpFrame ) );
- END;
- IF ch = 'S' THEN
- (*Store*)
- StrEdit.SetLength( RecName, 0 );
- (*We're using a null record name here to make PutScrFast
- take its record name from the 'name' field in EntryFrame.*)
- EnvironUtils.GetDate( month, day, year, dumstr, DateStr );
- ControlUtils.ChangeField( EntryFrame, DateStr, 'date', TRUE );
- (*Make the date field reflect date of last change.*)
- IF Scrn2Ndx.PutScrFast( NdxFile, EntryFrame,
- RecName, 'name') THEN
- IF NOT NdxFiles.WriteRecord( NdxFile, RecName) THEN
- ControlUtils.RdShwAndCntrlConst( ScreenFile, TmpFrame, '17' );
- (*"Cannot put record in file" message*)
- ELSE
- EntryFrame^.FrameChanged := FALSE;
- ControlUtils.RdShwAndCntrlConst( ScreenFile, TmpFrame, '15' );
- (*"Record successfully added" message*)
- END;
- ELSE
- ControlUtils.RdShwAndCntrlConst( ScreenFile, TmpFrame, '17' );
- END;
- ELSIF ch = 'D' THEN
- (*Delete*)
- ControlUtils.ReadInput( EntryFrame, RecName, 'name');
- IF MsgBox2.MsgOkay( TmpFrame, VWindows.SE,
- "Preparing to delete record. Please confirm." ) THEN
- IF NdxFiles.DeleteRecord( NdxFile, RecName) THEN
- ControlUtils.RdShwAndCntrlConst( ScreenFile, TmpFrame, '14' );
- (* successfully deleted *)
- ELSE
- ControlUtils.RdShwAndCntrlConst( ScreenFile, TmpFrame, '11' );
- (* cannot delete this record *)
- END;
- END;
- ELSIF ch = 'P' THEN
- (* Print *)
- PrintMenu();
- FramePainter.ShowDisplayFrame( EntryFrame, 0, 0, 0, 0 );
- ELSIF ch = 'E' THEN
- (*Edit.*)
- ControlUtils.Control( EntryFrame );
- END;
- UNTIL PosUtils.Equal(NextName, '2');
- (*Frame 2 is the Main Menu *)
- ScrnUtl2.CloseDisplayFrame( TmpFrame );
- END DoOneRecord;
- PROCEDURE ShowAllRecords( TheList: GenLists.GenList );
- VAR
- cnt, lngth, TypeCode: CARDINAL;
- TmpName: NdxTypes.RecNameStr;
- TmpFrame: ScrnTypes.DisplayFrame;
- BEGIN
- ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow );
- ScrnUtl2.ReadAndShow( ScreenFile, TmpFrame, '42' );
- (* changes the line at the bottom that explains the special keys *)
- lngth := GenLists.ListLength( TheList );
- cnt := 1;
- WHILE (cnt <= lngth) DO
- GenLists.GetElmt( TheList, cnt, TmpName, TypeCode );
- DoOneRecord( TmpName );
- INC(cnt);
- END;
- ScrnUtl2.ReadAndShow( ScreenFile, TmpFrame, '1' );
- (* resets the bottom line explaining the special keys *)
- ScrnUtl2.CloseDisplayFrame( TmpFrame );
- END ShowAllRecords;
- PROCEDURE ProcessRecord();
- VAR
- spot, dumc, LandingField, KeyHit: CARDINAL;
- done: BOOLEAN;
- NdxRec: NdxTypes.NdxElement;
- NextFrame: ScrnTypes.AFrameName;
- TmpFrame: ScrnTypes.DisplayFrame;
- BEGIN
- ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow );
- RecName := '';
- REPEAT
- NextFrame := '4'; (*the record selection form*)
- DspFiles.ReadDisplayFrame( ScreenFile, TmpFrame, NextFrame );
- REPEAT
- ControlUtils.ChangeField( TmpFrame, RecName, 'name', TRUE );
- FramePainter.ShowDisplayFrame( TmpFrame, 0, 0, 0, 0 );
- LandingField := 0;
- InputManager.ControlFrame( TmpFrame,
- LandingField, '', FALSE, NextFrame );
- IF NOT PosUtils.Equal( NextFrame, TmpFrame^.normlnext ) THEN
- ScrnUtl2.CloseDisplayFrame( TmpFrame );
- RETURN;
- END;
- ControlUtils.ReadInput( TmpFrame, RecName, 'name');
- done := NdxFiles.RecordExists( NdxFile, RecName);
- IF NOT done THEN
- done := MsgBox2.MsgOkay( TmpFrame, VWindows.SE,
- "Record not found. Preparing to create it. Please confirm." );
- END;
- IF NOT done THEN
- IF MsgBox2.MsgOkay( TmpFrame, VWindows.SE,
- "Search for a name in which this pattern appears?" ) THEN
- StrEdit.CrunchBlanks( RecName );
- spot := GenLists.ScanList( RecName, NdxFile^.Ndx,
- 1, 65535, dumc );
- IF spot > 0 THEN
- GenLists.GetElmt( NdxFile^.Ndx, spot, NdxRec, dumc );
- M2Strings.Assign( NdxRec.RecName, RecName );
- ELSE
- RecName := '';
- END;
- END;
- END;
- UNTIL done;
- DoOneRecord( RecName );
- UNTIL NOT PosUtils.Equal( NextFrame, '4' );
- ScrnUtl2.CloseDisplayFrame( TmpFrame );
- END ProcessRecord;
- PROCEDURE StoreList( TheList: GenLists.GenList );
- VAR
- ListName: ARRAY [0..79] OF CHAR;
- TmpList: GenLists.GenList;
- NextFrame: ScrnTypes.AFrameName;
- TmpFrame: ScrnTypes.DisplayFrame;
- BEGIN
- ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow );
- NextFrame := '20';
- (*List Storage Form*)
- DspFiles.ReadDisplayFrame( ScreenFile, TmpFrame,
- NextFrame );
- IF NOT (0 # ScrnUtl1.FieldNum( TmpFrame, 'list' )) THEN
- (*Find the editor field.*)
- HALT();
- END;
- IF NOT ScrnUtl1.ListToEdField( TheList, TmpFrame,
- TmpFrame^.CurrentField ) THEN
- (*Put the list created in BuildList into the editor
- field.*)
- HALT();
- END;
- StrConv.CardinalToStr( GenLists.ListLength( TheList), 0, ListName);
- StrEdit.Append( ListName, '.');
- ControlUtils.ChangeField( TmpFrame, ListName, 'size', FALSE);
- FramePainter.ShowDisplayFrame( TmpFrame, 0, 0, 0, 0 );
- REPEAT
- InputManager.ControlFrame( TmpFrame, 0, '', FALSE, NextFrame );
- IF PosUtils.Equal( NextFrame, '999' ) THEN
- (*They want to store the list.*)
- ControlUtils.ReadInput( TmpFrame, ListName, 'name' );
- (*Get the name they've chosen for the list out of
- the 'name' field.*)
- GenLists.CopyList( TheList, TmpList );
- IF NOT BuildLst.StoreRecNameList( NdxFile, ListName, TmpList ) THEN
- HALT();
- END;
- ScrnUtl2.ShowMessage( ScreenFile, '27' );
- (*Says store successful; waits for any key.*)
- ScrnUtl2.CloseDisplayFrame( TmpFrame );
- RETURN;
- END;
- UNTIL PosUtils.Equal( NextFrame, '21' );
- ScrnUtl2.CloseDisplayFrame( TmpFrame );
- END StoreList;
- PROCEDURE SearchFile();
- VAR
- ListMade: GenLists.GenList;
- ErrorField: CARDINAL;
- message, LimitingList: ARRAY [0..79] OF CHAR;
- dumbool: BOOLEAN;
- NextFrame: ScrnTypes.AFrameName;
- MsgFrame, TmpFrame: ScrnTypes.DisplayFrame;
- BEGIN (*SearchFile*)
- ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow );
- LOOP
- StrEdit.AssignStr( '', message );
- ErrorField := 0;
- NextFrame := '21'; (*The List Building form*)
- ScrnUtl2.ReadAndShow( ScreenFile, TmpFrame, NextFrame );
- REPEAT
- InputManager.ControlFrame( TmpFrame, ErrorField,
- message, FALSE, NextFrame );
- ErrorField := 0;
- (*Reset ErrorField and message so they'll signal an
- error on the next loop only if there's really been
- an error.*)
- StrEdit.AssignStr( '', message );
- IF NOT PosUtils.Equal( NextFrame, TmpFrame^.normlnext ) THEN
- (*exit if they press the backup or program-exit
- keys.*)
- EXIT;
- END;
- IF NOT ScrnUtl1.FieldIsBlank( TmpFrame,
- 'listname', ErrorField) THEN
- ControlUtils.ReadInput( TmpFrame, LimitingList, 'listname' );
- (*Get the name of the list they've chosen to use
- out of the 'name' field.*)
- ELSE
- StrEdit.AssignStr( '', LimitingList );
- END;
- ScrnTypes.InitDisplayFrame( MsgFrame, VWindows.CurrentWindow );
- ScrnUtl2.ReadAndShow( ScreenFile, MsgFrame, '43' );
- (*a screen that says list is being created *)
- BuildLst.BuildList( NdxFile, TmpFrame, 1, 13, LimitingList,
- ErrorField, ListMade );
- FrameManager.EraseFrame( MsgFrame );
- ScrnUtl2.CloseDisplayFrame( MsgFrame );
- IF ErrorField = 0 THEN
- BuildLst.DeleteListRec( ListMade);
- StoreList( ListMade );
- EXIT;
- ELSE
- StrEdit.AssignStr( "Something's wrong with this field.",
- message );
- END;
- UNTIL ErrorField = 0;
- END;
- ScrnUtl2.CloseDisplayFrame( TmpFrame );
- END SearchFile;
- PROCEDURE ManageLists();
- VAR
- TmpList: GenLists.GenList;
- LastListName : ARRAY [0..79] OF CHAR;
- NextFrame: ScrnTypes.AFrameName;
- TmpFrame: ScrnTypes.DisplayFrame;
- BEGIN
- ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow );
- LastListName[0] := 0C;
- LOOP
- NextFrame := '29'; (*The main list management menu.*)
- ControlUtils.ReadShowAndCntrl( ScreenFile, TmpFrame, NextFrame );
- IF PosUtils.Equal( NextFrame, TmpFrame^.parent ) THEN
- EXIT;
- END;
- CASE ScrnUtl1.SelectedChar(TmpFrame) OF
- 'M': (*Make a new list.*)
- SearchFile();
- | 'D': (*Delete a list.*)
- IF ControlUtils.GetStrResponse( ScreenFile,
- '30', LastListName, LastListName ) THEN
- (* if they didn't try to back up or exit *)
- IF BuildLst.DelRecNameList( NdxFile,
- LastListName ) THEN
- ScrnUtl2.ShowMessage( ScreenFile, '34' );
- (*Says the list was successfully deleted.*)
- ELSE
- ScrnUtl2.ShowMessage( ScreenFile, '35' );
- (*Says no such list stored; waits for any key.*)
- END;
- END;
- | 'S': (*Show lists.*)
- IF BuildLst.GetListNames( NdxFile, TmpList ) AND
- (GenLists.ListLength( TmpList) # 0) THEN
- IF NOT ControlUtils.ListBox( ScreenFile, '31',
- TmpList, LastListName, NextFrame ) THEN
- (* We don't care if they press Esc here. *)
- END;
- ELSE
- ScrnUtl2.ShowMessage( ScreenFile, '35' );
- (*Says no such list stored and waits for a key.*)
- END;
- | 'E': (*Edit a list.*)
- IF ControlUtils.GetStrResponse( ScreenFile,
- '32', LastListName, LastListName ) THEN
- (* if they didn't try to back up or exit *)
- IF BuildLst.GetRecNameList( NdxFile,
- LastListName, TmpList ) THEN
- StoreList( TmpList );
- ELSE
- ScrnUtl2.ShowMessage( ScreenFile, '35' );
- (*Says no such list stored; waits for any key.*)
- END;
- END;
- | 'A': (*Examine list of All records.*)
- NdxUtils.GetRecNames( NdxFile, TmpList );
- StoreList( TmpList );
- | 'R': (*Retrieve listed records.*)
- IF ControlUtils.GetStrResponse( ScreenFile,
- '33', LastListName, LastListName ) THEN
- (* if they didn't try to back up or exit *)
- IF BuildLst.GetRecNameList( NdxFile,
- LastListName, TmpList ) THEN
- ShowAllRecords( TmpList );
- NextFrame := '29'; (* The main list management menu. *)
- ELSE
- ScrnUtl2.ShowMessage( ScreenFile, '35' );
- (*Says no such list stored; waits for any key.*)
- END;
- END;
- ELSE
- END;
- END;
- ScrnUtl2.CloseDisplayFrame( TmpFrame );
- END ManageLists;
- PROCEDURE ErrorOpeningFile( ErrMsg: CARDINAL;
- ErrText, fname: ARRAY OF CHAR );
- VAR
- TmpStr1: ARRAY [0..149] OF CHAR;
- TmpStr2: ARRAY [0..59] OF CHAR;
- KeyHit: CARDINAL;
- BEGIN
- StrEdit.AssignStr( "Error in opening '", TmpStr1 );
- StrEdit.Append( TmpStr1, fname );
- StrEdit.Append( TmpStr1, "': " );
- IF ErrMsg # StringIO.MissingMessage THEN
- ErrStrgs.NumToStr( ErrMsg, TmpStr2 );
- StrEdit.Append( TmpStr1, TmpStr2 );
- ELSE
- StrEdit.Append( TmpStr1, ErrText);
- END;
- StrEdit.Append( TmpStr1, " Press any key." );
- WindowPrims.MsgBox( VWindows.SE, TmpStr1, KbdInput.AnyKeyNum, KeyHit );
- END ErrorOpeningFile;
- PROCEDURE NotPmiFile( fname: ARRAY OF CHAR): BOOLEAN;
- BEGIN
- RETURN NOT PosUtils.Present( 'pmidbms', fname);
- END NotPmiFile;
- PROCEDURE ExportRecords( NdxFile: NdxTypes.NdxFileType; VAR NextFrame:
- ScrnTypes.AFrameName; ScreenFile: ScrnTypes.DisplayFile);
- VAR
- TmpFrame: ScrnTypes.DisplayFrame;
- PROCEDURE ExportToNdxFile( NdxF1: NdxTypes.NdxFileType; RecNameList,
- MatchingFields: GenLists.GenList; NdxF2: NdxTypes.NdxFileType );
- VAR
- SearchingAll: BOOLEAN;
- TypeCode, lngth1, cnt: CARDINAL;
- TmpStr: NdxTypes.RecNameStr;
- TmpNdxRec: NdxTypes.NdxElement;
- BEGIN (* ExportToNdxFile *)
- lngth1 := GenLists.ListLength( RecNameList );
- IF lngth1 = 0 THEN
- SearchingAll := TRUE;
- lngth1 := GenLists.ListLength( NdxF1^.Ndx );
- ELSE
- SearchingAll := FALSE;
- END;
- ScrnUtl2.ReadAndShow( ScreenFile, TmpFrame, '38' );
- FOR cnt := 1 TO lngth1 DO
- IF SearchingAll THEN
- GenLists.GetElmt( NdxF1^.Ndx, cnt, TmpNdxRec, TypeCode );
- StrEdit.AssignStr( TmpNdxRec.RecName, TmpStr );
- ELSE
- GenLists.GetElmt( RecNameList, cnt, TmpStr, TypeCode );
- (*Put the cnt'th record name in TmpStr.*)
- END;
- IF (M2Strings.Length( TmpStr ) > 0) AND
- (0 # M2Strings.CompareStr( TmpStr, BuildLst.ListStorageRec)) THEN
- (* don't export the special record of list names *)
- NdxUtils.CopyMatchingFields( NdxF1, NdxF2, TmpStr, MatchingFields );
- END;
- END;
- END ExportToNdxFile;
- CONST
- FillThisField =
- 'Your selection requires completion of this field. Press any key.';
- VAR
- fname, ListName, TmpStr1, TmpStr2, message: ARRAY [0..79]
- OF CHAR;
- MatchingFieldList, RecNameList: GenLists.GenList;
- DestNdxFile: NdxTypes.NdxFileType;
- done: BOOLEAN;
- SavedMessage: CARDINAL;
- TmpFieldRec: ScrnTypes.InputFieldRecord;
- ErrField, ExpFile, KeyHit: CARDINAL;
- PROCEDURE AllFieldsCorrect( TheFrame: ScrnTypes.DisplayFrame;
- ReqFieldName: ARRAY OF CHAR; VAR BadFieldNum: CARDINAL;
- VAR message, DestFileName: ARRAY OF CHAR; ListFieldName:
- ARRAY OF CHAR; VAR RecNameList: GenLists.GenList ): BOOLEAN;
- VAR
- ListName: ARRAY [0..79] OF CHAR;
- dumbool : BOOLEAN;
- BEGIN
- IF ScrnUtl1.FieldIsBlank( TheFrame, ReqFieldName, BadFieldNum ) THEN
- StrEdit.AssignStr( FillThisField, message );
- done := FALSE;
- ELSE
- ControlUtils.ReadInput( TheFrame, DestFileName, ReqFieldName );
- StrEdit.DeleteChar( ' ', DestFileName );
- IF ScrnUtl1.FieldIsBlank( TheFrame, ListFieldName, BadFieldNum ) THEN
- StrEdit.AssignStr( FillThisField, message );
- GenLists.NewList( RecNameList );
- BadFieldNum := 0;
- done := TRUE;
- ELSE
- ControlUtils.ReadInput( TheFrame, ListName, ListFieldName);
- IF NOT BuildLst.GetRecNameList( NdxFile, ListName,
- RecNameList ) THEN
- done := FALSE;
- StrEdit.AssignStr( "List does not exist. Press any key.",
- message );
- ELSE
- BadFieldNum := 0;
- done := TRUE;
- END;
- END;
- END;
- RETURN done;
- END AllFieldsCorrect;
- PROCEDURE ToNdxFile();
- VAR
- TmpList1, TmpList2, TmpList3: GenLists.GenList;
- PROCEDURE PairFieldNames( list1, list2: GenLists.GenList; VAR
- outlist: GenLists.GenList);
- VAR
- lngth1, lngth2, cnt, TypeCode, strndx, spot: CARDINAL;
- TmpStr1, TmpStr2: ARRAY [0..79] OF CHAR;
- BEGIN
- lngth1 := GenLists.ListLength( list1 );
- lngth2 := GenLists.ListLength( list2 );
- GenLists.NewList( outlist );
- FOR cnt := 1 TO lngth1 DO
- GenLists.GetElmt( list1, cnt, TmpStr1, TypeCode );
- IF TypeCode = GenLists.StrCode THEN
- spot := GenLists.ScanList( TmpStr1, list2, 1, lngth2, strndx );
- IF (spot > 0) AND (strndx = 0) THEN
- GenLists.GetElmt( list2, spot, TmpStr2, TypeCode );
- StrEdit.Append( TmpStr1, '=' );
- StrEdit.Append( TmpStr1, TmpStr2 );
- GenLists.ListInsert( TmpStr1, GenLists.StrCode, outlist,
- GenLists.ListLength(outlist) + 1 );
- END;
- END;
- END;
- END PairFieldNames;
- BEGIN (*ToNdxFile*)
- done := AllFieldsCorrect( TmpFrame, 'cpyfname',
- ErrField, message, fname, 'cpylist', RecNameList );
- StrEdit.CrunchBlanks( fname);
- IF done THEN
- IF PosUtils.Equal( fname, NdxFile^.name) THEN
- done := FALSE;
- message := 'Cannot export from a file to itself';
- ErrField := 8;
- ELSIF NOT NdxBones.OpenNdxFile( DestNdxFile, fname ) THEN
- ErrorOpeningFile( StringIO.MissingMessage, 'Not an Index File.',
- fname );
- done := FALSE;
- ELSE
- DspFiles.ReadDisplayFrame( ScreenFile, TmpFrame, NextFrame );
- IF NOT (0 # ScrnUtl1.FieldNum( TmpFrame,
- 'oldstruct' )) THEN
- HALT();
- END;
- GenLists.CopyList( NdxFile^.StructLst, TmpList1 );
- IF NOT ScrnUtl1.ListToEdField( TmpList1,
- TmpFrame,
- TmpFrame^.CurrentField ) THEN
- HALT();
- END;
- IF NOT (0 # ScrnUtl1.FieldNum( TmpFrame,
- 'newstruct' )) THEN
- HALT();
- END;
- GenLists.CopyList( DestNdxFile^.StructLst, TmpList2 );
- IF NOT ScrnUtl1.ListToEdField( TmpList2,
- TmpFrame,
- TmpFrame^.CurrentField ) THEN
- HALT();
- END;
- IF NOT (0 # ScrnUtl1.FieldNum( TmpFrame, 'matches' )) THEN
- HALT();
- END;
- PairFieldNames( NdxFile^.StructLst,
- DestNdxFile^.StructLst, MatchingFieldList );
- GenLists.CopyList( MatchingFieldList, TmpList3 );
- IF NOT ScrnUtl1.ListToEdField( TmpList3,
- TmpFrame, TmpFrame^.CurrentField ) THEN
- HALT();
- END;
- GenLists.DisposeList( MatchingFieldList );
- (*We dispose here because the editor field now
- has a copy of the list.*)
- FramePainter.ShowDisplayFrame( TmpFrame, 0, 0, 0, 0 );
- InputManager.ControlFrame( TmpFrame, 0, '', FALSE,
- NextFrame );
- (*Let them edit the lists.*)
- IF NOT (0 # ScrnUtl1.FieldNum( TmpFrame, 'MATCHES')) THEN
- HALT();
- END;
- IF NOT ScrnUtl1.ListFromEdField( TmpFrame,
- TmpFrame^.CurrentField, MatchingFieldList ) THEN
- HALT();
- END;
- (*Now we've gotten the list back from the editor
- field, presumably changed in some way.*)
- GenLists.CopyList( MatchingFieldList, TmpList1 );
- IF PosUtils.Equal( NextFrame, TmpFrame^.normlnext ) THEN
- ExportToNdxFile( NdxFile, RecNameList,
- TmpList1, DestNdxFile );
- NextFrame := '24';
- END;
- NdxFiles.CloseNdxFile( DestNdxFile );
- END;
- END;
- END ToNdxFile;
- PROCEDURE ToAscii();
- BEGIN
- IF AllFieldsCorrect( TmpFrame, 'expfname',
- ErrField, message, fname, 'explist', RecNameList ) THEN
- IF NotPmiFile( fname) THEN
- SavedMessage := HandleIO.CreateFile( ExpFile, fname );
- IF SavedMessage = StringIO.NoError THEN
- ScrnUtl2.ReadAndShow( ScreenFile, TmpFrame, '38' );
- NdxUtils.ExportToFile( NdxFile, RecNameList, ExpFile );
- StringIO.PrintMessage( HandleIO.CloseHandle( ExpFile ) );
- NextFrame := '24';
- done := TRUE;
- ELSE
- ErrorOpeningFile( SavedMessage, '', fname );
- done := FALSE;
- END;
- ELSE
- ErrorOpeningFile( StringIO.MissingMessage,
- 'Invalid Reserved PMI File Name', fname );
- done := FALSE;
- END;
- END;
- END ToAscii;
- PROCEDURE ToPrinter();
- BEGIN
- done := AllFieldsCorrect( TmpFrame, 'prnlist',
- ErrField, message, fname, 'prnlist', RecNameList );
- IF done THEN
- ScrnUtl2.ReadAndShow( ScreenFile, TmpFrame, '38' );
- NdxUtils.ExportToFile( NdxFile, RecNameList, StringIO.StdPrn );
- NextFrame := '37';
- END;
- END ToPrinter;
- BEGIN (*ExportRecords*)
- ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow );
- NextFrame := '19';
- (*This is the export form; the one with all the lines
- and blanks for list and file names.*)
- ScrnUtl2.ReadAndShow( ScreenFile, TmpFrame, NextFrame );
- done := FALSE;
- ErrField := 0;
- StrEdit.AssignStr( '', message );
- StrEdit.AssignStr( '', fname );
- WHILE NOT done DO
- InputManager.ControlFrame( TmpFrame, ErrField,
- message, FALSE, NextFrame );
- IF PosUtils.Equal( NextFrame, TmpFrame^.parent ) THEN
- RETURN;
- END;
- CASE ScrnUtl1.SelectedChar(TmpFrame) OF
- (*To determine what they want us to do, we have to
- figure out where the pointer bar was when the
- screen was submitted.*)
- 'A', 'l', 'f':
- (*Export records to an ASCII file.*)
- ToAscii();
- | 'P', 'p': (*Print records.*)
- ToPrinter();
- | 'N', 'c', 'x': (*Copy records to another Ndx file.*)
- ToNdxFile();
- END;
- END; (*WHILE NOT done*)
- ScrnUtl2.CloseDisplayFrame( TmpFrame );
- END ExportRecords;
- PROCEDURE GetFile( VAR NdxFile: NdxTypes.NdxFileType; ScreenFile:
- ScrnTypes.DisplayFile; VAR NextFrame: ScrnTypes.AFrameName): BOOLEAN;
- VAR
- SavedMessage : CARDINAL;
- SelectedFile, FileSpec: ARRAY [0..79] OF CHAR;
- FileOpened, dumbool: BOOLEAN;
- structure: ARRAY [0..511] OF CHAR;
- pathleng, KeyHit: CARDINAL;
- TmpFrame: ScrnTypes.DisplayFrame;
- PROCEDURE OpenExisting( fname: ARRAY OF CHAR ): BOOLEAN;
- BEGIN
- IF FileOpened THEN
- NdxFiles.CloseNdxFile( NdxFile );
- END;
- IF NOT NdxBones.OpenNdxFile( NdxFile, fname ) THEN
- ErrorOpeningFile( StringIO.MissingMessage, 'Not an Index File.',
- fname );
- RETURN FALSE;
- ELSE
- WindowPrims.MsgBox( VWindows.SE,
- 'New file selected. Press any key.',
- KbdInput.AnyKeyNum, KeyHit );
- NextFrame := '2';
- (*We do this to guarantee that we fall out at the
- bottom of the loop.*)
- RETURN TRUE;
- END;
- END OpenExisting;
- PROCEDURE TryCreate();
- BEGIN (* TryCreate *)
- IF NotPmiFile( FileSpec ) THEN
- IF Drectory.ValidFile( FileSpec ) THEN
- WindowPrims.MsgBox( VWindows.SE,
- "File not found. Do you want to create it? (Y/N)",
- KbdInput.YorN, KeyHit );
- IF KbdInput.CAPkey(KeyHit) = ORD('Y') THEN
- IF FileOpened THEN
- NdxFiles.CloseNdxFile( NdxFile );
- END;
- (*For convenience we've stored the file structure in
- the DataList for frame 6.*)
- ListUtils.ListToString( TmpFrame^.DataList, structure );
- NdxFiles.CreateNdxFile( NdxFile, FileSpec, structure );
- WindowPrims.MsgBox( VWindows.SE,
- 'File created. Press any key.', KbdInput.AnyKeyNum,
- KeyHit );
- FileOpened := TRUE;
- END;
- ELSE
- ErrorOpeningFile( StringIO.MissingMessage,
- 'Invalid File Name', FileSpec );
- END;
- ELSE
- ErrorOpeningFile( StringIO.MissingMessage,
- 'Invalid Reserved PMI File Name', FileSpec );
- END;
- END TryCreate;
- BEGIN
- (*GetFile*)
- FileOpened := FALSE;
- ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow );
- REPEAT
- NextFrame := '6';
- (*File Creation/Selection form; prompts for a file
- specification*)
- ControlUtils.ReadShowAndCntrl( ScreenFile, TmpFrame, NextFrame );
- IF NOT PosUtils.Equal( NextFrame, TmpFrame^.normlnext ) THEN
- (*return if they press the backup key*)
- ScrnUtl2.CloseDisplayFrame( TmpFrame );
- RETURN FileOpened;
- END;
- ControlUtils.ReadInput( TmpFrame, FileSpec, 'path');
- (*Get the string out of the field named 'path' and put
- it in the variable FileSpec.*)
- StrEdit.CutTrailingChars( ' ', FileSpec);
- pathleng := M2Strings.Length(FileSpec);
- IF HandleIO.FileExists( FileSpec ) THEN
- (* open file entered *)
- FileOpened := OpenExisting( FileSpec );
- ELSIF (pathleng > 0) AND
- (NOT PosUtils.Present( '*', FileSpec)) AND
- (FileSpec[ pathleng-1] # '\') AND
- (FileSpec[ pathleng-1] # ':') THEN
- (* try to create file name entered *)
- TryCreate();
- ELSE
- (* search for file spec entered *)
- ScrnUtl2.PushFrame( TmpFrame );
- (*this saves frame 6*)
- NextFrame := '7';
- (*7 is a blank window to hold the file names*)
- DspFiles.ReadDisplayFrame( ScreenFile, TmpFrame, NextFrame );
- DirManager.ControlDirectory( FileSpec,
- TmpFrame, 1, SelectedFile, NextFrame );
- (*Loads frame 7 with a list of filenames that match
- the file specification in FileSpec, and controls
- scrolling of the pointer bar within the frame until
- the user selects a file. The 1 means
- ControlDirectory will list only file NAMES (i.e.,
- will use only one column). We could have it list
- size, date, and time information by using 2, 3, or
- 4 for the number of columns. *)
- IF PosUtils.Equal( NextFrame, TmpFrame^.normlnext ) THEN
- StrEdit.DeleteChar( ' ', SelectedFile );
- IF NOT PosUtils.Present( 'Error:', SelectedFile ) THEN
- FileOpened := OpenExisting( SelectedFile );
- ScrnUtl2.PopFrame( TmpFrame );
- (*TmpFrame is now frame 6.*)
- ELSE
- (* couldn't search for file, so try to create it *)
- ScrnUtl2.PopFrame( TmpFrame );
- (*TmpFrame is now frame 6.*)
- TryCreate();
- END;
- ELSE
- ScrnUtl2.PopFrame( TmpFrame );
- (*TmpFrame is now frame 6.*)
- END;
- END;
- UNTIL FileOpened;
- ScrnUtl2.CloseDisplayFrame( TmpFrame );
- RETURN FileOpened;
- END GetFile;
- PROCEDURE FileManagement( VAR NdxFile: NdxTypes.NdxFileType; VAR NextFrame:
- ScrnTypes.AFrameName; ScreenFile: ScrnTypes.DisplayFile);
- PROCEDURE CrunchMenu();
- VAR
- TotSize, GbgSize: LONGINT;
- PctUsed, NumDatRecs, NumGbgRecs: CARDINAL;
- dumstr: ARRAY [0..80] OF CHAR;
- TmpFrame: ScrnTypes.DisplayFrame;
- BEGIN
- ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow );
- REPEAT
- NextFrame := '10';
- DspFiles.ReadDisplayFrame( ScreenFile, TmpFrame, NextFrame );
- NdxUtils.SizeInfo( NdxFile, TotSize, GbgSize, PctUsed, NumDatRecs,
- NumGbgRecs);
- StrConv.LongIntegerToStr( TotSize, 0, dumstr);
- ControlUtils.ChangeField( TmpFrame, dumstr, 'size', FALSE );
- StrConv.LongIntegerToStr( GbgSize, 0, dumstr);
- ControlUtils.ChangeField( TmpFrame, dumstr, 'save', FALSE );
- StrConv.CardinalToStr( PctUsed, 0, dumstr);
- ControlUtils.ChangeField( TmpFrame, dumstr, 'pct', FALSE );
- StrConv.CardinalToStr( NumDatRecs, 0, dumstr);
- ControlUtils.ChangeField( TmpFrame, dumstr, 'custs', FALSE );
- StrConv.CardinalToStr( NumGbgRecs, 0, dumstr);
- ControlUtils.ChangeField( TmpFrame, dumstr, 'grecs', FALSE );
- FramePainter.ShowDisplayFrame( TmpFrame, 0, 0, 0, 0 );
- InputManager.ControlFrame( TmpFrame, 0, '', FALSE,
- NextFrame );
- IF PosUtils.Equal( NextFrame, '12' ) THEN
- ScrnUtl2.ReadAndShow( ScreenFile, TmpFrame, NextFrame );
- (*File crunch in progress*)
- NdxUtils.CrunchNdxFile( NdxFile);
- NextFrame := '13'; (*File crunch complete*)
- ControlUtils.ReadShowAndCntrl( ScreenFile, TmpFrame, NextFrame );
- END;
- UNTIL PosUtils.Equal( NextFrame, TmpFrame^.parent );
- ScrnUtl2.CloseDisplayFrame( TmpFrame );
- END CrunchMenu;
- PROCEDURE EditFile();
- VAR
- fname: ARRAY [0..79] OF CHAR;
- ready: BOOLEAN;
- SavedMessage: CARDINAL;
- KeyHit: CARDINAL;
- TheList: GenLists.GenList;
- ControlRec: VEditor.AnEdControlRec;
- TmpFrame: ScrnTypes.DisplayFrame;
- BEGIN
- ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow );
- ScrnUtl2.ReadAndShow( ScreenFile, TmpFrame, '18' );
- (*This frame prompts for a file name.*)
- REPEAT
- InputManager.ControlFrame( TmpFrame, 0, '', FALSE,
- NextFrame );
- IF NOT PosUtils.Equal( NextFrame, TmpFrame^.normlnext ) THEN
- ScrnUtl2.CloseDisplayFrame( TmpFrame );
- RETURN;
- END;
- ControlUtils.ReadInput( TmpFrame, fname, 'fname' );
- (*Get the file name out of the 'fname' field.*)
- IF NotPmiFile( fname) THEN
- GenLists.NewList( TheList );
- SavedMessage := ListUtils.TextFileToList( fname, TheList );
- IF SavedMessage = StringIO.NoError THEN
- ready := TRUE;
- ELSIF SavedMessage = StringIO.FileNotFound THEN
- WindowPrims.MsgBox( VWindows.SE,
- "File not found. Do you want to create it? (Y/N)",
- KbdInput.YorN, KeyHit );
- ready := KbdInput.CAPkey(KeyHit) = ORD('Y');
- IF ready THEN
- GenLists.NewList( TheList );
- END;
- ELSE
- ErrorOpeningFile( SavedMessage, '', fname );
- ready := FALSE;
- END;
- ELSE
- ErrorOpeningFile( StringIO.MissingMessage,
- 'Invalid Reserved PMI File Name', fname );
- ready := FALSE;
- END;
- UNTIL ready;
- VEditor.InitEdRec( ControlRec );
- VEditor.TheEditor( TheList, ControlRec );
- IF ControlRec.ChangeMade THEN
- (*Ask if they want to save the file.*)
- WindowPrims.MsgBox( VWindows.SE,
- "Do you want to save your changes? (Y/N)",
- KbdInput.YorN, KeyHit );
- ready := KbdInput.CAPkey(KeyHit) = ORD('Y');
- IF ready THEN
- SavedMessage := ListUtils.TextListToFile( TheList, fname );
- END;
- END;
- GenLists.DisposeList( TheList );
- ScrnUtl2.CloseDisplayFrame( TmpFrame );
- END EditFile;
- PROCEDURE GetRecDate( NdxFile: NdxTypes.NdxFileType;
- RecName: ARRAY OF CHAR; VAR Date: CARDINAL );
- VAR
- TypeCode, day, month, year, hours, minutes, seconds: CARDINAL;
- DateStr: ARRAY [0..31] OF CHAR;
- BEGIN
- Drectory.GetFileDateAndTime( NdxFile^.handle, month, day, year,
- hours, minutes, seconds );
- Date := ByteFiddler.DateToCardinal( month, day, year );
- IF NOT NdxFiles.GetField( NdxFile, RecName, 'DATE', TypeCode,
- DateStr ) THEN
- RETURN;
- END;
- IF NOT DateFunctions.StrToDate2( DateStr, FALSE, day, month, year ) THEN
- RETURN;
- END;
- Date := ByteFiddler.DateToCardinal( month, day, year );
- END GetRecDate;
- PROCEDURE FirstIsOlder( VAR date1, date2: CARDINAL ): BOOLEAN;
- BEGIN
- RETURN date1 < date2;
- END FirstIsOlder;
- PROCEDURE MergeFile();
- VAR
- NextFrame: ScrnTypes.AFrameName;
- OtherRecName: NdxTypes.RecNameStr;
- OtherNdxFile: NdxTypes.NdxFileType;
- AddingRecords, AlwaysUpdate, NeverUpdate, Transferring,
- DoSomething: BOOLEAN;
- OurDate, TheirDate, cnt: CARDINAL;
- FileName: ARRAY [0..63] OF CHAR;
- TmpFrame: ScrnTypes.DisplayFrame;
- BEGIN
- ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow );
- LOOP
- NextFrame := 'MergeOpts';
- ControlUtils.ReadShowAndCntrl( ScreenFile, TmpFrame, NextFrame );
- IF PosUtils.Equal( NextFrame, TmpFrame^.parent ) THEN
- EXIT;
- END;
- ControlUtils.ReadInput( TmpFrame, FileName, 'fname' );
- IF NOT NdxBones.OpenNdxFile( OtherNdxFile, FileName ) THEN
- EXIT;
- END;
- AddingRecords := ScrnUtl1.WhichChoiceKey( TmpFrame,
- ScrnUtl1.FieldNum(TmpFrame, 'add') ) = ORD('y');
- Transferring := ScrnUtl1.WhichChoiceKey( TmpFrame,
- ScrnUtl1.FieldNum(TmpFrame, 'transf') ) = ORD('y');
- CASE CHR(ScrnUtl1.WhichChoiceKey( TmpFrame,
- ScrnUtl1.FieldNum(TmpFrame, 'upd') )) OF
- 'A':
- AlwaysUpdate := TRUE;
- NeverUpdate := FALSE;
- | 'O':
- AlwaysUpdate := FALSE;
- NeverUpdate := FALSE;
- | 'N':
- AlwaysUpdate := FALSE;
- NeverUpdate := TRUE;
- END;
- cnt := 1;
- WHILE NdxUtils.GetRecName( OtherNdxFile, cnt, OtherRecName ) DO
- IF NdxFiles.RecordExists( NdxFile, OtherRecName ) THEN
- IF AlwaysUpdate THEN
- DoSomething := TRUE;
- ELSIF NeverUpdate THEN
- DoSomething := FALSE;
- ELSE
- GetRecDate( NdxFile, OtherRecName, OurDate );
- GetRecDate( OtherNdxFile, OtherRecName, TheirDate );
- IF FirstIsOlder( OurDate, TheirDate ) THEN
- DoSomething := TRUE;
- ELSE
- DoSomething := FALSE;
- END;
- END;
- ELSE
- DoSomething := AddingRecords;
- END;
- IF DoSomething THEN
- IF Transferring THEN
- IF NOT NdxUtils.TransferRecord(
- OtherRecName, OtherNdxFile, NdxFile ) THEN
- ErrorManager.WARN( OtherRecName );
- END;
- ELSE
- IF NOT NdxUtils.CopyRecord(
- OtherRecName, OtherNdxFile, NdxFile ) THEN
- ErrorManager.WARN( OtherRecName );
- END;
- END;
- END;
- INC( cnt );
- END;
- NdxFiles.CloseNdxFile( OtherNdxFile );
- END;
- ScrnUtl2.CloseDisplayFrame( TmpFrame );
- END MergeFile;
- VAR
- NdxFile2 : NdxTypes.NdxFileType;
- TmpFrame: ScrnTypes.DisplayFrame;
- BEGIN (* FileManagement *)
- ScrnTypes.InitDisplayFrame( TmpFrame, VWindows.CurrentWindow );
- LOOP
- NextFrame := '9';
- ControlUtils.ReadShowAndCntrl( ScreenFile, TmpFrame, NextFrame );
- IF PosUtils.Equal( NextFrame, TmpFrame^.parent ) THEN
- EXIT;
- END;
- CASE ScrnUtl1.SelectedChar(TmpFrame) OF
- 'C': (*Create or select a new file.*)
- IF GetFile( NdxFile2, ScreenFile, NextFrame) THEN
- NdxFiles.CloseNdxFile( NdxFile );
- NdxFile := NdxFile2;
- END;
- (*TmpFrame will be 6 at this point; NextFrame will be 9.*)
- |'s': (*Manage space usage in this file.*)
- CrunchMenu();
- |'M': (*Merge another file*)
- MergeFile();
- |'E': (*Edit a file.*)
- EditFile();
- ELSE
- END;
- END;
- ScrnUtl2.CloseDisplayFrame( TmpFrame );
- END FileManagement;
- PROCEDURE RestoreDisplay();
- BEGIN
- SmartScreen.SetAttribOrColor( SmartScreen.lightgrey,
- SmartScreen.black, SmartScreen.plain );
- SmartScreen.ClearPart( 1, 1, SmartScreen.MaxCol, SmartScreen.MaxRow );
- SmartScreen.SetCursorHeight( SavedCursorHeight );
- END RestoreDisplay;
- PROCEDURE CloseFiles();
- BEGIN
- DspFiles.CloseDisplayFile(ScreenFile);
- NdxFiles.CloseNdxFile( NdxFile );
- END CloseFiles;
- VAR
- NextFrame: ScrnTypes.AFrameName;
- BEGIN (*Main*)
- SavedCursorHeight := WindowPrims.GetCursorHeight();
- SmartScreen.SetCursorHeight( 0 );
- ErrorManager.AddTermProc( RestoreDisplay );
- IF NOT DspFiles.OpenDisplayFile( ScreenFile, "pmidbms.dsp") THEN
- ErrorManager.WARN( "Could not find PMIDBMS.DSP" );
- HALT;
- END;
- StrEdit.AssignStr( 'pmidbms.ndx', NdxFileName);
- GenLists.DiagMode := FALSE;
- IF NOT (NdxBones.OpenNdxFile( NdxFile, NdxFileName) OR
- GetFile( NdxFile, ScreenFile, NextFrame)) THEN
- ControlUtils.InputConst( DspFiles.MainFrame, '8' );
- (* Tell them we can't proceed without an Ndx file *)
- DspFiles.CloseDisplayFile( ScreenFile);
- RETURN;
- END;
- ScrnTypes.InitDisplayFrame( EntryFrame, VWindows.CurrentWindow );
- ErrorManager.AddTermProc( CloseFiles );
- LOOP
- NextFrame := '2';
- ControlUtils.Input( DspFiles.MainFrame, NextFrame );
- (*the top menu*)
- IF PosUtils.Equal( NextFrame, ScrnTypes.ProgramExit ) THEN
- EXIT;
- END;
- CASE ScrnUtl1.SelectedChar( DspFiles.MainFrame ) OF
- 'P': (*Process a record*)
- ProcessRecord();
- | 'U': (*Search*)
- ManageLists();
- | 'E': (*Export*)
- ExportRecords( NdxFile, NextFrame, ScreenFile);
- | 'M': (*File Info & Management*)
- FileManagement( NdxFile, NextFrame, ScreenFile);
- ELSE
- END;
- END;
- END PMIdbms.
|