mail.altrad.com/2015.02.mail.altrad.com.tar/mail.altrad.com/TEST/COMMERC_72_53OLD/PROGS/main.prg

Text File | 2014-04-02 | 150KB | 5,299 lines

PROCEDURE  MAIN ()
* Auteur...: R M ALCOCK
* Date.....: 4 JAN 1998
* Copyright: (c) 1995, R M ALCOCK, Tous droits réservés
* Notes....: Commercial Interface for VRP portables
*
*
#include "Inkey.ch"
#include "Setcurs.ch"
#include "Params"
#include "Directry.ch"        // For DIRECTORY function
#include "DCDIALOG.CH"
#include "DCPRINT.CH"
#include "FONT.CH"
#include "Appevent.ch"
#include "Gra.ch"
#include "Xbp.ch"
#include "Nls.ch"
#include "DCbitmap.ch"

*
LOCAL Mret, Last_Date, VolName

SETCURSOR(SC_NORMAL)
*
SET CONFIRM     ON
SET DATE        FRENCH
SET DELETED     ON
SET EXACT       ON
SET EXCLUSIVE   OFF
SET FIXED       OFF
SET SCOREBOARD  OFF
SET WRAP        ON
SET EPOCH TO    1980
*SET DEFAULT TO F:

*NationMsg("fr")
SetLocale( NLS_SCURRENCY, Chr(213) )     // Two lines to activate the euro symbol
SetLocale( NLS_ICURRENCYEURO, "1" )
LANGUAGE = "fr"

*
*EXTERNAL WIN,WOUT,HLON,HLOFF,PASSWD,RMAMENU,keysoff,RA_BRWSWHL
*
public mbuff, fb[10], fref, MENUCLR, PICKCLR
PUBLIC MTVA, MMONTANT, REMTOT, MFACTOT, TOTTTC, DPAY, MMQTE
// MMQTE added for PROFESS
PUBLIC New_Tarif:=.F., MDAT_MAX, M_Reg, M_Resp, MCLI, MRCODE, HCODE
PUBLIC F_Ran, V_Ran, SEED, M_Control
PUBLIC LCD
public M_FILTER:="", M_Browse, cKey, N_Cli, N_Rec
PUBLIC M_CLIC,M_TEL,M_ACT,CLIN,MCP,M_CLIP,T_Min,M_Dat1,M_Dat2,M_R_S,M_R_E
PUBLIC GetList:={}
PUBLIC ChosenClient
//
NET_USE (S_ATTACH, "ATTACH", .T., 0, "", "")

MDAT_MAX  = ATTACH->DATE_MAX
M_Reg     = ATTACH->REGION
M_Resp    = ATTACH->OWNER
M_Control = ATTACH->PCON
LCD       = ATTACH->LCD_SCREEN
USE

IF ISCOLOR()
   MENUCLR = D_MenuClr          // From PARAMS
   PICKCLR = D_PickClr
ELSE
   MENUCLR=SETCOLOR()
   PICKCLR="W/N,N/W,W/N,N/BG,W/N"
ENDIF

CLEAR

MT=CONAME+" - SYSTEM COMMERCIAL"
SEED=VAL(READ_SEED(6,5, MT, M_Reg))           // In file ENCODE.PRG
F_Ran = RANDOM (SEED, 5, 31)       // Generate 100 random n°s between 1 and 31
//
//
IF FILE ("XFER\NEWCLI.DBF")
   NET_USE (S_TEMP1, "XFER\NEWCLI", .F., 0, "", "")
   Last_Date = CTOD(DTOC(LUPDATE())) + 360      // Must ring Florensac every 60 days
                                    // temporarily very long !!!!!
   USE
ELSE
   Last_Date = CTOD("01/12/10")    // For the time being
ENDIF
//
VolName := DIRECTORY("C:", "V")      // Read the label

//
// If PWD.MEM exists when prog is restarted, something is wrong !
IF (FILE ("C:\PWD.MEM");
        .OR. DATE() > Last_Date;
        .OR. VolName [1,F_NAME] <> "ALTRAD");
        .AND. SEED <> -1

   CLEAR
   @ 7,2 SAY ""
   TEXT
   La dernière fois que l'ordinateur était arreté, vous n'aviez pas
   quitté le programme. Par consequent, il est nécessaire de réparer
   les fichiers. Il est aussi possible que les dernières modifications
   (et/ou saisie) n'ont pas été enregistrées.

   Patientez S.V.P.

   ENDTEXT

   NET_USE (S_CLIENT, "CLIENT", .T., 20, "", "")

   IF DATE() > Last_Date;
       .OR. VolName [1,F_NAME] <> "ALTRAD"

do while .f.

      //
      // Exterminate, Exterminate .......
      //
      GO BOTT
      SKIP -1
      COPY NEXT 1 TO TEMP
      USE
*      SWPRUNCMD("COPY CLIENT.DBF AZ.DBF>FRED",0, "", "")
*      SWPRUNCMD("COPY CLIENT.DBT AZ.DBT>FRED",0, "", "")
      COPY FILE CLIENT.DBF TO AZ.DBF
      COPY FILE CLIENT.DBT TO AZ.DBT
      NET_USE (S_CLIENT, "CLIENT", .T., 20, "", "")
      ZAP
      APPEND FROM TEMP
      APPEND FROM AZ
      NET_USE (S_TEMP1, "AZ", .T., 20, "", "")
      ZAP
      USE
*      SWPRUNCMD("DEL TEMP.DB?",0, "", "")
*      SWPRUNCMD("DEL AZ.DB?",0, "", "")
      ERASE TEMP.DBF
      ERASE TEMP.DBT
      ERASE AZ.DBF
      ERASE AZ.DBT
enddo

   ELSE
      // Check if any records are in the wrong state
      LOCATE FOR .NOT. CLISCRAMBL
      IF FOUND()
         DO WHILE.NOT.EOF()
            SCRAM_CLI (SEED)
            CONTINUE
         ENDDO
         // Re-Index everything
         USE
*         SWPRUNCMD("PROGS\REINDEX *",0, "", "")
         DO REINDEX WITH "*"
      ENDIF
   ENDIF
ENDIF
//
SAVE ALL LIKE M_Control TO C:\PWD  // Create the file to detect illegal termination
//
ERRORLEVEL(0)
NET_USE (S_CLIENT, "CLIENT", .F., 20, "", "")
SET INDEX TO CLIREF,CLINOM,CLICP
NET_USE (S_STOCK, "STOCK", .F., 20, "STCREF,STRLIB", "")
*
DO WHILE .T.

   bBlock = SetKey( K_F1, { || help_me ( ProcName(), ProcLine(), "" ) } )
   SetMouse(.T.)
   DO HLOFF WITH LCD
   CLEAR
   SELECT CLIENT
   GO TOP
   SET ORDER TO 1
   SET FILTER TO
   DO HLON
   @ 23,35 SAY "F1 : Aide"
   DO HLOFF WITH LCD
   *
   Mret=R_CLI(.T.)             // Select Client, Allow creation
   IF Mret <= 0                // Vide

      IF SELECT ("TEMPCLIN") <> 0
         SELECT TEMPCLIN
         USE
      ENDIF

      IF Mret < 0
         LOOP
      ENDIF

      IF ConfirmBox( , ;
                       "Voulez vous terminer le programme ?", ;
                       "Quitter", ;
                        XBPMB_YESNO , ;
                        XBPMB_QUESTION+XBPMB_APPMODAL+XBPMB_MOVEABLE, ;
                        XBPMB_DEFBUTTON2 ) = XBPMB_RET_NO
         LOOP
      ENDIF

      CLEAR
      ERASE C:\PWD.MEM         // To confirm correct exit
      RETURN                   // No Client selected

   ENDIF

   DO WHILE .T.
      IF Mret=1                // Need to search
         FREF = R_CLI2()
         IF EMPTY(FREF)
            SELECT TEMPCLIN
            USE
            EXIT
         ENDIF
      ELSE
         FREF = CLIREF
      ENDIF
      //
      // Client is selected
      //
      CLEAR
      IF .NOT. REC_LOCK(30)       // Need lock to unscramble
         RETURN
      ENDIF
      UNSCRAM_CLI(SEED)
      Window_cli(4)                  // Display Client Details
      SET CURSOR ON
      SCRAM_CLI(SEED)
      UNLOCK
      IF Mret=2                         // Only one client
         EXIT
      ENDIF
   ENDDO
ENDDO
RETURN
*
****************************************
*
FUNCTION CC
*.......................................
*
*COMMANDES
*
//
*
LOCAL aFields := {}, cKey, cOldColor, nRecSel
*
NET_USE (S_FACTA, "FACTA",  .F., 30, "FACTR", "")
NET_USE (S_COM, "COM", .F., 30, "COM,COMCL", "BON")
SET ORDER TO 2
do keysoff
*
cKey=fref
cOldColor := SetColor("W/B")
AADD(aFields, {"REF",     {||BON->COMMANDE} } )
AADD(aFields, {"ST" ,     {||BON->C_STATUS} } )
AADD(aFields, {"DATE",    {||BON->D_COMM  } } )
AADD(aFields, {"MONTANT", {||ROUND(BON->MONTANT*(1-BON->REM_SUP/100),2)} } )
DO WHILE .T.
   nRecSel := RA_BRWSWHL(aFields, {||BON->REFCLI = cKey}, cKey, 0, PICKCLR,;
                          8, 1, 22, MaxCol()-1, "F9 - ZOOM COMMANDE",, )
   DO CASE
      CASE  nRecSel == 0
        EXIT              // No record selected (Esc)

      CASE nRecSel < 0    // No matching Record
        do none with 18,1,20,78,mbuff
        EXIT

      OTHERWISE
        do ZCC
   ENDCASE
ENDDO
SetColor(cOldColor)
CLEAR SCREEN
SELECT BON
use
SELECT FACTA
USE
select CLIENT
do kon
RETURN .T.
*
****************************************
*
FUNCTION CC2
*.......................................
*
*Lines on COMMANDE
*
*
LOCAL aFields := {}, cKey, cOldColor, nRecSel, mbuff
*
NET_USE (S_FACTA, "FACTA",  .F., 30, "FACTR", "")
NET_USE (S_COM, "COM", .F., 30, "COM,COMCL", "BON")
SET ORDER TO 2
set exact off
SET RELATION TO COMMANDE INTO FACTA
do keysoff
*
cKey=fref
seek cKey
locate rest for val(c_status)<10
if .not. found()
   do none with 18,1,20,78,mbuff
else
   select FACTA
   copy rest to c:temp1 while facture=bon->commande

   net_use (S_TEMP1, "c:temp1", .T., 0, "", "")
   select bon
   continue
   do while refcli=fref
      select FACTA
      copy rest to c:temp2 while facture=bon->commande
      select temp1
      append from c:temp2
      select bon
      continue
   enddo
   erase c:temp2.dbf
   select bon
   set relation to
   set order to 1
   select temp1
   delete for substr(article,1,1) $ "+-*"
   pack
   index on article to c:temp1
   set relation to facture into bon
   go top
   cKey=article
   cOldColor := SetColor("W/B")
   AADD(aFields, {"REF",     {||TEMP1->ARTICLE} } )
   AADD(aFields, {"DESIG.",{||TEMP1->LIB  } } )
   AADD(aFields, {"QUANTITE" , {||TEMP1->QUANTITE } } )
   AADD(aFields, {"DATE",    {||BON->D_COMM  } } )
   DO WHILE .T.
      nRecSel := RA_BRWSWHL(aFields, {||.T.}, cKey, 0, PICKCLR,;
                          8, 1, 22, MaxCol()-1, "ARTICLES EN COMMANDE",, )
      DO CASE
         CASE  nRecSel == 0
           EXIT              // No record selected (Esc)

         CASE nRecSel < 0    // No matching Record
           do none with 18,1,20,78,mbuff
           EXIT

         OTHERWISE

         ENDCASE
   ENDDO
   select temp1
   use
   erase c:temp1.dbf
   erase c:temp1.ntx
endif
SetColor(cOldColor)
CLEAR SCREEN
SELECT BON
use
SELECT FACTA
USE
select CLIENT
do kon
set exact on
RETURN .T.
*
***
*
FUNCTION ZCC
LOCAL zbuff:="", t:=0, l:=0, b:=23, r:=79
//
// Need rec_lock here because two people could try to change the lines at once
// which would work because the lines are in TEMP not FACTA. Sort of deadly
// embrace. LOCK should sort this out because it effectively locks both
// the header and the lines. Need to make sure the same logic holds in the
// MENU version of the program.
//
REC_LOCK(0)
DO HLOFF WITH LCD
do keysoff
do win with t,l,b,r,zbuff,"COMMANDE"

DO COMM_OUT
@ 24,0 CLEAR TO 24,79
DO HLON
mt= "F1-HELP     F2-MENU"
@ 24,40-len(mt)/2 SAY mt
DO HLOFF WITH LCD
SET CURSOR OFF
@ 22,10 SAY""
DO WHILE LASTKEY()<>27
   set key K_F2 to COMMMENU
   wait ""                        // Wait allows function key actvation
ENDDO
SET CURSOR OFF
do wout with t,l,b,r,zbuff
@ 24,0 CLEAR TO 24,79
set key K_F2 to
*keyboard CHR(K_ESC)               // Force Exit
RETURN .T.
*
****************************************
*
FUNCTION EV
*.......................................
*
*EVENTS
*
//
*
LOCAL aFields := {}, La:=SELECT(), mst, aSort[6], aSaveSort, aPres, bEval

*
NET_USE (S_EVENT, "EVENT",  .F., 30, "EVENT,EVECODE", "")
SEEK CLIENT->CLIREF
IF .NOT. FOUND() .OR. LASTREC() == 0
   do none with 18,1,20,78,mbuff
   RETURN .T.
ENDIF

do keysoff

COPY TO "TEMPEV" WHILE EVENT->REFCLI = CLIENT->CLIREF
NET_USE (S_EVENT, "TEMPEV",  .T., 0, "", "EVENT")
INDEX ON DTOS(D_CRE)TO TEVDAT
INDEX ON BONREF     TO TEVCODE
INDEX ON TYPE       TO TEVTYPE
SET INDEX TO TEVDAT, TEVCODE, TEVTYPE

*
aSort[1] := GRA_CLR_WHITE // Sort Selected Color (Foreground)
aSort[2] := GRA_CLR_RED   // Sort Selected Color (Background)
aSort[3] := GRA_CLR_WHITE // Sort Unselected Color (Foreground)
aSort[4] := GRA_CLR_DARKGRAY // Sort Unselected Color (Background)
aSort[5] := BITMAP_RD_UP_RED  // Sort UP Bitmap
aSort[6] := BITMAP_RD_DOWN_RED  // Sort DOWN Bitmap

aSaveSort := DC_FindBrowseSort(aSort)

aPres := ;
  { { XBP_PP_COL_HA_FGCLR, GRA_CLR_WHITE },  ;
    { XBP_PP_COL_HA_BGCLR, GRA_CLR_DARKGRAY }, ;
    { XBP_PP_COL_DA_FGCLR, GRA_CLR_BLACK }, ;
    { XBP_PP_COL_DA_BGCLR, GRA_CLR_WHITE } }

aPres := ;
  { { XBP_PP_COL_HA_FGCLR, GRA_CLR_WHITE },  ;
    { XBP_PP_COL_HA_BGCLR, GRA_CLR_DARKGRAY }, ;
    { XBP_PP_COL_DA_FGCLR, GRA_CLR_BLACK }, ;
    { XBP_PP_COL_DA_BGCLR, GRA_CLR_WHITE } }

aFields := ;
   { ; // field            Header   Width  Index       Prompt
   { {||EVENT->D_CRE},  'Date',       10,    "TEVDAT",  'Date' } , ;
   { {||EVENT->TYPE},   'Libellé',    25,    "TEVTYPE", 'Type'  }, ;
   { {||EVENT->BONREF}, 'N° Bon',      6,    "TEVCODE", 'Bon' } ;
   }

bEval := {|o|o:drawingArea:setColorBG(GRA_CLR_CYAN)}

mst = DC_FindBrowse( aFields, nil, nil, nil, 90, 20, ;
    "HISTORIQUE (Cliquer Droit sur en-tête pour changer l'index)", ;
    nil, nil, nil, nil, nil, bEval, ;
    { aPres, { GRA_CLR_DARKGRAY, GRA_CLR_RED } }, ;
    nil, nil, nil, .5 )

DC_FindBrowseSort(aSaveSort)

IF Mst
  do ZEV
ENDIF

CLEAR SCREEN
SELECT EVENT
USE
SELECT(La)
do kon

RETURN .T.

***
*
FUNCTION ZEV
LOCAL zbuff:="", t:=0, l:=0, b:=23, r:=79, mt
//
DO HLOFF WITH LCD
do win with t,l,b,r,zbuff, ALLTRIM(EVENT->TYPE)
SELECT EVENT

DO CASE

   CASE EVENT->TYPE = "FACTURE"
      NET_USE (S_FACT, "FACT", .F., 0, "FACT", "BON")
      SEEK SUBSTR(EVENT->BONREF,1,6)+SUBSTR(EVENT->BONREF,8,2)
      IF .NOT. FOUND().OR. REFCLI<>EVENT->REFCLI
         ALARM ("ERREUR SYSTEME 02 "+REFCLI+" "+EVENT->REFCLI)
      ELSE
         DO FACT WITH .F., .F.
      ENDIF
      USE

   CASE EVENT->TYPE = "AVOIR"
      NET_USE (S_AVO, "AVO", .F., 0, "AVREF", "BON")
      SEEK SUBSTR(EVENT->BONREF, 1, LEN(BON->FACTURE))
      IF .NOT. FOUND().OR. REFCLI<>EVENT->REFCLI
         ALARM ("ERREUR SYSTEME 03 "+REFCLI+" "+EVENT->REFCLI)
      ELSE
         DO FACT WITH .F., .T.
      ENDIF
      USE

   CASE EVENT->TYPE = "COMMANDE"
      NET_USE (S_COM, "COM", .F., 0, "COM", "BON")
      SEEK SUBSTR(EVENT->BONREF, 1, LEN(BON->COMMANDE))
      IF .NOT. FOUND().OR. REFCLI<>EVENT->REFCLI
         ALARM ("ERREUR SYSTEME 04 "+REFCLI+" "+EVENT->REFCLI)
      ELSE
         DO COMM_OUT
      ENDIF
      USE

   OTHERWISE
      DO LIT_INIT
      SEEK SUBSTR(EVENT->BONREF, 1, LEN(LITIGE->CODE))
      // On CDV's machine, may be several visits with the same number
      LOCATE REST FOR CLIENT = EVENT->REFCLI;
                  WHILE CODE = SUBSTR(EVENT->BONREF, 1, LEN(LITIGE->CODE))
      IF .NOT. FOUND()
         ALARM ("ERREUR SYSTEME 01 "+CLIENT+" "+EVENT->REFCLI)
      ELSE
         DO WHILE LASTKEY()<>27
            DO LITFMT WITH 3          // normally delete but doesn't matter
            DO HLON
            mt= "F1-HELP     F2-MENU"
            @ 24,0 CLEAR TO 24,79
            @ 24,40-len(mt)/2 SAY mt
            DO HLOFF WITH LCD
            SET CURSOR OFF
            @ 22,10 SAY""
            set key K_F2 to LITMENU
            wait ""                     // Wait allows function key actvation
         ENDDO
         SET CURSOR OFF
         @ 24,0 CLEAR TO 24,79
         set key K_F2 to
         keyboard CHR(K_ESC)            // Force Exit
      ENDIF
      USE

ENDCASE
DO WHILE INKEY()<>27
ENDDO
do wout with t,l,b,r,zbuff
@ 24,0 CLEAR TO 24,79
SELECT EVENT
RETURN .T.
*
****************************************
*
FUNCTION LITMENU
*.......................................
*
LOCAL MA:= {}, MBUFF1:="", MSel:=SELECT()
LOCAL l:=50, b:=22
LOCAL t,r:=l+22
LOCAL L_CNT, ML, MPL
PRIVATE oPrinter

do keysoff
@ 24,0 CLEAR
AADD (MA, "RETOUR")
AADD (MA, "Modifier")
AADD (MA, "Imprimer")
AADD (MA, "Supprimer")
t=b-len(MA)-1
DO WIN WITH t,l,b,r,MBUFF1,"",""
SET COLOR TO &MENUCLR
SET WRAP ON
MCHOIX=ACHOICE(t+1,l+2,b-1,r-2,MA)
DO WOUT WITH t,l,b,r,MBUFF1
DO HLOFF WITH LCD              // Get colour right again

DO CASE

   CASE MCHOIX=2
      SET CURSOR ON
      DO LITFMT WITH 2         // Modify
      SET CURSOR OFF

   CASE MCHOIX=3               // Imprimer
*      SETPRC(0,0)
*      Default_Printer
*      SET DEVICE TO PRINT

      DCPRINT ON TO oPrinter

      DO PRINT_L
      @ DC_PRINTERROW()+1,0 DCPRINT SAY ""
      L_CNT=MLCOUNT(COMMENTAIR, 62, 4, .T.)
      FOR ML=1 TO L_CNT
          MPL=MEMOLINE(COMMENTAIR,62,ML,4,.T.)
          @ DC_PRINTERROW()+1, 4 DCPRINT SAY MPL
          IF DC_PRINTERROW() > 53
             DCPRINT EJECT
          ENDIF
      NEXT

      DCPRINT EJECT

      DCPRINT OFF

*      Default_Printer
*      SET DEVICE TO SCREEN

   CASE MCHOIX=4               // Delete
      IF CONFIRM (18,, "N", "CONFIRMATION SUPPRESSION")
         SELECT EVENT
         REC_LOCK()
         DELETE
         UNLOCK
         SELECT LITIGE
         REC_LOCK()
         DELETE
         UNLOCK
         SELECT(MSel)
         keyboard CHR(K_ESC)   // Force Exit
         RETURN .T.
      ENDIF

ENDCASE
keyboard " "      // Force Exit from wait
SELECT(MSel)
RETURN .T.
//
//-----------------------------------------------------------------
//
FUNCTION kon
*.......................................

RETURN .T.
**
//
//-----------------------------------------------------------------
//
FUNCTION NONE
*.......................................
parameters t,l,b,r,abuff
*
Alert( "VIDE")
/*DO HLON
do win with t,l,b,r,abuff,"VIDE"
do while INKEY(0) <> K_ESC
enddo
DO HLOFF WITH LCD
do wout with t,l,b,r,abuff
*/
RETURN .T.
*
//
//-----------------------------------------------------------------
//
FUNCTION Pg_Up
*.......................................
SCRAM_CLI(SEED)
UNLOCK
SELECT TEMPCLIN
SKIP -1
IF BOF()
   Tone(800)
   GO TOP
