DOS Wares/doswares.zip/doswares/DATABASE/DBASE4NL/SAMPLES.ZIP/VERKOPER.FRG

Text File | 1993-05-18 | 5.4 KB | 268 lines

* Programma..........:  VERKOPER.FRG
* Datum..............:  22-04-93
* Versies............: dBASE IV 2.0
*
* Notities:
* ------
* Voordat u deze procedure met het DO-commando gaat uitvoeren
* moet u LOCATE gebruiken, omdat de CONTINUE-
* opdracht zich in de hoofdlus bevindt.
*
*-- Parameters
PARAMETERS gl_noeject, gl_plain, gl_summary, gc_heading, gc_extra
** De eerste drie parameters zijn van het type Logisch.
** De vierde parameter is een tekenreeks en de vijfde is een extra parameter.
PRIVATE _peject, _wrap, ll_heading
ll_heading=.F.

*-- Testen op de aanwezigheid van records
IF EOF() .OR. .NOT. FOUND()
   RETURN
ENDIF

*-- regelovergang uitschakelen
_wrap=.F.

IF _plength < (_pspacing * 3 + 1) + (_pspacing + 1) + 2
   SET DEVICE TO SCREEN
   DEFINE WINDOW gw_report FROM 7,17 TO 11,62 DOUBLE
   ACTIVATE WINDOW gw_report
   @ 0,1 SAY "Verhoog de paginalengte voor dit rapport."
   @ 2,1 SAY "Druk op een toets ..."
   x=INKEY(0)
   DEACTIVATE WINDOW gw_report
   RELEASE WINDOW gw_report
   RETURN
ENDIF

_plineno=0          && regels instellen op nul
*-- NOEJECT-parameter
IF gl_noeject
   IF _peject="BEFORE"
      _peject="NONE"
   ENDIF
   IF _peject="BOTH"
      _peject="AFTER"
   ENDIF
ENDIF

*-- Instellingsomgeving
ON ESCAPE DO Prnabort
IF SET("TALK")="ON"
   SET TALK OFF
   gc_talk="ON"
ELSE
   gc_talk="OFF"
ENDIF
gc_space=SET("SPACE")
SET SPACE OFF
gc_time=TIME()      && systeemtijd opgegeven veld
gd_date=DATE()      &&&& systeemdatum  "    "    "     "
gl_fandl=.F.        && vlag voor eerste en laatste pagina
gl_prntflg=.T.      &&Doorgaan met het afdrukken van vlag
gl_widow=.T.        &&vlag voor het controleren van weduwezones
gn_length=LEN(gc_heading)  && lengte van kopregel opslaan
gn_level=2          &&verwerking van actieve zone
gn_page=_pageno     &&nummer van actieve pagina vastleggen
gn_pspace=_pspacing &&actieve regelafstand voor afdruk bepalen


*-- Instellen van pagina-onderbrekingen
gn_atline=_plength - (_pspacing + 1)
ON PAGE AT LINE gn_atline EJECT PAGE

*-- Afdrukken rapport

PRINTJOB

*-- Initiatie van samenvattingsvelden.
r_msum1=0

IF gl_plain
   ON PAGE AT LINE gn_atline DO Pgplain
ELSE
   ON PAGE AT LINE gn_atline DO Pgfoot
ENDIF

DO Pghead

gl_fandl=.T.        && eerste pagina gestart

DO Rintro

*-- Bestandslus
DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
   gn_level=0
   *-- Detailregels
   IF gl_summary
      DO Upd_Vars
   ELSE
      DO __Detail
   ENDIF
   gl_widow=.T.         && weduwecontrole inschakelen
   CONTINUE
ENDDO

IF gl_prntflg
   DO Rsumm
   IF _plineno <= gn_atline
      EJECT PAGE
   ENDIF
ELSE
   DO Rsumm
   DO Reset
   RETURN
ENDIF

ON PAGE

ENDPRINTJOB

DO Reset
RETURN
* EOP: C:\NL_15\DATA\VERKOPER.FRG

