Added sales sample · KcsDev1982/sunbelt-plb-samples@151ff19 · GitHub
Skip to content

Commit 151ff19

Browse files
KcsDev1982KcsDev1982
committed
Added sales sample
Added sales sample to visual PL/B course
1 parent 5214a7d commit 151ff19

20 files changed

Lines changed: 1344 additions & 1 deletion

‎courses/plb_visual/LabExercises/sales/ABOUT.PLF‎

5.01 KB
Binary file not shown.

‎courses/plb_visual/LabExercises/sales/customer.inc‎

Lines changed: 27 additions & 0 deletions

‎courses/plb_visual/LabExercises/sales/customer.plf‎

7.47 KB
Binary file not shown.

‎courses/plb_visual/LabExercises/sales/customer.pls‎

Lines changed: 350 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,350 @@
1+
*....................................................
2+
.
3+
.Open the Customer File
4+
. If the customer file is empty, all controls except the
5+
. New and Close buttons are disabled. Otherwise, the
6+
. first record is displayed.
7+
*
8+
.Open the file
9+
.
10+
CustOpen
11+
TRAP CustPrep IF IO
12+
OPEN CUSTLIST
13+
TRAPCLR IO
14+
*
15+
.Build a collection of the EditText objects
16+
. and a collection of the command buttons
17+
. except New and Close.
18+
.
19+
LISTINS CUSTTEXT,cust_txtNumber:
20+
cust_txtName,cust_txtAddress:
21+
cust_txtCity,cust_txtState:
22+
cust_txtZipcode,cust_txtFName:
23+
cust_txtLName
24+
.
25+
LISTINS CUSTCMD,cust_cmdDelete:
26+
cust_cmdFirst,cust_cmdPrevious:
27+
cust_cmdNext,cust_cmdLast
28+
*
29+
.Attempt to read the first record
30+
.
31+
CALL CustFirst
32+
CALL CustCount
33+
RETURN
34+
*....................................................
35+
.
36+
.Create the Customer File
37+
.
38+
CustPrep
39+
ALERT TYPE=YESNO,"The Customer file "::
40+
"does not exist - Create It ?":
41+
RESULT,"Warning"
42+
STOP IF (RESULT = 7)
43+
.
44+
PREPARE CUSTFILE,"CUSTOMER","CUSTOMER":
45+
"1-10","167"
46+
PREPARE CUSTFILA,"CUSTOMER","CUSTOMER":
47+
"U,1-10,11-50,51-90,91-120,121-122,123-127,128-147,148-167","167"
48+
RETURN
49+
*....................................................
50+
.
51+
.Close the customer form
52+
.
53+
CustClose
54+
IF (Searching)
55+
SETPROP CUSTCMD,ENABLED=1
56+
CLEAR CUSTDATA,Searching
57+
SETPROP cust_cmdNew,ENABLED=1
58+
SETPROP cust_txtNumber,READONLY=1
59+
SETPROP cust_cmdFind,TITLE="&Find"
60+
SETPROP cust_cmdDelete,TITLE="&Delete"
61+
CALL CustPut
62+
CALL CustRead
63+
CALL CustCount
64+
ELSE
65+
CALL CustDelete IF (Adding)
66+
SETPROP frmCustomer,VISIBLE=0
67+
ENDIF
68+
RETURN
69+
*....................................................
70+
.
71+
.Read the Customer File by Customer Number
72+
.
73+
CustRead
74+
CALL CustFirst IF (CUSTNUM = 0)
75+
.
76+
MOVE CUSTNUM,CUSTKEY
77+
TRAP CustRead1 IF IO
78+
READ CUSTFILE,CUSTKEY;CUSTDATA
79+
TRAPCLR IO
80+
RETURN IF OVER
81+
.
82+
CALL CustPut
83+
.
84+
CustRead1
85+
RETURN
86+
*....................................................
87+
.
88+
.Read the First Customer Record
89+
.
90+
CustFirst
91+
IF (SEARCHING)
92+
READ CUSTFILA,CUSTKEYA;CUSTDATA
93+
ELSE
94+
FILL " ",CUSTKEY
95+
READ CUSTFILE,CUSTKEY;;
96+
READKS CUSTFILE;CUSTDATA
97+
.
98+
IF OVER
99+
SETPROP CUSTTEXT,ENABLED=0
100+
SETPROP CUSTCMD,ENABLED=0
101+
RETURN
102+
ENDIF
103+
ENDIF
104+
.
105+
CALL CustPut
106+
RETURN
107+
*....................................................
108+
.
109+
.Read the Previous Customer Record
110+
.
111+
CustPrevious
112+
IF (Searching)
113+
READKGP CUSTFILA;CUSTDATA
114+
ELSE
115+
READKP CUSTFILE;CUSTDATA
116+
ENDIF
117+
IF OVER
118+
ALERT NOTE,"Beginning of file.",RESULT,"Move Previous"
119+
GOTO CustFirst
120+
ENDIF
121+
.
122+
CALL CustPut
123+
RETURN
124+
*....................................................
125+
.
126+
.Read the Next Customer Record
127+
.
128+
CustNext
129+
IF (SEARCHING)
130+
READKG CUSTFILA;CUSTDATA
131+
ELSE
132+
READKS CUSTFILE;CUSTDATA
133+
ENDIF
134+
IF OVER
135+
ALERT NOTE,"End of file.",RESULT,"Move Next"
136+
GOTO CustLast
137+
ENDIF
138+
.
139+
CALL CustPut
140+
RETURN
141+
*....................................................
142+
.
143+
.Read the Last Customer Record
144+
.
145+
CustLast
146+
IF (SEARCHING)
147+
READLAST CUSTFILA,CUSTKEYA;CUSTDATA
148+
ELSE
149+
FILL "9",CUSTKEY
150+
READ CUSTFILE,CUSTKEY;;
151+
READKP CUSTFILE;CUSTDATA
152+
RETURN IF OVER
153+
ENDIF
154+
.
155+
CALL CustPut
156+
RETURN
157+
*....................................................
158+
.
159+
.Delete the Customer Record
160+
.
161+
CustDelete
162+
IF (Adding)
163+
SETPROP CUSTCMD,ENABLED=1
164+
CLEAR CUSTDATA,Adding
165+
SETPROP cust_cmdNew,ENABLED=1
166+
SETPROP cust_txtNumber,READONLY=1
167+
CALL CustPut
168+
CALL CustRead
169+
.
170+
ELSE
171+
RETURN IF (CUSTNUM = 0)
172+
DELETE CUSTLIST
173+
CALL CustNext
174+
CALL CustPrevious IF OVER
175+
CALL CustCount
176+
ENDIF
177+
.
178+
CALL OrdCust
179+
RETURN
180+
*....................................................
181+
.
182+
.Add a Customer Record
183+
.
184+
CustNew
185+
SET ADDING // Indicate Adding
186+
SETPROP CUSTTEXT,ENABLED=1 // Enable EditTexts
187+
SETPROP cust_txtNumber,READONLY=0 // Allow Number Entry
188+
SETPROP CUSTCMD,ENABLED=0 // Disable Buttons
189+
SETPROP cust_cmdNew,ENABLED=0 // Disable New
190+
SETPROP cust_cmdDelete,ENABLED=1 // Enable Delete
191+
SETFOCUS cust_txtNumber // Position Cursor
192+
DELETEITEM CUSTTEXT,0 // Clear Fields
193+
RETURN
194+
*....................................................
195+
.
196+
.Save a Customer Record
197+
.
198+
CustSave
199+
CALL CUSTGET
200+
.
201+
IF (ADDING)
202+
WRITE CUSTLIST;CUSTDATA
203+
CALL CustCount
204+
CLEAR ADDING
205+
SETPROP CUSTCMD,ENABLED=1
206+
SETPROP cust_cmdNew,ENABLED=1
207+
SETPROP cust_txtNumber,READONLY=1
208+
ELSE
209+
UPDATE CUSTLIST;CUSTDATA
210+
ENDIF
211+
.
212+
SETPROP cust_cmdSave,ENABLED=0
213+
CALL OrdCust
214+
RETURN
215+
*....................................................
216+
.
217+
.Update the count of Customers
218+
.
219+
CustCount
220+
IF (SEARCHING)
221+
SETITEM cust_lblCount,0,"Search Results"
222+
ELSE
223+
GETFILE CUSTFILE,RECORDCOUNT=NWORK10
224+
.
225+
IF (NWORK10 = 0)
226+
MOVE "No Customers",MSG
227+
ELSEIF (NWORK10 = 1)
228+
MOVE "1 Customer",MSG
229+
ELSE
230+
MOVE NWORK10,DIM10
231+
SQUEEZE DIM10,DIM10
232+
PACK MSG WITH DIM10," Customers"
233+
ENDIF
234+
.
235+
SETITEM cust_lblCount,0,MSG
236+
.
237+
IF (NWORK10 > 1)
238+
SETPROP CUSTCMD,ENABLED=$TRUE
239+
ENDIF
240+
ENDIF
241+
RETURN
242+
*....................................................
243+
.
244+
.Transfer Record Data to the Form Objects
245+
.
246+
CustPut
247+
IF (CUSTNUM > 0)
248+
MOVE CUSTNUM,CUSTKEY
249+
ELSE
250+
CLEAR CUSTKEY
251+
ENDIF
252+
.
253+
SETITEM cust_txtNumber,0,CUSTKEY
254+
SETITEM cust_txtName,0,CONAME
255+
SETITEM cust_txtAddress,0,ADDRESS
256+
SETITEM cust_txtCity,0,CITY
257+
SETITEM cust_txtState,0,STATE
258+
SETITEM cust_txtZipcode,0,ZIPCODE
259+
SETITEM cust_txtFName,0,CONTACTFN
260+
SETITEM cust_txtLName,0,CONTACTLN
261+
RETURN
262+
*....................................................
263+
.
264+
.Transfer Record Data from the Form Objects
265+
.
266+
CustGet
267+
GETITEM cust_txtNumber,0,Result
268+
IF ZERO
269+
CLEAR CUSTNUM
270+
ELSE
271+
GETITEM cust_txtNumber,0,CUSTKEY
272+
MOVE CUSTKEY,CUSTNUM
273+
ENDIF
274+
.
275+
GETITEM cust_txtName,0,CONAME
276+
GETITEM cust_txtAddress,0,ADDRESS
277+
GETITEM cust_txtCity,0,CITY
278+
GETITEM cust_txtState,0,STATE
279+
GETITEM cust_txtZipcode,0,ZIPCODE
280+
GETITEM cust_txtFName,0,CONTACTFN
281+
GETITEM cust_txtLName,0,CONTACTLN
282+
RETURN
283+
*....................................................
284+
.
285+
.Enable the Save button when the required files are input
286+
.
287+
CustVerify
288+
SETPROP cust_cmdSave,ENABLED=$FALSE
289+
GETITEM Cust_txtNumber,0,RESULT // Number is required
290+
RETURN IF ZERO
291+
GETITEM Cust_txtName,0,RESULT // Name is required
292+
RETURN IF ZERO
293+
.
294+
SETPROP cust_cmdSave,ENABLED=$TRUE
295+
RETURN
296+
*....................................................
297+
.
298+
.Locate a customer
299+
.
300+
CustFind
301+
IF (Searching)
302+
CALL CUSTGET
303+
CLEAR CUSTKEYA
304+
IMPLODE MSG,";",cust_txtNumber:
305+
cust_txtName,cust_txtAddress:
306+
cust_txtCity,cust_txtState:
307+
cust_txtZipcode,cust_txtFName:
308+
cust_txtLName
309+
EXPLODE MSG,";",CUSTKEYA
310+
FOR FIELDNO,"1",CUSTFCNT
311+
COUNT RESULT,CUSTKEYA(FIELDNO)
312+
IF NOT ZERO
313+
IF (CUSTSRCH(FIELDNO) = "F" AND RESULT < 3)
314+
ALERT CAUTION,"At least three characters required for search":
315+
RESULT,"Find"
316+
RETURN
317+
ENDIF
318+
PACK DIM10 WITH FIELDNO,CUSTSRCH(FIELDNO)
319+
REP " 0",DIM10
320+
SPLICE DIM10,CUSTKEYA(FIELDNO)
321+
ENDIF
322+
REPEAT
323+
READ CUSTFILA,CUSTKEYA;CUSTDATA
324+
IF OVER
325+
ALERT NOTE,"No matching records found",RESULT,"Find"
326+
SETFOCUS cust_txtNumber
327+
ENDIF
328+
CALL CUSTPUT
329+
SETPROP cust_cmdDelete,ENABLED=1
330+
SETPROP cust_cmdFirst,ENABLED=1
331+
SETPROP cust_cmdPrevious,ENABLED=1
332+
SETPROP cust_cmdNext,ENABLED=1
333+
SETPROP cust_cmdLast,ENABLED=1
334+
RETURN
335+
336+
ELSE
337+
SET SEARCHING // Indicate Adding
338+
SETPROP CUSTCMD,ENABLED=0 // Disable Navigation
339+
SETPROP cust_cmdNew,ENABLED=0 // Disable New
340+
SETPROP CUSTTEXT,ENABLED=1 // Enable EditTexts
341+
SETPROP cust_txtNumber,READONLY=0 // Allow Number Entry
342+
SETPROP cust_cmdClose,ENABLED=1: // Enable Delete
343+
Title="Cancel" // Change Caption
344+
SETPROP cust_cmdFind,Title="Search" // Change Caption
345+
SETFOCUS cust_txtNumber // Position Cursor
346+
DELETEITEM CUSTTEXT,0 // Clear Fields
347+
ENDIF
348+
.
349+
CALL CustCount
350+
RETURN

‎courses/plb_visual/LabExercises/sales/customer.txt‎

1014 Bytes
Binary file not shown.

‎courses/plb_visual/LabExercises/sales/detail.inc‎

Lines changed: 15 additions & 0 deletions

‎courses/plb_visual/LabExercises/sales/detail.plf‎

2.85 KB
Binary file not shown.

0 commit comments

Comments
 (0)