ENDIF
SELECT CLIENT
REC_LOCK(0)          // Need lock to unscramble
REC_LOCK(0)
UNSCRAM_CLI(SEED)
FREF=CLIENT->CLIREF
RETURN .T.
//
//-----------------------------------------------------------------
//
FUNCTION Pg_Dn
*.......................................
SCRAM_CLI(SEED)
UNLOCK
SELECT TEMPCLIN
SKIP
IF  EOF()
   Tone(500)
   GO BOTT
ENDIF
SELECT CLIENT
REC_LOCK(0)         // Need lock to unscramble
REC_LOCK(0)
UNSCRAM_CLI(SEED)
FREF=CLIENT->CLIREF
RETURN .T.
//
//-----------------------------------------------------------------
//
FUNCTION Imp_FICHE
*.......................................
DCPRINT ON TO oPrinter
*IF .NOT. ISPRINTER()
*   SET PRINT OFF
*   SET DEVICE TO SCREEN
*   ALARM ("PAS D'IMPRIMANTE")
*   RETURN .T.
*ENDIF

*Default_Printer
*SET DEVICE TO PRINT
*SETPRC(0,0)

Det_Out (2,.F.)      // Line 3, Don't unscramble/scramble
DCPRINT Eject
*Default_Printer
*SET DEVICE TO SCREEN

DCPRINT OFF
RETURN .T.
//
//---------------------------------------------------
//
FUNCTION ST               // Choose a Stock Item from a browsed list
LOCAL La, mst, aFields := {}, cKey, cOldColor, nRecSel, nOrder
LOCAL t:=0,l:=0,b:=24,r:=79,Zbuff:=""

LOCAL  aPres, aSort[6], aSaveSort, bEval

PARAMETERS ZOOMON,CONTROL  // ZOOMON = .F. does not allow a zoom to full article
                           //    details (e.g. when called from R_ART)
*
*
IF PCOUNT()<>1             // When ST is called on a FN key, PCOUNT=3
                           // Otherwise it is 1 (with param) or 0 (no para.)
   ZOOMON=.T.              // Default=.T. ( MODIFY STOCK gives PCOUNT()= 1)
ENDIF
IF PCOUNT()<>2
   CONTROL=4               // default is NOT READ
ENDIF
IF PCOUNT()<>3
   FROMSTM=.T.             // Called by R_ART, Client may not be set up
ENDIF
 *
DO KEYSOFF
La=SELECT()
select STOCK
nOrder=INDEXORD()
GO TOP

aSort[1] := GRA_CLR_WHITE // Sort Selected Color (Foreground)
aSort[2] := GRA_CLR_RED   // Sort Selected Color (Background)
aSort[3] := GRA_CLR_WHITE // Sort Unselected Color (Foreground)
aSort[4] := GRA_CLR_DARKGRAY // Sort Unselected Color (Background)
aSort[5] := BITMAP_RD_UP_RED  // Sort UP Bitmap
aSort[6] := BITMAP_RD_DOWN_RED  // Sort DOWN Bitmap

aSaveSort := DC_FindBrowseSort(aSort)

aPres := ;
  { { XBP_PP_COL_HA_FGCLR, GRA_CLR_WHITE },  ;
    { XBP_PP_COL_HA_BGCLR, GRA_CLR_DARKGRAY }, ;
    { XBP_PP_COL_DA_FGCLR, GRA_CLR_BLACK }, ;
    { XBP_PP_COL_DA_BGCLR, GRA_CLR_WHITE } }

aPres := ;
  { { XBP_PP_COL_HA_FGCLR, GRA_CLR_WHITE },  ;
    { XBP_PP_COL_HA_BGCLR, GRA_CLR_DARKGRAY }, ;
    { XBP_PP_COL_DA_FGCLR, GRA_CLR_BLACK }, ;
    { XBP_PP_COL_DA_BGCLR, GRA_CLR_WHITE } }

aFields := ;
   { ; // field            Header   Width  Index       Prompt
   { {||STOCK->STCOMMREF}, 'Réf',         5,    "STCREF", 'Référence' } , ;
   { {||STOCK->STLIB},     'Libellé',    25,    "STRLIB",  "Libellé" }, ;
   { {||STOCK->STPRIXVTR}, 'Prix Tarif',  5,    nil,     nil }, ;
   { {||STOCK->STCESSTR},  'Cession',     5,    nil,     nil }, ;
   { {||STOCK->POIDS},     'Poids',       4,    nil,     nil } ;
   }

bEval := {|o|o:drawingArea:setColorBG(GRA_CLR_CYAN)}

mst = DC_FindBrowse( aFields, nil, nil, nil, 90, 20, ;
    "A R T I C L E S (Cliquer Droit sur en-tête pour changer l'index)", ;
    nil, nil, nil, nil, nil, bEval, ;
    { aPres, { GRA_CLR_DARKGRAY, GRA_CLR_RED } }, ;
    nil, nil, nil, .5 )

DC_FindBrowseSort(aSaveSort)

SELECT(La)
RETURN .T.
**********************************
*
FUNCTION R_ART ( R,C,MART )
LOCAL La
La=SELECT()
SELECT STOCK
IF PCOUNT()<3
   MART=SPACE(LEN(STOCK->STCOMMREF))
ENDIF
SET KEY K_F5 TO ZRART    // F5 for tarift pick list
@ R,C GET MART
READ
SET KEY K_F5 TO
IF LEN(TRIM(MART))>0 .AND. VAL(MART)<>0
   MART=PAD(MART,LEN(MART))
ENDIF
SELECT(La)
RETURN MART

******
FUNCTION ZRART
CLEAR GETS
DO ST WITH .F.            // no ZOOMON
IF LASTKEY()<>K_ESC
   MART=STCOMMREF
ENDIF
RETURN .T.
//
//-----------------------------------------------------
//
FUNCTION LAST_VISIT (Ro, Co, Print)

// Finds the last visit to the client.
// If called by display (Print = .F.) displays info
// if called from print (Print = .T.) RETURNs the memo or nothing

LOCAL La:=SELECT(), LVis:=0, MRet := ""
DEFAULT Print TO .F.

IF .NOT. Print
   @ Ro,    1       SAY "DERNIERE VISITE : "
   @ ROW(), COL()   SAY  CLIENT->DERNVISIT
   @ ROW(), COL()+3 SAY "ACTION AVANT LE : "
   @ ROW(), COL()   GET  CLIENT->RELANCE
ENDIF

NET_USE (S_EVENT, "EVENT",  .F., 30, "EVENT", "")
SEEK CLIENT->CLIREF
IF FOUND()
   DO WHILE REFCLI = CLIENT->CLIREF .AND. .NOT. EOF()
      IF ALLTRIM(EVENT->TYPE) $ "VISITETELEPHONE"
         LVis=RECNO()       // Find the last visit
         exit               // Index now in descending order
      ENDIF
      SKIP
   ENDDO
   IF LVis <> 0
      GO LVis
      DO LIT_INIT
      SEEK SUBSTR(EVENT->BONREF, 1, LEN(LITIGE->CODE))
      // On CDV's machine, may be several visits with the same number
      LOCATE REST FOR CLIENT = EVENT->REFCLI;
                  WHILE CODE = SUBSTR(EVENT->BONREF, 1, LEN(LITIGE->CODE))
      IF Print
         MRet = IF(FOUND(), LITIGE->COMMENTAIRE, "")
      ELSE
         IF .NOT. FOUND()
            ALARM ("ERREUR SYSTEME 01 "+CLIENT+" "+EVENT->REFCLI)
         ELSE
            MEMOEDIT(LITIGE->COMMENTAIRE,Ro+1,Co,22,74,.F.,.F.)    // Browse
         ENDIF
         //
         // CLose files opened by LIT_INIT
         //
         SELECT LITIGE
         USE
         SELECT LITREG
         USE
         SELECT LITCOD
         USE
      ENDIF
   ENDIF
ENDIF

SELECT EVENT
USE

SELECT(La)
RETURN MRet
//
//-----------------------------------------------------
//
FUNCTION R_CLI(CRE_CLI)

LOCAL nEvent, mp1, mp2
LOCAL oDlg, oXbp, drawingArea, aEditControls := {}, oXbp1
LOCAL ActiBox, GamBox, oXbpFax, oXbpRel, oRb1, oRb2, oRb3

LOCAL MREF,  M_Gam, M_Fax, M_T_Min
LOCAL M_REL, Mix_Array := {}
LOCAL M_Dat_Base := CTOD("01/01/89")
LOCAL La := SELECT(), i

// M_FILTER, M_CLIC, M_TEL, M_ACT, CLIN, MCP, M_CLIP, T_Min
// M_Dat1, M_Dat2, M_R_S, M_R_E
// are all defined as PUBLIC in MAIN


IF PCOUNT()=0
   CRE_CLI=.F.
ENDIF

F_Ran= RANDOM (SEED, 5, 31)   // Generate 5 random n°s between 1 and 31

AADD (Mix_Array, "49-900    ")
AADD (Mix_Array, "SECURIFRAN")
AADD (Mix_Array, "42-700    ")
AADD (Mix_Array, "ROULANT   ")
AADD (Mix_Array, "CH49/AUTO ")
AADD (Mix_Array, "PLANCHERS ")
AADD (Mix_Array, "DIFFUSION ")
AADD (Mix_Array, "DIVERS    ")

