luni, 1 iulie 2013

FoxProW pentru incepatori Cap. 10 P.2

Continuare Cap. 10 p. 2

Program: C:\CURS\PROGT\MENUS.PRG
System: Evidenta situatiilor financiar-contabile Author: Emil Pfeiffer Copyn'ght(c) 1998, Emil Pfeiffer Lasîmodified: 08/14/98 9:59
Called by: FIN.PRG
Calls: INTMENU.PRG
IESMENU.PRG
CORMENU.PRG
LINMENU.PRG
LOUMENU.PRG
INMENU.PRG
LISMENU.PRG
ACTMENU.PRG
CINTMENU.PRG
COUTMENU.PRG
Documented 08/14/98 at 10:19 FoxDoc
DEFINING THE MAIN MENU AND POP-UP'S
********************************
28 set talk off
29 clea
30 set color set to co1
31 define menu mainmenu
32 define pad intrari of mainmenu prompt 'INTRARI' at 0,0
33 define pad iesiri of mainmenu prompt 'IESIRI' at 0,8
34 define pad corectii of mainmenu prompt 'CORECTII' at 0,15
35 define pad list_jn of mainmenu prompt 'LIST INTR' at 0,25
36 define pad list_out of mainmenu prompt 'LIST ies' at 0,35
37 define pad init of mainmenu prompt 'INITIALIZARE' at 0,44
38 define pad list_stoc of mainmenu prompt 'LIST STOC' at 0,58
39 define pad actual of mainmenu prompt 'ACTUALIZARE' at 0,68
40
41 on pad intrari of mainmenu activate popup intpop
42 on pad iesiri of mainmenu activate popup iespop
43 on pad corectii of mainmenu activate popup corpop
44 on pad listjn of mainmenu activate popup linpop
45 on pad list_out of mainmenu activate popup loupop
46 on pad init of mainmenu activate popup inpop
47 on pad list_stoc of mainmenu activate popup lispop
48 on pad actual of mainmenu activate popup actpop
49
50 define popup intpop from 2,1 shadow
51 define bar 1 ofintpop prompt '\<Note de Predare' message;
52 Aceasta functie este invalida!!! Selectati alta'
53 define bar 2 ofintpop prompt 'h \<lnventar' message;
54 Aceasta functie este invalida!" Selectati alta'
55 define bar 3 of intpop prompt 'Nota de \<Receptie' message;
56 Aceasta functie este invalida!!! Selectati alta'
57 on selection popup intpop do intmenu
58
59 define popup iespop from 2,8 shadow
60 define bar 1 of iespop prompt '\<Proces Verbal de Casare' message;
61 Aceasta functie este invalida!!! Selectati alta'
62 define bar 2 of iespop prompt '\<Facturi' message;
63 Aceasta functie este invalida!!! Selectati alta'
64 define bar 3 of iespop prompt '\<Note de Transfer' message;
65 Aceasta functie este invalida!!! Setectati alta'
66 define bar 4 of iespop prompt 'Note de \<Restituire' message;
67 Aceasta functie este invalida!!! Selectati alta'
68 define bar 5 of iespop prompt '\<Scoatere din custodie' message;
69 ' Aceasta functie este invalida!!! Selectati alta'
70 define bar 6 of iespop prompt '\<Bon de consum' message;
71 ' Realizeaza inregistrarea bonurilor de consum'
72 on selection popup iespop do iesmenu
73
74 define popup corpop from 2,15 shadow
75 define bar 1 of corpop prompt '\<Intrari' message;
76 Aceasta functie este invalida!!! Selectati alta'
77 define bar 2 of corpop prompt 'i\<Esiri' message;
78 ' Realizeaza corectarea unor documente care au fost introduse anterior'
79 define bar 3 of corpop prompt' \<Fisademagazielmessage;
80 ' Realizeaza vizualizarea fisei de magazie'
81 on seiection popup corpop do cormenu
82
83 define popup linpop from 2,24 shadow
84 define bar 1 of linpop prompt 'Centralizare pe \<Conturi' message;
85 ' Aceasta functie este invalida!!! Selectati alta'
86 define bar 2 of linpop prompt 'Centralizare pe tip \<Document';
87 message ' Aceasta functie este invalida!!! Selectati alta'
88 define bar 3 of linpop prompt '\<Lista documentelor' message;
89 ' Aceasta functie este invalida!!! Selectati alta'
90 on selection popup linpop do linmenu "
91
92 define popup loupop from 2,31 stiadow
93 define bar 1 of loupop prompt 'Centralizare pe \<Beneficiari';
94 message' Aceasta functie este invalida!!'Selectati aita'
95 define bar 2 of loupop prompt 'Centralizare pe \<Conturi' message;
96 ' Aceasta functie este invalida!!! Selectati alta'
97 define bar 3 of loupop prompt 'Centralizare pe tip \<Document';
98 message ' Aceasta functie este invalida!!! Selectati alta'
98 define bar 4 of loupop prompt 'Situatia \<Vinzarilor' message;
00 ' Aceasta functie este invalida!" Setectati a'ta'
101 define bar 5 of loupop prompt '\<Lista documentelor' message;
102 ' Aceasta functie este invalida!!! Selectati alta'
103 on selection popup loupop do loumenu
104
105 define popup inpop from 2,40 shadow
106 define bar 1 of inpop prompt '\<0perare in stocuri' message;
107 ' Aceasta functie este invalida!!! Selectati alta'
108 define bar 2 of inpop prompt '\<Penalizari Facturi' message ;
109 ' Aceasta functie este invalida!." Selectati alta'
110 define bar 3 of inpop prompt '\<Verificare stoc = O' message;
111 ' Aceasta functie este invalida!." Seiectati alta'
112 on selection popup inpop do inmenu
113
114 define bar 1 of lisnop prompt '\<Ecran balanta verificare' message'
115 ' Vizualizarea balantei de verificare'
117 define bar 2 of lispop prompt 'Balanta \<Analitica' message;
118 ' Aceasta functie este invalida!!! Selectati alta'
119 define bar 3 of lispop prompt 'Situatia \<7' message;
120 ' Aceasta functie este invalida!!! Selectati alta'
121 define bar 4 of lispop prompt '\<Balanta sintetica' message;
122 ' Aceasta functie este invalida!!! Selectati alta'
123 define bar 5 of lispop prompt 'Balanta de \<Verificare' message;
124 ' Aceasta functie este invalida!!! Selectati alta'
125 define bar 6 of lispop prompt 'Balanta sintetica pe \<Mag.';
126 message ' Aceasta functie este invalida!!! Selectati alta'
127 define bar 7 of lispop prompt 'Stocuri cu miscare \<Lenta';
128 message ' Aceasta functie este invalida!!! Selectati alta'
129 define bar 8 of lispop prompt 'Stocuri \<Fara miscare' message;
130 ' Aceasta functie este invalida!!! Selectati alta'
131 define bar 9 of lispop prompt 'ColectareNote\<Predare' message;
132 ' Aceasta functie este invalida!!! Selectati alta'
133 define bar 10 of lispop prompt '\<Salvare (dbf.zip)' message;
134' Realizeaza salvarea bazelor de date pe luna. Se executa inainte de inchidere!!'
135 on selection popup lispop do lismenu
136
137 define popup actpop from 2,61 shadow
138 define bar 1 of actpop prompt '\<Adaugare' message;
139 ' Aceasta functie este invalida!!! Setectati alta'
140 define bar 2 of actpop prompt '\<Modificare' message;
141 ' Aceasta functie este invalida!!! Selectati a!ta'
142 define bar 3 of actpop prompt '\<Stergere' message;
143 ' Aceasta functie este invalida!!! Selectati alta'
144 define bar 4 of actpop prompt'\<Listare'message;
145 ' Aceasta functie este invalida!!! Selectati alta'
146 define bar 5 of actpop prompt '\<Vizualizare' message;
147 ' Aceasta functie este invalida!!! Selectati alta'
148 definebar6ofactpopprompt'\<CalculCC'message;
149 ' Realizeaza calculul cifrei de control'
150 define bar 7 of actpop prompt '\<Beneficiari adaugare' message;
151 ' Aceasta functie este invalida!!! Selectati alta'
152 define bar 8 of actpop prompt '\<Editare benef message;
153 ' Aceasta functie este invalida!!! Selectati alta'
154 define bar 9 of actpop prompt 'Ster\<gere beneficiari'message;
155 ' Aceasta functie este invalida!!! Selectati alta'
156 define bar 10 of actpop prompt "\/i\zualizare bânef messaae;
157 ' Aceasta functie este invalida!!! Selectati alta'
158 define bar 11 of actpop prompt '\<Terminare program' message;
159 'lesirea din lucrare'
160 on selection popup actpop do actmenu
161
162 define popup int1 pop from 8,20 shadow
163 define bar 1 of int'i pop prompt "\<Note de Predare' message;
164 ' Aceasta functie este invalida!!! Selectati alta'
155 define bar 2 of int1 pop prompt 'h \<!nventar' message;
156 ' Aceasta functie este invalida!!! Selectati alta'
157 define bar 3 of int1 pop prompt 'Nota de \<Receptie' message;
158 ' Aceasta functie este invalida!!! Selectati alta'
169 on selection popup intlpop do cintmenu
170
171 define popup ies1pop from 8,20 shadow
172 define bar 1 of ies1pop prompt '\<Proces Verbal de Casare';
173 message ' Aceasta functie este invalida!!! Selectati alta'
174 define bar 2 of ies1 pop prompt '\<Facturi' message;
175 ' Aceasta functie este invalida!!! Selectati alta'
176 define bar 3 of iest pop prompt '\<Note de Transfer' message;
177 ' Aceasta functie este invalida!!! Seiectati alta'
178 define bar 4 of ies1 pop prompt 'Note de \<Restituire' message;
179 ' Aceasta functie este invalida!!! Selectati alta'
180 define bar 5 of ieslpop prompt '\<Scoatere din custodie' message;
181 ' Aceasta functie este invalida!!! Selectati alta'
182 define bar 6 of ies1 pop prompt '\<Bonu"; de consum' message;
183 'Corectie la bonurile de consum introduse'
184 on selection popup ies1 pop do coutmenu
185: EOF: MENUS.ACT
Programul MENUS.PRG este programul care vizualizează şi serveşte la
selectarea şi lansarea programelor componente ale lucrării de evidenţă contabilă a produselor finite şi a materialelor. O mare parte din opţiunile acestei lucrări sunt invalide, oarece sunt multe programe şi pentru a evita o lucrare extrem de voluminoasă nu prezentăm toate programele, Programete care nu sunt valide sunt semnalate (mesaj în subsolul ecranului) la selectarea opţiunii respective, pentru a evita încercarea de lansare a acestei opţiuni (eroare).

