| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391 |
- IMPLEMENTATION MODULE Invtry;
- (*
- * ModBase
- * Release 3.0
- * (c) Copyright 1986 - 1991 PMI
- * P.O. Box 8402
- * Green Bay Wi 53308
- * All Rights Reserved
- * by Ed Ross
- *)
- FROM ModBase3 IMPORT UpdateDBFile,WriteDBRec,DeleteRecord,ReadDBRec,
- AppendBlank;
- FROM DBIndxes IMPORT CurrentRec;
- FROM PMIGlobals IMPORT PMIScreens;
- FROM DBStuff IMPORT MakeKey;
- FROM FrameManager IMPORT EraseFrame;
- FROM Scrn2DBF IMPORT FrameToDBF, DBFToFrame;
- FROM PosUtils IMPORT Equal;
- FROM ScrnUtl2 IMPORT CloseDisplayFrame;
- FROM StrEdit IMPORT CrunchBlanks,DeleteRightJustified,CAPstr,AssignStr;
- FROM M2Strings IMPORT Length;
- FROM StrConv IMPORT StrToReal;
- FROM LowLevel IMPORT Fill;
- FROM StringIO IMPORT PrintMessage,WriteStr,WriteEol,outp;
- (* these next two are from stonybrook - the pmi version doesn't work*)
- FROM EnvironUtils IMPORT ReadEnvironment;
- FROM SmartScreen IMPORT ClearScreen;
- FROM VWindows IMPORT ClearPart, CurrentWindow, SetCursorHeight;
- FROM ScrnTypes IMPORT DisplayFrame,InitDisplayFrame,AFrameName,
- ContinueInput,CancelInput,SubmitInput;
- FROM FramePainter IMPORT ShowDisplayFrame;
- FROM InputManager IMPORT ControlFrame;
- FROM Prompts IMPORT Prompt,PromptStr,PromptYN;
- FROM SYSTEM IMPORT ADR,SIZE;
- FROM ControlUtils IMPORT ControlSeparately, LoadFrameList,Control,ReadInput;
- FROM DspFiles IMPORT ReadDisplayFrame;
- FROM HandleIO IMPORT FileExists;
- FROM LowLevel IMPORT Fill;
- FROM GenLists IMPORT GenList, NewList,ListLength,GetElmt,DisposeList;
- FROM ScrnTypes IMPORT AFrameName, InitDisplayFrame,DisplayFile;
- FROM DBFInvtry IMPORT InvtryDBF, OpenInvtryDBF,
- CloseInvtryDBF,FixInvRec,InvtryRec,MoveInvtryToDBF,MoveInvtryFromDBF,
- FindInvtryByInvcode, FindInvtryByOrderfrm, NextInvtry,
- PrevInvtry,FirstInvtry,LastInvtry,InvcodeIdx;
- IMPORT InitCompilerMods;
- FROM NumTypes IMPORT Real8;
- FROM UOpsExt IMPORT Lookup,LookupProc;
- FROM UserOps IMPORT AKeyHandler,TheKeyHandler;
- IMPORT Key;
- VAR
- Status : INTEGER;
- Environ : ARRAY [0..60] OF CHAR;
- J : CARDINAL;
- TopMenu : GenList;
- FirstTime: BOOLEAN;
- NextFrame,EndingFrame : AFrameName;
- SelChar : CHAR;
- NoData : BOOLEAN; (* true when no data is on the screen *)
- InvtryDF : DisplayFrame;
- PullDnMenu : GenList;
- CurrentDF : DisplayFrame; (* used with lookup *)
- LookUpOk : BOOLEAN;
- InitInvtry : BOOLEAN;
- PROCEDURE LookUpInvty(VAR Key : ARRAY OF CHAR);
- (* this routine will be called to lookup the database item
- and fill in the blanks *)
- VAR
- Inv : InvtryRec;
- CKey : ARRAY[0..10] OF CHAR;
- B : BOOLEAN;
- BEGIN
- CAPstr(Key);
- AssignStr(Key,CKey);
- MakeKey(CKey);
- IF NOT FindInvtryByInvcode(CKey)
- THEN
- GeneralInventory(CKey)
- END;
- AssignStr(Key,CKey);
- LookUpOk := TRUE;
- DBFToFrame(InvtryDBF,CurrentDF); (* fill in the frame and update*)
- ShowDisplayFrame(CurrentDF,0,0,0,0);
- END LookUpInvty;
- PROCEDURE UpdateInvQuant(InvtryNbr : ARRAY OF CHAR; ChangeAmt: Real8);
- (* add the change amount to the on hand amount. The change amount could
- be positive or negative *)
- END UpdateInvQuant;
- PROCEDURE AddInvBatch();
- (* take the value from the screen and add to the inventory record*)
- (* used when new orders come in *)
- VAR
- OldLookup : Lookup;
- FrameName : AFrameName;
- AddStr : ARRAY[0..10] OF CHAR;
- AddAmt : Real8;
- B : BOOLEAN;
- InvRec : InvtryRec;
- BEGIN
- OldLookup := LookupProc; (* save old lookup proc *)
- LookupProc :=LookUpInvty;
- InitDisplayFrame(CurrentDF,CurrentWindow);
- REPEAT
- ReadDisplayFrame(PMIScreens,CurrentDF,'InvAdd');
- ShowDisplayFrame(CurrentDF,0,0,0,0);
- ControlFrame(CurrentDF,0,'',FALSE,FrameName);
- IF NOT LookUpOk
- THEN
- Prompt('Item not found ');
- ELSE
- ReadInput(CurrentDF,AddStr,'AddAmt');
- B := StrToReal(AddStr,0,AddAmt);
- B := FrameToDBF(InvtryDBF,CurrentDF);
- MoveInvtryFromDBF(InvRec);
- InvRec.ONHAND := InvRec.ONHAND + AddAmt;
- InvRec.ONORDER := 'N';
- MoveInvtryToDBF(InvRec);
- WriteDBRec(InvtryDBF);
- END;
- UNTIL NOT Equal(FrameName,'InvAdd');
- CloseDisplayFrame(CurrentDF);
- LookupProc := OldLookup;
- END AddInvBatch;
- PROCEDURE CtlKeyHandler(FrameRec : DisplayFrame; VAR LastKey : CARDINAL;
- VAR NextFrame : AFrameName);
- VAR
- B : BOOLEAN;
- BEGIN
- NextFrame := ContinueInput;
- CASE LastKey OF
- Key.PgUp : B:= PrevInvtry();
- |Key.PgDn : B:= NextInvtry();
- |Key.CtrlPgDn : LastInvtry();
- |Key.CtrlPgUp : FirstInvtry();
- |Key.Escape : NextFrame := CancelInput;
- |Key.Return : NextFrame := SubmitInput;
- ELSE
- END;
- IF NOT (LastKey = Key.Escape) (* update the display *)
- THEN
- DBFToFrame(InvtryDBF,FrameRec);
- ShowDisplayFrame(FrameRec,0,0,0,0);
- END;
- END CtlKeyHandler;
- PROCEDURE GetInvItem( VAR InvItem : InvtryRec): BOOLEAN;
- (* this routine controls the problems associated with not finding
- the inventory item on a lookup - will allow the user to
- go forward, backward in the inventory records till the
- correct item is found -
- Returns the item in the record
- otherwise returns false *)
- VAR
- OldKeyHandler : AKeyHandler;
- NxtFrame : AFrameName;
- B : BOOLEAN;
- BEGIN
- OldKeyHandler := TheKeyHandler;
- TheKeyHandler := CtlKeyHandler;
- InitDisplayFrame(InvtryDF,CurrentWindow);
- ReadDisplayFrame(PMIScreens,InvtryDF,'InvSearch');
- ReadDBRec(InvtryDBF,CurrentRec(InvcodeIdx)); (* get closest rec*)
- DBFToFrame(InvtryDBF,InvtryDF);
- ShowDisplayFrame(InvtryDF,0,0,0,0);
- ControlFrame(InvtryDF,1,'',TRUE,NxtFrame);
- TheKeyHandler := OldKeyHandler;
- B := Equal('SUBMIT',NxtFrame);
- CloseDisplayFrame(InvtryDF);
- IF B
- THEN
- MoveInvtryFromDBF(InvItem);
- RETURN TRUE;
- ELSE
- RETURN FALSE;
- END;
- END GetInvItem;
- PROCEDURE UpdateInvBatch();
- (* this routine will update the inventory items in a batch mode*)
- (* until the user hits esc key*)
- VAR
- OldLookup : Lookup;
- FrameName : AFrameName;
- B : BOOLEAN;
- BEGIN
- OldLookup := LookupProc; (* save old lookup proc *)
- LookupProc := LookUpInvty;
- InitDisplayFrame(CurrentDF,CurrentWindow);
- REPEAT
- ReadDisplayFrame(PMIScreens,CurrentDF,'InvUpdate');
- ShowDisplayFrame(CurrentDF,0,0,0,0);
- ControlFrame(CurrentDF,0,'',FALSE,FrameName);
- IF NOT LookUpOk
- THEN
- Prompt('Item not found ');
- ELSE
- B := FrameToDBF(InvtryDBF,CurrentDF);
- FixInvRec();
- WriteDBRec(InvtryDBF);
- END;
- UNTIL NOT Equal(FrameName,'Update');
- CloseDisplayFrame(CurrentDF);
- LookupProc := OldLookup;
- END UpdateInvBatch;
- PROCEDURE FileMenu(SelChar: CHAR);
- VAR
- B : BOOLEAN;
- Str : ARRAY [0..80] OF CHAR;
- BEGIN
- CASE SelChar OF
- 'A' : ReadDisplayFrame(PMIScreens,InvtryDF,'Invtry'); (*Clear out any of the fields *)
- ShowDisplayFrame(InvtryDF,0,0,0,0);
- Control(InvtryDF); (* alow user input *)
- AppendBlank(InvtryDBF);
- B := FrameToDBF(InvtryDBF,InvtryDF); (* do something if couldn't add*)
- FixInvRec();
- WriteDBRec(InvtryDBF);
- |'F' : FirstInvtry();
- DBFToFrame(InvtryDBF,InvtryDF);
- ShowDisplayFrame(InvtryDF,0,0,0,0);
- |'L' : LastInvtry();
- DBFToFrame(InvtryDBF,InvtryDF);
- ShowDisplayFrame(InvtryDF,0,0,0,0);
- |'N' : IF NextInvtry()
- THEN
- DBFToFrame(InvtryDBF,InvtryDF);
- ShowDisplayFrame(InvtryDF,0,0,0,0);
- END;
- |'P' : IF PrevInvtry()
- THEN
- DBFToFrame(InvtryDBF,InvtryDF);
- ShowDisplayFrame(InvtryDF,0,0,0,0);
- END;
- |'I' : (* The first unused letter in the index name or 'Q' *)
- Fill(ADR(Str),SIZE(Str),0);
- PromptStr('Enter Invtry Invcode ',Str);
- CrunchBlanks(Str);
- CAPstr(Str);
- IF NOT FindInvtryByInvcode(Str)
- THEN
- END;
- DBFToFrame(InvtryDBF,InvtryDF);
- ShowDisplayFrame(InvtryDF,0,0,0,0);
- |'O' : (* The first unused letter in the index name or 'Q' *)
- Fill(ADR(Str),SIZE(Str),0);
- PromptStr('Enter Invtry Orderfrm ',Str);
- CrunchBlanks(Str);
- IF NOT FindInvtryByOrderfrm(Str)
- THEN
- Prompt('Invtry Not Found');
- ELSE
- DBFToFrame(InvtryDBF,InvtryDF);
- ShowDisplayFrame(InvtryDF,0,0,0,0);
- END;
- END; (* end of case *)
- END FileMenu;
- PROCEDURE EditMenu(SelChar : CHAR);
- VAR
- B : BOOLEAN;
- BEGIN
- CASE SelChar OF
- 'U' : Control(InvtryDF);
- B := FrameToDBF(InvtryDBF,InvtryDF);
- FixInvRec();
- WriteDBRec(InvtryDBF);
- |'D' : IF PromptYN('About to delete inventory ',InvtryDF)
- THEN
- DeleteRecord(InvtryDBF);
- B := NextInvtry(); (* set the index to next - then prev to point to *)
- (* the correct item *)
-
- FileMenu('P'); (* display the next customer *)
- NoData := TRUE;
- END;
- END;
- END EditMenu;
- PROCEDURE Init();
- BEGIN
- NewList(PullDnMenu);
- LoadFrameList(PMIScreens,'InvtryTopMenu',PullDnMenu);
- InitInvtry := TRUE;
- END Init;
- PROCEDURE GeneralInventory(VAR InvtyCode : ARRAY OF CHAR);
- VAR
- Inv : InvtryRec;
- B : BOOLEAN;
- BEGIN
- InitDisplayFrame(InvtryDF,CurrentWindow);
- ReadDisplayFrame(PMIScreens,InvtryDF,'Invtry');
- MakeKey(InvtyCode);
- IF InvtyCode[0] = CHR(0)
- THEN FirstInvtry();
- ELSE
- IF NOT NextInvtry() (* assume already did a find by number *)
- THEN
- B := PrevInvtry();
- END;
- END;
- DBFToFrame(InvtryDBF,InvtryDF);
- ShowDisplayFrame(InvtryDF,0,0,0,0);
- IF NOT InitInvtry
- THEN Init();
- END;
- NoData := TRUE;
- REPEAT
- NextFrame := 'InvtryTopMenu';
- ControlSeparately(PullDnMenu,NextFrame,SelChar,EndingFrame);
- IF Equal(EndingFrame,'InvtryFileMenu')
- THEN FileMenu(SelChar);
- ELSIF Equal(EndingFrame,'InvtEditMenu')
- THEN EditMenu(SelChar);
- END;
- UNTIL SelChar='X'; (* Assumes 'X' is only used to exit *)
- MoveInvtryFromDBF(Inv);
- AssignStr(Inv.INVCODE,InvtyCode);
- CloseDisplayFrame(InvtryDF);
- END GeneralInventory;
- PROCEDURE ControlInvtry();
- VAR
- NextFrame : AFrameName;
- Str : ARRAY[0..10] OF CHAR;
- DF : DisplayFrame;
- BEGIN
- ClearScreen();
- InitDisplayFrame(DF,CurrentWindow);
- OpenInvtryDBF(TRUE);
- REPEAT
- ReadDisplayFrame(PMIScreens,DF,'InvtryMain');
- ControlFrame(DF,1,'',TRUE,NextFrame);
- IF Equal(NextFrame,'GenInv')
- THEN Str := '';
- GeneralInventory(Str);
- ELSIF Equal(NextFrame,'AddInv')
- THEN AddInvBatch();
- ELSIF Equal(NextFrame,'UpdateInv')
- THEN UpdateInvBatch();
- END;
- ClearScreen();
- UNTIL Equal(NextFrame,'Exit');
- CloseDisplayFrame(DF);
- END ControlInvtry;
- BEGIN
- InitInvtry := FALSE;
- END Invtry.
|