DO WHILE .T.
   SET FILTER TO
   Mret = 1                           // RETURN Value
   M_FILTER = "VAL(CLISTATUS)<3"      // Initialise the selection

  SELECT CLIENT
   SET ORDER TO 1                     // Index by Reference
   GO TOP

   MFREF=SPACE(LEN(CLIREF))
   CLIN= SPACE(LEN(CLINOM))
   MCP=  SPACE(LEN(CLICP))
   M_CLIC= SPACE(LEN(CLICONTACT))
   M_TEL = SPACE(LEN(CLIPHONE))
   M_ACT = SPACE(LEN(CLIPROFESS))
   M_Gam=''
   M_Fax='N'
   M_T_Min = ""
   M_CLIP =''
   M_REL = 'N'
   M_Dat1 = M_Dat_Base
   M_Dat2 = M_Dat1
   M_R_S = CTOD("01/01/89")
   M_R_E = DATE() + 30

   oDlg := XbpDialog():new( AppDesktop(), , {353,205}, {600,400}, , .F.)
   oDlg:taskList := .T.
   oDlg:title := "SELECTION"
   oDlg:create()

   drawingArea := oDlg:drawingArea
   drawingArea:setFontCompoundName( "8.Arial" )

   oXbp1 := XbpStatic():new( drawingArea, , {40,252}, {348,108} )
   oXbp1:caption := ""
   oXbp1:clipSiblings := .T.
   oXbp1:type := XBPSTATIC_TYPE_GROUPBOX
   oXbp1:create()

   oXbp := XbpStatic():new( oXbp1, , {12,60}, {120,24} )
   oXbp:caption := "NOM DU CLIENT :"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( oXbp1, , {144,60}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 30
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIN ), CLIN := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )
   SetAppFocus(oXbp)

   oXbp := XbpStatic():new( oXbp1, , {24,36}, {108,24} )
   oXbp:caption := "CODE POSTALE :"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( oXbp1, , {144,36}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 5
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( MCP ), MCP := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpStatic():new( oXbp1, , {36,12}, {96,24} )
   oXbp:caption := "NUMERO CLIENT :"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( oXbp1, , {144,12}, {72,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 10
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( MFREF ), MFREF := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )


   oXbp := XbpPushButton():new( drawingArea, , {420,252},  {84,24},;
             { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE }, { XBP_PP_FGCLR, -58 } } )
   oXbp:caption := "GO"
   oXbp:tabStop := .T.
   oXbp:create()
   oXbp:activate := {|| Gather( aEditControls ), PostAppEvent( xbeP_Quit ) }


   oXbp := XbpStatic():new( drawingArea, , {108,216}, {120,24} )
   oXbp:caption := "CONTACT :"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( drawingArea, , {240,216}, {108,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 17
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( M_CLIC ), M_CLIC := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpStatic():new( drawingArea, , {108,192}, {120,24} )
   oXbp:caption := "ACTIVITE :"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   ActiBox := XbpCombobox():new( drawingArea, , {240,132}, {74,84}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   ActiBox:tabstop := .T.
   ActiBox:create()
   ActiBox:Additem ("MACO")
   ActiBox:Additem ("COUV")
   ActiBox:Additem ("PEIN")
   ActiBox:Additem ("FACA")
   ActiBox:Additem ("CHAR")
   ActiBox:Additem ("ISOL")
   ActiBox:Additem ("PLAT")
   ActiBox:Additem ("INDU")
   ActiBox:Additem ("LOCA")
   ActiBox:Additem ("DIVS")
   ActiBox:Additem ("CETC")

   oXbp := XbpStatic():new( drawingArea, , {96,168}, {132,24} )
   oXbp:caption := "EQUIPEE FAX :"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbpFax := XbpCheckBox():new( drawingArea, , {240,168}, {96,24} )
   oXbpFax:tabStop := .T.
   oXbpFax:create()
   oXbpFax:setData (.F.)
   oXbpFax:selected := {|| NIL }

   oXbp := XbpStatic():new( drawingArea, , {84,144}, {144,24} )
   oXbp:caption := "CLIENT/PROSPECT/TOUS :"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oRb1 := XbpRadioButton():new( drawingArea, , {240,144}, {48,24} )
   oRb1:caption := "Client"
   oRb1:tabStop := .T.
   oRb1:create()
   oRb1:selected := {|| NIL }

   oRb2 := XbpRadioButton():new( drawingArea, , {288,144}, {60,24} )
   oRb2:caption := "Prospect"
   oRb2:tabStop := .T.
   oRb2:create()
   oRb2:selected := {|| NIL }

   oRb3 := XbpRadioButton():new( drawingArea, , {360,144}, {120,24} )
   oRb3:caption := "Tous"
   oRb3:tabStop := .T.
   oRb3:selection := .T.
   oRb3:create()
   oRb3:selected := {|| NIL }

   oXbp := XbpStatic():new( drawingArea, , {132,120}, {96,24} )
   oXbp:caption := "TAILLE MINIMUM :"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( drawingArea, , {240,120}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 4
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, M_T_Min, M_T_Min := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpStatic():new( drawingArea, , {84,96}, {144,24} )
   oXbp:caption := "GAMME MEFRAN :"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   GamBox := XbpCombobox():new( drawingArea, , {240,36}, {94,84}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   GamBox:tabstop := .T.
   GamBox:create()
   FOR i = 1 TO LEN(Mix_Array)
      GamBox:Additem  (Mix_Array[i])
   NEXT

   oXbp := XbpStatic():new( drawingArea, , {84,72}, {144,24} )
   oXbp:caption := "A RELANCER :"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbpRel := XbpCheckBox():new( drawingArea, , {240,72}, {24,24} )
   oXbpRel:tabStop := .T.
   oXbpRel:create()
   oXbpRel:selected := {|| NIL }

   oXbp := XbpStatic():new( drawingArea, , {264,72}, {72,24} )
   oXbp:caption := " AVANT LE :"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( drawingArea, , {336,72}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, DtoC( M_R_E ), M_R_E := CtoD(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpStatic():new( drawingArea, , {396,72}, {60,24} )
   oXbp:caption := "APRES LE :"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( drawingArea, , {456,72}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, DtoC( M_R_S ), M_R_S := CtoD(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpStatic():new( drawingArea, , {84,48}, {144,24} )
   oXbp:caption := "PAS VISITE DEPUIS :"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( drawingArea, , {240,48}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 10
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, DtoC( M_Dat1 ), M_Dat1 := CtoD(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpStatic():new( drawingArea, , {84,24}, {144,24} )
   oXbp:caption := "PAS COMMANDE DEPUIS :"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( drawingArea, , {240,24}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 10
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, DtoC( M_Dat2 ), M_Dat2 := CtoD(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oDlg:show()

   nEvent := xbe_None
   DO WHILE nEvent <> xbeP_Close .AND. nEvent <>xbeP_Quit
      nEvent := AppEvent( @mp1, @mp2, @oXbp )
      oXbp:handleEvent( nEvent, mp1, mp2 )
   ENDDO

   IF LastAppEvent()= xbeP_Close
         Mret=0                          // Client not selected
      EXIT
   ENDIF

   //
   // Get the data and see if the user has specified anything interesting
   //
   M_Act = ALLTRIM(ActiBox:xbpSLE:getdata())
   M_Gam = ALLTRIM(GamBox:xbpSLE:getdata())
   M_Fax = IIF(oXbpFax:GetData(), "O", "N")
   M_Rel = IIF(oXbpRel:GetData(), "O", "N")
   T_Min = INT(VAL(M_T_Min))
   // Radio Buttons
   IF oRB3:GetData()
      M_Clip = ""
   ELSEIF oRB2:GetData()
      M_Clip = "P"
   ELSE
      M_Clip = "C"
   ENDIF

   IF .NOT. EMPTY (MFREF)
      //
      // If the reference is specified, all other parameters are irrelevant,
      // but if they are specified, the user may want to create a new client
      //
      IF .NOT. EMPTY(CLIN).AND. .NOT. EMPTY(MCP);
         .AND. CRE_CLI .AND. SUBSTR(MFREF,1,1)="*"
            IF CONFIRM (11,5,"O","Créer un prospect ? ")
            //
            // Create a new prospect: a prospect becomes a
            // client when he orders something
            //
            NET_USE (S_ATTACH, "ATTACH", .T., 0, "", "")
            DO WHILE .T.
               SELECT ATTACH

               // Allocate next number

               FREF=SUBSTR(MCP,1,2) + SUBSTR(M_Resp,2,2) + PAD(STR(NUM_CLI),5)
               REPLACE NUM_CLI WITH NUM_CLI+1
               SELECT CLIENT
               SEEK "C"+FREF
               IF FOUND()
                  LOOP        // Try the next available prospect number
               ENDIF
               SEEK "P" + FREF
               IF .NOT. FOUND()
                  FREF= "P" + FREF
                  Mret = 1
                  EXIT        // O.K. found a valid number
               ENDIF
            ENDDO
            SELECT ATTACH
            USE
            SELECT CLIENT
            ADD_REC(0)
            REPLACE CLIREF      WITH FREF,;
                    CLINOM      WITH CLIN,;
                    CLICP       WITH MCP,;
                    CLIREGION   WITH M_Resp,;
                    CLISCRAMBLE WITH .F.
            Window_Cli (1)
            SCRAM_CLI (SEED)
            LOOP
         ENDIF
      ELSE
         //
         // Not Prospect creation, try to find client
         //
         SET ORDER TO 1   // CLREF
         SEEK MFREF
         IF FOUND() .AND. VAL(CLISTATUS)<3  // Not deleted
            Mret=2                          // straight to client
            EXIT
         ENDIF
         FREF= "P" + SUBSTR(MFREF,2,LEN(CLIENT->CLIREF)-1)
         SEEK FREF
         IF FOUND() .AND. VAL(CLISTATUS) < 3
            ALARM ("ATTENTION - C'est un PROSPECT pas un CLIENT")
            Mret=2                        // straight to client
            EXIT
         ENDIF

         ALARM ("NUMERO CLIENT INEXISTANT OU CLIENT SUPPRIME")
         // Shouldn't normally create a client because
         // he should previously have been a prospect.
         // Nevertheless, allow creation if the user insists!
         IF .NOT. EMPTY(CLIN) .AND. .NOT. EMPTY(MCP);
            .AND. CRE_CLI .AND. CONFIRM (11,5,"O","Créer un Client ? ")
            SELECT CLIENT
            ADD_REC(0)
            REPLACE CLIREF      WITH MFREF,;
                    CLINOM      WITH CLIN,;
                    CLICP       WITH MCP,;
                    CLIREGION   WITH M_Resp,;
                    CLISCRAMBLE WITH .F.
            Window_Cli (1)
            SCRAM_CLI (SEED)
         ENDIF
         LOOP
      ENDIF
   ELSE
      //
      // FREF not specified, try the other keys
      //
      //
      // Now set up filter or choose client
      //
      IF .NOT. EMPTY(M_CLIC)      // "CLIENT"-type condition
         SET ORDER TO 0
         LOCATE FOR CLICONTACT = SCRAMBLE (M_CLIC,;
                                  RANDOM(REC_SEED (SEED), 30, 31));
                            .AND. VAL(CLISTATUS) < 3
         IF FOUND()
            SET ORDER TO 1
            Mret=2                     // straight to client
            EXIT
         ENDIF
            ALARM ("CLIENT INEXISTANT OU SUPPRIME")
         LOOP
      ELSE
         IF .NOT. EMPTY(M_ACT)
            //
            // M_ACT is set up which is a FILTER type condition
            //
            M_FILTER = M_FILTER + ".AND.CLIPROFESS=M_ACT"
         ENDIF
         //
         // Fax ?
         //
         IF M_Fax = 'O'
            M_FILTER = M_FILTER+".AND.CLIFAX<>SCRAMBLE(SPACE(15),"+;
                                      "RANDOM(REC_SEED (SEED), 30, 31))"
         ENDIF
         //
         // Client/Prospect ?
         //
         IF M_CLIP <> ' '
            M_FILTER = M_FILTER+".AND.CLIREF=M_CLIP"
         ENDIF
         //
         // Taille Mini ?
         //
         IF T_Min > 0
            M_FILTER = M_FILTER+".AND.VAL(CLITAILLE)>=T_Min"
         ENDIF
         //
         // Gamme MEFRAN ?
         IF .NOT. EMPTY(M_Gam)
            SET EXACT OFF
            i = ASCAN(PADR(M_Gam, LEN(Mix_Array[1])), Mix_Array)
            SET EXACT ON
            IF I<>0
               M_FILTER = M_FILTER+".AND.Q_"+STR(I,1)+"<>0"
            ENDIF
         ENDIF
         IF M_REL='O'
            M_FILTER=M_FILTER+".AND.RELANCE>=M_R_S.AND.RELANCE<M_R_E"
         ENDIF
         IF M_Dat1>M_Dat_Base
            M_FILTER=M_FILTER+".AND.DERNVISIT<M_Dat1"
         ENDIF
         IF M_Dat2>M_Dat_Base
            M_FILTER=M_FILTER+".AND.DCANNEE<M_Dat2"
         ENDIF
      ENDIF
   ENDIF
   CLIN=ALLTRIM(CLIN)
   MCP=ALLTRIM(MCP)
   SET EXACT OFF
   Mret = 1
   //
   // Select the search method and complete the filter condition
   //
   IF .NOT. EMPTY(CLIN)
      //
      // Scramble the data so as to be the same as the file
      //
      CLIN = SCRAMBLE (IIF(LEN(CLIN)<= 5,CLIN,SUBSTR(CLIN,1,5)),F_Ran)
      //
      // Search by NAME
      //
      SET ORDER TO 2         // CLINOM
      IF .NOT. EMPTY(MCP)
         M_FILTER=M_FILTER+".AND.CLICP=MCP"
      ENDIF
      SEEK CLIN
      COPY TO C:TEMPCLIN FIELDS CLIREF FOR &M_FILTER WHILE CLIENT->CLINOM=CLIN

   ELSEIF .NOT. EMPTY(MCP)
      //
      // Search by C.P.
      //
      SET ORDER TO 3         // CLICP
      SEEK MCP
      COPY TO C:TEMPCLIN FIELDS CLIREF FOR &M_FILTER WHILE CLIENT->CLICP=MCP

   ELSE
      //
      // Search whole file
      //
      SET ORDER TO 0
      GO TOP
      COPY TO C:TEMPCLIN FIELDS CLIREF FOR &M_FILTER
   ENDIF
   EXIT

ENDDO

SET ORDER TO 1                 // Whatever happened
IF Mret <> 0 .AND. Mret <> 2   // Client not selected
   NET_USE (S_TEMP2, "C:TEMPCLIN", .T., 0, "", "")
   IF RECCOUNT() = 0
      oDlg : close()
      oDlg : Destroy()
      Alarm("Vide")            // Error Message
      SELECT (La)
      RETURN-1
   ELSE
      COUNT TO N_Cli FOR CLIREF<>"P"
      N_Rec=RECCOUNT()
      GO TOP
      SET RELATION TO CLIREF INTO CLIENT
   ENDIF
ENDIF
SET EXACT ON
SET SOFTSEEK OFF

oDlg : close()
oDlg : Destroy()

SELECT (La)
RETURN Mret

*
***************************
*
FUNCTION R_CLI2 ()
//
LOCAL La, aFields := {},  cOldColor, nRecSel, FREF

La=SELECT()
SELECT TEMPCLIN
IF RECCOUNT()=0               // Was a single record which has been deleted
   SELECT (La)
   RETURN ""
ENDIF
F_Ran= RANDOM (SEED, 5, 31)   // Generate 5 random n°s between 1 and 31
cOldColor := SetColor()
AADD(aFields, {" REF",   {||IIF(CLIENT->CLIRISQUE<>" ",;
                              "*"+CLIREF,;
                              " "+CLIREF)}, 6 } )
AADD(aFields, {"NOM" ,  {||UNS_NOM(CLIENT->CLINOM)}, 18 } )
AADD(aFields, {"C.P.",  {||CLIENT->CLICP }, 3 } )
AADD(aFields, {"VILLE", {||UNS_NOM(SUBSTR(CLIENT->CLIVILLE,1,20))}, 13} )
AADD(aFields, {"TEL",   {||UNS_FIELD(CLIENT->CLIPHONE) }, 8 } )
AADD(aFields, {"PROF",  {||CLIENT->CLIPROFESS }, 3 } )
AADD(aFields, {"F.J.",  {||CLIENT->CLIABV }, 3 } )
SET EXACT OFF
SET SOFTSEEK OFF

nRecSel:= CL_BRWSWHL(aFields)

FREF = DECODE_REPLY (nRecSel)
SET EXACT ON
SELECT (La)
SetColor (cOldColor)
RETURN FREF
*
//
//-------------------------------------------------------------------------
//
FUNCTION DECODE_REPLY (nRecSel)
//
LOCAL mbuff:=""

DO CASE
   CASE  nRecSel == 0
      RETURN ""        // No record selected (Esc)
   CASE nRecSel < 0    // No matching Record
       Alarm ("Vide")
*      DO HLON
*      do win with 18,1,20,78,mbuff,"VIDE"
*      do while INKEY(0) <> K_ESC
*      enddo
*      DO HLOFF WITH LCD
      RETURN ""
   OTHERWISE
      RETURN CLIENT->CLIREF
ENDCASE
RETURN ""
//
//-------------------------------------------------------------------------
//
FUNCTION UNS_NOM(Nom)
//
// Returns an unscrambled client name or VILLE. Used by R_CLI
//
LOCAL M, La
//
// Set up global variables
//
// F_Ran already set up by R_CLI
La=SELECT()
SELECT CLIENT
V_Ran= RANDOM(REC_SEED (SEED), LEN(Nom)-5, 31)    // 25 codes.
M    = UNSCRAMBLE (SUBSTR(Nom,1,5), F_Ran)
M = M +  UNSCRAMBLE (SUBSTR(Nom, 6, LEN(Nom)-5), V_Ran)
SELECT(La)
RETURN M
//
//-------------------------------------------------------------------------
//
FUNCTION UNS_FIELD(Nom)
//
// Returns an unscrambled field
//
LOCAL M, La
//
// Set up global variables
//
// F_Ran already set up by R_CLI
La=SELECT()
SELECT CLIENT
V_Ran= RANDOM(REC_SEED (SEED), LEN(Nom), 31)    // 25 codes.
M    = UNSCRAMBLE (Nom, V_Ran)
SELECT(La)
RETURN M
//
********************************

*
FUNCTION V_Proff(Proff)
//
// Validates the Profession Code in the current record
// Uses the string ValidProff from PARAMS
//
RETURN EMPTY(Proff) .OR. Proff+"," $ ValidProff
//
//--------------------------------------------
//
FUNCTION SIRET (Code)
LOCAL I:=1, J, Tot:=0

Code = ALLTRIM (Code)
IF EMPTY(Code)
   RETURN .T.
ENDIF
IF LEN(Code) <> 14
   RETURN .F.
ENDIF
//
// For the time being ......
//
return .T.
//
DO WHILE I < 14
   J=VAL(SUBSTR(Code,I,1))*2
   J=IIF(J>10, J-9, J)
   Tot = Tot + J + VAL(SUBSTR(Code, I+1, 1))
   I=I+2
ENDDO
RETURN MOD(Tot, 10) = 0
//
/* ------------------------------------------------------------------- */
//
FUNCTION CL_BRWSWHL(aFields)

LOCAL nEvent, mp1, mp2, oXbp, oBut, oBrowse, aSize, i
LOCAL oLdWin,  TheElement
PRIVATE ChosenClient:=0

   oXbp := GuiStdDialog( "Sélection CLIENT/PROSPECT", {10,100}, {675,400})

   oBut := XbpPushButton():new( oXbp:drawingArea, , {295,3}, {84,24},;
                                { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE }, { XBP_PP_FGCLR, -58 } } )
   oBut:caption := "Impression"
   oBut:tabStop := .T.
   oBut:create()
   oBut:activate := {|| PRINT_CLI() }

   // create browser in window
   aSize = oXbp:drawingarea:currentsize()
   aSize[2] = aSize[2] - 30
   oBrowse := GuiBrowseDb( oXbp:drawingArea, {0,30}, aSize )

   FOR i = 1 TO LEN(aFields)

      /* make the new column  - Contents, size, header*/
      oBrowse:addColumn(aFields[i, 2],aFields[i, 3] , aFields[i, 1] )
   NEXT
   oBrowse:CursorMode:=XBPBRW_CURSOR_ROW
   // overload resize that browser fills the window
   oXbp:drawingArea:resize := ;
       {|mp1,mp2,obj| obj:childList()[1]:setSize(mp2) }

   oXbp:show()
   oBrowse:show()
   oldWin = SetAppFocus(oBrowse)

   ChosenClient = 0

   DO WHILE nEvent <> xbeP_Close
      nEvent := AppEvent( @mp1, @mp2, @TheElement,0 )
      TheElement:handleEvent( nEvent, mp1, mp2 )
   ENDDO

   oXbp:hide()
   oBrowse:destroy()
   oXbp:destroy()
   SetAppFocus( oldWin )

RETURN ChosenClient

******************************************************************
* Create GUI Browser with navigation codeblocks
******************************************************************
FUNCTION GuiBrowseDB( oParent, aPos, aSize )
   LOCAL oBrowse

   oBrowse := XbpBrowse():new( oParent,, aPos, aSize,, .F. ):create()

   // navigation codeblocks for the browser
   oBrowse:skipBlock     := {|n| DbSkipper(n) }
   oBrowse:goTopBlock    := {| | DbGoTop()    }
   oBrowse:goBottomBlock := {| | DbGoBottom() }
   oBrowse:phyPosBlock   := {| | Recno()      }
   oBrowse:phyPosBlock   := {| | Recno()      }
   oBrowse:ItemSelected  := {| | ChosenClient:=Recno(), PostAppEvent (xbeP_Close) }
   // Code blocks for the vertical scrollbar.
   // Note: DbPosition() returns values in the range from 0 to 100.
   // We multiply this with 10 to increase the granularity of
   // the vertical scrollbar.
   oBrowse:posBlock      := {| | DbPosition()*10    }
   oBrowse:goPosBlock    := {|n| DbGoPosition(n/10) }
   oBrowse:lastPosBlock  := {| | 1000               }
   oBrowse:firstPosBlock := {| | 0                  }

RETURN oBrowse


******************************************************************
* Create std dialog window hidden
******************************************************************
FUNCTION GuiStdDialog( cTitle, aPos, aSize )
   LOCAL oDlg

   DEFAULT cTitle TO "Standard Dialog Window"

   oDlg          := XbpDialog():new( AppDesktop(),,aPos, aSize,, .F. )
   oDlg:icon     := 1
   oDlg:taskList := .T.
   oDlg:title    := cTitle
*   oDlg:titlebar := .F.
   oDlg:drawingArea:ClipChildren := .T.
   oDlg:create()
   oDlg:drawingArea:setFontCompoundName( FONT_DEFPROP_SMALL )

RETURN oDlg
//
//------------------------------------------------------------
//
FUNCTION PRINT_CLI ()
//
LOCAL La:=SELECT(), M_choice, NRec

SELECT TEMPCLIN
NRec=RECNO()    // In TEMPCLIN

DO WHILE .T.
   //
   // DO allows multiple outputs of the same list
   //
   IF .NOT. Ini_Print (@M_choice)
      EXIT
   ELSE
      Print_Temp (M_choice)
   ENDIF
ENDDO

DCPRINT OFF
SET EXACT ON
SELECT TEMPCLIN
GO NRec
SELECT(La)
RETURN .T.
//
//-----------------------------------------------
//
FUNCTION Ini_Print ( m_choice )

LOCAL oBtn, oDlg,  oXbp, nEvent, mp1, mp2
LOCAL Ans:= .F.

/*
Ans = Alert( "Choisir format d'impression", {"Sommaire", "Détail", "Annuler"} )
IF Ans = <> 1 .AND. Ans = <> 2
   RETURN .F.
ENDIF
m_Choice = IIF(Ans = 1, "S", "D")
RETURN .T.
*/

oDlg := GuiStdDialog( "Impression", {50,200}, {200,150})
oDlg:setModalState(XBP_DISP_APPMODAL)
oDlg:show()
SetAppFocus(oDlg)
//
// Create push buttons
//

oBtn:= XbpPushButton():new( oDlg:drawingArea,,{25,70},{100,30} )
oBtn:caption := "Sommaire"
oBtn:tabStop := .T.
oBtn:activate := {|| Ini_Print_But(@m_choice, "S", @Ans), PostAppEvent( xbeP_Close )  }
oBtn:create()

oBtn:= XbpPushButton():new( oDlg:drawingArea,, {25,40},{100,30}  )
oBtn:caption := "Détail"
oBtn:tabStop := .T.
oBtn:activate := {|| Ini_Print_But(@m_choice, "D", @Ans), Ans = "Hello", PostAppEvent( xbeP_Close ) }
oBtn:create()

oBtn:= XbpPushButton():new( oDlg:drawingArea,, {25,10},{100,30}  )
oBtn:caption := "Cancel"
oBtn:cancel  := .T.
oBtn:tabStop := .T.
oBtn:activate := {|| Ans=.F., PostAppEvent( xbeP_Close ) }
oBtn:create()

nEvent := xbe_None
DO WHILE nEvent <> xbeP_Close
   nEvent := AppEvent( @mp1, @mp2, @oXbp )
   oXbp:handleEvent( nEvent, mp1, mp2 )
ENDDO
oDlg:hide()
oDlg:destroy()

RETURN Ans
//
FUNCTION Ini_Print_But (choice,valeur,Reponse)
choice=valeur
reponse=.T.
RETURN .T.
//
//-----------------------------------------------
//
FUNCTION Print_Temp (R_Type)
LOCAL Mb,La, P_Pos, P_Mem :="<><><>"
PRIVATE oPrinter
La=SELECT()

Mb=""

SELECT TEMPCLIN
GO TOP
CLEAR
IF R_Type = "S"
   //
   // Print summary report
   //
   INDEX ON CLIENT->CLIPROFESS TO TEMP

   DCPRINT ON TO oPrinter FONT "8.Lucida Console" PREVIEW

   DCPRINT ?"CLIENT"+SPACE(72)+"TELEPHONE"
   DO WHILE .NOT. EOF()
      SELECT CLIENT
      REC_LOCK()
      REC_LOCK()        //Ha Ha !
      UNSCRAM_CLI (SEED)
      IF CLIPROFESS <> P_Mem
         IF DC_PRINTERROW() > 48
            DCPRINT EJECT
         ENDIF
         DCPRINT ?
         DCPRINT ?
         DCPRINT ? "ACTIVITE " + CLIPROFESS
         DCPRINT ? "-------------"
         P_Mem = CLIPROFESS
      ENDIF
      DCPRINT ? CLIREF+" "+SUBSTR(CLINOM,1,28)+" "+CLICP+" "+CLIVILLE+" "+" "+CLIPHONE+" "+CLIPHONED
      SCRAM_CLI (SEED)
      UNLOCK
      IF DC_PRINTERROW() > 55
         DCPRINT EJECT
      ENDIF
      SELECT TEMPCLIN
      SKIP
   ENDDO
   EJECT

   DCPRINT OFF
   SET INDEX TO
   ERASE TEMP.NTX
ELSE
   //
   // Print detail report

   DCPRINT ON TO oPrinter FONT "8.Lucida Console" PREVIEW
   P_Pos = 2

   DO WHILE .NOT. EOF()
      DET_OUT(P_Pos)           // Print the report

      IF DC_PRINTERROW() < 30
         P_Pos = 33
         @ P_Pos -2,1 DCPRINT SAY REPLICATE("-",78)
      ELSE
         DCPRINT EJECT
         P_Pos = 2
      ENDIF
      //
      // Allow the User to kill it!
      //
      IF INKEY() = K_ESC .OR. LASTKEY() = K_ESC
        EXIT
      ENDIF
      SKIP

   ENDDO

   DCPRINT OFF
ENDIF
SELECT(La)


RETURN .T.
//
//-----------------------------------------------
//
FUNCTION Det_Out(Lin, Scram)
LOCAL ML:=0, L_CNT, MPL, La, V_String
DEFAULT Scram to .T.

La:=SELECT()
SELECT CLIENT
IF SCRAM
   REC_LOCK()       // Need lock to unscramble
   REC_LOCK()
   UNSCRAM_CLI(SEED)
ENDIF
@  Lin,    4  DCPRINT SAY  CLIREF
@  Lin,   15  DCPRINT SAY  CLINOM
@  Lin,   46  DCPRINT SAY  CLIABV
@  Lin,   53  DCPRINT SAY "Contact"
@  Lin,   61  DCPRINT SAY CLICONTACT
@  Lin+2,  4  DCPRINT SAY  CLIRUE
@  Lin+2, 57  DCPRINT SAY "BANQUE"
@  Lin+3,  4  DCPRINT SAY  CLIADS
@  Lin+3, 51  DCPRINT SAY  CLIBANK
@  Lin+4,  4  DCPRINT SAY  CLICP
@  Lin+4, 11  DCPRINT SAY  CLIVILLE
@  Lin+4, 51  DCPRINT SAY  CLIBCODE
@  Lin+4, 57  DCPRINT SAY  CLIBCGUI
@  Lin+4, 63  DCPRINT SAY  CLIBNCPT
@  Lin+4, 75  DCPRINT SAY  CLIBRIB

@  Lin+6 ,  4  DCPRINT SAY "Tél BUR  : " + CLIPHONE
@  Lin+6 , 40  DCPRINT SAY "Dom   : "  + CLIPHONED
@  Lin+7,   4  DCPRINT SAY "   Voit  : " + CLIPHONEV
@  Lin+7,  40  DCPRINT SAY "Fax   : " + CLIFAX

@  Lin+8,   4  DCPRINT SAY "Activité : " + CLIPROFESS
@  Lin+8,  40  DCPRINT SAY "Siret : "  + CLISIRET

@  Lin+9 ,  4   DCPRINT SAY "Dern. Cde:"
@  Lin+9 , 15  DCPRINT SAY  DCANNEE
@  Lin+9 , 24  DCPRINT SAY "TAILLE : " + CLITAILLE
@  Lin+9 , 41  DCPRINT SAY "Date de Création (MMAA):"
@  Lin+9 , 66  DCPRINT SAY DATE_CRE PICTURE '9999'

Lin=Lin+11
IF .NOT. EMPTY(COMMENTAIR)
   @  Lin,  4  DCPRINT SAY "COMMENTAIRE"
   L_CNT=MLCOUNT(COMMENTAIR, 62, 4, .T.)
   FOR ML=1 TO L_CNT
      MPL=MEMOLINE(COMMENTAIR,62,ML,4,.T.)
      @ ML+Lin,4 DCPRINT SAY MPL
   NEXT
ENDIF

Lin=Lin+ML+2
@ Lin,  4 DCPRINT SAY "DERNIERE VISITE : "
@ Lin, 22 DCPRINT SAY  CLIENT->DERNVISIT
@ Lin, 35 DCPRINT SAY "ACTION AVANT LE : "
@ Lin, 53 DCPRINT SAY CLIENT->RELANCE

V_String = LAST_VISIT(0,0,.T.)
IF .NOT. EMPTY(V_String)
   L_CNT=MLCOUNT(V_String, 62, 4, .T.)
   FOR ML=1 TO L_CNT
      MPL=MEMOLINE(V_String, 62, ML, 4, .T.)
      @ ML+Lin,4 DCPRINT SAY MPL
   NEXT
ENDIF

IF SCRAM
   SCRAM_CLI(SEED)
   UNLOCK
ENDIF

SELECT(La)
RETURN .T.

//
//----------------------------------------------------------------
//
FUNCTION COMC (BONTYPE)   //BONTYPE set in menu ="1" for normal fixed price

* Auteur...: R M ALCOCK
* Date.....: 6/3/95
* Copyright: (c) 1992, R M ALCOCK, Tous droits réservés
* Notes....: PROGRAMME DE ENREGISTREMENT COMMANDE
*          : called by COMMENU (MAINMENU)
*          : MEFRAN MEFRAN
*          : no PORT in the header
*          : includes risque, New_Tarif starred out
*          ;
DEFAULT BONTYPE TO "1"
SAVE ALL LIKE BONTYPE TO C:BT
*
DO WHILE .T.
   RESTORE FROM C:BT ADDITIVE     // Clears Local parameters, restores BONTYPE
   CLEAR
   MT = CONAME+" - SAISIE COMMANDE"
   @ 2,40-LEN(MT)/2 SAY MT
   @ 1,40-2-LEN(MT)/2 TO 3,40+2+LEN(MT)/2 DOUBLE
   IF .NOT. R_CLI(.T.)
      RETURN .T.
   ENDIF
   CLEAR
   @ 2,40-LEN(MT)/2 SAY MT
   @ 1,40-2-LEN(MT)/2 TO 3,40+2+LEN(MT)/2 DOUBLE
   SELECT CLIENT
   @ 4,2 SAY CLINOM+" "+CODEPOSTE+" "+VILLE
   *
   DO S_COMM WITH BONTYPE
ENDDO
RETURN .T.
*******

FUNCTION S_COMM (BONTYPE)
LOCAL t,l,b,r,m_tva:="O"
*
*Client is selected and databases open.
*
* All saisie comes in here so check risque
IF CLIENT->CLIRISQUE ="E"
   ALARM("RISQUE CODE E - COMPTE BLOQUE")
   RETURN .T.
ENDIF
*
*New_Tarif:=CONFIRM (21,4,"N","NOUVEAUX PRIX")
New_Tarif:=.F.
//
*
NET_USE (S_COM, "COM",    .F., 30, "COM,COMCL", "BON")
NET_USE (S_FACTA, "FACTA",  .F., 30, "FACTR", "")

t=0
l=0
b=23
r=79
zbuff=" "
do win with t,l,b,r,zbuff,"SAISIE COMMANDE",""
//
SELECT BON
*
DO WHILE .T.
   @ t+1,l+1 CLEAR TO b-1,r-1
   MCOMM=SPACE(5)
   @ 2,4 SAY "COMMANDE : " GET MComm ;
              PICTURE REPLICATE('9',LEN(MComm))
   READ
   IF EMPTY(MCOMM)
      RETURN .T.
   ENDIF
   IF X_REF("C"+Mcomm,"BON")
      ALARM ("COMMANDE EXISTE DEJA")
      LOOP
   ENDIF
   IF .NOT. CONFIRM (21,,"O","CONFIRMATION SAISIE : ")
      RETURN .T.
   ENDIF
   EXIT
ENDDO
ADD_REC(0)
REPLACE COMMANDE WITH "C"+MComm, EXPORT WITH 1, ;
        D_COMM WITH DATE(), REFCLI WITH CLIENT->CLIREF,;
        C_STATUS WITH "00", REGION WITH M_Reg
@ 2,30 SAY CLIENT->CLINOM
DO WHILE .T.
   @ 3,2 CLEAR TO 20,78
   @ 3,4 SAY "Remise EXCEPTIONNELLE (%):" GET REM_SUP RANGE 0,25
   @ 4,4 SAY "TVA (O/N)                :" GET M_TVA PICTURE '@!';
                                                    VALID M_TVA $ "ON"
   @ 6,4 SAY "ATTENTION - TVA et Remise EXCEPTIONNELLE ne peuvent pas être modifiées"
   READ
   IF REM_SUP<>0.AND..NOT.CONFIRM(10,,"N","Confirmation REMISE EXCEPTIONNELLE")
      LOOP
   ENDIF
   IF M_TVA='N'.AND..NOT.CONFIRM(10,,"N","Confirmation FACTURATION HORS TAXE")
      LOOP
   ENDIF
   EXIT
ENDDO
SELECT BON
REPLACE COMMENT WITH "TEL:"+CLIENT->CLIPHONE, EXPORT WITH IIF(M_TVA="O",1,0)
*
SELECT FACTA
ADD_REC(0)
REPLACE FACTURE WITH BON->COMMANDE,LIGNE WITH "99",ARTICLE WITH "+",;
       TYPE WITH BONTYPE
UNLOCK

DO LINESM

CLEAR

DO COMM_OUT WITH .T.,.F.

SELECT BON

DO RESET_SOLDE WITH "+"

SELECT BON
COMMIT
USE
SELECT FACTA
USE
RETURN .T.
*
************
//
//----------------------------------------------------------------
//
* Programme: COMMPROC.PRG
* Auteur...: R M ALCOCK
* Date.....: 13/01/94
* Copyright: (c) 1992, R M ALCOCK, Tous droits réservés
* Notes....: PROCEDURES FOR COMMANDE SAISIE/MODIF
*          : !!!!!!!!!  line 147 *ed out for test (okflag always .T.)
*          : PRIXREEL now QUANTITE*PRIXREEL
*
*
FUNCTION ENTETE
//
//  SOLDEE and LIMITT set up in COMC
//
LOCAL Re
SELECT BON

Re=1-BON->REM_SUP/100

@ 1,0 SAY REFCLI
@ 1,12 SAY CLIENT->CLINOM
@ 1,43 SAY IIF (AVOIR,"   AVOIR REF","COMMANDE REF ")
@ 1,57 SAY COMMANDE
@ 2,0 SAY "HT : "
@ 2,5 SAY TOTHT*Re PICTURE '999999.99'
@ 2,16 SAY "TVA : "
@ 2,22 SAY TVATOT*Re PICTURE '999999.99'
IF .NOT. AVOIR
   @ 2,34 SAY "SOLDE :"
   @ 2,42 SAY (CLISOLDEE+TOTHT*Re) PICTURE '9999999.99'
   @ 2,54 SAY "LIMITE :"
   @ 2,63 SAY ENCOURSMAX PICTURE '999999999.99'
   IF CLISOLDEE+(TOTHT*Re) > ENCOURSMAX
     ?CHR(7)
   ENDIF
ENDIF
@ 3,0 SAY REPLICATE("-",75)
@ 4,0 SAY "ART   LIBELLE                      *  QTE.   PRIX U REM. R PRIX NET     TOTAL HT"

RETURN .T.
*
*****
**************************
*
FUNCTION ECROUT
PRIVATE I
IF LN < 18 .AND. .NOT. FORCE
   RETURN .T.
ENDIF
La=SELECT()
SELECT FACTA
MF=FACTURE
@ 5,0 CLEAR
LN = 0
IF NSKIP + NLIGNE >=0
   SKIP NSKIP
ELSE
   SKIP -NLIGNE
ENDIF
DO WHILE .T.
   DO LINEOUT
   SKIP
   LN=LN+1
   IF LN >= 5 .OR. EOF() .OR. FACTURE <> MF
      EXIT
   ENDIF
ENDDO
IF FORCE
   LN=LN-1
   SKIP-1
ENDIF
SELECT (La)
RETURN .T.
*
******************************
*
FUNCTION LINEOUT
*
@ 5+LN,2 SAY ARTICLE
@ 5+LN,9 SAY LIB PICTURE REPLICATE("X",23)
I=SUBSTR(ARTICLE,1,1)
IF I<>"*" .AND. I<>"+" .AND. I<>"-"
   @ 5+LN,33 SAY QUANTITE
   @ 5+LN,39 SAY PU
   @ 5+LN,49 SAY REM_LINE
   @ 5+LN,54 SAY IIF(REPORT=98,"N","O")
   @ 5+LN,57 SAY ROUND(PRIXREEL/QUANTITE,2) PICTURE '999999.99'
   @ 5+LN,69 SAY PRIXREEL PICTURE '999999.99'
   WAIT
ENDIF
RETURN .T.
*******************************
*
FUNCTION LIGNEIN
* this is only used by AVOC
*
* LN = NUMERO LIGNE COURANTE
* SAISIE LIGNE ARTICLE :
*
La=SELECT()
SELECT FACTA
Fa=SELECT()
*CTYPE IS NOT "C" FOR THE FIRST ADDITIONAL LINE ON MODIFICATION
IF CTYPE = "C"
   ADD_REC(0)
 ELSE
   CTYPE = "C"
ENDIF
REC_LOCK(0)
MART=R_ART (5+LN,0)
REPLACE FACTURE WITH BON->COMMANDE, TYPE WITH BONTYPE,;
        ARTICLE WITH MART ,REPORT WITH 60
DO R_LINE
SELECT(La)
RETURN .T.
*******************************
*
FUNCTION R_LINE
PRIVATE  M_Q, M_R, MTXT, M_RPX
*
* Used by both LIGNEIN and LIGNEMOD
*
SET ESCAPE OFF
DO WHILE .T.
   *LOOP ALLOWS ARTICLE REFERENCE TO BE CHANGED
   SELECT (Fa)
   IF SUBSTR(ARTICLE,1,1)="+"
      REPLACE LIGNE WITH "99"
      ENDIT = .T.
      EXIT
   ENDIF
   REPLACE LIGNE WITH STR(NLIGNE+1,2)
   IF ARTICLE = "*"
      @ 5+LN,2 SAY ARTICLE
      @ 5+LN,9 GET LIB PICTURE "@S23"
      READ
      EXIT
   ENDIF
   *
   IF ARTICLE="-"
      EXIT
   ENDIF
   *
   *ARTICLE=STFAM+STREF OR = CODE_DIVERS
   AREF=ARTICLE
   IF ARTICLE <> CODE_DIVERS
      *
      *REAL ARTICLE REFERENCE
      SELECT STOCK
      SEEK AREF
      OKFLAG=.T.
      IF FOUND()
        *THE ARTICLE EXISTS IN THE STOCK FILE
         MPU=IIF(New_Tarif, STPRIXVNEW, STPRIXV)

         PPROMO = GET_PPROMO()     // returns prix promo (0 if no promotion)
         IF PPROMO > 0
            MPU=PPROMO
            ALARM("PRIX PROMOTION" )
         ENDIF
         OKFLAG=.T.
      ELSE
         * NON REFERENCED ARTICLE
         OKFLAG=.F.
      ENDIF
      SELECT (Fa)
      IF OKFLAG
          REPLACE LIB WITH STOCK->STLIB,;
            PU WITH MPU,LINETVA WITH STOCK->STTVA,;
            REM_LINE WITH "00",;
            FAM_PROD WITH STOCK->STFAM_PROD,REPORT WITH 0
            //
          ARTPDS=STOCK->POIDS
       ELSE
          AREF = "ERROR"
          REPLACE ARTICLE WITH ' ',LINETVA WITH 1,REM_LINE WITH "00"
          ARTPDS=0
       ENDIF
   ELSE
      * ARTICLE IS CODE_DIVERS
      ARTPDS=0
      REPLACE LINETVA WITH 1 ,REM_LINE WITH "00"
   ENDIF
   *APPLIES TO ALL ARTICLES IN THE CATALOGUE OR NOT

   DO LINEOUT

   REPLACE ARTICLE WITH R_ART(5+LN,2,ARTICLE)

   IF ARTICLE = AREF .AND. AREF <> "ERROR"
      @ 5+LN,09 GET LIB PICTURE "@S23"
      @ 5+LN,33 GET QUANTITE VALID QUANTITE > 0 .AND. UPDPRXREEL()
      @ 5+LN,39 GET PU VALID UPDPRXREEL()
      @ 5+LN,49 GET REM_LINE PICTURE '99' VALID VAL(REM_LINE) <= MAXREMLN;
                                                .AND. UPDPRXREEL()
      IF .NOT. AVOIR
         // REPORT used for articles not to be delivered
         M_RPX = IIF(REPORT=98,"N","O")
         @ 5+LN, 54 GET M_RPX PICTURE '@!' VALID M_RPX $ "ON"
         READ
      ENDIF
      READ
      REPLACE REPORT WITH IIF(M_RPX="N",98,0)
      // you must do this every time
      UPDPRXREEL()
      // displays it as well

      IF BON->EXPORT = 0
         VALUETVA = 0
      ELSE
         IF LINETVA=2
            VALUETVA = TVARED
         ELSE
            VALUETVA = TVARATE
         ENDIF
      ENDIF
      IF .NOT. AVOIR
         IF ARTICLE = CODE_DIVERS
            PREFACT = .T.
         ELSE
            M_Q=QUANTITE
            M_R=ARTICLE

     *       DO CHK_STOK WITH M_R , M_Q

            * here only reset STPORT if operating on FACTA (ie saisie)
            IF ALIAS()="FACTA"
               PREFACT = .T.
               DO SETPF WITH STOCK->REF,M_Q,.T.,.F.  // incl composes
                                                           // only STPORT
            ENDIF
         ENDIF
      ENDIF
      SELECT STOCK
      UNLOCK
      SELECT (Fa)
      ARTTOT=PRIXREEL
         TOTHT=TOTHT+ARTTOT
         TOTPDS=TOTPDS+(QUANTITE*ARTPDS)
         TVATOT = TVATOT +(ARTTOT*VALUETVA)
      MMQTE=QUANTITE
      EXIT
   ENDIF
ENDDO
SELECT (Fa)
UNLOCK
SET ESCAPE ON
LN=LN+1
NLIGNE=NLIGNE+1
RETURN .T.
*
************
*
FUNCTION UPDPRXREEL

REPLACE PRIXREEL WITH CALCPU(PU) *QUANTITE
@ 5+LN,57 SAY ROUND(PRIXREEL/QUANTITE,2) PICTURE '999999.99'
@ 5+LN,69 SAY PRIXREEL PICTURE '999999.99'

RETURN .T.
*
******
*
FUNCTION CALCPU

PRIVATE mprix

MPRIX=PU*(100-VAL(REM_LINE))/100

RETURN MPRIX

*****************
*
FUNCTION GET_PPROMO()           // CLIENT  and STOCK positioned
                                // works on today's date
LOCAL La,MCLREF,MSREF,PP
La=SELECT()
SELECT TARIFT
USE
NET_USE (S_PROMOS, "PROMOS", .F., 0, "PROMOS", "")
MCLREF=CLIENT->CLIREF
MSREF=STOCK->STCOMMREF
PP=0
SEEK MSREF+MCLREF
IF FOUND() .AND.  D_FIN>=SYSDATE() .AND. D_DEBUT<=DATE()
   PP=PRIXPROMO
ENDIF
NET_USE (S_TARIFT,"TARIFT", .F., 0, "TARIFT", "")         // restore TARIFT
SELECT (La)                     // restore entry conditions
RETURN PP                       // prom prix or 0
******************
*
FUNCTION LIGNEMOD
LOCAL La, OLDART
*
* LN = NUMERO LIGNE COURANTE
* MODIFY LIGNE ARTICLE :
*
La=SELECT()
SELECT TEMPLN
Fa=SELECT()
OLDART=ARTICLE
OLDN = QUANTITE
OLDP = QUANTITE * PU
OLDREP = REPORT
BONTYPE=TYPE
LN=ROW()-5             // Offset of 4 in R_LINE
CTYPE="M"
REC_LOCK(0)
MC=COL()
*@ ROW(),0 CLEAR TO ROW(),79
MART=R_ART(5+LN,2)                  // Get new reference
IF MART=SPACE(LEN(STOCK->STCOMMREF)).OR.MART=OLDART
   UNLOCK
   RETURN .T.
ENDIF
REPLACE ARTICLE WITH MART
*
IF LIGNE="99"
   IF SUBSTR(ARTICLE,1,1)="-"
      REPLACE ARTICLE WITH "+"      // Can't delete last line!
   ELSE
      ** Replace last record i.e. add a new one
      RN=RECNO()
      ADD_REC(0)
      REPLACE FACTURE WITH BON->COMMANDE, TYPE WITH BONTYPE,;
              LIGNE WITH "99", ARTICLE WITH "+"
      GO RN
      REPLACE LIGNE WITH STR(RN,2)
   ENDIF
ENDIF
IF AT(SUBSTR(ARTICLE,1,1),"-+")=0   // Deleted Article or last line
   NLIGNE=VAL(LIGNE)-1              // Reset by R_LINE
   DO R_LINE
ENDIF
*
CHANGED = .T.
*
SELECT(La)
RETURN .T.
*
*******************************
*
FUNCTION C_TOTPDS
*
*  TOTPDS already zero from calling prog, and  first line  is selected

LOCAL La,mp
La=SELECT()

DO WHILE FACTURE=BON->COMMANDE .AND. .NOT. EOF()
*   IF REPORT =0
      AREF=ARTICLE
      SELECT STOCK
      SEEK AREF
      IF FOUND()
         mp=POIDS
      ELSE
         mp=0
      ENDIF
      SELECT (La)
      TOTPDS = TOTPDS+(QUANTITE*mp)
*   ENDIF
   SKIP
ENDDO
SELECT (La)
RETURN .T.
*
****************
*
FUNCTION UPSTATS
LOCAL La
*
*RESETS TOT_POIDS  only in BON
*
La=SELECT()
SELECT BON
REPLACE TOT_POIDS WITH TOTPDS
SELECT (La)
RETURN .T.
*
**********************************
*
FUNCTION RESET_SOLDE (SIGN)                   // of client
// assumes client locked
LOCAL La, MAJVAL
La=SELECT()

SELECT BON
MAJVAL = MONTANT*(1-(REM_SUP/100))   // val now in BON
SELECT CLIENT
IF SIGN="+"
   REPLACE CLISOLDE WITH CLISOLDE + MAJVAL
ELSE
   REPLACE CLISOLDE WITH CLISOLDE - MAJVAL
ENDIF
SELECT (La)
RETURN .T.
*
********************
*
FUNCTION COMM_OUT (MAJ,MODCLI)    // .T. if update allowed, .T. if you can

* this is called by saisie/modify commande and PFACT, and AVOC
* MONTANT is the TTC FROM SAISIE LINES
* need to know if refcli is changeable so second param exists
* for saisie MODCLI is .F. . You can't modify the client from the comm system
* MODCLI is only .T. for modify from mainmenu , or PFACT , or AVOC
* can't change the commande ref. or the montant

LOCAL ro, MREF,MREFCLI,TXT
SET ESCAPE OFF
IF PCOUNT()=0
   MAJ    =.F.
   MODCLI =.F.
ENDIF
IF PCOUNT()=1
   MODCLI =.F.
ENDIF
*
SELECT BON
IF .NOT. MAJ
   SET INTENSITY OFF
ELSE
   REC_LOCK()
ENDIF
*
*
IF SELECT("BON")=S_AVO
   TXT = "AVOIR"
ELSEIF SELECT("BON")=S_FACT
   TXT = "FACT."
ELSE
   TXT = "COMM."
ENDIF
@ 2,4 SAY TXT +"  : "+COMMANDE
IF MAJ .AND. MODCLI
   DO WHILE .T.
      MREFCLI=REFCLI
      @ 2,29 SAY "CLIENT :" GET MREFCLI
      READ
      IF VAL(MREFCLI)=VAL(REFCLI)
         EXIT
      ENDIF
      SELECT CLIENT

      MREF =MREFCLI

      SEEK MREF
      IF .NOT. FOUND()
         ALARM("CLIENT INCONNU")
         SELECT BON
         LOOP
      ELSE
         SELECT BON
         REPLACE REFCLI WITH MREF
         EXIT
      ENDIF
   ENDDO
   CLEAR GETS
   SET INTENSITY ON
ENDIF
// loop which follows is to check the integrity of the ttc and the echeances
//
DO WHILE .T.
  @ 2,29 SAY "CLIENT : " +REFCLI
  @ ROW(),COL()+2 SAY  CLIENT->CLINOM
  @ ROW()+1,25 SAY "CLIENT REF : " GET CLI_COMM
  ro=ROW()
  scolor=SETCOLOR()
  IF CLIENT->CLIRISQUE <>" "
     SETCOLOR("*"+scolor)
     @ 22,74 SAY "RISQ"
     IF MAJ
       ?CHR(7)
     ENDIF
  ELSE
     @ 22,74 SAY "    "
  ENDIF
  SETCOLOR(scolor)
*  @ ro+2,4 SAY " STATUS   : "+C_STATUS
  IF SELECT("BON")=S_AVO .OR. SELECT("BON")=S_FACT
     @ ro+2,4 SAY "DATE "+TXT+":" GET D_COMM  RANGE ;
      CTOD("01/" + STR(MONTH(SYSDATE()),2) +"/" + STR(YEAR(SYSDATE())-1900,2)),;
      SYSDATE()
  ELSE
     @ ro+2,4 SAY "DATE "+TXT+" :" GET D_COMM
  ENDIF

  @ ROW(),COL()+8 SAY "DATE DEPART   : " GET D_LIVR
  @ ROW()+1,4 SAY " TVA (O/N):  " + IIF(BON->EXPORT=0,"N","O")
  @ ROW(),COL()+4 SAY " % REMISE SUP :"
  @ ROW(),COL()+1 SAY REM_SUP
*  IF SELECT("BON")<>S_AVO
*    @ ROW(),COL()+10 SAY  "REGL. GROUPE   :" GET REGL_GRP PICTURE "@!" ;
*                                         VALID AT(REGL_GRP,"G ")>0
*  ENDIF
  @ ROW()+1,8 SAY "VRP   : " GET REGION VALID REGION<>SPACE(4)
  @ ROW(),COL()+2 SAY " MONTANT TTC :"
  @ ROW(),COL()+1 SAY STR(MONTANT*(1-REM_SUP/100),10,2)  PICTURE '9999999.99'
  @ ROW()+2,4 SAY "LIVRAISON :" GET LIVR_NOM
  @ ROW()+1,16 GET LIVR_RUE
  @ ROW()+1,16 GET LIVR_ADS
  @ ROW()+1,16 GET LIVR_CP
  @ ROW(),COL()+3 GET LIVR_VILLE
  IF SELECT("BON")=S_AVO
    IF MAJ
      READ
      UNLOCK
    ELSE
      CLEAR GETS
    ENDIF
    EXIT
  ENDIF
  // not for avoirs
  @ ROW()+2,4 SAY "Remarques :" GET COMMENT
  @ ROW()+1,4 SAY "Remarques :" GET COMMENT2

  @ ROW()+2, 4 SAY "ECHEANCES :"

  @ ROW()+1,4      GET MECH1
  @ ROW(),COL()+2  GET CP1   VALID IIF(MECH1=0, CP1=" ", CP1$"0235679")
  @ ROW(),COL()+2  GET DECH1 VALID (EMPTY(DECH1).AND. MECH1=0) .OR.;
                             ( DECH1>=D_COMM .AND. DECH1<D_COMM+120 )

  @ ROW(),COL()+3  GET MECH2
  @ ROW(),COL()+2  GET CP2   VALID IIF(MECH2=0, CP2=" ", CP2$"0235679")
  @ ROW(),COL()+2  GET DECH2 VALID (EMPTY(DECH2).AND. MECH2=0) .OR.;
                             ( DECH2>=D_COMM .AND. DECH2<D_COMM+120 )

  @ ROW(),COL()+3  GET MECH3
  @ ROW(),COL()+2  GET CP3   VALID IIF(MECH3=0, CP3=" ", CP3$"0235679")
  @ ROW(),COL()+2  GET DECH3 VALID (EMPTY(DECH3).AND. MECH3=0) .OR.;
                             ( DECH3>=D_COMM .AND. DECH3<D_COMM+120 )

  @ ROW()+1,4      GET MECH4
  @ ROW(),COL()+2  GET CP4   VALID IIF(MECH4=0, CP4=" ", CP4$"0235679")
  @ ROW(),COL()+2  GET DECH4 VALID (EMPTY(DECH4).AND. MECH4=0) .OR.;
                             ( DECH4>=D_COMM .AND. DECH4<D_COMM+120 )

  @ ROW(),COL()+3  GET MECH5
  @ ROW(),COL()+2  GET CP5   VALID IIF(MECH5=0, CP5=" ", CP5$"0235679")
  @ ROW(),COL()+2  GET DECH5 VALID (EMPTY(DECH5).AND. MECH5=0) .OR.;
                             ( DECH5>=D_COMM .AND. DECH5<D_COMM+120 )

  @ ROW(),COL()+3  GET MECH6
  @ ROW(),COL()+2  GET CP6   VALID IIF(MECH6=0, CP6=" ", CP6$"0235679")
  @ ROW(),COL()+2  GET DECH6 VALID (EMPTY(DECH6).AND. MECH6=0) .OR.;
                             ( DECH6>=D_COMM .AND. DECH6<D_COMM+120 )

  @ ROW()+1,4      GET MECH7
  @ ROW(),COL()+2  GET CP7   VALID IIF(MECH7=0, CP7=" ", CP7$"0235679")
  @ ROW(),COL()+2  GET DECH7 VALID (EMPTY(DECH7).AND. MECH7=0) .OR.;
                             ( DECH7>=D_COMM .AND. DECH7<D_COMM+120 )

  @ ROW(),COL()+3  GET MECH8
  @ ROW(),COL()+2  GET CP8   VALID IIF(MECH8=0, CP8=" ", CP8$"0235679")
  @ ROW(),COL()+2  GET DECH8 VALID (EMPTY(DECH8).AND. MECH8=0) .OR.;
                             ( DECH8>=D_COMM .AND. DECH8<D_COMM+120 )

  @ ROW(),COL()+3  GET MECH9
  @ ROW(),COL()+2  GET CP9   VALID IIF(MECH9=0, CP9=" ", CP9$"0235679")
  @ ROW(),COL()+2  GET DECH9 VALID (EMPTY(DECH9).AND. MECH9=0) .OR.;
                             ( DECH9>=D_COMM .AND. DECH9<D_COMM+120 )

  @ ROW()+1,4      GET MECH10
  @ ROW(),COL()+2  GET CP10   VALID IIF(MECH10=0, CP10=" ", CP10$"0235679")
  @ ROW(),COL()+2  GET DECH10 VALID (EMPTY(DECH10).AND. MECH10=0) .OR.;
                             ( DECH10>=D_COMM .AND. DECH10<D_COMM+120 )

  @ ROW(),COL()+3  GET MECH11
  @ ROW(),COL()+2  GET CP11   VALID IIF(MECH11=0, CP11=" ", CP11$"0235679")
  @ ROW(),COL()+2  GET DECH11 VALID (EMPTY(DECH11).AND. MECH11=0) .OR.;
                             ( DECH11>=D_COMM .AND. DECH11<D_COMM+120 )

  @ ROW(),COL()+3  GET MECH12
  @ ROW(),COL()+2  GET CP12   VALID IIF(MECH12=0, CP12=" ", CP12$"0235679")
  @ ROW(),COL()+2  GET DECH12 VALID (EMPTY(DECH12).AND. MECH12=0) .OR.;
                             ( DECH12>=D_COMM .AND. DECH12<D_COMM+120 )

  IF MAJ
     READ
     IF .NOT. CHK_TTC()
         LOOP
     ENDIF
     UNLOCK
     SELECT CLIENT
     REPLACE DCANNEE WITH BON->D_COMM,;
             CLISTATUS WITH "1"      // Force update to Florensac
     SELECT BON
     EXIT
  ELSE
     CLEAR GETS
     EXIT
  ENDIF
ENDDO
SET INTENSITY ON
SET ESCAPE ON
*
RETURN .T.
*
*************
FUNCTION CHK_TTC
LOCAL Totech,Mval
Totech=MECH1+MECH2+MECH3+MECH4+MECH5+MECH6+MECH7+MECH8+MECH9+MECH10+;
            MECH11+MECH12
IF Totech=0 .AND. MONTANT=0
   RETURN .T.
ENDIF
Mval= ROUND(MONTANT*(1-REM_SUP/100),2)
IF ABS(Mval-Totech)>0.001
    @ 0,0 SAY " "
    ALARM("Total des echéances = " + STR(Totech,10,2)+" TTC = "+STR(Mval,10,2))
    // this is OK if reglement is grouped only
    IF REGL_GRP="G"
       RETURN .T.
    ELSE
       RETURN .F.
    ENDIF
ENDIF
RETURN .T.
*
//
//-----------------------------------------------------------------
//
* Programme: LITPROC.PRG
* Auteur...: R M ALCOCK
* Date.....: 13 MAY
* Copyright: (c) 1992, R M ALCOCK, Tous droits réservés
* Notes....: PROCEDURES for LITIGE system
*
*
FUNCTION LIT_INIT
*
NET_USE (S_LITIGE, "LITIGE", .T., 30, "", "")
IF .NOT. FILE("LITIGE.NTX")
   INDEX ON CODE TO LITIGE
ENDIF
IF .NOT. FILE("LITDATE.NTX")
   INDEX ON A_DATE TO LITDATE
ENDIF
IF .NOT. FILE("LITCLI.NTX")
   INDEX ON CLIENT TO LITCLI
ENDIF
NET_USE (S_LITIGE, "LITIGE", .F., 30, "", "")
FIL_LOCK(0)
SET INDEX TO LITIGE,LITDATE,LITCLI
UNLOCK
NET_USE (S_LITREG, "LITREG", .F., 0, "", "")
NET_USE (S_LITCOD, "LITCOD", .F., 0, "", "")
SELECT LITIGE
RETURN .T.
*
**************************************
*
FUNCTION CRELIT
*
LOCAL HM:="C O N T A C T  - CREATION", MCODE, M_Type
SELECT LITCOD
M_Type = RMAMENU(HM,MRCODE,LCD)      // Get Type of record
DO HLOFF WITH LCD
CLEAR
M_Type = ALLTRIM(LIBELLE)
//
IF M_Type<>""

   NET_USE (S_ATTACH, "ATTACH", .T., 0, "", "")
   MCODE = "95"+PAD(STR(VISITNUM,4) , 4)
   REPLACE VISITNUM WITH IIF(VISITNUM<9999, VISITNUM+1, 1)
   USE

   SELECT LITIGE
   ADD_REC(0)
   REPLACE REGION WITH M_Reg, D_ECR WITH DATE(), CODE WITH MCODE,;
                    RESP WITH M_Resp, CLIENT WITH MCLI, TYPE WITH M_Type
   DO LITFMT WITH 1           // Read date, Label, Memo
*   READ
   //
   // Create an EVENT record and attach it to the client
   //
   SELECT EVENT
   ADD_REC (0)
   STORE_EVENT()
   SELECT CLIENT
   REPLACE DERNVISIT WITH LITIGE->D_ECR,;
           RELANCE   WITH LITIGE->A_DATE,;
           CLISTATUS WITH "1"
   ALARM ("CONTACT ENREGISTRE")

ENDIF
SELECT LITIGE
USE
SELECT LITCOD
USE
SELECT LITREG
USE

RETURN .T.
*
******
FUNCTION LECRAN
*
* Used by LITFMT to display a record

*
DO HLON
@  2, 2  SAY  "DATE   : "
@  2,12  SAY  D_ECR
@  2, 40  SAY "ACTION AVANT LE :"
DO HLOFF WITH LCD
@  2, 58  SAY  LITIGE->A_DATE
@  4, 2  SAY  "CLIENT :"
@  4, 11  SAY  LITIGE->CLIENT
IF .NOT. EMPTY(LITIGE->CLIENT)
  @  4, 23  SAY CLIENT->CLIABV+" "+CLIENT->CLINOM
ENDIF
@  6,  2  SAY "VRP    :"
@  6, 11  SAY  LITIGE->REGION
@  6, 17  SAY "CODE :"
@  6, 24  SAY  LITIGE->CODE
@  6, 32  SAY "TYPE :"
@  6, 39  SAY  LITIGE->TYPE

IF LITIGE->TYPE $ "IMPAYEE,LITIGE"
   @  8, 2   SAY "FACTURE:"
   @  8, 11  SAY  LITIGE->FACTURE
   @  8, 22  SAY "MONTANT:"
   @  8, 31  SAY LITIGE->MONTANT
ENDIF
@ 11,  1  SAY "COMMENTAIRE :"
*
RETURN .T.
*
//
//------------------------------------------------------------------------
//
FUNCTION PRINT_L
*
@  2, 2  DCPRINT SAY  "DATE   : "
@  2,12  DCPRINT SAY  D_ECR
@  2,40  DCPRINT SAY "ACTION AVANT LE :"
@  2,58  DCPRINT SAY  LITIGE->A_DATE
@  4, 2  DCPRINT SAY  "CLIENT :"
@  4,11  DCPRINT SAY  LITIGE->CLIENT
IF .NOT. EMPTY(LITIGE->CLIENT)
  @  4, 23  DCPRINT SAY CLIENT->CLIABV+" "+CLIENT->CLINOM
ENDIF
@  6,  2  DCPRINT SAY "VRP    :"
@  6, 11  DCPRINT SAY  LITIGE->REGION
@  6, 17  DCPRINT SAY "CODE :"
@  6, 24  DCPRINT SAY  LITIGE->CODE
@  6, 32  DCPRINT SAY "TYPE :"
@  6, 39  DCPRINT SAY  LITIGE->TYPE

IF LITIGE->TYPE $ "IMPAYEE,LITIGE"
   @  8, 2   DCPRINT SAY "FACTURE:"
   @  8, 11  DCPRINT SAY  LITIGE->FACTURE
   @  8, 22  DCPRINT SAY "MONTANT:"
   @  8, 31  DCPRINT SAY LITIGE->MONTANT
ENDIF
@ 11,  1  DCPRINT SAY "COMMENTAIRE :"
*
RETURN .T.
*
//
//--------------------------------------------------------------------------------
//
FUNCTION LITFMT (CONTROL)
*
* Control = 1   Creation, don't read REGION, CODE, RESP
* Control = 2   Modif, all parameters except D_ECR and CODE can be changed
* Control = 3   Deletion, no read
*
LOCAL abuff
REC_LOCK(0)

IF Control=1
   // Create
   do win with 0,0,23,79,abuff, "CREATION "+ALLTRIM(EVENT->TYPE)
ENDIF

DO LECRAN                        // OUTPUT Screen Format
@ 12,  1  TO 12, 10
MEMOEDIT(LITIGE->COMMENTAIR,13,1,21,78,.F.,.F.,74)
IF CONTROL=3                     // CONTROL=3 No Gets
   RETURN .T.
ENDIF
@  2, 12  GET  LITIGE->D_ECR  RANGE DATE()-300, DATE()
@  2, 58  GET  LITIGE->A_DATE RANGE DATE(),DATE()+500
IF LITIGE->TYPE $ "IMPAYEE,LITIGE"
   @  8, 11  GET  LITIGE->FACTURE
   @  8, 31  GET  LITIGE->MONTANT
ENDIF
READ

IF LASTKEY()<>K_ESC
   // Operate on Memo field
   @ 11,18 CLEAR TO 21,78
   DO HLON
   @ 23,31 SAY "   F1 pour Aide   " //spaces to overwrite old message
   DO HLOFF WITH LCD
   ED_MEMO()         // FUNCTION used so that HELP can decode situation
ENDIF

IF UPDATED()

   IF LITIGE->D_ECR > CLIENT->DERNVISIT
      REPLACE CLIENT->DERNVISIT WITH LITIGE->D_ECR,;
              CLIENT->CLISTATUS WITH "1"
   ENDIF
   IF CLIENT->RELANCE > LITIGE->A_DATE
      REPLACE CLIENT->RELANCE   WITH LITIGE->A_DATE,;
              CLIENT->CLISTATUS WITH "1"
   ENDIF

   SELECT EVENT
   SEEK LITIGE->CODE
   IF FOUND()
      STORE_EVENT()
   ENDIF
ENDIF

UNLOCK
IF Control=1
   // Create
   do wout with 0,0,23,79,abuff
ENDIF

RETURN .T.
***
FUNCTION LITCLI()
LOCAL La,R:=.T.
La=SELECT()
IF EMPTY(LITIGE->CLIENT)
   RETURN .T.
ENDIF
SELECT CLIENT
SEEK LITIGE->CLIENT
IF .NOT. FOUND()
  R= .F.
ELSE
  DO LECRAN
ENDIF
SELECT (La)
RETURN R
****
//
//------------------------------
//
FUNCTION STORE_EVENT()
//
LOCAL M_Sel:=SELECT()
SELECT LITCOD
LOCATE FOR CODE = EVENT->TYPE
SELECT EVENT
REPLACE REFCLI WITH LITIGE->CLIENT,;
        D_CRE  WITH LITIGE->D_ECR,;
        TYPE   WITH LITIGE->TYPE,;
        BONREF WITH LITIGE->CODE
SELECT (M_Sel)
RETURN .T.
//
//------------------------------
//
FUNCTION ED_MEMO()
LOCAL bBlock
//
// Only exists so the HELP system will work !!!
//
bBlock = SetKey( K_F1, { || help_me ( ProcName(), ProcLine(), "COMMENTAIR" ) } )
REPLACE COMMENTAIR WITH MEMOEDIT(COMMENTAIR,13,1,21,78,.T.)
SetKey ( K_F1, bBlock)
RETURN .T.
//
//-----------------------------------------------------------
//

* Programme: COMMENT. PRG   (was proc T_COMMENT in MAIN)
* Auteur...: R M ALCOCK
* Date.....: 3/3/95
* Copyright: (c) 1995, R M ALCOCK, Tous droits réservés
* Notes....: Used by MAIN and MAINMENU
*
*
FUNCTION T_COMMENT (CONTROL)

LOCAL La,MA[4],MBUFF1:="",MBuff2:="",MCHOIX
LOCAL t:=17,l:=57,b:=22,r:=75             // Menu Position
LOCAL TL:=5, LM:=5, RM:=76, BM:=23        // Comment Screen
LOCAL oPrinter, bBlock

La=SELECT()
SELECT CLIENT
MA[1]="RETOUR   "
MA[2]="Modifier "
MA[3]="Imprimer "
MA[4]="Supprimer"
*
DO WIN WITH TL,LM,BM,RM,MBUFF2,"COMMENTAIRE",""   // Preserve outside screen

MEMOEDIT(COMMENTAIR,TL+1,LM+2,BM-1,RM-2,.F.,.F.)  // Display the memo
bBlock = SetKey( K_F1, { || help_me ( ProcName(), ProcLine(), "COMMENTAIR" ) } )
*
DO WHILE .T.
   DO WIN WITH t,l,b,r,MBUFF1,"COMMENTAIRE",""    // Preserve the memo
   IF CONTROL=1                          // Creation
      MCHOIX=2                           // Force an edit
      CONTROL=0                          // Normal next time
   ELSE
      SET COLOR TO &MENUCLR
      MCHOIX=ACHOICE(t+1,l+2,b-1,r-1,MA)
      DO HLOFF WITH LCD                  // Get Colour back
   ENDIF
   DO WOUT WITH t,l,b,r,MBUFF1           // Get back memo without menu
   DO CASE
      CASE MCHOIX=0.OR.MCHOIX=1          // RETOUR
         SELECT(La)
         EXIT
      CASE MCHOIX=2                      // Modifier
         @ 23,34 SAY "F1 pour Aide"
         REPLACE COMMENTAIR WITH MEMOEDIT(COMMENTAIR,TL+1,LM+2,BM-1,RM-2,.T.)
         REPLACE CLISTATUS WITH "1"      // Force update to Florensac

      CASE MCHOIX=3                      // Imprimer

         DCPRINT ON TO oPrinter

         @ 2,4 DCPRINT SAY "COMMENTAIRE Client : " +CLIENT->CLIREF
         @ PROW(),PCOL()+2 DCPRINT SAY CLINOM
         L_CNT=MLCOUNT(COMMENTAIR, 62, 4, .T.)
         FOR ML=1 TO L_CNT
             MPL=MEMOLINE(COMMENTAIR,62,ML,4,.T.)
             @ ML+4,4 DCPRINT SAY MPL
         NEXT
         DCPRINT EJECT

         DCPRINT OFF


      CASE MCHOIX=4                      // Efface memo
         IF CONFIRM (21,3,"N","EFFACE COMMENTAIRE : ")
            REPLACE COMMENTAIR WITH ""
            REPLACE CLISTATUS WITH "1"   // Force update to Florensac
         ENDIF
         @ 21,3 CLEAR TO 21,79
      OTHERWISE
   ENDCASE
ENDDO
DO WOUT WITH TL,LM,BM,RM,MBUFF2
SetKey ( K_F1, bBlock)
SELECT (La)
RETURN .T.
//
//----------------------------------------------------------------
//
FUNCTION COMM
* Auteur...: R M ALCOCK
* Date.....: 6/3/95
* Copyright: (c) 1992, R M ALCOCK, Tous droits réservés
* Notes....: Modification Command (MEFRAN)
*                         ---
*
* First Choose the Commande
*
DO WHILE .T.
   CLEAR
   SELECT BON
   SET CURSOR ON
   MCOM=SPACE(LEN(COMMANDE))
   MT = CONAME+" - MODIFICATION COMMANDE"
   @ 2,40-LEN(MT)/2 SAY MT
   @ 1,40-2-LEN(MT)/2 TO 3,40+2+LEN(MT)/2 DOUBLE

   @ ROW()+6,14 SAY "Commande REFERENCE :";
                GET MCOM
   READ
   IF MCOM=SPACE(LEN(COMMANDE))
      RETURN .T.
   ENDIF
   *
   *
   SET ORDER TO 1
   SEEK MCOM
   IF .NOT. FOUND()
      @ 12,14 SAY "COMMANDE N'EXISTE PAS - Tapez une touche"
      WAIT " "
      LOOP
   ENDIF
   * Commande Selected, do Modif.
   t=0
   l=0
   b=23
   r=79
   zbuff=" "
   REC_LOCK(0)
   * as in ZCC
   do win with t,l,b,r,zbuff,"COMMANDE"
   * client is not yet selected
   SELECT CLIENT
   SEEK BON->REFCLI
   SELECT BON
   DO COMM_OUT
   SET CURSOR OFF
   DO COMMMENU
   do wout with t,l,b,r,zbuff
ENDDO
RETURN .T.
*
****************************************
*
FUNCTION COMMMENU (MODCLI)
*.......................................
*
LOCAL MA[4],MBUFF1,t,l,b,r,MCHOIX,MSEL,DEL:=.F.
MODCLI=IIF (PCOUNT()=0,.T.,.F.)
                   // If called from F2 in Commercial system PCOUNT
                   // can never be zero because it is automatically set
                   // to the name of the calling routine, therefore
                   // if not set, the call is from COMM
*
MCHOIX=1           // Selction Code in Menu
MSEL=SELECT()
SELECT BON
*
do keysoff
t=12
l=52
b=17
r=72
MBUFF1=""
MA[1]="RETOUR   "
MA[2]="Modifier En-tête"
MA[3]="         Lignes"
MA[4]="Supprimer"
DO WHILE .T.
   DO WIN WITH t,l,b,r,MBUFF1,"",""
   SET COLOR TO &MENUCLR
   //
   // Should test the status here to deal with blocked commandes - STATUS 40
   //
   MCHOIX=ACHOICE(t+1,l+2,b-1,r-1,MA)
   DO WOUT WITH t,l,b,r,MBUFF1
   DO HLOFF WITH LCD
   DO CASE
      CASE MCHOIX=0.OR.MCHOIX=1
         SELECT(MSEL)
         IF .NOT. MODCLI
            set key K_F2 to COMMMENU  // If MODCLI=.F. called from MAIN
         ENDIF
         RETURN .T.
      CASE MCHOIX=2
         SET CURSOR ON
         IF VAL(BON->C_STATUS)=40
           ALARM("COMMANDE BLOQUEE")
         ELSE
           IF VAL(BON->C_STATUS)>9
             ALARM("ATTENTION!! DEJA FACTUREE")
           ENDIF
         ENDIF
         DO COMM_OUT WITH .T.,MODCLI
         SET CURSOR OFF
      CASE MCHOIX=3
         SET CURSOR ON
         IF VAL(BON->C_STATUS)<>0
            ALARM("BON DEJA ENVOYEE A FLORENSAC")
         ENDIF
*         IF VAL(BON->C_STATUS)=10
*            ALARM("ATTENTION!! DEJA FACTUREE")
*         ENDIF
         IF VAL(BON->C_STATUS)=40
           ALARM("COMMANDE BLOQUEE")
         ENDIF
         DO LINESM                   // Modification Lines
         IF Changed .AND. VAL(BON->C_STATUS)=0
            CLEAR
            DO COMM_OUT WITH .T., .F.
         ENDIF
         SET CURSOR OFF
      CASE MCHOIX=4                  // DELETE
                                     // only packs COM, FACTA packed at FDM
         IF VAL(C_STATUS)<>09
            ALARM("COMMANDE DEJA ENVOYEE A FLORENSAC - ANNULATION INTERDIT")
         ELSE
            @ b-3,l+1 TO b-1,l+19 DOUBLE
            IF CONFIRM (20,,"N","CONFIRMATION SUPPRESSION COMMANDE ? ")
               IF MONTH(D_COMM)=MONTH(MDAT_MAX)
                  DEL =.T.                         // this month's cde
               ENDIF
               DO RESET_SOLDE WITH "-"
               SELECT BON
               AREF=COMMANDE
               REC_LOCK(0)
               IF DEL
                 DELETE
               ELSE
                * REPLACE C_STATUS WITH "99"    always delete for now,
                 DELETE
               ENDIF
               UNLOCK
               SELECT FACTA
               SEEK AREF
               DO WHILE FACTURE=AREF .AND. .NOT. EOF()
                  REC_LOCK(0)
                  IF SUBSTR(ARTICLE,1,1)<>"+"
                     OLDART=ARTICLE
                     OLDQTE=QUANTITE
                     OLDREP=REPORT
                     REPLACE REPORT WITH 99       // so as not to do SETPF
                     DO RESETPF
                  ENDIF
                  IF DEL
                    DELETE
                  ENDIF
                  UNLOCK
                  SKIP
               ENDDO
               UNLOCK
               SELECT(MSEL)
               DO WOUT WITH t,l,b,r,MBUFF1
               KEYBOARD CHR(27)+CHR(27)     //Force Terminate
               RETURN .T.
            ENDIF
         ENDIF
   ENDCASE
   SET CURSOR OFF
   Do HLON                     // Equivalent of WIN to make correct Frame
   @ 0,0 clear to 23,79
   @ 0,0 to 23,79 double
   @ 0,32 say "COMMANDE"
   @ 23,31 SAY "Esc pour terminer"
   Do HLOFF WITH LCD
   DO COMM_OUT WITH .F.        // Visualise
ENDDO
RETURN .T.
*
****************************************
*
FUNCTION LINESM
*.......................................
*
Local Blq:=.F.,MAJMONT,TOTHT,TOTTARIF

CLEAR
SELECT BON
AREF=COMMANDE
SELECT FACTA
SEEK AREF
COPY TO C:TEMPLN WHILE FACTURE=AREF
UNLOCK
NET_USE (S_TEMPLN, "C:TEMPLN",  .T., 30, "", "")
MREC=RECCOUNT()
Fa=SELECT()
*
*FIRST SELECT THE RECORD
*
PRIVATE fbuff[8],tbuff[8],sbuff[8]
Fbuff[1]="ARTICLE"
Fbuff[2]="LIB"
Fbuff[3]="QUANTITE"
Fbuff[4]="PU"
Fbuff[5]="REM_LINE"
Fbuff[6]="IIF(REPORT=98,'N','O')"
Fbuff[7]="PRIXREEL/QUANTITE"
Fbuff[8]="PRIXREEL"
   *
Tbuff[1]="ART"
Tbuff[2]="LIBELLE"
Tbuff[3]=" QTE."
Tbuff[4]="   PRIX U"
Tbuff[5]="REM "
Tbuff[6]="LI"
Tbuff[7]=" PRIX NET"
Tbuff[8]="  TOTAL NET"
*
Sbuff[2]="@S23 "
Sbuff[3]="9999"
Sbuff[5]="99"
Sbuff[7]="@Z ######.##"
Sbuff[8]="@Z ########.##"
*
PUBLIC Changed,PREFACT,TOTPDS,Recalc
//
Recalc=.F.
Changed=.F.
PREFACT=.F.
TOTPDS =0                    // in fact TOTPDS is recalculated if MAJ
SET CURSOR OFF
IF SELECT("BON")=S_AVO
   @ 1,0 SAY "AVOIR    : " +AREF
ELSE
   @ 1,0 SAY "COMMANDE : " +AREF
ENDIF

@ 1,20 SAY CLIENT->CLINOM
*
My_DBEDIT(3,0,21,79,Fbuff,"RMAED",Sbuff,Tbuff,"-"," ")
//
SUM PRIXREEL TO TOTHT FOR AT(SUBSTR(ARTICLE,1,1),"-*")=0
* .AND. REPORT=0
TOTHT=TOTHT*(1-BON->REM_SUP/100)
SUM PU*QUANTITE TO TOTTARIF FOR AT(SUBSTR(ARTICLE,1,1),"-*")=0
* .AND. REPORT=0
*
TVATOT =IIF(BON->EXPORT=0,0,TOTHT*TVARATE)
TVATTOT=IIF(BON->EXPORT=0,0,TOTTARIF*TVARATE)
IF BON->MONTANT=0
   // remise is  TARIF-NET which is not O if there is a remise line
   // or a rem sup
   Remis=(TOTTARIF-TOTHT)/TOTTARIF
ELSE
   Remis=(TVATTOT+TOTTARIF-(BON->MONTANT*(1-BON->REM_SUP/100)));
          /(TVATTOT+TOTTARIF)
ENDIF
//  must come out of the next bit with majmont set up
SET CURSOR ON
@ 20,0 CLEAR TO 20,79
IF BON->REM_SUP>0
  ALARM("Remise exceptionnelle sur la commande = " +STR(BON->REM_SUP,5,2) +" %")
ENDIF
@ 20, 1      SAY "TARIF TTC :" +STR(TVATTOT+TOTTARIF,10,2)
@ 20,COL()+2 SAY "NET TTC :"   +STR(TVATOT+TOTHT,10,2)
@ 20,COL()+2 SAY "NET HT :"    +STR(TOTHT,10,2)
@ 20,65      SAY "Remise :"    +STR(Remis*100,5,1)+"%"
//
// now proposes in the box either the sum of all prixreels after remsup
// or the previous montant after rem_sup
//
MM=IIF(BON->MONTANT=0,TVATOT+TOTHT,;
                      ROUND(BON->MONTANT*(1-BON->REM_SUP/100),2))
Remis=(TVATTOT+TOTTARIF-MM)/(TVATTOT+TOTTARIF)

IF VAL(BON->C_STATUS)=0 .AND.(Remis*100 > MAXREM1 .OR.;
     .NOT. CONFIRM (21,,"N","Montant TTC à facturer ? " + STR(MM,11,2)))

    DO WHILE .T.
       Blq=.F.
       @ 22,65 CLEAR TO 23,79
       SET ESCAPE OFF
       @ 21,10 SAY "Tapez le montant à facturer :" GET MM PICTURE '99999999.99'
       READ
       Remis=(TVATTOT+TOTTARIF-MM)/(TVATTOT+TOTTARIF)
       @ 20,65      SAY "Remise :"    +STR(Remis*100,5,1)+"%"
       IF SELECT("BON")<>S_AVO
          IF Remis*100 > MAXREM1
             ALARM("REMISE EN DEPASSEMENT")
             Blq=.T.
          ENDIF
       ENDIF
       ANS="N"
       @ 22,10 SAY "Confirmation ? (O/N)? " GET ANS
       READ
       IF UPPER(ANS)="O"
          MAJMONT=MM
          IF Blq
             ALARM("LA COMMANDE SERA BLOQUEE")
             Changed =.T.
          ENDIF
          EXIT
       ELSE
          @ 21,0 CLEAR TO 23,79
          LOOP
       ENDIF
    ENDDO
ENDIF
MAJMONT=MM
SET ESCAPE ON

IF  MAJMONT<>BON->MONTANT*(1-BON->REM_SUP/100)
    Changed=.T.
    Recalc=.T.
ENDIF
IF Changed
   Ln=IIF(RECCOUNT()>15,21,RECCOUNT()+5)
   DO HLON
   @ Ln,25 TO Ln+3,54 DOUBLE
   DO HLOFF WITH LCD
   CHOIX=1
   @ Ln+1,28 PROMPT "Mise à jour des fichiers"
   @ Ln+2,28 PROMPT "Abandon sans mise à jour"
   MENU TO CHOIX
   *
   @ Ln+1,28 CLEAR TO Ln+2,53
   @ Ln+1,28 SAY "Patientez S.V.P. ......"
   *
   IF CHOIX=2                     // abandon
      Changed = .F.
   ELSE                           // M A J
      SELECT BON                  //moved 27/1
      REC_LOCK(0)
      REPLACE MONTANT WITH MAJMONT/(1-REM_SUP/100)
      UNLOCK
      SELECT TEMPLN
      DO RECALCPR                 // Mod of 3/1/95 ....

      TOTPDS=0
      GO TOP
      DO C_TOTPDS                  // calcs TOTPDS for all lines report=0 or not
                                   // whether in TEMPLN or FACTA
      IF Blq
         SELECT BON
         REC_LOCK(0)
         REPLACE C_STATUS WITH "40"
         UNLOCK
      ENDIF
      SELECT TEMPLN
      SET RELATION TO FACTURE+LIGNE INTO FACTA
      GO TOP
      DO WHILE RECNO()<MREC
        * CLEAR
         SELECT FACTA
         REC_LOCK()
         REC_LOCK()
         OLDQTE=QUANTITE
         OLDART=ARTICLE
         OLDREP=REPORT
         REPLACE  ARTICLE WITH TEMPLN->ARTICLE, QUANTITE WITH TEMPLN->QUANTITE,;
               LIB WITH TEMPLN->LIB, PU WITH TEMPLN->PU
         REPLACE REPORT WITH TEMPLN->REPORT,PRIXREEL WITH TEMPLN->PRIXREEL,;
                TYPE WITH TEMPLN->TYPE,REM_LINE WITH TEMPLN->REM_LINE,;
                LINETVA WITH TEMPLN->LINETVA
         UNLOCK
         IF  OLDQTE<>QUANTITE .OR. OLDART<>ARTICLE .OR. OLDREP<>REPORT
            IF OLDREP<>REPORT .AND. REPORT=0
               // something has changed from delai to immed
                   PREFACT=.T.
            ENDIF
            IF REPORT=0 .AND. SUBSTR(OLDART,1,1)="+" .AND.;
                AT(SUBSTR(ARTICLE,1,1),"-*")=0
                // last line been changed to a real immediate thing
                PREFACT=.T.
            ENDIF
            IF REPORT=0 .AND. SUBSTR(OLDART,1,1)="*" .AND.;
              AT(SUBSTR(ARTICLE,1,1),"-*+")=0
              // a comment line has been changed to a real immediate thing
              PREFACT=.T.
            ENDIF

            IF SELECT("BON")<>S_AVO
                 DO RESETPF                   // which does SETPF as well
            ENDIF
         ENDIF        // change with "ACTION"
         SELECT TEMPLN
         SKIP
      ENDDO
      *
      IF RECCOUNT()>MREC          // Records have been added
         GO TOP
         DELETE NEXT MREC-1       // The old "+" record is now re-used
         GO TOP
         DELETE FOR SUBSTR(ARTICLE,1,1)="+"
         PACK
         IF SELECT("BON")<>S_AVO
            Fa=SELECT()
            GO TOP
            OLDART=SPACE(6)
            OLDQTE=0
            DO WHILE .NOT. EOF()
              IF AT(SUBSTR(ARTICLE,1,1),"+-*")=0
                 DO RESETPF
              ENDIF
              SKIP
           ENDDO
         ELSE
           // Avoirs, do nothing
         ENDIF
         USE                  // releases templn
         SELECT FACTA
         APPEND FROM C:TEMPLN       // Just the additions
         SELECT (Fa)               // templn
      ENDIF          // of added lines in TEMPLN

      // next bit deals with PREFACT

      IF PREFACT .AND. (BON->C_STATUS="09" .OR. BON->C_STATUS="10")
        // at least one line of an entirely delayed commande is to be delivered
        // and the bon did not come out last time
         // or this commande is already factured for a partial delivery
        SELECT BON
        REC_LOCK()
        REPLACE C_STATUS WITH "00"
        UNLOCK
        SELECT  (Fa)           // dummy
      ENDIF
      //
      // now the bottom bit
      //
        SELECT (Fa)      // need this
   ENDIF     // maj fich
ENDIF        // of changed
SELECT(Fa)
USE           // release templn
*

SET CURSOR ON
ERASE C:TEMPLN.DBF
CLEAR TYPEAHEAD
RETURN .T.

*
********
FUNCTION RECALCPR
// starts off by resetting ALL prixreels
// takes the ttc and resets PRIXREEL proportionally in FACTA or TEMPLN
// with rounding so that the sum of all the lines=ttc/1.186
// BON is COM AND THE RIGHT DATABASE MUST BE SELECTED  !!!!!!!

Local La,Re,Diff,Remis,FRED,R_MEM
La=SELECT()
*SELECT FACTA              // Mod of 3/1/95 ....
R_MEM=RECNO()
GO TOP                     // Mod of 3/1/95 ....
*SEEK BON->COMMANDE        // Mod of 3/1/95 ....
Re=RECNO()
DO WHILE FACTURE=BON->COMMANDE .AND. .NOT. EOF()
   REC_LOCK()
   IF AT(SUBSTR(ARTICLE,1,1),"*-+")>0
      REPLACE PRIXREEL WITH 0,REM_LINE WITH "00",PU WITH 0,QUANTITE WITH 0
   ELSE
      REPLACE PRIXREEL WITH CALCPU(PU)*QUANTITE
   ENDIF
   UNLOCK
   SKIP
ENDDO
GO Re
SUM REST PRIXREEL TO MREEL WHILE FACTURE=BON->COMMANDE
FRED=IIF(BON->EXPORT=0,0,TVARATE)
MREEL=MREEL*(1-BON->REM_SUP/100)
MNETHT=ROUND(BON->MONTANT*(1-BON->REM_SUP/100)/(1+FRED),2)
IF MREEL<>MNETHT
   // PRIXREEL NEEDS ADJUSTING
   Remis=(MREEL-MNETHT)/MREEL
   GO Re
   DO WHILE .NOT. EOF() .AND. FACTURE=BON->COMMANDE
     IF AT(SUBSTR(ARTICLE,1,1),"+-*")=0
        REC_LOCK(0)
        REPLACE PRIXREEL WITH ROUND(PRIXREEL*(1-Remis),2)
        UNLOCK
     ENDIF
     SKIP
   ENDDO
   // check it
   GO re
   SUM REST PRIXREEL TO MREEL  WHILE FACTURE=BON->COMMANDE
   IF MREEL<>MNETHT
      Diff=MREEL - MNETHT
      IF ABS(Diff)>0.005
         ALARM("RECTIFICATION PRIX REEL (en francs)= " +STR(DIFF,9,2))
      ENDIF
      GO Re
      IF AT(SUBSTR(ARTICLE,1,1),"+*-")=0
        LOCATE REST FOR PRIXREEL>0 WHILE FACTURE=BON->COMMANDE
          // get the first one
      ENDIF
      REC_LOCK(0)
      REPLACE PRIXREEL WITH PRIXREEL-Diff
      UNLOCK
   ENDIF
   GO Re
ENDIF
GO R_MEM     // Position FACTA on the original record
SELECT(La)
RETURN .T.
*

**************
FUNCTION RESETPF

* resets STPORT for OLDART AND OLDQTE (modified lines)
* irrespective of changes in REPORT
* All commandes are in STPORT for ANJOU
* you know it must be done or else you wouldn't be here.
* never changes the STREEL

LOCAL Fa
PRIVATE NEWART,NEWQTE
RETURN .T.         // Not needed for Portables
Fa=SELECT()
NEWART=ARTICLE
NEWQTE=QUANTITE
SELECT STOCK
IF OLDART<>SPACE(6).AND. OLDART<>CODE_DIVERS .AND.(AT(SUBSTR(OLDART,1,1),"-*")=0)
    SEEK OLDART
    REC_LOCK(0)
    REPLACE STPORT WITH STPORT-OLDQTE
    UNLOCK
ENDIF
*
SELECT (Fa)
DO SETPF WITH NEWART,NEWQTE,.T.,.F.         // for NEWQTE of modif or saisie
RETURN .T.
*
****************

FUNCTION RMAED
PARAMETERS status, fld_ptr
PRIVATE a_request,ARTTOT,OLDART,OLDN,OLDP,OLDREM,OLDRP,TOTHT,TVATOT,;
        CTYPE,NLIGNE,ENDIT,AVOIR
* PREFACT = .F.
AVOIR = .F.
TOTHT = 0
TVATOT= 0
*TOTPDS=0
LN=0
NLIGNE=0
ENDIT = .F.
*CTYPE SET FOR LIGNEIN
*CTYPE="C"
key_stroke=LASTKEY()
DO CASE
   CASE status=0
      a_request=1
   CASE status=1
      a_request=1
   CASE status=2
      a_request=1
   CASE status=3
      a_request=1
   CASE status=4
      a_request=KeyExcept(key_stroke)
ENDCASE
RETURN a_request
*
FUNCTION KeyExcept (action_key)
LOCAL M_RPX
*
DO CASE
   CASE action_key=K_ESC.OR.action_key=K_F9
      RETURN 0                             // Terminate DBEDIT

   otherwise
      IF fld_ptr>=7                        // Can't edit PRIXREEL or TOTAL
         TONE(100,1)
         RETURN 1
      ENDIF
      IF SUBSTR(ARTICLE,1,1)="-"
         TONE(100,1)                       // Can't edit deleted article
         RETURN 1
      ENDIF

      if action_key <> K_ENTER
         keyboard CHR(action_key)
      endif

      IF fld_ptr<>1
         SET CURSOR ON
         OLDLIB=LIB
         OLDQTE=QUANTITE
         OLDPU=PU
         OLDRP=REPORT
         OLDREM=REM_LINE
         MREF=ARTICLE
         IF fld_ptr=6
            // REPORT used for articles not to be delivered
            M_RPX = IIF(OLDRP=98,"N","O")
            @ROW(),COL() GET M_RPX PICTURE '@!' VALID M_RPX $ "ON"
            READ
            REPLACE REPORT WITH IIF(M_RPX="N",98,0)
         ELSE
            field_name=Fbuff[fld_ptr]
            @ROW(),COL() GET &field_name PICTURE Sbuff[fld_ptr]
            READ
         ENDIF
         SET CURSOR OFF
         IF OLDQTE<>QUANTITE.OR.PU<>OLDPU.OR.OLDRP<>REPORT.OR.OLDREM<>REM_LINE
            Changed=.T.
            Recalc=.T.   // set marker to recalculate PRIXREEL
            REPLACE PRIXREEL WITH CALCPU(PU)*QUANTITE
         ENDIF
         IF OLDLIB<>LIB
            Changed=.T.
         ENDIF
         RETURN 2
      ELSE
          *
          * It is the Article
          SET CURSOR ON
          DO LIGNEMOD
          SET CURSOR OFF
          RETURN 2
          *
      ENDIF

ENDCASE
RETURN 0
//
//-------------------------------------------------------------------
//
FUNCTION  FACT (MAJ,Av)

* Auteur...: R M ALCOCK
* Date.....: August 31
* Copyright: (c) 1992, R M ALCOCK, Tous droits réservés
* Notes....: FACTURE /AVOIR (not FACTURATION !) visu / modif
*          : now a file by itself and not a procedure file
*

LOCAL La
La=SELECT()
SELECT BON

DEFAULT MAJ TO .F.
DEFAULT Av  TO .F.

IF .NOT. MAJ
   SET INTENSITY OFF
ELSE
   REC_LOCK()
ENDIF
*
*
IF Av
   @ 3,4 SAY " AVOIR    : "+FACTURE  +"  du  "
   @ ROW(), COL() GET DFACT RANGE  ;
      CTOD("01/" + STR(MONTH(SYSDATE()),2) +"/" + STR(YEAR(SYSDATE())-1900,2)),;
       SYSDATE()

ELSE

   @ 3,4 SAY " FACTURE  : "+FACTURE+"/"+ECH+"  du  "
   @ ROW(), COL() GET DFACT  RANGE  ;
      CTOD("01/" + STR(MONTH(SYSDATE()),2) +"/" + STR(YEAR(SYSDATE())-1900,2)),;
       SYSDATE()

ENDIF
@ ROW()+2,4 SAY " V.R.P.   :" GET REGION
@ ROW()+1,4 SAY " COMMANDE :" GET COMMANDE
@ ROW(),COL()+4 SAY "CLIENT :"+REFCLI+"  "+ CLIENT->CLINOM
@ ROW()+1,4 SAY " STATUS   : "
IF VAL(C_STATUS)>0
   @ ROW(),COL() GET C_STATUS
ELSE
   @ ROW(),COL() SAY C_STATUS
ENDIF
IF .NOT. Av
  @ ROW(),COL()+4 SAY "DATE COMMANDE  :" GET D_COMM
ENDIF
@ ROW(),COL()+4 SAY "REF :" GET CLI_COMM
@ ROW()+1,4 SAY " EXPORT   :" GET FACT->EXPORT
@ ROW(),COL()+5 SAY "DATE LIVRAISON :" GET D_LIVR
@ ROW(),COL()+4 SAY " % REMISE SUP :" GET REM_SUP
@ ROW()+1,4 SAY " POIDS    :"
@ ROW(),COL() GET TOT_POIDS
*@ ROW(),COL()+6 SAY " PORT  :" GET PORT
@ ROW()+2,4 SAY "LIVRAISON :" GET LIVR_NOM
@ ROW()+1,16 GET LIVR_RUE
@ ROW()+1,16 GET LIVR_ADS
@ ROW()+1,16 GET LIVR_CP
@ ROW(),COL()+3 GET LIVR_VILLE

@ ROW()+2,4 SAY "TOTAL TTC : "
@ ROW(),COL()+1 GET MONTANT RANGE 0,9999999
IF .NOT. Av
*   @ ROW(),COL()+4 SAY "   NOMBRE ECH. :" GET NUM_ECH
   @ ROW(),COL()+4 SAY "CODE PAIEMENT  :" GET CP1

   @ ROW()+2,4 SAY "ECHEANCE  : "
   @ ROW(),COL()+1 GET MECH1 RANGE 0,9999999
   @ ROW(),COL()+4 SAY " DATE ECHEANCE : "
   @ ROW(),COL()+1 GET DECH1
ENDIF
@ ROW(),COL()+6 SAY "REGLE : "
IF VAL(C_STATUS)>0
   @ ROW(),COL()+1 GET RECH1 PICTURE "Y"
ELSE
   @ ROW(),COL()+1 SAY RECH1
ENDIF
IF MAJ
   READ
   UNLOCK
ELSE
   CLEAR GETS
ENDIF

SET INTENSITY ON

SELECT (La)
RETURN .T.

//
//-------------------------------------------------------------------
//

FUNCTION SETPF (NEWART,NEWQTE,DOSTPORT,DOSTREEL)

* Auteur...: R M ALCOCK
* Date.....: 22 April 1994
* Copyright: (c) 1994, R M ALCOCK, Tous droits réservés
* Notes....: Procedure which was in COMPROC and now is here for the facturation
*          : STOCK and STCOMP must be opened
*
LOCAL Fa
//
// If DOSTPORT it ADDS NEWQTE to STPORT
// If DOSTREEL then it ADDS NEWQTE to STREEL, this is for avoirs with maj stock
// locks and unlocks
// FACTA must be selected
//
Fa = SELECT ()
SELECT STOCK
IF NEWART<>CODE_DIVERS .AND. SUBSTR(NEWART,1,1)<>"-".AND. SUBSTR(NEWART,1,1)<>"*"
   SEEK NEWART
   IF FOUND()
      REC_LOCK(0)
      IF DOSTPORT
          REPLACE STPORT WITH STPORT+NEWQTE
      ENDIF
      IF DOSTREEL .AND. STTYP="S"             // S for stocked articles ANJOU
         REPLACE STREEL WITH STREEL + NEWQTE
      ENDIF
      UNLOCK
   ENDIF
ENDIF

SELECT(Fa)
RETURN .T.
//
//--------------------------------------------------------------------------
//
* Programme: HELPPRG.PRG
* Auteur...: R M ALCOCK
* Date.....: 26/11/93
* Copyright: (c) 1993, R M ALCOCK, Tous droits réservés
* Notes....: HELP system
*
*
FUNCTION help_me ( mproc,The_line,The_var )
local t,l:=0,b,r:=79, zbuff:="", mr,mcol,mht:= {}, choix:=1
LOCAL C_String

mr=row()                            // Save current cursor posn.
mcol=col()
ml=1                                // Most help just one line
* Get rid of alias from The_Var
The_Var = IIF (at(">",The_Var)=0, The_Var, substr(The_Var, at(">",The_Var)+1, len(The_Var)))
//
// Handle COMMENT as a special case
//
IF mproc="T_COMMENT".OR. The_Var="COMMENTAIR" .OR. mproc="ED_MEMO"
   //
   // C_String is pairs of control characters to send to MEMOEDIT
   //
   C_String :=         CHR(0)+CHR(0)  +CHR(23)+CHR(27) +CHR(27)+CHR(27)
   C_String=C_String + CHR(25)+CHR(0) +CHR(20)+CHR(0)  +CHR(2)+CHR(0)

   t=15
   l=48
   b=22
   do win with t,l,b,r,zbuff,"AIDE"

   @ t+1,     l+3 PROMPT "Continuer la modification"
   @ ROW()+1, L+3 PROMPT "Sauve et Terminer"
   @ ROW()+1, L+3 PROMPT "Terminer sans sauvegarde"
   @ ROW()+1, L+3 PROMPT "Efface Ligne"
   @ ROW()+1, L+3 PROMPT "Efface Mot"
   @ ROW()+1, L+3 PROMPT "Reformatage Paragraphe"
   MENU TO CHOIX

   CHOIX=CHOIX*2-1
   KEYBOARD SUBSTR(C_String, CHOIX, 2)

   do wout with t,l,b,r,zbuff
   @mr,mcol say ""                     // Reset cursor position
   return .T.
ENDIF

ALARM (mproc+" "+str(The_line)+" "+The_var)


t=10
l=4
b=t+10
r=l+40
do win with t,l,b,r,zbuff,"AIDE"

@ t+1,     l+3 PROMPT "Sélection CLient(s)"
@ ROW()+1, L+3 PROMPT "Profession / Activité"
@ ROW()+1, L+3 PROMPT "Choisir un article"
@ ROW()+1, L+3 PROMPT "Modification Ligne de commande"
@ ROW()+1, L+3 PROMPT "Code Paiement"
@ ROW()+1, L+3 PROMPT "Reformatage Paragraphe"
MENU TO CHOIX

do wout with t,l,b,r,zbuff
IF LASTKEY() = K_ESC
   RETURN .F.
ENDIF

DO CASE
  //
   CASE CHOIX = 1
     AADD (MHT, "Recherche par Code Postale ou Nom = Tapez les premiers chiffres")
     AADD (MHT, "Numéro Client = Cxxxxxxxxx pour un client ou Pxxxxxxxx pour un prospect")
     AADD (MHT, "")
     AADD (MHT, "Pour créer un client/prospect, renseignez les zones 'NOM' et 'Code Postale'")
     AADD (MHT, "              et mettre '*' à gauche en zone 'NUMERO' (Création prospect)")
     AADD (MHT, "                          ou son numéro (Cxxxxxxxxx)  (Création Client)")

  CASE CHOIX = 2
     AADD (MHT, SUBSTR(ValidProff,1,60))
     AADD (MHT, SUBSTR(ValidProff,61))

   CASE CHOIX = 3
     AADD (MHT, "F5 pour le catalogue / tarif")

   CASE CHOIX = 4
     AADD (MHT, [Si vous voulez changer l'article, selectionnez "ART" avec <-])
     AADD (MHT, "vous pouvez ensuite tapez F5 pour obtenir le tarif / catalogue")
     AADD (MHT, "")
     AADD (MHT, "Sélectionnez le '+' pour ajouter une ligne")
     AADD (MHT, "")
     AADD (MHT, [les zones :])
     AADD (MHT, [  "LI"      est "O" si la ligne est à livrée sinon "N"])
     AADD (MHT, [  "PRIX U"  est normalement le prix tarif, mais vous pouvez le modifier])
     AADD (MHT, [  "REM"     est la % remise a appliquer à cette ligne])
     AADD (MHT, "")
     AADD (MHT, "Tapez Esc pour terminer la saisie")

  CASE CHOIX = 5
     AADD (MHT, "CODE PAIEMENT  - Si Montant = 0, Code = Espace , sinon:")
     AADD (MHT, "0 - Déjà reglé")
     AADD (MHT, "2 - Traite à la livraison")
     AADD (MHT, "3 - Cheque joint")
     AADD (MHT, "5 - Cheque à la livraison")
     AADD (MHT, "6 - Traite à l'acceptation")
     AADD (MHT, "7 - Traite acceptée (L.C.R.)")
     AADD (MHT, "9 - Financement")

  CASE The_Var="CLIABV"
     AADD (MHT, "Forme juridique,  S.A., SARL, ENT .....")

  CASE The_Var="CLICONTACT"
     AADD (MHT, "Entrez le nom du client si différent du nom société")

  CASE The_Var="CLITAILLE"
     AADD (MHT, "Nombre de personnes dans l'entreprise")

  CASE The_Var="CLIRUE" .OR. The_Var="CLIADS" .OR. The_Var="CLICP" .OR. The_Var="CLIVILLE"
     AADD (MHT, "Adresse du client")

  CASE The_Var="CLIBANK" .OR. The_Var="CLIBANKADS"
     AADD (MHT, "Nom et adresse de la Banque du client")

  CASE The_Var="CLIBCGUI" .OR. The_Var="CLIBCODE" .OR.;
       The_Var="CLIBNCPT" .OR. The_Var="CLIBRIB"
     AADD (MHT, "RIB du client - CODE BANQUE, GUICHET, COMPTE, CLE")

  CASE SUBSTR(The_Var,1,3) = "QL_"
     AADD (MHT, "Nom et unité du matériel concurrent")

  CASE SUBSTR(The_Var,1,3) = "QC_"
     AADD (MHT, "Quantité de matériel concurrent")

  CASE The_Var="CLI_COMM"
     AADD (MHT, "Référence donné par le client à cette commande")

  CASE The_Var="REM_SUP"
     AADD (MHT, "Remise a appliquer sur cette commande")

  CASE The_Var = "EXPORT"
     AADD (MHT, "1 = France     0=Export (TVA=0)")

  CASE SUBSTR(The_Var,1,4)="DECH"
     AADD (MHT, "Date d'echéance")

   OTHERWISE
*     // next bit of code is useful for debugging
*     AADD (MHT, "MPROC = " + MPROC)
*     AADD (MHT, "LINE  = " + STR(LINE))
*     AADD (MHT, "The_Var   = " + The_Var)
     AADD (MHT, "Aide n'est pas disponible")
ENDCASE
*
t=22-LEN(MHT)
b=t+1+LEN(MHT)
l=0
r=79
do win with t,l,b,r,zbuff,"AIDE"
FOR I=1 TO LEN(MHT)
   @ T+I,l+3 say MHT[I]
NEXT
//
do while INKEY(0) <> K_ESC
enddo
do wout with t,l,b,r,zbuff
@mr,mcol say ""                     // Reset cursor position
return .T.
*
//
//------------------------------------------------------------------------
//
FUNCTION ENCODE (CONTROL)
* Auteur...: R M ALCOCK
* Date.....: 26/2/95
* Copyright: (c) 1995, R M ALCOCK, Tous droits réservés
* Notes....: Subroutines to encode data
*
*
LOCAL SEED,C
DEFAULT CONTROL TO ""
*
SET CONFIRM     ON
SET DATE        FRENCH
SET DELETED     ON
SET EXACT       ON
SET EXCLUSIVE   OFF
SET FIXED       OFF
SET SCOREBOARD  ON
SET TALK        OFF
SET BELL        OFF
SET EPOCH TO 1980

PUBLIC LCD:=.T., M_Control

CLOSE DATABASES
SELECT 1
USE ATTACH
M_Control = PCON         // Password Control

USE CLIENT EXCLUSIVE

SEED=VAL(READ_SEED(6,5,;
         IIF (CONTROL="", "DECRYPTAGE FICHIER", "CODAGE FICHIER")))
@ 6,0 CLEAR

IF CONTROL = ""
   // Should be unscramble
   GO TOP
   COUNT NEXT 10 FOR CLISCRAMBL TO C
   IF C < 10 .AND. .NOT. CONFIRM (5,,"N","CONFIRM DECRYPTAGE")
         QUIT
   ENDIF
   //
   GO TOP
   @ 6,0 SAY "DECRYPTAGE FICHIER"

   DO WHILE .NOT. EOF()
      SPEEDO (8,RECCOUNT())
      UNSCRAM_CLI(SEED)
      SKIP
   ENDDO
   //
ELSE
   //
   @ 6,0 SAY "CODAGE FICHIER"

   DO WHILE .NOT. EOF()
      SPEEDO (8,RECCOUNT())
      SCRAM_CLI(SEED)
      SKIP
   ENDDO
ENDIF
?"Indexation REF"
INDEX ON CLIREF TO CLIREF
?"Indexation CODE POSTALE"
INDEX ON CLICP+SUBSTR(CLIVILLE,1,5) TO CLICP
?"Indexation NOM"
INDEX ON CLINOM TO CLINOM
//
//
RETURN .T.
//
//
//-------------------------------------------------------------------------
//
// Function scrambles a CLIENT record
//
FUNCTION SCRAM_CLI (SEED)
//
// SEED is the seed for the random number generator
//
LOCAL M_FIX:= RANDOM (SEED, 5, 31)   // Generate 5 random n°s between 1 and 31
LOCAL M_VAR:= RANDOM(REC_SEED (SEED), 30, 31)    // 30 codes.
LOCAL M,N
//
// M_FIX is used for those variables which are indexed and therefore must
// use the same translation for all
//
// M_VAR increases the degree of randomness because the seed is different
// for each record. Hence the translation is different for the same
// parameters in different records
//
//
IF CLISCRAMBL
   RETURN .T.        // Already scrambled
ENDIF
//
// Scramble CLINOM and VILLE  using fixed translation for the first 5 chars
// and variable translation for the rest. All others are variable
//
M =   SCRAMBLE (SUBSTR(CLINOM,1,5), M_FIX)
M=M + SCRAMBLE (SUBSTR(CLINOM, 6, LEN(CLINOM)-5), M_VAR)
N=    SCRAMBLE (SUBSTR(CLIVILLE, 1, 5), M_FIX)
N=N + SCRAMBLE (SUBSTR(CLIVILLE, 6, LEN(CLIVILLE)-5), M_VAR)
REPLACE CLINOM     WITH M,;
        CLIVILLE   WITH N,;
        CLIRUE     WITH SCRAMBLE (CLIRUE,     M_VAR),;
        CLIADS     WITH SCRAMBLE (CLIADS,     M_VAR),;
        CLISIRET   WITH SCRAMBLE (CLISIRET,   M_VAR),;
        CLICONTACT WITH SCRAMBLE (CLICONTACT, M_VAR),;
        CLICONTAC2 WITH SCRAMBLE (CLICONTAC2, M_VAR)

REPLACE CLIPHONE  WITH SCRAMBLE (CLIPHONE,  M_VAR),;
        CLIPHONED WITH SCRAMBLE (CLIPHONED, M_VAR),;
        CLIPHONEV WITH SCRAMBLE (CLIPHONEV, M_VAR),;
        CLIFAX    WITH SCRAMBLE (CLIFAX,    M_VAR),;
        CLIBNCPT  WITH SCRAMBLE (CLIBNCPT,  M_VAR),;
        CNTRL     WITH SCRAMBLE (CNTRL,     M_VAR),;
        CLISCRAMBL WITH .T.
RETURN .T.
//
//
//-------------------------------------------------------------------------
//
// Function unscrambles a CLIENT record
//
FUNCTION UNSCRAM_CLI (SEED)
//
LOCAL M_FIX:= RANDOM (SEED, 5, 31)   // Generate 5 random n°s between 1 and 31
LOCAL M_VAR:= RANDOM(REC_SEED (SEED), 30, 31)    // 30 codes.
LOCAL M, N
//
// See comments on SCRAM_CLI
//
IF .NOT. CLISCRAMBL
   RETURN .T.        // Already unscrambled
ENDIF
M =   UNSCRAMBLE (SUBSTR(CLINOM,1,5), M_FIX)
M=M + UNSCRAMBLE (SUBSTR(CLINOM, 6, LEN(CLINOM)-5), M_VAR)
N=    UNSCRAMBLE (SUBSTR(CLIVILLE, 1, 5), M_FIX)
N=N + UNSCRAMBLE (SUBSTR(CLIVILLE, 6, LEN(CLIVILLE)-5), M_VAR)

REPLACE CLINOM     WITH M,;
        CLIVILLE   WITH N,;
        CLIRUE     WITH UNSCRAMBLE (CLIRUE,     M_VAR),;
        CLIADS     WITH UNSCRAMBLE (CLIADS,     M_VAR),;
        CLISIRET   WITH UNSCRAMBLE (CLISIRET,   M_VAR),;
        CLICONTACT WITH UNSCRAMBLE (CLICONTACT, M_VAR),;
        CLICONTAC2 WITH UNSCRAMBLE (CLICONTAC2, M_VAR)

REPLACE CLIPHONE   WITH UNSCRAMBLE (CLIPHONE,  M_VAR),;
        CLIPHONED  WITH UNSCRAMBLE (CLIPHONED, M_VAR),;
        CLIPHONEV  WITH UNSCRAMBLE (CLIPHONEV, M_VAR),;
        CLIFAX     WITH UNSCRAMBLE (CLIFAX,    M_VAR),;
        CLIBNCPT   WITH UNSCRAMBLE (CLIBNCPT,  M_VAR),;
        CNTRL      WITH UNSCRAMBLE (CNTRL,     M_VAR),;
        CLISCRAMBL WITH .F.
RETURN .T.
//
//
//-------------------------------------------------------------------------
//
// Function creates a seed from a fixed seed (1000 - 9999) and RECNO()
//
FUNCTION REC_SEED (SEED)
//
IF SEED >= 0                  // If not, it is the SERVER - leave alone
   SEED = RECNO() * 10000 + SEED
   DO WHILE SEED > 9999
      SEED = SEED / 7         // Largest prime under 10
   ENDDO
ENDIF
RETURN SEED
//
//-------------------------------------------------------------------------
//
// Function scrambles a string
//
// Each character of R_STRING (a series of random numbers between 1 and 31) is
// added to its equivalent character in A_STRING so as to scramble it
//
FUNCTION SCRAMBLE (A_String, R_String)
//
LOCAL I,Ans:=""
//
IF LEN(A_String) > 0
   FOR I=1 TO LEN (A_String)
      Ans=Ans+CHR(ASC(SUBSTR(A_String,I,1))+ASC(SUBSTR(R_String,I,1)))
   NEXT
ENDIF
RETURN Ans
//
//
//-------------------------------------------------------------------------
//
// Function unscrambles a string
//
// Each character of R_STRING (a series of random numbers between 1 and 31) is
// subtracted from its equivalent character in A_STRING so as to unscramble it
//
FUNCTION UNSCRAMBLE (A_String, R_String)
//
LOCAL I,Ans:=""

IF LEN(A_String) > 0
   FOR I=1 TO LEN (A_STRING)
      Ans=Ans+CHR(ASC(SUBSTR(A_String,I,1))-ASC(SUBSTR(R_String,I,1)))
   NEXT
ENDIF
RETURN Ans
//
//-------------------------------------------------------------------------
//
// Function generates an string full of random characters
//
// PARAMETERS: SEED  = a 4 digit number used to seed the generator
//             No    = the number of random characters required
//             Max   = the maximum character value
//                     i.e. each character is between 1 and Max inclusive
//
//     Returns Ans   = A string of length No containing the random chacters
//
FUNCTION RANDOM (SEED, No, Max)
//
LOCAL Ans:="", IC, MF, MC, MS

IF SEED < 0                 // No Coding required
   RETURN REPLICATE(CHR(0),No)
ENDIF

FOR IC = 1 TO No

   // Make sure that the seed does not have an exact square root !!!
   //
   DO WHILE .T.
      MS=SQRT (SEED)
      MS=(MS * 10000 - INT(MS * 10000)) // Take off 1st 4 digits of fraction
      IF MS <> 0                        // There is still a fractional part
         EXIT                           // so it is O.K.
      ENDIF
      SEED = SEED+1                     // Try the next integer up
   ENDDO

   MF = SQRT(SEED)-INT(SQRT(SEED))      // Fractional part of square root
   MC = INT( MF * Max )                 // Range is 0 to Max-1
   Ans = Ans + CHR(MC+1)                // Add to answer string
   SEED = INT(MF * 10000)               // New seed (4 digits)

NEXT
RETURN Ans
//
//-------------------------------------------------------------------------
//
FUNCTION SPEEDO(MRow,Mlong)
*
@ MRow, 79*RECNO()/Mlong SAY "▌"
RETURN .T.
//
//-------------------------------------------------------------------------
//
FUNCTION READ_SEED (MROW,MCOL, MT, M_Reg)

// The equivalent of PASSWD()
// Requires a GLOBAL variable M_Control containing the 6 character
// control field from ATTACH->PCON


LOCAL MPW, I:=0, C
*
DO HLOFF WITH LCD
CLEAR

FOR i=1 TO 9999
   MPW = STR(i,4,0)
   IF M_Control == RANDOM(VAL(MPW),6,31)
      RETURN MPW  // Password is O.K.
   ENDIF
NEXT
ALARM ("ACCES INTERDIT")
QUIT
RETURN 0


@ 2,40-LEN(MT)/2 SAY MT
@ 1,40-LEN(MT)/2-2 TO 3,40+LEN(MT)/2+2 DOUBLE
IF PCOUNT() > 3
   @ 5,5 SAY "NUMERO VRP   : "+M_Reg
ENDIF

@ 23,75 SAY "V9.1"

DO WHILE I < 3

   CLEAR TYPEAHEAD
   MPW=""
   @ MROW,0 CLEAR TO MROW,79
   @ MROW,MCOL SAY "MOT DE PASSE ? "
   //
   // DO Reads in the user's attempt at the password
   //
   DO WHILE .T.
      C=INKEY(0)
      DO CASE
      CASE C=13
         EXIT
      CASE C>31.AND.C<127
         @ ROW(),COL() SAY "*"
         MPW=MPW+CHR(C)
      CASE (C=8.OR.C=19).AND.LEN(MPW)>0    // Backspace or left arrow
         @ROW(),COL()-1 SAY " "
         @ROW(),COL()-1 SAY ""
         MPW=SUBSTR(MPW,1,LEN(MPW)-1)
      ENDCASE
   ENDDO
   //
*   // !!!!!!!!!!!!!!!!!!!!!
*   //
*   SELECT 2
*   USE ATTACH EXCLUSIVE
*   REPLACE PCON WITH RANDOM(VAL(MPW),6,31)
*   SELECT CLIENT
*   RETURN MPW
*   //
*   //!!!!!!!!!!!!!!!!!!!!!!!
*   //
   IF EMPTY(MPW)
*      RETURN "-1" // File is not coded
   ELSEIF M_Control == RANDOM(VAL(MPW),6,31)
      RETURN MPW  // Password is O.K.
   ENDIF

   I=I+1
ENDDO

ALARM ("ACCES INTERDIT")
QUIT
RETURN .F.
//
//-------------------------------------------------------------------
//
FUNCTION REINDEX (M_ALL)
* Auteur...: R M ALCOCK
* Date.....: 15/2/93
* Copyright: (c) 1992, R M ALCOCK, Tous droits réservés
* Notes....: RE-INDEX PROGRAM
*            Intended to create NTX type Indexes
*            Link File uses RMALIBX which has no references to DBFNDX
*
*
LOCAL MT:=CONAME+" - INDEX FICHIERS"
LOCAL MP:=40-LEN(MT)/2
LOCAL NumFiles := 15                //Number of Databases !!!
LOCAL I, CHOIX

*SET DEFAULT TO F:
SET CONFIRM     ON
SET DATE        FRENCH
SET DELETED     ON
SET EXACT       ON
SET EXCLUSIVE   OFF
SET FIXED       OFF
SET SCOREBOARD  OFF
SET WRAP        ON
SET EPOCH TO    1980
*
CLEAR
*
IF PCOUNT()=0
   M_ALL = .F.
ELSE
   M_ALL = IIF ( M_ALL<> "*", .F., .T.)
ENDIF
IF M_ALL
   @ 0,MP SAY MT
   @ 5,5 SAY "Index tous les fichiers !!!"
   FOR I=1 TO NumFiles
      R_IND (I)
   NEXT
ELSE
   DO WHILE .T.
      CLEAR
      @ 0,MP SAY MT
      @ 2,2 PROMPT "Q U I T T E R"
      @ ROW()+1,2 PROMPT "TARIF"
      @ ROW()+1,2 PROMPT "VRPS"
      @ ROW()+1,2 PROMPT "CLIENTS"
      @ ROW()+1,2 PROMPT "FAMILLES"
      @ ROW()+1,2 PROMPT "COMMANDES CLIENTS"
      @ ROW()+1,2 PROMPT "FACTURES Clients"
      @ ROW()+1,2 PROMPT "LIGNES de Facturation / Avoirs / Commandes"
      @ ROW()+1,2 PROMPT "EVENEMENTS / LITIGES / VISITES Clients"
      @ ROW()+1,2 PROMPT "PROMOTIONS"
      MENU TO CHOIX
      IF CHOIX=1
         RETURN .T.
      ENDIF
      R_IND(CHOIX-1)
      WAIT
   ENDDO
ENDIF
RETURN .T.
*
******************************
*
FUNCTION R_IND(CHOIX)

DO CASE

CASE CHOIX = 1
*   NET_USE (1, "STOCK", .T., 30, "", "")
*   ANNOUNCE_IT()
*   INDEX ON STCOMMREF TO STCREF
*   INDEX ON STFAM_PROD+STCOMMREF TO STREF
*   NET_USE (1, "STCOMP", .T., 30, "", "")
 *  ANNOUNCE_IT()
 *  INDEX ON cref TO STCOMP

CASE CHOIX = 2
   IF FILE("VRPS.DBF")
      NET_USE (1, "VRPS", .T., 30, "", "")
      ANNOUNCE_IT()
      INDEX ON VRP TO VRPS
      INDEX ON EQUIPE+VRP TO VRPREG
*      NET_USE (1, "VRPSTOCK", .T., 30, "", "")
*      ANNOUNCE_IT()
*      INDEX ON VRP TO VRPSTOCK

   ENDIF

CASE CHOIX = 3
   NET_USE (1, "CLIENT", .T., 30, "", "")
   ANNOUNCE_IT()
   INDEX ON CLIREF TO CLIREF
   INDEX ON CLICP+SUBSTR(CLIVILLE,1,5) TO CLICP
   INDEX ON SUBSTR(CLINOM,1,5) TO CLINOM

CASE CHOIX = 4
   NET_USE (1, "TARIFT", .T., 30, "", "")
   ANNOUNCE_IT()
   INDEX ON CODE TO TARIFT

   NET_USE (1, "DOC", .T., 30, "", "")
   ANNOUNCE_IT()
   INDEX ON STR(PAGE,2)+STR(SECT,2)+STR(LINE,2) TO DOC

   NET_USE (1, "SECT", .T., 30, "", "")
   ANNOUNCE_IT()
   INDEX ON FM+SF+PAGE+SECT TO SECTFM
   INDEX ON PAGE+SECT TO SECT

CASE CHOIX = 5
   NET_USE (1, "COM", .T., 30, "", "")
   ANNOUNCE_IT()
   INDEX ON commande TO COM
   INDEX ON refcli TO COMCL

CASE CHOIX = 6
   NET_USE (1, "FACT", .T., 30, "", "")
   ANNOUNCE_IT()
   INDEX ON REFCLI TO FACCL
   INDEX ON FACTURE+ECH TO FACT

CASE CHOIX = 7
   NET_USE (1, "FACTA", .T., 30, "", "")
   ANNOUNCE_IT()
   INDEX ON facture+ligne TO FACTR

CASE CHOIX = 8
   NET_USE (1, "LITIGE", .T., 30, "", "")
   ANNOUNCE_IT()
   INDEX ON CODE TO LITIGE
   INDEX ON A_DATE TO LITDATE
   INDEX ON CLIENT TO LITCLI
   NET_USE (1, "EVENT", .T., 30, "", "")
   ANNOUNCE_IT()
*   INDEX ON REFCLI+STR(CTOD('01/01/79')-D_CRE,5) TO EVENT
   INDEX ON REFCLI+DTOS(D_CRE) TO EVENT DESCENDING
   INDEX ON BONREF TO EVECODE

CASE CHOIX = 10
   NET_USE (1, "PROMOS", .T., 30, "", "")
   ANNOUNCE_IT()
   INDEX ON PROMOS->ARTICLE + PROMOS->CLIENT TO PROMOS
   *
ENDCASE

RETURN .T.
*
******************************
*
FUNCTION ANNOUNCE_IT
*
CLEAR
@ 5,5 SAY "INDEX FICHIER : " + ALIAS(1)
RETURN .T.
//
//---------------------------------------------------------------------
//
///////////////////////////////////////////////////////////////////////////////
//
//  Function-oriented code created by the Xbase++ FormDesigner
//    Creation date: 14/02/2007 Time: 16:07:40
//
///////////////////////////////////////////////////////////////////////////////
/*
#
*/
#PRAGMA LIBRARY( "ASCOM10.LIB" )

FUNCTION Window_Cli(Control)

   LOCAL nEvent, mp1, mp2
   LOCAL oDlg, oXbp, drawingArea, aEditControls := {}, oXbp1, oXbp2
   LOCAL oTab1, oTab2, oTab3

   PUBLIC The_Menu_Bar

   oDlg := XbpDialog():new( AppDesktop(), , {10,100}, {819,656}, , .F.)
   oDlg:taskList := .T.
   oDlg:title := "CLIENT / PROSPECT"
   oDlg:create()

   The_Menu_Bar := oDlg:menuBar()     // Set up the Menu system PUBLIC variable
   MAIN_MENU()

   drawingArea := oDlg:drawingArea
   drawingArea:setFontCompoundName( "8.Arial" )

   oTab1:= XbpTabPage():new( drawingArea, , {12,48}, {780,516}, { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE } } )
   oTab1:caption := "Général"
   oTab1:minimized := .F.
   oTab1:tabStop := .T.
   oTab1:create()
   oTab1:DropZone := .T.
   oTab1:TabActivate := ;
          {|| oTab2:minimize(), oTab3:minimize(), oTab1:maximize() }

   oTab2:= XbpTabPage():new( drawingArea, , {12,48}, {780,516}, { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE } } )
   oTab2:caption := "Finance"
   oTab2:preOffset := 20
   oTab2:postOffset := 60
   oTab2:minimized := .T.
   oTab2:tabStop := .T.
   oTab2:create()
   oTab2:TabActivate := ;
          {|| oTab1:minimize(), oTab3:minimize(), oTab2:maximize() }

   oTab3:= XbpTabPage():new( drawingArea, , {12,48}, {780,516}, { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE } } )
   oTab3:caption := "Commentaire"
   oTab3:minimized := .F.
   oTab3:preOffset := 40
   oTab3:postOffset := 40
   oTab2:minimized := .T.
   oTab3:tabStop := .T.
   oTab3:create()
   oTab3:TabActivate := ;
          {|| oTab1:minimize(), oTab2:minimize(),  oTab3:maximize() }

   oXbp := XbpPushButton():new( drawingArea, , {252,12}, {84,24},;
                                { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE }, { XBP_PP_FGCLR, -58 } } )
   oXbp:caption := "Suivant"
   oXbp:tabStop := .T.
   oXbp:create()
   oXbp:activate := {|| Gather( aEditControls ), Pg_Dn(), Scatter ( aEditControls ) }

   oXbp := XbpPushButton():new( drawingArea, , {156,12}, {84,24},;
                                { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE }, { XBP_PP_FGCLR, -58 } } )
   oXbp:caption := "Precédant"
   oXbp:tabStop := .T.
   oXbp:create()
   oXbp:activate := {|| Gather( aEditControls ), Pg_Up(), Scatter ( aEditControls ) }

   oXbp := XbpPushButton():new( drawingArea, , {24,12}, {84,24},;
                                { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE }, { XBP_PP_FGCLR, -58 } } )
   oXbp:caption := "Annul"
   oXbp:tabStop := .T.
   oXbp:create()
   oXbp:activate := {|| PostAppEvent( xbeP_Close ) }

   oTab2:minimize()
   oTab3:minimize()
   oTab1:maximize()

   oXbp := XbpSLE():new( oTab1, , {72,456}, {72,24},;
                { { XBP_PP_BGCLR, GRA_CLR_CYAN },;
                  { XBP_PP_DISABLED_BGCLR, GRA_CLR_CYAN } ,;
                  { XBP_PP_FGCLR, GRA_CLR_BLACK } } )
   oXbp:bufferLength := 10
   oXbp:editable := .F.
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIREF ), CLIENT->CLIREF := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oTab1, , {156,456}, {192,24}, { { XBP_PP_BGCLR, GRA_CLR_CYAN }, { XBP_PP_FGCLR, GRA_CLR_BLACK } } )
   oXbp:bufferLength := 30
   oXbp:editable := .T.
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLINOM ), CLIENT->CLINOM := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oTab1, , {432,456}, {96,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 17
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLICONTACT ), CLIENT->CLICONTACT := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpStatic():new( oTab1, , {372,456}, {48,24} )
   oXbp:caption := "Contact:"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp1 := XbpStatic():new( oTab1, , {72,312}, {264,132} )
   oXbp1:caption := "Addresse"
   oXbp1:clipSiblings := .T.
   oXbp1:type := XBPSTATIC_TYPE_GROUPBOX
   oXbp1:create()

   oXbp := XbpSLE():new( oXbp1, , {12,84}, {180,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 30
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIRUE ), CLIENT->CLIRUE := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp1, , {12,48}, {180,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 30
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIADS ), CLIENT->CLIADS := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp1, , {12,12}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 5
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLICP ), CLIENT->CLICP := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp1, , {60,12}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 30
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIVILLE ), CLIENT->CLIVILLE := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp2 := XbpStatic():new( oTab1, , {372,348}, {360,96} )
   oXbp2:caption := "Téléphone"
   oXbp2:clipSiblings := .T.
   oXbp2:type := XBPSTATIC_TYPE_GROUPBOX
   oXbp2:create()

   oXbp := XbpStatic():new( oXbp2, , {12,48}, {48,24} )
   oXbp:caption := "Bureau:"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( oXbp2, , {72,48}, {96,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 15
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIPHONE ), CLIENT->CLIPHONE := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpStatic():new( oXbp2, , {180,48}, {48,24} )
   oXbp:caption := "Dom:"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( oXbp2, , {240,48}, {84,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 15
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIPHONED ), CLIENT->CLIPHONED := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpStatic():new( oXbp2, , {12,12}, {48,24} )
   oXbp:caption := "Portable:"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( oXbp2, , {72,12}, {96,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 15
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIPHONEV ), CLIENT->CLIPHONEV := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpStatic():new( oXbp2, , {180,12}, {48,24} )
   oXbp:caption := "Fax:"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( oXbp2, , {240,12}, {108,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 15
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIFAX ), CLIENT->CLIFAX := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpStatic():new( oTab1, , {384,300}, {48,24} )
   oXbp:caption := "Activité:"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( oTab1, , {432,300}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 4
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIPROFESS ), CLIENT->CLIPROFESS := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpStatic():new( oTab1, , {72,264}, {84,24} )
   oXbp:caption := "Dernière Visite:"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( oTab1, , {156,264}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 8
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, DtoC( CLIENT->DERNVISIT ), CLIENT->DERNVISIT := CtoD(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpStatic():new( oTab1, , {240,264}, {84,24} )
   oXbp:caption := "Action avant le :"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( oTab1, , {324,264}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 8
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, DtoC( CLIENT->RELANCE ), CLIENT->RELANCE := CtoD(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpStatic():new( oTab1, , {480,300}, {36,24} )
   oXbp:caption := "Taille:"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( oTab1, , {516,300}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 4
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLITAILLE ), CLIENT->CLITAILLE := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpStatic():new( oTab1, , {564,300}, {96,24} )
   oXbp:caption := "Créa&tion (MMYY):"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( oTab1, , {660,300}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 4
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->DATE_CRE, '@N' ), CLIENT->DATE_CRE := Val(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpMLE():new( oTab1, , {84,168}, {648,84}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:tabStop := .T.
   oXbp:create()

//
//----------------------------------------------------------------------
//
//  FINANCE PAGE


   oXbp := XbpSLE():new( oTab2, , {72,456}, {72,24},;
                { { XBP_PP_BGCLR, GRA_CLR_CYAN },;
                  { XBP_PP_DISABLED_BGCLR, GRA_CLR_CYAN } ,;
                  { XBP_PP_FGCLR, GRA_CLR_BLACK } } )
   oXbp:bufferLength := 10
   oXbp:editable := .F.
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIREF ), CLIENT->CLIREF := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oTab2, , {156,456}, {192,24}, { { XBP_PP_BGCLR, GRA_CLR_CYAN }, { XBP_PP_FGCLR, GRA_CLR_BLACK } } )
   oXbp:bufferLength := 30
   oXbp:editable := .T.
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLINOM ), CLIENT->CLINOM := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpStatic():new( oTab2, , {432,456}, {36,24} )
   oXbp:caption := "Siret :"
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( oTab2, , {480,456}, {84,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 14
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLISIRET ), CLIENT->CLISIRET := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp1 := XbpStatic():new( oTab2, , {72,384}, {420,60} )
   oXbp1:caption := "Banque"
   oXbp1:clipSiblings := .T.
   oXbp1:type := XBPSTATIC_TYPE_GROUPBOX
   oXbp1:create()

   oXbp := XbpSLE():new( oXbp1, , {12,12}, {84,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 24
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIBANK ), CLIENT->CLIBANK := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp1, , {96,12}, {120,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 24
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIBANKADS ), CLIENT->CLIBANKADS := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp1, , {240,12}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 5
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIBCODE ), CLIENT->CLIBCODE := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp1, , {276,12}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 5
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIBCGUI ), CLIENT->CLIBCGUI := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp1, , {312,12}, {72,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 11
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIBNCPT ), CLIENT->CLIBNCPT := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp1, , {384,12}, {24,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 2
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIBRIB ), CLIENT->CLIBRIB := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp2 := XbpStatic():new( oTab2, , {288,132}, {276,228} )
   oXbp2:caption := "EQUIVALENT CONCURRENT                      Quantité"
   oXbp2:clipSiblings := .T.
   oXbp2:type := XBPSTATIC_TYPE_GROUPBOX
   oXbp2:create()

   oXbp := XbpSLE():new( oXbp2, , {12,180}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 12
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_1 ), CLIENT->QL_1 := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp2, , {12,156}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 12
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_2 ), CLIENT->QL_2 := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp2, , {12,132}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 12
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_3 ), CLIENT->QL_3 := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp2, , {12,108}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 12
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_4 ), CLIENT->QL_4 := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp2, , {12,84}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 12
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_5 ), CLIENT->QL_5 := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp2, , {12,60}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 12
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_6 ), CLIENT->QL_6 := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp2, , {12,36}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 12
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_7 ), CLIENT->QL_7 := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp2, , {12,12}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 12
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_8 ), CLIENT->QL_8 := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp2, , {216,180}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 6
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_1, '@N' ), CLIENT->QC_1 := Val(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp2, , {216,156}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 6
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_2, '@N' ), CLIENT->QC_2 := Val(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp2, , {216,132}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 6
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_3, '@N' ), CLIENT->QC_3 := Val(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp2, , {216,108}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 6
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_4, '@N' ), CLIENT->QC_4 := Val(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp2, , {216,84}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 6
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_5, '@N' ), CLIENT->QC_5 := Val(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp2, , {216,60}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 6
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_6, '@N' ), CLIENT->QC_6 := Val(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp2, , {216,36}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 6
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_7, '@N' ), CLIENT->QC_7 := Val(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp2, , {216,12}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 6
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_8, '@N' ), CLIENT->QC_8 := Val(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp3 := XbpStatic():new( oTab2, , {72,132}, {168,228} )
   oXbp3:caption := "MATERIEL MEFRAN    Quantité"
   oXbp3:clipSiblings := .T.
   oXbp3:type := XBPSTATIC_TYPE_GROUPBOX
   oXbp3:create()

   oXbp := XbpStatic():new( oXbp3, , {12,180}, {84,24} )
   oXbp:caption := "49-900"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpStatic():new( oXbp3, , {12,156}, {84,24} )
   oXbp:caption := "SECURIFRAN"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpStatic():new( oXbp3, , {12,132}, {84,24} )
   oXbp:caption := "42-700"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpStatic():new( oXbp3, , {12,108}, {84,24} )
   oXbp:caption := "ROULANTS"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpStatic():new( oXbp3, , {12,84}, {84,24} )
   oXbp:caption := "CH49/AUTO."
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpStatic():new( oXbp3, , {12,60}, {84,24} )
   oXbp:caption := "PLANCHERS"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpStatic():new( oXbp3, , {12,36}, {84,24} )
   oXbp:caption := "DIFFUSION"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpStatic():new( oXbp3, , {12,12}, {84,24} )
   oXbp:caption := "DIVERS"
   oXbp:clipSiblings := .T.
   oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
   oXbp:create()

   oXbp := XbpSLE():new( oXbp3, , {108,12}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 6
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_8, '@N' ), CLIENT->Q_8 := Val(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp3, , {108,36}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 6
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_7, '@N' ), CLIENT->Q_7 := Val(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp3, , {108,60}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 6
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_6, '@N' ), CLIENT->Q_6 := Val(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp3, , {108,84}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 6
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_5, '@N' ), CLIENT->Q_5 := Val(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp3, , {108,108}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 6
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_4, '@N' ), CLIENT->Q_4 := Val(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp3, , {108,132}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 6
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_3, '@N' ), CLIENT->Q_3 := Val(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp3, , {108,156}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 6
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_2, '@N' ), CLIENT->Q_2 := Val(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oXbp3, , {108,180}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:bufferLength := 6
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_1, '@N' ), CLIENT->Q_1 := Val(x) ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )



//
//----------------------------------------------------------------------
//
//  COMMENT PAGE


   oXbp := XbpSLE():new( oTab3, , {72,456}, {72,24},;
                { { XBP_PP_BGCLR, GRA_CLR_CYAN },;
                  { XBP_PP_DISABLED_BGCLR, GRA_CLR_CYAN } ,;
                  { XBP_PP_FGCLR, GRA_CLR_BLACK } } )
   oXbp:bufferLength := 10
   oXbp:editable := .F.
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIREF ), CLIENT->CLIREF := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpSLE():new( oTab3, , {156,456}, {192,24}, { { XBP_PP_BGCLR, GRA_CLR_CYAN }, { XBP_PP_FGCLR, GRA_CLR_BLACK } } )
   oXbp:bufferLength := 30
   oXbp:editable := .T.
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLINOM ), CLIENT->CLINOM := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oXbp := XbpMle():new( oTab3, , {84,68}, {588,328}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
   oXbp:wordWrap :=.T.
   oXbp:horizScroll := .F.
   oXbp:editable:=.T.
   oXbp:setFontCompoundName( "10.Arial" )
   oXbp:tabStop := .T.
   oXbp:dataLink := {|x| IIf( PCOUNT()==0, CLIENT->COMMENTAIR, CLIENT->COMMENTAIR := x ) }
   oXbp:create():setData()
   AAdd ( aEditControls, oXbp )

   oDlg:show()
   SetAppFocus(oDlg)

   nEvent := xbe_None
   DO WHILE nEvent <> xbeP_Close
      nEvent := AppEvent( @mp1, @mp2, @oXbp )
      oXbp:handleEvent( nEvent, mp1, mp2 )
   ENDDO
   oDlg:hide()
   oDlg:destroy()
RETURN .T.

//
//--------------------------------------------------------
//
FUNCTION MAIN_MENU ()


LOCAL LL, CHOICE, cSaveScrn, PromptList
LOCAL The_Prompts :=  {}, SM := {}, The_Codes :=  {}

The_Prompts :=  { ;
                "MENU",;
                    {"Historique",           {||Dispatcher ("MH")},;
                     "@",, ;
                     "Impression",           {||Dispatcher ("IM")},;
                     "@",, ;
                     "Saisie Commande",      {||Dispatcher ("CC")},;
                     "Modification Commande",{||Dispatcher ("CM")},;
                     "Commandes en cours",   {||Dispatcher ("EC")},;
                     "@",, ;
                     "Suppression",          {||Dispatcher ("S")},;
                     "@",, ;
                     "Catalogue",            {||Dispatcher ("SM")},;
                     "@",, ;
                     "RETOUR",               {||QUIT_IT()}   },;
                "?",;
                    {"Général",      {||HELP_ME("01")},;
                     "Recherche",    {||HELP_ME("02")},;
                     "Catégories",   {||HELP_ME("03")} };
                  }

   CREATE_MENU (The_Prompts)
   RETURN .T.
//
//----------------------------------------------------------
//
FUNCTION QUIT_IT()

PostAppEvent (xbeP_Close)

RETURN .T.
//
//-----------------------------------------------------------------------------------------------
//
FUNCTION CREATE_MENU(The_Choices)
LOCAL i, j, oMenu, Menu_Items, oSubMenu, SM, k

FOR i = 1 TO LEN (The_Choices) STEP 2

   oMenu    := XbpMenu():new( The_Menu_Bar )  // New MENU object
   oMenu:title := The_Choices[i]              // Menu Name
   oMenu:setName(i * 100)                     // Code for this menu
   oMenu:create()

   Menu_Items = The_Choices[i+1]
   FOR j = 1 TO LEN (Menu_Items) -1 STEP 2
      IF ValType (Menu_Items [j]) = "A"

         SM = Menu_Items [j]
         oSubMenu       := XbpMenu():new( oMenu )
         oSubMenu:title := SM[1]
         oSubMenu:create()

         SM = SM[2]
         FOR k = 1 TO LEN(SM)-1 STEP 2
            IF (SM [k]) = "@"
               oSubMenu:addItem( {NIL, NIL, XBPMENUBAR_MIS_SEPARATOR, 0} )
            ELSE
               oSubMenu:addItem( { SM[k], SM[k+1] } )
            ENDIF
         NEXT k

         oMenu:addItem( { oSubMenu, NIL } )

      ELSEIF (Menu_Items [j]) = "@"
         oMenu:addItem( {NIL, NIL, XBPMENUBAR_MIS_SEPARATOR, 0} )
      ELSE
         oMenu:addItem( {Menu_Items [j] , Menu_Items [j+1]},  )
      ENDIF
   NEXT j

   The_Menu_Bar:addItem( {oMenu, NIL} )     // Create the Menu

NEXT i

RETURN .T.
//
//-----------------------------------------------------
//
FUNCTION Dispatcher (Control)


Menu_On_Off (.F.)             // disable other menu choices
The_Menu_Bar:enableItem(The_Menu_Bar:numItems())    // Except HELP

DO CASE
   CASE Control = "MH"   // Historique
      DO EV

   CASE Control = "IM"   // Impression
      i=1
   CASE Control = "CC"   // Saisie Commande
      SET CURSOR ON
      DO S_COMM WITH "1"

   CASE Control = "CM"   // Modif. Cde
      i=1

   CASE Control = "EC"   // Cdes en Cours
      DO CC

   CASE Control = "S"    // Suppression
      i=1

   CASE Control = "SM"   // Stock
     DO ST WITH 4


ENDCASE

Menu_On_Off (.T.)             // enable menu choices
RETURN .T.
//
//-----------------------------------------------------------------------------------------------
//

FUNCTION Menu_On_Off(CONTROL)
LOCAL oMenu ,I,J

FOR i = 1 TO The_Menu_Bar:numItems()      // Number of main menu items
   IF Control
      The_Menu_Bar:enableItem( i )
   ELSE
      The_Menu_Bar:disableItem( i )
   ENDIF
NEXT
RETURN .T.

//
//-----------------------------------------------------------------------------------------------
//
//
//////////////////////////////////////////////////////////////////////
//
//  APPSYS.PRG
//
//  Copyright:
//      Alaska Software, (c) 1997-2002. All rights reserved.
//
//  Contents:
//      AppSys() - Creates default application window
//
//  Remarks:
//      This file is part of the XppRt0.lib.
//
//  Syntax:
//      The function AppSys() is called automatically during
//      the programm startup.
//
//////////////////////////////////////////////////////////////////////

#include "xbp.ch"

****************************************************************************
* Function AppSys() to create default output devices
****************************************************************************

FUNCTION AppSys()

#define DEF_ROWS       30
#define DEF_COLS       80

LOCAL oCrt, nAppType := AppType()
LOCAL aSizeDesktop, aPos
LOCAL DEF_FONTHEIGHT:= 16
LOCAL DEF_FONTWIDTH:=  8

PUBLIC aWindow[3], The_Menu_Bar

// Compute window position (center window
// on the Desktop)
aSizeDesktop    := AppDesktop():currentSize()

*IF aSizeDesktop[1] > 800
*   DEF_FONTHEIGHT:= 22
*   DEF_FONTWIDTH:=  12
*ENDIF

aPos            := { (aSizeDesktop[1]-(DEF_COLS * DEF_FONTWIDTH))  /2, ;
                     (aSizeDesktop[2]-(DEF_ROWS * DEF_FONTHEIGHT)) /2  }

// Create XbpCRT object
oCrt := XbpCrt():New ( NIL, NIL, aPos, DEF_ROWS, DEF_COLS )
oCrt:FontWidth  := DEF_FONTWIDTH
oCrt:FontHeight := DEF_FONTHEIGHT
oCrt:title      := "MEDEF - REPERTOIRE DES AIDES"

IF aSizeDesktop[1] <= 800
   oCrt:FontName   := "Alaska Crt"
ELSE
   oCrt:FontName   := "Lucida Console"
ENDIF

oCrt:Create()
aWindow[1] := oCrt
*The_Menu_Bar := oCrt:menuBar()     // Set up the Menu system PUBLIC variable
*MAIN_MENU ()

oCrt:setpos(apos)

// Init Presentation Space
oCrt:PresSpace()

// XbpCrt gets active window and output device
SetAppWindow ( oCrt )
SETCOLOR ("n/w")
CLEAR


//
// Help Window
//
aWindow[2] := XbpCrt():new(AppDesktop(), NIL, {50, 100}, 24, 80, "ASSISTANCE" )
aWindow[2]:FontWidth  := 8
aWindow[2]:FontHeight := 16
aWindow[2]:create()
aWindow[2]:setModalState (XBP_DISP_APPMODAL)
aWindow[2]:PresSpace()

SetAppWindow( aWindow[2] )
SETCOLOR ('n/w,r/w')
CLS
aWindow[2]:hide()
//
// Mot_Clé window
//
aWindow[3] := XbpCrt():new(AppDesktop(), NIL, {50, 100}, 5, 20, "" )
aWindow[3]:FontWidth  := DEF_FONTWIDTH
aWindow[3]:FontHeight := DEF_FONTHEIGHT
aWindow[3]:Border := XBPDLG_NO_BORDER
aWindow[3]:Closeable := .F.
aWindow[3]:titleBar := .F.
aWindow[3]:FontName   := "Arial"
aWindow[3]:create()
aWindow[3]:PresSpace()
SetAppWindow( aWindow[3] )
SETCOLOR ('n/w,r/w')
CLS
aWindow[3]:hide()

SetAppWindow ( oCrt )
oBMP2:= XbpBitmap():new():create( oCrt )  // Logo for display
oBMP2:loadfile( "LOGO2.BMP" )
oBMP2:draw( NIL, {100 ,100} )             // Draw the logo
SetAppFocus(oCrt)

RETURN .T.