1 ****************************************
2 *
3 * Program: C:\CURS\PROGT\IESMENU.PRG
4 *
5 * System: Evidenta situatiilor financiar-contabile
6 * Author: Emil Pfeiffer
7 * Copyright (c) 1998, Emil Pfeiffer
8 * Last modified: 03/29/97 10:47
9 *
10 * Called by: MENUS.PRG
11 *
12 * Calls: BAR() (function in ?)
13 : PVC.PRG
14 : AE.PRG
15 : NT.PRG
16 : NP.PRG
17 : OCUST.PRG
18 : BC.PRG
19 *
20 * Documented 08/14/98 at 10.19
21 *************************************
22 choice = bar()
23 hide menu mainmenu
24 hide popup iespop
25 flmstoc = .f.
26 do case
27 case choice = 1
28 do pvc
29 case choice = 2
30 do ae
31 case choice = 3
32 do nt
33 case choice = 4
34 do np with 33
35 case choice = 5
36 do ocust
37 case choice = 6
38 do bc with 11
39 endcase
40 deactivate window all
41 show menu mainmenu
42 show popup intpop
43 clear
44 return
45 *
46 *EOF: IESMENU.ACT

Este meniul de lansare a documenfelor de ieşire din lucrarea de evidenta a produselor finite şi materialelor.
1 **********************************
2 *
3 * Procedure file: C:\CURS\PROGtBC.PRG\
4 *
5 * System: Evidenta situatiilor financiar-contabile
6 * Author: Emil Pfeiffer
7 * Copyright (c) 1998, Emil Pfeiffer
8 * Last modified: 03/29/97 10:47
9 *
10 * Procs & Fncts: DESIGN
11 * GET_ANTET
12 * GET_TEMS
13 * GET_LINE
14 * MOVE_UP
15 * MOVE_DOWN
16 * NO_DOC
17 * DEL REC
18 *