*Bijwerken van samenvattingsvelden en/of rekenvelden.
PROCEDURE Upd_Vars
*telling
r_msum1=r_msum1+1
RETURN
* EOP: Upd_Vars

*-- Vlag instellen zodat met ESC de DO WHILE-lus wordt verlaten
PROCEDURE Prnabort
gl_prntflg=.F.
RETURN
* EOP: Prnabort

PROCEDURE Pghead
?? IIF(gl_plain,'',gd_date) AT 0,;
 "Pag. " AT 72,;
 IIF(gl_plain,'',_pageno) PICTURE "999"
?
?
?
RETURN
* EOP: Pghead

PROCEDURE Rintro
?
DEFINE BOX FROM 31 TO 63 HEIGHT 4 SINGLE
?
?? "A&T MEUBELINDUSTRIE" AT 38
?
?? "RAPPORT VERKOPERS" AT 39
?
?
?
?? ;
"══════════════════════════════════════════════════════════════════════";
+ "══════════";
AT 0
?
RETURN
* EOP: Rintro

PROCEDURE __Detail
IF 8 * gn_pspace < gn_atline - (_pspacing * 3 + 1)
   IF gl_widow .AND. _plineno+8 * gn_pspace > gn_atline + 1
      EJECT PAGE
   ENDIF
ENDIF
DO Upd_Vars
?
?? "VERKOOPNR.: " STYLE "BU" AT 0,;
 Verkoop_nr FUNCTION "T" STYLE "BU"
?
?? Verkoper FUNCTION "T" AT 0
?
?? Adres1 FUNCTION "T" AT 0,;
 "  " ,;
 Adres2 FUNCTION "T"
?
?? Postcode FUNCTION "T" PICTURE "9999 AA" AT 0,;
 "  " ,;
 Woonplaats FUNCTION "T" PICTURE "!!!!!!!!!!!!!!!!!!!!" ,;
 " (" ,;
 Provincie FUNCTION "T" ,;
 ")"
?
?? "CONTACT:  " AT 0,;
 Contact FUNCTION "T" ,;
 Telefoon FUNCTION "T" PICTURE "XXX#X#XXXXX" AT 52,;
 "TOESTEL: " AT 64,;
 Intern FUNCTION "T"
?
?? "CONDITIES:  " AT 0,;
 Condities FUNCTION "T" ,;
 "KORTING: " AT 28,;
 Korting PICTURE "99" ,;
 "%"
?
?? ;
"──────────────────────────────────────────────────────────────────────";
+ "──────────";
AT 0
?
RETURN
* EOP: __Detail

PROCEDURE Rsumm
?
?? ;
"══════════════════════════════════════════════════════════════════════";
+ "══════════";
AT 0
?
?? "TOTAAL AANTAL VERKOPERS: " AT 0,;
 r_msum1 PICTURE "999"
?
?? ;
"══════════════════════════════════════════════════════════════════════";
+ "══════════";
AT 0
gl_fandl=.F.        && laatste pagina gereed
?
RETURN
* EOP: Rsumm

PROCEDURE Pgfoot
PRIVATE _box, _pspacing
gl_widow=.F.         && weduwecontrole uitschakelen
_pspacing=1
?
IF .NOT. gl_plain
   _pspacing=gn_pspace
   ?? "SAMENGESTELD DOOR AFDELING VERKOOP" AT 32
ENDIF
EJECT PAGE
*is het paginanummer hoger dan die van de laatste pagina
IF _pageno > _pepage
   GOTO BOTTOM
   SKIP
   gn_level=0
ENDIF
IF .NOT. gl_plain .AND. gl_fandl
   _pspacing=gn_pspace
   DO Pghead
ENDIF
RETURN
* EOP: Pgfoot

*-- Pagina-onderbreking bij gebruik van PLAIN-optie.
PROCEDURE Pgplain
PRIVATE _box
EJECT PAGE
RETURN
* EOP: Pgplain

*-- dBASE-omgeving opnieuw instellen voordat rapport wordt aangeroepen
PROCEDURE Reset
SET SPACE &gc_space.
SET TALK &gc_talk.
ON ESCAPE
ON PAGE
RETURN
* EOP: Reset