19 * Set by:IESMENU.PRG
20 *
21 * Calls DESIGN (procedure in BC.PRG)
22 * DATE() (function in ?)
23 * GET_ANTET (procedure in BC.PRG)
24 * GET_ITEMS (procedure in BC.PRG)
25 *
26 * Uses: MISC.DBF :
27 * TMP.DBF :
28 * NOM.DBF
29 *
30 * Indexes: INDMISC.IDX
31 ISMISC.IDX
32 INDNOM.IDX
33 *
34 * Documented 08/14/98 at 10:20 FoxDoc
35 **********************************************
36 *
37 * NP.PRG culegere BC-uri, FL-uri şi FD-uri
38 *********************************
39 parameter document
40 close databases
41 activate screen
42 clear
43 define window errwind from 1,40 to 3,79 double color scheme 1
44 define window itemwind from 15,6 to 23,74 none
45 select a
46 use misc index indmisc, fismisc
47 select b
48 use tmp
49 *—————————!!!
50 select d
51 use nom index indnom
52 *----------------------------!!!
53 select b
54 do design
55 nir = .t.
56 vdata = date()
57 do while nir
58 select tmp
59 zap
60 store 0 to vnrdoc, vsec, vform, vmag
61 store ' ' to vum
62 do get_antet
63 if nir
64 do get_items
65 endif
66 enddo
67 close databases
68 activate screen
69 clear
70 retum
71
80 *,****************************
81 *!
82 *! Procedure: DESIGN
83 *.'
84 *! Called by: BC.PRG
85 *! : CORBC.PRG
86 *
87 *********************************
80 procedure design
81
82 *ANTET
83 @ 2,5,8,75 box
84 @ 4, 5 to 4, 75
85 @ 6,5 to 6,75
86 i = 0
87 for i=19 to 61 step 14
88 @ 5, i say '|' && semnul este bara verticală 'l'
89 @ 7, i say '|'
90 @ 4, i say ' ┴ ' && semnuf este continuare cu leg. sus.
91 @ 6, i say '┼' && semnul este continuare în cruce.
92 @ 8,i say '┬' && semnul este continuare cu leg. jos.
93 endfor
94 for i=4 to 6 step 2
95 @ i,5 say'├' && semnul ester contin. limitat stânga.
96 @ i,75 say '┤' &&semnuleste 'contin.limitat dreapta.
97 endfor
&& semnele se găsesc în meniul FOX SPECIAL CHARACTER
98 @ 2,13 say '|'
99 @ 4,13 say ' ┴ '
100 @ 3,13 say '├'
101 do case
102 case document = 11
103 @ 0, 30 say 'OPERARE BONURf DE CONSUM'
104 case document = 12
105 @ 0,30 say 'OPERARE FISE LIMITA'
106 case document = 13
107 @ 0,30 say 'OPERARE FiSE DE DEROGARE'
108 endcase
109 @ 3, 7 say'ANTET' color r/w+
110 @ 5, 7 say 'NR.DOCUMEN'
111 @ 5,24 say'DATA'
112 @ 5,37 say'SECTIA'
113 @ 5. 51 say 'FORMATIA'
114 @ 5. 65 say 'MAGAZIA'
115 *
116 *POZITII
117 @ 10,5,25,75 box
118 @ 12,5 to 12,75
119 @14, 5 to14,75
120 for i=11 to 59 step 16
121 @ 12,i say "│"
122 @13,i say "│"
123 @14,i say "┼"
124 @ 24, i say "┴"
125 endfor
126 for i=12 to 14 step 2
127 @ i,5 say '├'
128 @ i, 75 say "┤"
129 endfor
130 activate window itemwind
131 for i = 0 to 8
132 for j=5 to 53 step16
133 @ i,j say "│"
134 endfor
135 endfor
136 activate screen
137 @11,7 say 'POZITII 'color r/w+
138 @10,15 say "│"
139 @11,15 say '|'
140 @12,15 "┴"
141 @11,16 say 'MATERIAL:'
142 @13,7 say 'NR.'
143 @13,13 say 'CODMATERIAL'
144 @ 13,34 say 'CONT'
145 @ 13,47 say 'CANTITATE'
146 @13,64 say 'VALOARE'
147 @ 9,5 say 'CANTITATE' color gr+/b
148 @ 9,40 say 'VALOARE:' color gr+/b
149 retum
150 *
163 *********************
164 *
165 Procedure: GET_ANTET
166 *
167 Called by: BC.PRG
168 : CORBC.PRG
169 *
170 Calls: SYS() (function in ?)
171 NO_DOC (procedure in BC.PRG)
172 READKEY (function in ?)
173 *
174 **********************************
163 procedure get_antet
164 = sys(2002,1) && set cureor on
165 set intensity on
166 set confirm on
167 antet_ok = .f.
168 do while .not. antet_ok
169 @ 7,10 get vnrdoc picture [999999] valid no_doc(vnrdoc)
170 @ 7,22 get vdata when vnrdoc # 0
171 @ 7,39 get vsec picture [99] when vnrdoc # 0
172 @ 7,54 get vform picture [99] when vnrdoc # 0
173 @ 7,68 get vmag picture [99] when vnrdoc # 0
174 read
175 exit_code = readkey()
176 antet_ok = (exit_code = 15) .or. (exit_code = 271) .or.;
177 (exit_code = 7) .or. (exit_code = 263)
178 if vnrdoc > 0
179 nir = .t.
180 else
181 nir = .f.
182 endif
183 enddo
184 return
185 *
212 ******************************************
213 *
214 * Procedure: GET_ITEMS
215 *
216 * Called by: BC.PRG
217 * : CORBC.PRG
218 *
219 * Calls: REPLICATE() (function in ?)
220 * : STR() (function in ?)
221 : INKEYQ function in ?)
222 : MOVE_UP (procedure in BC.PRG)
223 : MOVE.DOWN (procedure in BC.PRG)
224 : DEL_REC (procedure in BC.PRG)
225 : CHR() function in ?)
226 : GET_LINE (procedure in BC.PRG)
227 EOF() (function in?)
228 ADDSTOC.PRG
229 RECNO() (function in ?)
230 SUBSTOC.PRG
231 REC1() (function in ?)
232 RECCOUNT() (function in ?)
233 MIN() ( function in ?)
234
235 Uses: TMP.DBF
236*
237 *************************************
212 procedure get_tems
213 set intensity off
214 modifying = .f.
215 select tmp
216 activate window itemwind
217 nr=1
218 records=0
219 row_nr=0
220 store 0 to vcod, vpret, vcant, wal
221 vum=' '
222 vcont=replicate( ,12)
223 iteming = .t.
224 store 0 to totcant, totval
225 do white iteming
226 @ row_nr, 1 say str(nr, 2) +'.'
227 if modifying
228 @ row_nr, 09 say vcod picture [9999999999]
229 @ row_nr, 23 say vcont
230 @ row_nr, 40 say vcant picture [9999999.999]
231 @ row_nr, 57 say vcant * vpret picture [99999999,99]
232 endif
233 @ row_nr, 09 say"
234 ch=inkey(0)
235 do case
236 case ch=5
237 do move_up
238 case ch=24
239 do move_down
240 case ch = 7
241 = del_rec(nr)
242 activate screen

243 stc=str(totcant,11,3)
244 stv=str(totval ,12,2)
245 @ 9,17 get stc colorgr+/b

246 @ 9,50 get stv color gr+/b

247 clear gets

248 activate window itemwind

249 case (ch > 47 .and. ch < 58) .or. ch = 13

250 keyboard chr(ch)
251 do get_line
252 activate screen
253 stc = str(totcant, 11,3)
254 stv = str(totval ,12,2)
255 @ 9,17 get stc color gr+/b
256 @ 9,50 get stv colorgr+/b
257 clear gets
258 activate window itemwind
259 endcase
260 enddo
261 select misc
262 select tmp
263 go top
264 if.not.eof0
265 scan all
266 select misc
267 append blank
268 replace type with document, sec with vsec, form with vform
269 replace nrdoc with vnrdoc, data with vdata;
270 mag with vmag
271 replace cont with tmp.cont,cod with tmp.cod, pret with tmp.pret;
272 cant with tmp->cant, valoare with tmp->valoare
273 select tmp
274 endscan
275 *---——————
276 do addstoc with document,vmag
277 *-—-.——————!!!
278 endif
279 clear
280 for i = 0 to 8
281 for j = 5 to 53 step 16

282 @ i,j say 

283; Endfor;
284; Endfor
285; activate screen
286; totcant = 0
287; totval = 0
288; stc = str(totcant, 11,3)
289; stv = str(totval ,12,2)
290; @ 9,17 get stc color gr+/b
291; @ 9,50 get stv color gr+/b
292; clear gets
293; set intensity on
294; return
295
309; ***********************
310; *i
311; *! Procedure: GET_LINE
312; *.
313; *.' Called by: GET_ITEMS; (procedure in BC.PRG)
314
315; *' Calls: ISMAT(); (function in ACTMENU.PRG)
315; *! : STR() (function in?)
317; *! : VAL() ; (function in ?)
318; *! : READKEY(); (function in?)
319; *! :CCONTROL; (procedure in FIN.PRG)
320; *l
321 ; ******************************;
309; procedure get_line
310; lineok = .f.
311; do while .not. lineok
312; @ rownr, 09 get vcod picture; [9999999999] valid:
313; is_mat(vcod)
314; read
315; sele nom
316; Seek str(vcod,10)
317; vcont=nom.cont
318; vv=val(cont)
319; If vv>=300
320; vv=vv+300
321; else
322; vv=vv+300
323 endif
324 vcont='600'
325 sele tmp
326 @ row_nr, 23 get vcont pict '!!!!!!!!!!' when vcod > 0
327 @ row_nr, 40 get vcant picture [9999999.999] when vcod > 0
328 read
329 @ row_nr, 57 say vcant * vpret picture [99999999.99]
330 exit_code = readkey()
331 if exit_cod = 15 .or. exit_code = 271
332 line_ok =.t.
333 endif
334 enddo
335 select tmp
336 if vcod = 0
337 iteming = .f.
338 else
339 totcant = totcant + vcant
340 totval =totval +vcant*vpret
341 if modifying
342 totcant=totcant-cant
343 totval =totval-cant*pret
344 endif
345 row_nr=row_nr+1
346 if row_nr=9
347 row_nr=8
348 scroll 10,0,8,68,1
349 for i = 5 to 53 step16
350 @ 8, i say '|'
351 endfor
352 endif
353 if .not.modifying
354 records = records + 1
355 append blank
356 endif
357 replace cant with vcant
358 replace cod with vcod
359 replace pret with vpret
360 replace valoare wit vcant*vpret
351 replace cont with vcont
362 skip
363 nr=nr+1
364 if nr > records
365 modifying = .f.
366 else
367 vcod =cod
368 vcant = cant
369 vcont = cont
370 vpret = pret
371 endif
372 endif
373 return
374
382 *****************************
383 *.
384 *! Procedure: MOVE_UP
385 *!
386*! Called by: GET_ITEMS (procedure in BC.PRG)
387 *!
382 procedure move_up
383 if nr>1
384 modifying = .t.
385 nr=nr-1
386 if nr = records
387 @ row_nr, 1 say' '
388 endif
389 if row_nr>0
390 row_nr = row_nr - 1
391 else
392 scroll 0,0,8,68, -1
393 for i=5 to 53 step 16
394 @ row_nr, i say 'l'
395 endfor
396 endif
397 select tmp
398 skip -1
399 vcod =cod
400 vcant = cant
401 vcont = cont
402 vpret = pret
403 endif
404 return
405 *

413 ************************************
414 *
415 * PROCEDURE MOVE_DOWN
416 *
417 * Called by GET_ITEMS (procedure in BC.PRG)
418 *
419 ************************************
413 procedure move_down
414 sele tmp
415 if nr=records
415 skip
416 nr = nr + 1
417 if row_nr>8
row_nr = row_nr + 1
419 else
421 scroll 0,0,8,68,1
422 for i = 5 to 53 step 16
423 @ row_nr,i say '|'
424 endfor
425 endif
426 endif
427 if nr > records
428 modifying = .F.
429 else
430 vcod = cod
431 vcant = cant
432 vcont = cont
433 vpret = pret
434 endif
435 return
436
451 **********************************
452 *
453 * Function IS_MAT()
454 *
455 * Called by ACTMENU.PRG
456 * : FIS.PRG
457 * : GET_LINE (procedure in BC.PRG)
458 *
459 * Calls: STR() (function in ?)
460 * FOUND() (function in ?)
461 *!:SUBSTR() (function in?)
462 * : CHR() (function in?)
463 *
464 ****************************************
451 function is_mat
452 parameter xcod
453 if xcod>0
454 *************************
455 scod = str(xcod,8)
456 select nom
457 ********************
458 find '&scod'
459 if found()
460 vpret = pretunitar
461 vum=unitmas
462 deactivate window errwind
463 activate screen
464 @ 11,27 say substr(denumire, 1,45)
465 @11,71 say unitmas
466 activate window itemwind
467 return .t.
468 else
469 activate window errwind
470 @ 0,1 say 'Material inexistent in nomenclator!'
471 return .f.
472 endif
473 else
474 return .t.
475 endif
476
489 *
Procedure: NO_DOC

490 *


491 *
Called by: GET_ANTET
ANTET (proced in BC
492 *


493 *
Calls: STR()
(function in?)
494 *
:FOUND()
(function in?)
495 *



function no_doc
parameter coddoc
if coddoc > 0
select misc
sdoc = str(document, 2) + str(coddoc, 6)
find '&sdoc'
if found()
activate window enwind
@ 0,1 say 'Document deja existent!'
return .f.
else
deactivate window errwind
return .t.
endif
else
retum .t.
endif

***************************
* Procedure: DEL_REC
* Called by:GET_ITEMS (procedure in BC.PRG)
* Calls: MIN() : (function in?)
* STR() (function in?)
******'****************************,*****
515 function del_rec
516 parameter recnr && rec to delete
517 select tmp
518 if records >= recnr
519 totcant=toitcant-cant
520 totval=totval-cant*pret
521 delete
522 skip
523 records=records-1
524 if records < recnr
525 if records > 0
526 go bott
527 vcod=cod
528 vcont=cont
529 vpret = pret
530 vcant = cant
531 skip
532 endif
533 @ row_nr,0 clear to row_nr,68
534 for i=5 to 53 step 16
535 @ row_nr, i say 'l' .
536 endfor
537 modifying=.f.
538 else
539 vcod = cod
540 vcont = cont
541 vpret = pret
542 vcant = cant
543 scroll row_nr, 0,8,68,1
544 dif=recnr-row_nr
545 for i = row_nr to min(8,row_nr+records-recnr)
546 @ i,1 say str(i+dif,2)+'.'
547 endfor
548 if records>=dif+8
549 skip 8 - row_nr
550 @ 8, 1say str(i,2)+'.'
551 @ 8,09 say cod picture [9999999999]
552 @ 8, 23 say cont
553 @ 8,40 say cant picture [9999999.999]
554 @ 8,57 say cant * pret picture [99999999.99]
555 skip row_nr - 8
556 endif
557 for i=5 to 53 step 16
558 @ 8, i say''
559 endfor
560 endif
561 endif
562 retum 7
563
565 *: EOF: BC.ACT
          Este programul de introducere pentru bonurile de consum (singurul program

prezentat pentru introducerea de documente). Celelalte programe de introducere a
documentelor: note de intrare-recepţie, proces verbal de custodie, facturi, note de transfer, etc) suntprograme asemănătoare având evident şi unele deosebiri faţă de acestea. Va fi prezentat in extenso (ca şi celelalte programe) după ce vor fi listate toate programele.

*******************************
* Program: C:\CURS\PROGT\ADDSTOC.PRG
  1. System: Evidenta situatiilor financiar-contabile
* Author: Emil Pfeiffer
* Copyright (c) 1998, Emil Pfeiffer
* Last modified: 05/21/97 9:37
* Called by: GET_ITEMS (procedure in BC.PRG)
* Calls: USED() (function in?)
* :STR() (function in?)
* :FOUND() (function in?)
* :RECNO(): (function in?)
* DATE() (function in?)
* Uses: MTOT.DBF
* : MISC3.DBF
* : STOC.DBF
* Indexes: MTOT.IDX
* : MISC3.IDX
* : INDSTOC.IDX
* Documented 08/14/98 at 10:20 FoxDoc
**************************************
28 parameter doc.pmag
29 priv lmag, lcod, xx
30 if flmped
31 select 8
32 use mtot index mtot
33 endif
34 select 5
35 use misc3 inde misc3
36 select 7
37 openned = used()
38 if .not.opened
39 use stoc inde indstoc
40 endif
41 select tmp
42 if vcont='351'.and.doc=16
43 repl all cont with vcont
44 go top
45 endif
46 scan all
47 if doc=9.and.cont='351'
48 lmag=pmag
49 lcod=cod
50 else
51 if cod=0
52 lmag=0
53 else
54 lmag=pmag
55 endif
56 lcod=cod
57 endif
58 if doc=9.and.tmp.cont=l351'.and.tmp.codies#0.and;
.tmp.codies#tmp.cod
59 vind = str(lmag,2)+str(cod, 10)
60 vind1=str(codies,10)
61 else
62 vind = str(lmag,2)+str(lcod,10)
63 vind1=str(lcod,10)
64 endif
65 select stoc
66 seek vind
67 if.not.found()
68 append blank
69 repl codmater with lcod, codmag with Imag, cantitate with 0,
70 i with 0, pi with 0, o with 0, po with 0
71 endif
72 if doc=33
73 rep! o with o - tmp->cant, po with po - tmp->valooare
74 else
75 if doc>10.and.doo#33
76 if doc = 16 .and. tmp->cont='351'
77 reccr=recno()
78 seek '0'+vind1
79 if not.found()
80 append blank
81 repl codmater with lcod, codmag with 0, o with 0, po with 0
82 endif
83 repl i with i+tmp->cant, pi with pi+tmp->valoare
84 go reccr
85 endif
86 if doc=15
87 repl o with o-tmp.cant, po with po-tmp.valoare
88 endif
89 if doc#15.and.doc#33
90 repl o with o + tmp->cant, po with po + tmp->valoare
91 endif
92 else
93 if doc <> 9.and.doc<>7
94 replace i with i + tmp->cant
95 replace pi with pi + tmp->valoare
96 else
97 if tmp.cont<>'351'
98 replace i with i -tmp.cant
99 replace pi with pi-tmp.valoare
100 endif
101 if tmp->cont='351'
102 reccr=recno()
103 seek vind
104 replace pi with pi+tmp->valoare
105 replace i with i+tmp->cant
106 seek '0'+vindl
107 replace po with po+tmp->valoare,o with o+tmp->cant
108 go reccr
109 else
110 seek vind
111 replace i with i+tmp->cant
112 sele nom
113 seek str(tmp.cod,10)
114 sele stoc
115 replace pi with pi + tmp->cant*nom->pretunitar
116 endif
117 endif
118 endif
118 endif
120 if doc>10.and.lmag#0
121 select misc3
122 seek str(tmp->mag,2)+str(tmp->cod,10)
123 if .not. found()
124 appe blank
125 repl cod with tmp->cod, mag with Imag, data with date()
126 endif
127 if doc=33
128 repl etcr with etcr-tmp->cant,mag with Imag
129 endif
130 if doc<14
131 repl eccr with eccr+tmp->cant.mag with Imag
132 endif
133 if doc=11 .or.doc=12
134 if data<tmp->data
135 repl data with tmp->data
136 endif
137 endif
138 select tmp
139 endif
140 if doc<10.and.lmag#0
141 se!ect misc3
142 seek str(tmp->mag,2)+str(tmp->cod,10)
143 if.not.found()
144 appe blank
145 repl cod with tmp->cod, mag with Imag, data with date()
146 endif
147 repl etcr with etcr+tmp->cant,mag with Imag
148 endif
149 if flpmed
150 select tmp
151 if (type= 1 .and. (cont='401' .or. cont='498')) .or.;
152 (type= 16 .and. cont='400') .or.;
153 (type= 9 .and. cont='401') .or. type=33
154 select mtot
155 seek str(tmp->cod, 10)
156 if.not.found()
157 append blank
158 repl codmater with tmp->cod, cantitate with 0, i with 0, ;
159 pi with 0, o with 0, po with 0
160 endif
161 do case
162 case tmp->type = 1
163 valo = tmp->valoare
164 cantit = tmp->cant
165 case tmp->type=16
166 valo = -tmp->valoare
167 cantit = -tmp->cant
168 case tmp->type = 9
169 cantit = tmp->cant
170 select nom
171 seek str(tmp->cod,10)
172 select mtot
173 valo = cantit*nom->pretunitar
174 endcase
175 repl cantitate with cantitate+cantit
176 repl valoare with valoare+valo
177 select nom
178 seek str(tmp.cod,10)
179 if(mtot,cantitate + mtot.i + mtot.o + mtot.pi;
180 +mtot.po) # 0.and. mtot.cantitate + mtot.i - mtot.o > 0
181 replace pretmediu with (mtot.cantitate * pretunitar ;
182 + 'ntot.pi - mtot.po) / (mtot.cantitate + mtot.i - mtot.o)
183 else
184 replace pretmediu with pretunitar
185 endif
186 endif
187 endif
188 select tmp
189 endscan
190 if flpmed
191 sele 8
192 use
193 endif
194 if .not.opened
195 sele 7
196 use
197 endif
198 return
199 * EOF: ADDSTOC.ACT


        Acest program (ADDSTOC.PRG) realizează adăugarea poziţiilor de materiale (produse finite) în fişierul de stocuri în momentul operării meterialului (produsului) În acest fel toate materialele existente în fişierul de mişcări vor fi prezente şi în fişierul de stoc. Când se va consulta fişierul de stoc (în orice moment) vor fi obţinute situaţii la zi având toate documentele operate prezente. Există un program asemănător(SUBSTOC.PRG) care realizează operarea ştergerilor din STOC .adică operarea documentelor de corecţie (care pot avea şi ştergeri) în fişierul de stoc.
1 
*******************************
2 

3 
Procedure file: C:\CURS\PROGT\CORMENU.PRG
4 

5 
System: Evidenta situatiilor financiar-contabile
6 
Author: Emil Pfeiffer
7 
Copyright (c) 1998, Emil Pfeiffer
8 
Last modified: 08/19/91 15:47
9 

10 
Procs & Fncts: CORIMENU
11 
:COROMENU
12 

13 
Set by:MENUS.PRG
14

15 
Calls: BAR() (function in ?)
16 
CORIMENU (procedure in CORMENU.PRG)
17 
COROMENU (procedure in CORMENU.PRG)
18 
FIS.PRG
19 


Documented 08/14/98 at 10:19 FoxDoc
21
********************************************

22 choice = bar()
23 do case
24 case choice = 1
25 do corimenu
26 case choice = 2
27 do coromenu
28 case choice = 3
29 do fls
30 endcase
31 clear
32 retum
33 *

41 **********************************
42 * procedure: CORIMENU
43 * Called by: CORMENU.PRG
44 *
45 *********^************************
46 *
41 procedure corimenu 42 42 activate popup indpop
43 return
44*
52 *******************************************
53 *
54 *! Procedure: COROMENU
55 *!
56 * Called by: CORMENU.PRG
57*!
58 *********************'***********
52 procedure coromenu
53 activate popup ieslpop
54 return
55 *: EOF: CORMENU.ACT

        CORMENU.PRG este un program meniu construit pentru a se putea selecta şi lansa programele de corecţie. Programele de corecţie (singurul ce va fi discutat aici este CORBC..PRG) au fost concepute pentru a putea corecta eventualele erori de introdusere din documente. Având în vedere că funcţionarea lor este asemănătoare cu a prograrnelor de introducere cu diferenţa că se vizualizează documentul introdus şi se pot aduce corecţii corecţii la acest document. Corecţiile se fac de asemenea şi în fişieruf de stoc care este adus la zi.

1 ******************************************
2 *
3 * Procedure file: C:\CURS\PROGT\F!S.PRG
4 *
5 * System: Evidenta situatiilor financiar-contabile
6 * Author: Emil Pfeiffer
7 * Last modified: 08/21/98 10:41
8 *
9 * Procs & Fncts: SCROLLING
10 *
11 * Setby:CORMENU.PRG
12 *
13 * Calls: STR() (function in ?)
14 * CCONTROL (procedure in FIN.PRG)
15 * IS_MAT() (function in actmenu.prg)
16 * LEFT() (function in?)
17 * RECCOUNT() (function in?)
18 * FOUND() (function in?)
19 * DTOC() (function in?)
20 * SCROLLING (procedure in FIS.PRG)
21 *
22 * Uses: STOC.DBF
23 * TYPE.DBF
24 * MISC.DBF
25 * NOM.DBF
26 * FISTMP.DBF
27 * FTMP.DBF
28 *
29 * Indexes: INDSTOC.IDX
30 * TYPE.IDX
31 * FISMISC.IDX
33 * INDNOM.IDX
34 * IFISTMP.IDX
35 *
36 * Documented 08/21/98 at 10:48 FoxDoc
37 ***********************************************
38 set intensity on
39 set talk off
40 set status off
41 set bell off
42 set notify off
43 set near on
44 set confirm on
45 hide popup all
46 hide menu all
47 deactivate window all
48 activate screen
49 clear
50 close data
51 select e
52 use stoc index indstoc
53 select d
54 use type index type
55 select c
56 use misc inde fismisc
57 set filter to .not. (type=9 .and. cont='206')
58 dime win(2)
59 win(1) = 'inwin'
60 win(2) = 'outwin'
61 define window titwin from 0,0 to 3, 79 title ;
'FISAdeMAGAZIE'double
62 defîne window inwin from 8,1 to 22,38
63 define window outwin from 8,40 to 22, 78
64 define windoweirwin from 15,15 to 20,65 double
65 define window scrollwin from 3,15 to 5,65 double
66 @ 4,0 to 24,79 double
67 @ 6,1 to 6,78
68 @ 5,39 to 23, 39
69 @ 4,39 say 'l'
70 @ 6,39say '+'
71 @ 24,39 say '┘'
72 @ 5,15 say 'INTRARI'
73 @ 5,55 say 'IESIRI'
74 @ 7,1 say 'Tip Nr.Doc Data Cantitate'
75 @ 7,40 say 'Tip Nr.Doc Data Cantitate'
76 @ 7,1 fill to 7,78
77 select b
78 use nom index indnom
79 sele a
80 use fistmp
81 zap
82 set relation to str(type,2) into type
83 activate window titwin
84 vag = o
85 @ 0,0 say 'Mag:' get vmag picture '99'
86 read
87 vcod = 0
88 do while vmag#0
89 @ 0,9 say 'Cod:' get vcod picture '99999999' valid vcod = 0;
90 .or. (ccontroi(vcod) .and. is_mat(vmag, vcod))
91 read
92 do while vcod#0
93 scod = str(vcod,8)
94 select b
95 seek str(vcod,8)
96 select e
97 seek str(vmag,2)+str(vcod,8)
98 select a
99 @ 0,25 say 'UM : '+b->unitmas
100 @ 0,34 say 'Pret: '+str(b->pretunitar, 10,3)
101 @ 1, 0 say 'Denumire: '+left(b->denumire, 30)
102 @ 1,42 say 'STOC: '+str(e->cantitate, 10,3)+' ->'
103 stocin = e->cantitate
104 activate window errwin
105 clear
106 @ 0,22 say 'Asteptati un moment...'
107 select misc
108 if reccount()>0
109 scod = str(vcod,8)
110 store 0 to totin, totout, nrin, nrout
111 seek str(vcod,8)
112 if found()
113 copy to ftmp rest for cod = vcod .and. cant<>.and. mag = vmag
114 select tistmp
115 zap
116 append from ftmp
117 index on str(type, 2)+dtoc(data, 1) to ifistmp
118 count for type < 10 to nrin
119 sum cant totout for type<10
120 sum cant to totout for type > 10
121 nrout = reccount() - nrin
122 deactivate window errwin
123 activate window titwin
124 @ 1, 65 say stocin + totin - totout picture '9999999.999'
125 if nrout>0
126 find '11'
127 activate window outwin
128 clear
129 if nrout>13
130 activate screen
131 @ 5,75 say '+'
132 activate window outwin
133 for i=1 to13
134 ? type->short, nrdoc,' '.data, cant
135 skip
136 endfor
137 else
138 activate screen
139 @ 5,75 say " "
140 activate window outwin
141 for i=1 to nrout
142 ? type->short, nrdoc,' ',data, cant
143 skip endfor endif endif ]fnrin>0
144 find '1'
145 activate window inwin
146 clear
147 if nrin>13 -
148 activate screen
148 @ 5,35 say '+'
149 activate window inwin
150 clear
151 if nrin<13
152 activate screeen
153 @ 5,35 say '+'
154 activate windows inwin
155 for i=1 to 13
156 ?type->short, nrdoc,' ',data, cant
157 skip
158 endfor
159 else
160 activate screen
161 @ 5,35 say ' '
162 activate window inwin
163 for i=1 to nrin
164 ? type->short, nrdoc, ' '.data, cant
165 Skip
166 endfor
167 endif
168 endif
169 endif
170 else
171 store 0 to totin, totout, nrin, nrout
172 endif
173 deativate window errwin

Publicat de la Niciun comentariu:
Etichete: , , , ,
Abonați-vă la: Comentarii (Atom)