home *** CD-ROM | disk | FTP | other *** search
/ mail.altrad.com / 2015.02.mail.altrad.com.tar / mail.altrad.com / TEST / COMMERC_72_53 / PROGS / main.prg < prev    next >
Text File  |  2014-04-10  |  150KB  |  5,299 lines
  1. PROCEDURE  MAIN ()
  2. * Auteur...: R M ALCOCK 
  3. * Date.....: 4 JAN 1998
  4. * Copyright: (c) 1995, R M ALCOCK, Tous droits réservés
  5. * Notes....: Commercial Interface for VRP portables
  6. *
  7. *
  8. #include "Inkey.ch"
  9. #include "Setcurs.ch"
  10. #include "Params"
  11. #include "Directry.ch"        // For DIRECTORY function
  12. #include "DCDIALOG.CH"
  13. #include "DCPRINT.CH"
  14. #include "FONT.CH"
  15. #include "Appevent.ch"
  16. #include "Gra.ch"
  17. #include "Xbp.ch"
  18. #include "Nls.ch"
  19. #include "DCbitmap.ch"
  20.  
  21. *
  22. LOCAL Mret, Last_Date, VolName
  23.  
  24. SETCURSOR(SC_NORMAL)
  25. *
  26. SET CONFIRM     ON
  27. SET DATE        FRENCH
  28. SET DELETED     ON
  29. SET EXACT       ON
  30. SET EXCLUSIVE   OFF
  31. SET FIXED       OFF
  32. SET SCOREBOARD  OFF
  33. SET WRAP        ON
  34. SET EPOCH TO    1980
  35. *SET DEFAULT TO F:
  36.  
  37. *NationMsg("fr")
  38. SetLocale( NLS_SCURRENCY, Chr(213) )     // Two lines to activate the euro symbol
  39. SetLocale( NLS_ICURRENCYEURO, "1" )
  40. LANGUAGE = "fr"
  41.  
  42. *
  43. *EXTERNAL WIN,WOUT,HLON,HLOFF,PASSWD,RMAMENU,keysoff,RA_BRWSWHL
  44. *
  45. public mbuff, fb[10], fref, MENUCLR, PICKCLR
  46. PUBLIC MTVA, MMONTANT, REMTOT, MFACTOT, TOTTTC, DPAY, MMQTE
  47. // MMQTE added for PROFESS
  48. PUBLIC New_Tarif:=.F., MDAT_MAX, M_Reg, M_Resp, MCLI, MRCODE, HCODE
  49. PUBLIC F_Ran, V_Ran, SEED, M_Control
  50. PUBLIC LCD
  51. public M_FILTER:="", M_Browse, cKey, N_Cli, N_Rec
  52. PUBLIC M_CLIC,M_TEL,M_ACT,CLIN,MCP,M_CLIP,T_Min,M_Dat1,M_Dat2,M_R_S,M_R_E
  53. PUBLIC GetList:={}
  54. PUBLIC ChosenClient
  55. //
  56. NET_USE (S_ATTACH, "ATTACH", .T., 0, "", "")
  57.  
  58. MDAT_MAX  = ATTACH->DATE_MAX
  59. M_Reg     = ATTACH->REGION
  60. M_Resp    = ATTACH->OWNER
  61. M_Control = ATTACH->PCON
  62. LCD       = ATTACH->LCD_SCREEN
  63. USE
  64.  
  65. IF ISCOLOR()
  66.    MENUCLR = D_MenuClr          // From PARAMS
  67.    PICKCLR = D_PickClr
  68. ELSE
  69.    MENUCLR=SETCOLOR()
  70.    PICKCLR="W/N,N/W,W/N,N/BG,W/N"
  71. ENDIF
  72.  
  73. CLEAR
  74.  
  75. MT=CONAME+" - SYSTEM COMMERCIAL"
  76. SEED=VAL(READ_SEED(6,5, MT, M_Reg))           // In file ENCODE.PRG
  77. F_Ran = RANDOM (SEED, 5, 31)       // Generate 100 random n°s between 1 and 31
  78. //
  79. //
  80. IF FILE ("XFER\NEWCLI.DBF")
  81.    NET_USE (S_TEMP1, "XFER\NEWCLI", .F., 0, "", "")
  82.    Last_Date = CTOD(DTOC(LUPDATE())) + 360      // Must ring Florensac every 60 days
  83.                                     // temporarily very long !!!!!
  84.    USE
  85. ELSE
  86.    Last_Date = CTOD("01/12/10")    // For the time being
  87. ENDIF
  88. //
  89. VolName := DIRECTORY("C:", "V")      // Read the label
  90.  
  91. //
  92. // If PWD.MEM exists when prog is restarted, something is wrong !
  93. IF (FILE ("C:\PWD.MEM");
  94.         .OR. DATE() > Last_Date;
  95.         .OR. VolName [1,F_NAME] <> "ALTRAD");
  96.         .AND. SEED <> -1
  97.  
  98.    CLEAR
  99.    @ 7,2 SAY ""
  100.    TEXT
  101.    La dernière fois que l'ordinateur était arreté, vous n'aviez pas
  102.    quitté le programme. Par consequent, il est nécessaire de réparer
  103.    les fichiers. Il est aussi possible que les dernières modifications
  104.    (et/ou saisie) n'ont pas été enregistrées.
  105.  
  106.    Patientez S.V.P.
  107.  
  108.    ENDTEXT
  109.  
  110.    NET_USE (S_CLIENT, "CLIENT", .T., 20, "", "")
  111.  
  112.    IF DATE() > Last_Date;
  113.        .OR. VolName [1,F_NAME] <> "ALTRAD"
  114.  
  115. do while .f.
  116.  
  117.       //
  118.       // Exterminate, Exterminate .......
  119.       //
  120.       GO BOTT
  121.       SKIP -1
  122.       COPY NEXT 1 TO TEMP
  123.       USE
  124. *      SWPRUNCMD("COPY CLIENT.DBF AZ.DBF>FRED",0, "", "")
  125. *      SWPRUNCMD("COPY CLIENT.DBT AZ.DBT>FRED",0, "", "")
  126.       COPY FILE CLIENT.DBF TO AZ.DBF
  127.       COPY FILE CLIENT.DBT TO AZ.DBT
  128.       NET_USE (S_CLIENT, "CLIENT", .T., 20, "", "")
  129.       ZAP
  130.       APPEND FROM TEMP
  131.       APPEND FROM AZ
  132.       NET_USE (S_TEMP1, "AZ", .T., 20, "", "")
  133.       ZAP
  134.       USE
  135. *      SWPRUNCMD("DEL TEMP.DB?",0, "", "")
  136. *      SWPRUNCMD("DEL AZ.DB?",0, "", "")
  137.       ERASE TEMP.DBF
  138.       ERASE TEMP.DBT
  139.       ERASE AZ.DBF
  140.       ERASE AZ.DBT
  141. enddo
  142.  
  143.    ELSE
  144.       // Check if any records are in the wrong state
  145.       LOCATE FOR .NOT. CLISCRAMBL
  146.       IF FOUND()
  147.          DO WHILE.NOT.EOF()
  148.             SCRAM_CLI (SEED)
  149.             CONTINUE
  150.          ENDDO
  151.          // Re-Index everything
  152.          USE
  153. *         SWPRUNCMD("PROGS\REINDEX *",0, "", "")
  154.          DO REINDEX WITH "*"
  155.       ENDIF
  156.    ENDIF
  157. ENDIF
  158. //
  159. SAVE ALL LIKE M_Control TO C:\PWD  // Create the file to detect illegal termination
  160. //
  161. ERRORLEVEL(0)
  162. NET_USE (S_CLIENT, "CLIENT", .F., 20, "", "")
  163. SET INDEX TO CLIREF,CLINOM,CLICP
  164. NET_USE (S_STOCK, "STOCK", .F., 20, "STCREF,STRLIB", "")
  165. *
  166. DO WHILE .T.
  167.  
  168.    bBlock = SetKey( K_F1, { || help_me ( ProcName(), ProcLine(), "" ) } )
  169.    SetMouse(.T.)
  170.    DO HLOFF WITH LCD
  171.    CLEAR
  172.    SELECT CLIENT
  173.    GO TOP
  174.    SET ORDER TO 1
  175.    SET FILTER TO
  176.    DO HLON
  177.    @ 23,35 SAY "F1 : Aide"
  178.    DO HLOFF WITH LCD
  179.    *
  180.    Mret=R_CLI(.T.)             // Select Client, Allow creation
  181.    IF Mret <= 0                // Vide
  182.  
  183.       IF SELECT ("TEMPCLIN") <> 0
  184.          SELECT TEMPCLIN
  185.          USE
  186.       ENDIF
  187.  
  188.       IF Mret < 0 
  189.          LOOP
  190.       ENDIF
  191.  
  192.       IF ConfirmBox( , ; 
  193.                        "Voulez vous terminer le programme ?", ; 
  194.                        "Quitter", ; 
  195.                         XBPMB_YESNO , ; 
  196.                         XBPMB_QUESTION+XBPMB_APPMODAL+XBPMB_MOVEABLE, ;
  197.                         XBPMB_DEFBUTTON2 ) = XBPMB_RET_NO
  198.          LOOP
  199.       ENDIF                  
  200.  
  201.       CLEAR
  202.       ERASE C:\PWD.MEM         // To confirm correct exit
  203.       RETURN                   // No Client selected
  204.  
  205.    ENDIF
  206.  
  207.    DO WHILE .T.
  208.       IF Mret=1                // Need to search
  209.          FREF = R_CLI2()
  210.          IF EMPTY(FREF)
  211.             SELECT TEMPCLIN
  212.             USE
  213.             EXIT
  214.          ENDIF
  215.       ELSE
  216.          FREF = CLIREF
  217.       ENDIF
  218.       //
  219.       // Client is selected
  220.       //
  221.       CLEAR
  222.       IF .NOT. REC_LOCK(30)       // Need lock to unscramble
  223.          RETURN
  224.       ENDIF
  225.       UNSCRAM_CLI(SEED)
  226.       Window_cli(4)                  // Display Client Details
  227.       SET CURSOR ON
  228.       SCRAM_CLI(SEED)
  229.       UNLOCK
  230.       IF Mret=2                         // Only one client
  231.          EXIT
  232.       ENDIF
  233.    ENDDO
  234. ENDDO
  235. RETURN
  236. *
  237. ****************************************
  238. *
  239. FUNCTION CC
  240. *.......................................
  241. *
  242. *COMMANDES
  243. *
  244. //
  245. *
  246. LOCAL aFields := {}, cKey, cOldColor, nRecSel
  247. *
  248. NET_USE (S_FACTA, "FACTA",  .F., 30, "FACTR", "")
  249. NET_USE (S_COM, "COM", .F., 30, "COM,COMCL", "BON")
  250. SET ORDER TO 2
  251. do keysoff
  252. *
  253. cKey=fref
  254. cOldColor := SetColor("W/B")
  255. AADD(aFields, {"REF",     {||BON->COMMANDE} } )
  256. AADD(aFields, {"ST" ,     {||BON->C_STATUS} } )
  257. AADD(aFields, {"DATE",    {||BON->D_COMM  } } )
  258. AADD(aFields, {"MONTANT", {||ROUND(BON->MONTANT*(1-BON->REM_SUP/100),2)} } )
  259. DO WHILE .T.
  260.    nRecSel := RA_BRWSWHL(aFields, {||BON->REFCLI = cKey}, cKey, 0, PICKCLR,;
  261.                           8, 1, 22, MaxCol()-1, "F9 - ZOOM COMMANDE",, )
  262.    DO CASE
  263.       CASE  nRecSel == 0
  264.         EXIT              // No record selected (Esc)
  265.  
  266.       CASE nRecSel < 0    // No matching Record
  267.         do none with 18,1,20,78,mbuff
  268.         EXIT
  269.  
  270.       OTHERWISE
  271.         do ZCC
  272.    ENDCASE
  273. ENDDO
  274. SetColor(cOldColor)
  275. CLEAR SCREEN
  276. SELECT BON
  277. use
  278. SELECT FACTA
  279. USE
  280. select CLIENT
  281. do kon
  282. RETURN .T.
  283. *
  284. ****************************************
  285. *
  286. FUNCTION CC2
  287. *.......................................
  288. *
  289. *Lines on COMMANDE
  290. *
  291. *
  292. LOCAL aFields := {}, cKey, cOldColor, nRecSel, mbuff
  293. *
  294. NET_USE (S_FACTA, "FACTA",  .F., 30, "FACTR", "")
  295. NET_USE (S_COM, "COM", .F., 30, "COM,COMCL", "BON")
  296. SET ORDER TO 2
  297. set exact off
  298. SET RELATION TO COMMANDE INTO FACTA
  299. do keysoff
  300. *
  301. cKey=fref
  302. seek cKey
  303. locate rest for val(c_status)<10
  304. if .not. found()
  305.    do none with 18,1,20,78,mbuff
  306. else
  307.    select FACTA
  308.    copy rest to c:temp1 while facture=bon->commande
  309.  
  310.    net_use (S_TEMP1, "c:temp1", .T., 0, "", "")
  311.    select bon
  312.    continue
  313.    do while refcli=fref
  314.       select FACTA
  315.       copy rest to c:temp2 while facture=bon->commande
  316.       select temp1
  317.       append from c:temp2
  318.       select bon
  319.       continue
  320.    enddo
  321.    erase c:temp2.dbf
  322.    select bon
  323.    set relation to
  324.    set order to 1
  325.    select temp1
  326.    delete for substr(article,1,1) $ "+-*"
  327.    pack
  328.    index on article to c:temp1
  329.    set relation to facture into bon
  330.    go top
  331.    cKey=article
  332.    cOldColor := SetColor("W/B")
  333.    AADD(aFields, {"REF",     {||TEMP1->ARTICLE} } )
  334.    AADD(aFields, {"DESIG.",{||TEMP1->LIB  } } )
  335.    AADD(aFields, {"QUANTITE" , {||TEMP1->QUANTITE } } )
  336.    AADD(aFields, {"DATE",    {||BON->D_COMM  } } )
  337.    DO WHILE .T.
  338.       nRecSel := RA_BRWSWHL(aFields, {||.T.}, cKey, 0, PICKCLR,;
  339.                           8, 1, 22, MaxCol()-1, "ARTICLES EN COMMANDE",, )
  340.       DO CASE
  341.          CASE  nRecSel == 0
  342.            EXIT              // No record selected (Esc)
  343.  
  344.          CASE nRecSel < 0    // No matching Record
  345.            do none with 18,1,20,78,mbuff
  346.            EXIT
  347.  
  348.          OTHERWISE
  349.  
  350.          ENDCASE
  351.    ENDDO
  352.    select temp1
  353.    use
  354.    erase c:temp1.dbf
  355.    erase c:temp1.ntx
  356. endif
  357. SetColor(cOldColor)
  358. CLEAR SCREEN
  359. SELECT BON
  360. use
  361. SELECT FACTA
  362. USE
  363. select CLIENT
  364. do kon
  365. set exact on
  366. RETURN .T.
  367. *
  368. ***
  369. *
  370. FUNCTION ZCC
  371. LOCAL zbuff:="", t:=0, l:=0, b:=23, r:=79
  372. //
  373. // Need rec_lock here because two people could try to change the lines at once
  374. // which would work because the lines are in TEMP not FACTA. Sort of deadly
  375. // embrace. LOCK should sort this out because it effectively locks both
  376. // the header and the lines. Need to make sure the same logic holds in the
  377. // MENU version of the program.
  378. //
  379. REC_LOCK(0)
  380. DO HLOFF WITH LCD
  381. do keysoff
  382. do win with t,l,b,r,zbuff,"COMMANDE"
  383.  
  384. DO COMM_OUT
  385. @ 24,0 CLEAR TO 24,79
  386. DO HLON
  387. mt= "F1-HELP     F2-MENU"
  388. @ 24,40-len(mt)/2 SAY mt
  389. DO HLOFF WITH LCD
  390. SET CURSOR OFF
  391. @ 22,10 SAY""
  392. DO WHILE LASTKEY()<>27
  393.    set key K_F2 to COMMMENU
  394.    wait ""                        // Wait allows function key actvation
  395. ENDDO
  396. SET CURSOR OFF
  397. do wout with t,l,b,r,zbuff
  398. @ 24,0 CLEAR TO 24,79
  399. set key K_F2 to
  400. *keyboard CHR(K_ESC)               // Force Exit
  401. RETURN .T.
  402. *
  403. ****************************************
  404. *
  405. FUNCTION EV
  406. *.......................................
  407. *
  408. *EVENTS
  409. *
  410. //
  411. *
  412. LOCAL aFields := {}, La:=SELECT(), mst, aSort[6], aSaveSort, aPres, bEval
  413.  
  414. *
  415. NET_USE (S_EVENT, "EVENT",  .F., 30, "EVENT,EVECODE", "")
  416. SEEK CLIENT->CLIREF
  417. IF .NOT. FOUND() .OR. LASTREC() == 0
  418.    do none with 18,1,20,78,mbuff
  419.    RETURN .T.
  420. ENDIF
  421.  
  422. do keysoff
  423.  
  424. COPY TO "TEMPEV" WHILE EVENT->REFCLI = CLIENT->CLIREF 
  425. NET_USE (S_EVENT, "TEMPEV",  .T., 0, "", "EVENT")
  426. INDEX ON DTOS(D_CRE)TO TEVDAT
  427. INDEX ON BONREF     TO TEVCODE
  428. INDEX ON TYPE       TO TEVTYPE
  429. SET INDEX TO TEVDAT, TEVCODE, TEVTYPE
  430.  
  431. *
  432. aSort[1] := GRA_CLR_WHITE // Sort Selected Color (Foreground)
  433. aSort[2] := GRA_CLR_RED   // Sort Selected Color (Background)
  434. aSort[3] := GRA_CLR_WHITE // Sort Unselected Color (Foreground)
  435. aSort[4] := GRA_CLR_DARKGRAY // Sort Unselected Color (Background)
  436. aSort[5] := BITMAP_RD_UP_RED  // Sort UP Bitmap
  437. aSort[6] := BITMAP_RD_DOWN_RED  // Sort DOWN Bitmap
  438.  
  439. aSaveSort := DC_FindBrowseSort(aSort)
  440.  
  441. aPres := ;
  442.   { { XBP_PP_COL_HA_FGCLR, GRA_CLR_WHITE },  ;
  443.     { XBP_PP_COL_HA_BGCLR, GRA_CLR_DARKGRAY }, ;
  444.     { XBP_PP_COL_DA_FGCLR, GRA_CLR_BLACK }, ;
  445.     { XBP_PP_COL_DA_BGCLR, GRA_CLR_WHITE } }
  446.  
  447. aPres := ;
  448.   { { XBP_PP_COL_HA_FGCLR, GRA_CLR_WHITE },  ;
  449.     { XBP_PP_COL_HA_BGCLR, GRA_CLR_DARKGRAY }, ;
  450.     { XBP_PP_COL_DA_FGCLR, GRA_CLR_BLACK }, ;
  451.     { XBP_PP_COL_DA_BGCLR, GRA_CLR_WHITE } }
  452.  
  453. aFields := ;
  454.    { ; // field            Header   Width  Index       Prompt
  455.    { {||EVENT->D_CRE},  'Date',       10,    "TEVDAT",  'Date' } , ;
  456.    { {||EVENT->TYPE},   'Libellé',    25,    "TEVTYPE", 'Type'  }, ;
  457.    { {||EVENT->BONREF}, 'N° Bon',      6,    "TEVCODE", 'Bon' } ;
  458.    }
  459.  
  460. bEval := {|o|o:drawingArea:setColorBG(GRA_CLR_CYAN)}
  461.  
  462. mst = DC_FindBrowse( aFields, nil, nil, nil, 90, 20, ;
  463.     "HISTORIQUE (Cliquer Droit sur en-tête pour changer l'index)", ;
  464.     nil, nil, nil, nil, nil, bEval, ;
  465.     { aPres, { GRA_CLR_DARKGRAY, GRA_CLR_RED } }, ;
  466.     nil, nil, nil, .5 )
  467.  
  468. DC_FindBrowseSort(aSaveSort)
  469.  
  470. IF Mst
  471.   do ZEV
  472. ENDIF
  473.  
  474. CLEAR SCREEN
  475. SELECT EVENT
  476. USE
  477. SELECT(La)
  478. do kon
  479.  
  480. RETURN .T.
  481.  
  482. ***
  483. *
  484. FUNCTION ZEV
  485. LOCAL zbuff:="", t:=0, l:=0, b:=23, r:=79, mt
  486. //
  487. DO HLOFF WITH LCD
  488. do win with t,l,b,r,zbuff, ALLTRIM(EVENT->TYPE)
  489. SELECT EVENT
  490.  
  491. DO CASE
  492.  
  493.    CASE EVENT->TYPE = "FACTURE"
  494.       NET_USE (S_FACT, "FACT", .F., 0, "FACT", "BON")
  495.       SEEK SUBSTR(EVENT->BONREF,1,6)+SUBSTR(EVENT->BONREF,8,2)
  496.       IF .NOT. FOUND().OR. REFCLI<>EVENT->REFCLI
  497.          ALARM ("ERREUR SYSTEME 02 "+REFCLI+" "+EVENT->REFCLI)
  498.       ELSE
  499.          DO FACT WITH .F., .F.
  500.       ENDIF
  501.       USE
  502.  
  503.    CASE EVENT->TYPE = "AVOIR"
  504.       NET_USE (S_AVO, "AVO", .F., 0, "AVREF", "BON")
  505.       SEEK SUBSTR(EVENT->BONREF, 1, LEN(BON->FACTURE))
  506.       IF .NOT. FOUND().OR. REFCLI<>EVENT->REFCLI
  507.          ALARM ("ERREUR SYSTEME 03 "+REFCLI+" "+EVENT->REFCLI)
  508.       ELSE
  509.          DO FACT WITH .F., .T.
  510.       ENDIF
  511.       USE
  512.  
  513.    CASE EVENT->TYPE = "COMMANDE"
  514.       NET_USE (S_COM, "COM", .F., 0, "COM", "BON")
  515.       SEEK SUBSTR(EVENT->BONREF, 1, LEN(BON->COMMANDE))
  516.       IF .NOT. FOUND().OR. REFCLI<>EVENT->REFCLI
  517.          ALARM ("ERREUR SYSTEME 04 "+REFCLI+" "+EVENT->REFCLI)
  518.       ELSE
  519.          DO COMM_OUT
  520.       ENDIF
  521.       USE
  522.  
  523.    OTHERWISE
  524.       DO LIT_INIT
  525.       SEEK SUBSTR(EVENT->BONREF, 1, LEN(LITIGE->CODE))
  526.       // On CDV's machine, may be several visits with the same number
  527.       LOCATE REST FOR CLIENT = EVENT->REFCLI;
  528.                   WHILE CODE = SUBSTR(EVENT->BONREF, 1, LEN(LITIGE->CODE))
  529.       IF .NOT. FOUND()
  530.          ALARM ("ERREUR SYSTEME 01 "+CLIENT+" "+EVENT->REFCLI)
  531.       ELSE
  532.          DO WHILE LASTKEY()<>27
  533.             DO LITFMT WITH 3          // normally delete but doesn't matter
  534.             DO HLON
  535.             mt= "F1-HELP     F2-MENU"
  536.             @ 24,0 CLEAR TO 24,79
  537.             @ 24,40-len(mt)/2 SAY mt
  538.             DO HLOFF WITH LCD
  539.             SET CURSOR OFF
  540.             @ 22,10 SAY""
  541.             set key K_F2 to LITMENU
  542.             wait ""                     // Wait allows function key actvation
  543.          ENDDO
  544.          SET CURSOR OFF
  545.          @ 24,0 CLEAR TO 24,79
  546.          set key K_F2 to
  547.          keyboard CHR(K_ESC)            // Force Exit
  548.       ENDIF
  549.       USE
  550.  
  551. ENDCASE
  552. DO WHILE INKEY()<>27
  553. ENDDO
  554. do wout with t,l,b,r,zbuff
  555. @ 24,0 CLEAR TO 24,79
  556. SELECT EVENT
  557. RETURN .T.
  558. *
  559. ****************************************
  560. *
  561. FUNCTION LITMENU
  562. *.......................................
  563. *
  564. LOCAL MA:= {}, MBUFF1:="", MSel:=SELECT()
  565. LOCAL l:=50, b:=22
  566. LOCAL t,r:=l+22
  567. LOCAL L_CNT, ML, MPL
  568. PRIVATE oPrinter
  569.  
  570. do keysoff
  571. @ 24,0 CLEAR
  572. AADD (MA, "RETOUR")
  573. AADD (MA, "Modifier")
  574. AADD (MA, "Imprimer")
  575. AADD (MA, "Supprimer")
  576. t=b-len(MA)-1
  577. DO WIN WITH t,l,b,r,MBUFF1,"",""
  578. SET COLOR TO &MENUCLR
  579. SET WRAP ON
  580. MCHOIX=ACHOICE(t+1,l+2,b-1,r-2,MA)
  581. DO WOUT WITH t,l,b,r,MBUFF1
  582. DO HLOFF WITH LCD              // Get colour right again
  583.  
  584. DO CASE
  585.  
  586.    CASE MCHOIX=2
  587.       SET CURSOR ON
  588.       DO LITFMT WITH 2         // Modify
  589.       SET CURSOR OFF
  590.  
  591.    CASE MCHOIX=3               // Imprimer
  592. *      SETPRC(0,0)
  593. *      Default_Printer
  594. *      SET DEVICE TO PRINT
  595.  
  596.       DCPRINT ON TO oPrinter
  597.  
  598.       DO PRINT_L
  599.       @ DC_PRINTERROW()+1,0 DCPRINT SAY ""
  600.       L_CNT=MLCOUNT(COMMENTAIR, 62, 4, .T.)
  601.       FOR ML=1 TO L_CNT
  602.           MPL=MEMOLINE(COMMENTAIR,62,ML,4,.T.)
  603.           @ DC_PRINTERROW()+1, 4 DCPRINT SAY MPL
  604.           IF DC_PRINTERROW() > 53
  605.              DCPRINT EJECT
  606.           ENDIF
  607.       NEXT
  608.       
  609.       DCPRINT EJECT
  610.       
  611.       DCPRINT OFF
  612.       
  613. *      Default_Printer
  614. *      SET DEVICE TO SCREEN
  615.  
  616.    CASE MCHOIX=4               // Delete
  617.       IF CONFIRM (18,, "N", "CONFIRMATION SUPPRESSION")
  618.          SELECT EVENT
  619.          REC_LOCK()
  620.          DELETE
  621.          UNLOCK
  622.          SELECT LITIGE
  623.          REC_LOCK()
  624.          DELETE
  625.          UNLOCK
  626.          SELECT(MSel)
  627.          keyboard CHR(K_ESC)   // Force Exit
  628.          RETURN .T.
  629.       ENDIF
  630.  
  631. ENDCASE
  632. keyboard " "      // Force Exit from wait
  633. SELECT(MSel)
  634. RETURN .T.
  635. //
  636. //-----------------------------------------------------------------
  637. //
  638. FUNCTION kon
  639. *.......................................
  640.  
  641. RETURN .T.
  642. **
  643. //
  644. //-----------------------------------------------------------------
  645. //
  646. FUNCTION NONE
  647. *.......................................
  648. parameters t,l,b,r,abuff
  649. *
  650. Alert( "VIDE")
  651. /*DO HLON
  652. do win with t,l,b,r,abuff,"VIDE"
  653. do while INKEY(0) <> K_ESC
  654. enddo
  655. DO HLOFF WITH LCD
  656. do wout with t,l,b,r,abuff
  657. */
  658. RETURN .T.
  659. *
  660. //
  661. //-----------------------------------------------------------------
  662. //
  663. FUNCTION Pg_Up
  664. *.......................................
  665. SCRAM_CLI(SEED)
  666. UNLOCK
  667. SELECT TEMPCLIN
  668. SKIP -1
  669. IF BOF()
  670.    Tone(800)
  671.    GO TOP
  672. ENDIF
  673. SELECT CLIENT
  674. REC_LOCK(0)          // Need lock to unscramble
  675. REC_LOCK(0)
  676. UNSCRAM_CLI(SEED)
  677. FREF=CLIENT->CLIREF
  678. RETURN .T.
  679. //
  680. //-----------------------------------------------------------------
  681. //
  682. FUNCTION Pg_Dn
  683. *.......................................
  684. SCRAM_CLI(SEED)
  685. UNLOCK
  686. SELECT TEMPCLIN
  687. SKIP
  688. IF  EOF()
  689.    Tone(500)
  690.    GO BOTT
  691. ENDIF
  692. SELECT CLIENT
  693. REC_LOCK(0)         // Need lock to unscramble
  694. REC_LOCK(0)
  695. UNSCRAM_CLI(SEED)
  696. FREF=CLIENT->CLIREF
  697. RETURN .T.
  698. //
  699. //-----------------------------------------------------------------
  700. //
  701. FUNCTION Imp_FICHE
  702. *.......................................
  703. DCPRINT ON TO oPrinter
  704. *IF .NOT. ISPRINTER()
  705. *   SET PRINT OFF
  706. *   SET DEVICE TO SCREEN
  707. *   ALARM ("PAS D'IMPRIMANTE")
  708. *   RETURN .T.
  709. *ENDIF
  710.  
  711. *Default_Printer
  712. *SET DEVICE TO PRINT
  713. *SETPRC(0,0)
  714.  
  715. Det_Out (2,.F.)      // Line 3, Don't unscramble/scramble
  716. DCPRINT Eject
  717. *Default_Printer
  718. *SET DEVICE TO SCREEN
  719.  
  720. DCPRINT OFF
  721. RETURN .T.
  722. //
  723. //---------------------------------------------------
  724. //
  725. FUNCTION ST               // Choose a Stock Item from a browsed list
  726. LOCAL La, mst, aFields := {}, cKey, cOldColor, nRecSel, nOrder
  727. LOCAL t:=0,l:=0,b:=24,r:=79,Zbuff:="" 
  728.  
  729. LOCAL  aPres, aSort[6], aSaveSort, bEval
  730.  
  731. PARAMETERS ZOOMON,CONTROL  // ZOOMON = .F. does not allow a zoom to full article
  732.                            //    details (e.g. when called from R_ART)
  733. *
  734. *
  735. IF PCOUNT()<>1             // When ST is called on a FN key, PCOUNT=3
  736.                            // Otherwise it is 1 (with param) or 0 (no para.)
  737.    ZOOMON=.T.              // Default=.T. ( MODIFY STOCK gives PCOUNT()= 1)
  738. ENDIF
  739. IF PCOUNT()<>2
  740.    CONTROL=4               // default is NOT READ
  741. ENDIF
  742. IF PCOUNT()<>3
  743.    FROMSTM=.T.             // Called by R_ART, Client may not be set up
  744. ENDIF
  745.  *
  746. DO KEYSOFF
  747. La=SELECT()
  748. select STOCK
  749. nOrder=INDEXORD()
  750. GO TOP
  751.  
  752. aSort[1] := GRA_CLR_WHITE // Sort Selected Color (Foreground)
  753. aSort[2] := GRA_CLR_RED   // Sort Selected Color (Background)
  754. aSort[3] := GRA_CLR_WHITE // Sort Unselected Color (Foreground)
  755. aSort[4] := GRA_CLR_DARKGRAY // Sort Unselected Color (Background)
  756. aSort[5] := BITMAP_RD_UP_RED  // Sort UP Bitmap
  757. aSort[6] := BITMAP_RD_DOWN_RED  // Sort DOWN Bitmap
  758.  
  759. aSaveSort := DC_FindBrowseSort(aSort)
  760.  
  761. aPres := ;
  762.   { { XBP_PP_COL_HA_FGCLR, GRA_CLR_WHITE },  ;
  763.     { XBP_PP_COL_HA_BGCLR, GRA_CLR_DARKGRAY }, ;
  764.     { XBP_PP_COL_DA_FGCLR, GRA_CLR_BLACK }, ;
  765.     { XBP_PP_COL_DA_BGCLR, GRA_CLR_WHITE } }
  766.  
  767. aPres := ;
  768.   { { XBP_PP_COL_HA_FGCLR, GRA_CLR_WHITE },  ;
  769.     { XBP_PP_COL_HA_BGCLR, GRA_CLR_DARKGRAY }, ;
  770.     { XBP_PP_COL_DA_FGCLR, GRA_CLR_BLACK }, ;
  771.     { XBP_PP_COL_DA_BGCLR, GRA_CLR_WHITE } }
  772.  
  773. aFields := ;
  774.    { ; // field            Header   Width  Index       Prompt
  775.    { {||STOCK->STCOMMREF}, 'Réf',         5,    "STCREF", 'Référence' } , ;
  776.    { {||STOCK->STLIB},     'Libellé',    25,    "STRLIB",  "Libellé" }, ;
  777.    { {||STOCK->STPRIXVTR}, 'Prix Tarif',  5,    nil,     nil }, ;
  778.    { {||STOCK->STCESSTR},  'Cession',     5,    nil,     nil }, ;
  779.    { {||STOCK->POIDS},     'Poids',       4,    nil,     nil } ;
  780.    }
  781.  
  782. bEval := {|o|o:drawingArea:setColorBG(GRA_CLR_CYAN)}
  783.  
  784. mst = DC_FindBrowse( aFields, nil, nil, nil, 90, 20, ;
  785.     "A R T I C L E S (Cliquer Droit sur en-tête pour changer l'index)", ;
  786.     nil, nil, nil, nil, nil, bEval, ;
  787.     { aPres, { GRA_CLR_DARKGRAY, GRA_CLR_RED } }, ;
  788.     nil, nil, nil, .5 )
  789.  
  790. DC_FindBrowseSort(aSaveSort)
  791.  
  792. SELECT(La)
  793. RETURN .T.
  794. **********************************
  795. *
  796. FUNCTION R_ART ( R,C,MART )
  797. LOCAL La
  798. La=SELECT()
  799. SELECT STOCK
  800. IF PCOUNT()<3
  801.    MART=SPACE(LEN(STOCK->STCOMMREF))
  802. ENDIF
  803. SET KEY K_F5 TO ZRART    // F5 for tarift pick list
  804. @ R,C GET MART
  805. READ
  806. SET KEY K_F5 TO
  807. IF LEN(TRIM(MART))>0 .AND. VAL(MART)<>0
  808.    MART=PAD(MART,LEN(MART))
  809. ENDIF
  810. SELECT(La)
  811. RETURN MART
  812.  
  813. ******
  814. FUNCTION ZRART
  815. CLEAR GETS
  816. DO ST WITH .F.            // no ZOOMON
  817. IF LASTKEY()<>K_ESC
  818.    MART=STCOMMREF
  819. ENDIF
  820. RETURN .T.
  821. //
  822. //-----------------------------------------------------
  823. //
  824. FUNCTION LAST_VISIT (Ro, Co, Print)
  825.  
  826. // Finds the last visit to the client.
  827. // If called by display (Print = .F.) displays info
  828. // if called from print (Print = .T.) RETURNs the memo or nothing
  829.  
  830. LOCAL La:=SELECT(), LVis:=0, MRet := ""
  831. DEFAULT Print TO .F.
  832.  
  833. IF .NOT. Print
  834.    @ Ro,    1       SAY "DERNIERE VISITE : "
  835.    @ ROW(), COL()   SAY  CLIENT->DERNVISIT
  836.    @ ROW(), COL()+3 SAY "ACTION AVANT LE : "
  837.    @ ROW(), COL()   GET  CLIENT->RELANCE
  838. ENDIF
  839.  
  840. NET_USE (S_EVENT, "EVENT",  .F., 30, "EVENT", "")
  841. SEEK CLIENT->CLIREF
  842. IF FOUND()
  843.    DO WHILE REFCLI = CLIENT->CLIREF .AND. .NOT. EOF()
  844.       IF ALLTRIM(EVENT->TYPE) $ "VISITETELEPHONE"
  845.          LVis=RECNO()       // Find the last visit
  846.          exit               // Index now in descending order
  847.       ENDIF
  848.       SKIP
  849.    ENDDO
  850.    IF LVis <> 0
  851.       GO LVis
  852.       DO LIT_INIT
  853.       SEEK SUBSTR(EVENT->BONREF, 1, LEN(LITIGE->CODE))
  854.       // On CDV's machine, may be several visits with the same number
  855.       LOCATE REST FOR CLIENT = EVENT->REFCLI;
  856.                   WHILE CODE = SUBSTR(EVENT->BONREF, 1, LEN(LITIGE->CODE))
  857.       IF Print
  858.          MRet = IF(FOUND(), LITIGE->COMMENTAIRE, "")
  859.       ELSE
  860.          IF .NOT. FOUND()
  861.             ALARM ("ERREUR SYSTEME 01 "+CLIENT+" "+EVENT->REFCLI)
  862.          ELSE
  863.             MEMOEDIT(LITIGE->COMMENTAIRE,Ro+1,Co,22,74,.F.,.F.)    // Browse
  864.          ENDIF
  865.          //
  866.          // CLose files opened by LIT_INIT
  867.          //
  868.          SELECT LITIGE
  869.          USE
  870.          SELECT LITREG
  871.          USE
  872.          SELECT LITCOD
  873.          USE
  874.       ENDIF
  875.    ENDIF
  876. ENDIF
  877.  
  878. SELECT EVENT
  879. USE
  880.  
  881. SELECT(La)
  882. RETURN MRet
  883. //
  884. //-----------------------------------------------------
  885. //
  886. FUNCTION R_CLI(CRE_CLI)
  887.  
  888. LOCAL nEvent, mp1, mp2
  889. LOCAL oDlg, oXbp, drawingArea, aEditControls := {}, oXbp1
  890. LOCAL ActiBox, GamBox, oXbpFax, oXbpRel, oRb1, oRb2, oRb3
  891.  
  892. LOCAL MREF,  M_Gam, M_Fax, M_T_Min 
  893. LOCAL M_REL, Mix_Array := {}
  894. LOCAL M_Dat_Base := CTOD("01/01/89")
  895. LOCAL La := SELECT(), i
  896.  
  897. // M_FILTER, M_CLIC, M_TEL, M_ACT, CLIN, MCP, M_CLIP, T_Min
  898. // M_Dat1, M_Dat2, M_R_S, M_R_E
  899. // are all defined as PUBLIC in MAIN
  900.  
  901.  
  902. IF PCOUNT()=0
  903.    CRE_CLI=.F.
  904. ENDIF
  905.  
  906. F_Ran= RANDOM (SEED, 5, 31)   // Generate 5 random n°s between 1 and 31
  907.  
  908. AADD (Mix_Array, "49-900    ")
  909. AADD (Mix_Array, "SECURIFRAN")
  910. AADD (Mix_Array, "42-700    ")
  911. AADD (Mix_Array, "ROULANT   ")
  912. AADD (Mix_Array, "CH49/AUTO ")
  913. AADD (Mix_Array, "PLANCHERS ")
  914. AADD (Mix_Array, "DIFFUSION ")
  915. AADD (Mix_Array, "DIVERS    ")
  916.  
  917. DO WHILE .T.
  918.    SET FILTER TO
  919.    Mret = 1                           // RETURN Value
  920.    M_FILTER = "VAL(CLISTATUS)<3"      // Initialise the selection
  921.  
  922.   SELECT CLIENT
  923.    SET ORDER TO 1                     // Index by Reference
  924.    GO TOP
  925.  
  926.    MFREF=SPACE(LEN(CLIREF))
  927.    CLIN= SPACE(LEN(CLINOM))
  928.    MCP=  SPACE(LEN(CLICP))
  929.    M_CLIC= SPACE(LEN(CLICONTACT))
  930.    M_TEL = SPACE(LEN(CLIPHONE))
  931.    M_ACT = SPACE(LEN(CLIPROFESS))
  932.    M_Gam=''
  933.    M_Fax='N'
  934.    M_T_Min = ""
  935.    M_CLIP =''
  936.    M_REL = 'N'
  937.    M_Dat1 = M_Dat_Base
  938.    M_Dat2 = M_Dat1
  939.    M_R_S = CTOD("01/01/89")
  940.    M_R_E = DATE() + 30
  941.    
  942.    oDlg := XbpDialog():new( AppDesktop(), , {353,205}, {600,400}, , .F.)
  943.    oDlg:taskList := .T.
  944.    oDlg:title := "SELECTION"
  945.    oDlg:create()
  946.  
  947.    drawingArea := oDlg:drawingArea
  948.    drawingArea:setFontCompoundName( "8.Arial" )
  949.  
  950.    oXbp1 := XbpStatic():new( drawingArea, , {40,252}, {348,108} )
  951.    oXbp1:caption := ""
  952.    oXbp1:clipSiblings := .T.
  953.    oXbp1:type := XBPSTATIC_TYPE_GROUPBOX
  954.    oXbp1:create()
  955.  
  956.    oXbp := XbpStatic():new( oXbp1, , {12,60}, {120,24} )
  957.    oXbp:caption := "NOM DU CLIENT :"
  958.    oXbp:clipSiblings := .T.
  959.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  960.    oXbp:create()
  961.  
  962.    oXbp := XbpSLE():new( oXbp1, , {144,60}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  963.    oXbp:bufferLength := 30
  964.    oXbp:tabStop := .T.
  965.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIN ), CLIN := x ) }
  966.    oXbp:create():setData()
  967.    AAdd ( aEditControls, oXbp )
  968.    SetAppFocus(oXbp)
  969.    
  970.    oXbp := XbpStatic():new( oXbp1, , {24,36}, {108,24} )
  971.    oXbp:caption := "CODE POSTALE :"
  972.    oXbp:clipSiblings := .T.
  973.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  974.    oXbp:create()
  975.  
  976.    oXbp := XbpSLE():new( oXbp1, , {144,36}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  977.    oXbp:bufferLength := 5
  978.    oXbp:tabStop := .T.
  979.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( MCP ), MCP := x ) }
  980.    oXbp:create():setData()
  981.    AAdd ( aEditControls, oXbp )
  982.  
  983.    oXbp := XbpStatic():new( oXbp1, , {36,12}, {96,24} )
  984.    oXbp:caption := "NUMERO CLIENT :"
  985.    oXbp:clipSiblings := .T.
  986.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  987.    oXbp:create()
  988.  
  989.    oXbp := XbpSLE():new( oXbp1, , {144,12}, {72,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  990.    oXbp:bufferLength := 10
  991.    oXbp:tabStop := .T.
  992.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( MFREF ), MFREF := x ) }
  993.    oXbp:create():setData()
  994.    AAdd ( aEditControls, oXbp )
  995.  
  996.  
  997.    oXbp := XbpPushButton():new( drawingArea, , {420,252},  {84,24},;
  998.              { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE }, { XBP_PP_FGCLR, -58 } } )
  999.    oXbp:caption := "GO"
  1000.    oXbp:tabStop := .T.
  1001.    oXbp:create()
  1002.    oXbp:activate := {|| Gather( aEditControls ), PostAppEvent( xbeP_Quit ) }
  1003.  
  1004.  
  1005.    oXbp := XbpStatic():new( drawingArea, , {108,216}, {120,24} )
  1006.    oXbp:caption := "CONTACT :"
  1007.    oXbp:clipSiblings := .T.
  1008.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  1009.    oXbp:create()
  1010.  
  1011.    oXbp := XbpSLE():new( drawingArea, , {240,216}, {108,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  1012.    oXbp:bufferLength := 17
  1013.    oXbp:tabStop := .T.
  1014.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( M_CLIC ), M_CLIC := x ) }
  1015.    oXbp:create():setData()
  1016.    AAdd ( aEditControls, oXbp )
  1017.  
  1018.    oXbp := XbpStatic():new( drawingArea, , {108,192}, {120,24} )
  1019.    oXbp:caption := "ACTIVITE :"
  1020.    oXbp:clipSiblings := .T.
  1021.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  1022.    oXbp:create()
  1023.  
  1024.    ActiBox := XbpCombobox():new( drawingArea, , {240,132}, {74,84}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  1025.    ActiBox:tabstop := .T.
  1026.    ActiBox:create()
  1027.    ActiBox:Additem ("MACO")
  1028.    ActiBox:Additem ("COUV")
  1029.    ActiBox:Additem ("PEIN")
  1030.    ActiBox:Additem ("FACA")
  1031.    ActiBox:Additem ("CHAR")
  1032.    ActiBox:Additem ("ISOL")
  1033.    ActiBox:Additem ("PLAT")
  1034.    ActiBox:Additem ("INDU")
  1035.    ActiBox:Additem ("LOCA")
  1036.    ActiBox:Additem ("DIVS")
  1037.    ActiBox:Additem ("CETC")
  1038.  
  1039.    oXbp := XbpStatic():new( drawingArea, , {96,168}, {132,24} )
  1040.    oXbp:caption := "EQUIPEE FAX :"
  1041.    oXbp:clipSiblings := .T.
  1042.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  1043.    oXbp:create()
  1044.  
  1045.    oXbpFax := XbpCheckBox():new( drawingArea, , {240,168}, {96,24} )
  1046.    oXbpFax:tabStop := .T.
  1047.    oXbpFax:create()
  1048.    oXbpFax:setData (.F.)
  1049.    oXbpFax:selected := {|| NIL }
  1050.  
  1051.    oXbp := XbpStatic():new( drawingArea, , {84,144}, {144,24} )
  1052.    oXbp:caption := "CLIENT/PROSPECT/TOUS :"
  1053.    oXbp:clipSiblings := .T.
  1054.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  1055.    oXbp:create()
  1056.  
  1057.    oRb1 := XbpRadioButton():new( drawingArea, , {240,144}, {48,24} )
  1058.    oRb1:caption := "Client"
  1059.    oRb1:tabStop := .T.
  1060.    oRb1:create()
  1061.    oRb1:selected := {|| NIL }
  1062.  
  1063.    oRb2 := XbpRadioButton():new( drawingArea, , {288,144}, {60,24} )
  1064.    oRb2:caption := "Prospect"
  1065.    oRb2:tabStop := .T.
  1066.    oRb2:create()
  1067.    oRb2:selected := {|| NIL }
  1068.  
  1069.    oRb3 := XbpRadioButton():new( drawingArea, , {360,144}, {120,24} )
  1070.    oRb3:caption := "Tous"
  1071.    oRb3:tabStop := .T.
  1072.    oRb3:selection := .T.
  1073.    oRb3:create()
  1074.    oRb3:selected := {|| NIL }
  1075.  
  1076.    oXbp := XbpStatic():new( drawingArea, , {132,120}, {96,24} )
  1077.    oXbp:caption := "TAILLE MINIMUM :"
  1078.    oXbp:clipSiblings := .T.
  1079.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  1080.    oXbp:create()
  1081.  
  1082.    oXbp := XbpSLE():new( drawingArea, , {240,120}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  1083.    oXbp:bufferLength := 4
  1084.    oXbp:tabStop := .T.
  1085.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, M_T_Min, M_T_Min := x ) }
  1086.    oXbp:create():setData()
  1087.    AAdd ( aEditControls, oXbp )
  1088.  
  1089.    oXbp := XbpStatic():new( drawingArea, , {84,96}, {144,24} )
  1090.    oXbp:caption := "GAMME MEFRAN :"
  1091.    oXbp:clipSiblings := .T.
  1092.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  1093.    oXbp:create()
  1094.  
  1095.    GamBox := XbpCombobox():new( drawingArea, , {240,36}, {94,84}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  1096.    GamBox:tabstop := .T.
  1097.    GamBox:create()
  1098.    FOR i = 1 TO LEN(Mix_Array)
  1099.       GamBox:Additem  (Mix_Array[i])
  1100.    NEXT
  1101.  
  1102.    oXbp := XbpStatic():new( drawingArea, , {84,72}, {144,24} )
  1103.    oXbp:caption := "A RELANCER :"
  1104.    oXbp:clipSiblings := .T.
  1105.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  1106.    oXbp:create()
  1107.  
  1108.    oXbpRel := XbpCheckBox():new( drawingArea, , {240,72}, {24,24} )
  1109.    oXbpRel:tabStop := .T.
  1110.    oXbpRel:create()
  1111.    oXbpRel:selected := {|| NIL }
  1112.  
  1113.    oXbp := XbpStatic():new( drawingArea, , {264,72}, {72,24} )
  1114.    oXbp:caption := " AVANT LE :"
  1115.    oXbp:clipSiblings := .T.
  1116.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  1117.    oXbp:create()
  1118.  
  1119.    oXbp := XbpSLE():new( drawingArea, , {336,72}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  1120.    oXbp:tabStop := .T.
  1121.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, DtoC( M_R_E ), M_R_E := CtoD(x) ) }
  1122.    oXbp:create():setData()
  1123.    AAdd ( aEditControls, oXbp )
  1124.  
  1125.    oXbp := XbpStatic():new( drawingArea, , {396,72}, {60,24} )
  1126.    oXbp:caption := "APRES LE :"
  1127.    oXbp:clipSiblings := .T.
  1128.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  1129.    oXbp:create()
  1130.  
  1131.    oXbp := XbpSLE():new( drawingArea, , {456,72}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  1132.    oXbp:tabStop := .T.
  1133.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, DtoC( M_R_S ), M_R_S := CtoD(x) ) }
  1134.    oXbp:create():setData()
  1135.    AAdd ( aEditControls, oXbp )
  1136.  
  1137.    oXbp := XbpStatic():new( drawingArea, , {84,48}, {144,24} )
  1138.    oXbp:caption := "PAS VISITE DEPUIS :"
  1139.    oXbp:clipSiblings := .T.
  1140.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  1141.    oXbp:create()
  1142.  
  1143.    oXbp := XbpSLE():new( drawingArea, , {240,48}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  1144.    oXbp:bufferLength := 10
  1145.    oXbp:tabStop := .T.
  1146.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, DtoC( M_Dat1 ), M_Dat1 := CtoD(x) ) }
  1147.    oXbp:create():setData()
  1148.    AAdd ( aEditControls, oXbp )
  1149.  
  1150.    oXbp := XbpStatic():new( drawingArea, , {84,24}, {144,24} )
  1151.    oXbp:caption := "PAS COMMANDE DEPUIS :"
  1152.    oXbp:clipSiblings := .T.
  1153.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  1154.    oXbp:create()
  1155.  
  1156.    oXbp := XbpSLE():new( drawingArea, , {240,24}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  1157.    oXbp:bufferLength := 10
  1158.    oXbp:tabStop := .T.
  1159.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, DtoC( M_Dat2 ), M_Dat2 := CtoD(x) ) }
  1160.    oXbp:create():setData()
  1161.    AAdd ( aEditControls, oXbp )
  1162.  
  1163.    oDlg:show()
  1164.  
  1165.    nEvent := xbe_None
  1166.    DO WHILE nEvent <> xbeP_Close .AND. nEvent <>xbeP_Quit
  1167.       nEvent := AppEvent( @mp1, @mp2, @oXbp )
  1168.       oXbp:handleEvent( nEvent, mp1, mp2 )
  1169.    ENDDO
  1170.   
  1171.    IF LastAppEvent()= xbeP_Close
  1172.          Mret=0                          // Client not selected
  1173.       EXIT
  1174.    ENDIF
  1175.  
  1176.    //
  1177.    // Get the data and see if the user has specified anything interesting
  1178.    //
  1179.    M_Act = ALLTRIM(ActiBox:xbpSLE:getdata())
  1180.    M_Gam = ALLTRIM(GamBox:xbpSLE:getdata())
  1181.    M_Fax = IIF(oXbpFax:GetData(), "O", "N")  
  1182.    M_Rel = IIF(oXbpRel:GetData(), "O", "N")
  1183.    T_Min = INT(VAL(M_T_Min))
  1184.    // Radio Buttons
  1185.    IF oRB3:GetData()
  1186.       M_Clip = ""
  1187.    ELSEIF oRB2:GetData()      
  1188.       M_Clip = "P"
  1189.    ELSE
  1190.       M_Clip = "C"
  1191.    ENDIF
  1192.  
  1193.    IF .NOT. EMPTY (MFREF)
  1194.       //
  1195.       // If the reference is specified, all other parameters are irrelevant,
  1196.       // but if they are specified, the user may want to create a new client
  1197.       //
  1198.       IF .NOT. EMPTY(CLIN).AND. .NOT. EMPTY(MCP);
  1199.          .AND. CRE_CLI .AND. SUBSTR(MFREF,1,1)="*"
  1200.             IF CONFIRM (11,5,"O","Créer un prospect ? ")
  1201.             //
  1202.             // Create a new prospect: a prospect becomes a
  1203.             // client when he orders something
  1204.             //
  1205.             NET_USE (S_ATTACH, "ATTACH", .T., 0, "", "")
  1206.             DO WHILE .T.
  1207.                SELECT ATTACH
  1208.  
  1209.                // Allocate next number
  1210.  
  1211.                FREF=SUBSTR(MCP,1,2) + SUBSTR(M_Resp,2,2) + PAD(STR(NUM_CLI),5)
  1212.                REPLACE NUM_CLI WITH NUM_CLI+1
  1213.                SELECT CLIENT
  1214.                SEEK "C"+FREF
  1215.                IF FOUND()
  1216.                   LOOP        // Try the next available prospect number
  1217.                ENDIF
  1218.                SEEK "P" + FREF
  1219.                IF .NOT. FOUND()
  1220.                   FREF= "P" + FREF
  1221.                   Mret = 1
  1222.                   EXIT        // O.K. found a valid number
  1223.                ENDIF
  1224.             ENDDO
  1225.             SELECT ATTACH
  1226.             USE
  1227.             SELECT CLIENT
  1228.             ADD_REC(0)
  1229.             REPLACE CLIREF      WITH FREF,;
  1230.                     CLINOM      WITH CLIN,;
  1231.                     CLICP       WITH MCP,;
  1232.                     CLIREGION   WITH M_Resp,;
  1233.                     CLISCRAMBLE WITH .F.
  1234.             Window_Cli (1)
  1235.             SCRAM_CLI (SEED)
  1236.             LOOP
  1237.          ENDIF
  1238.       ELSE
  1239.          //
  1240.          // Not Prospect creation, try to find client
  1241.          //
  1242.          SET ORDER TO 1   // CLREF
  1243.          SEEK MFREF
  1244.          IF FOUND() .AND. VAL(CLISTATUS)<3  // Not deleted
  1245.             Mret=2                          // straight to client
  1246.             EXIT
  1247.          ENDIF
  1248.          FREF= "P" + SUBSTR(MFREF,2,LEN(CLIENT->CLIREF)-1)
  1249.          SEEK FREF
  1250.          IF FOUND() .AND. VAL(CLISTATUS) < 3
  1251.             ALARM ("ATTENTION - C'est un PROSPECT pas un CLIENT")
  1252.             Mret=2                        // straight to client
  1253.             EXIT
  1254.          ENDIF
  1255.          
  1256.          ALARM ("NUMERO CLIENT INEXISTANT OU CLIENT SUPPRIME")
  1257.          // Shouldn't normally create a client because
  1258.          // he should previously have been a prospect.
  1259.          // Nevertheless, allow creation if the user insists!
  1260.          IF .NOT. EMPTY(CLIN) .AND. .NOT. EMPTY(MCP);
  1261.             .AND. CRE_CLI .AND. CONFIRM (11,5,"O","Créer un Client ? ")
  1262.             SELECT CLIENT
  1263.             ADD_REC(0)
  1264.             REPLACE CLIREF      WITH MFREF,;
  1265.                     CLINOM      WITH CLIN,;
  1266.                     CLICP       WITH MCP,;
  1267.                     CLIREGION   WITH M_Resp,;
  1268.                     CLISCRAMBLE WITH .F.
  1269.             Window_Cli (1)
  1270.             SCRAM_CLI (SEED)
  1271.          ENDIF
  1272.          LOOP
  1273.       ENDIF
  1274.    ELSE
  1275.       //
  1276.       // FREF not specified, try the other keys
  1277.       //
  1278.       //
  1279.       // Now set up filter or choose client
  1280.       //
  1281.       IF .NOT. EMPTY(M_CLIC)      // "CLIENT"-type condition
  1282.          SET ORDER TO 0
  1283.          LOCATE FOR CLICONTACT = SCRAMBLE (M_CLIC,;
  1284.                                   RANDOM(REC_SEED (SEED), 30, 31));
  1285.                             .AND. VAL(CLISTATUS) < 3
  1286.          IF FOUND()
  1287.             SET ORDER TO 1
  1288.             Mret=2                     // straight to client
  1289.             EXIT
  1290.          ENDIF
  1291.             ALARM ("CLIENT INEXISTANT OU SUPPRIME")
  1292.          LOOP
  1293.       ELSE
  1294.          IF .NOT. EMPTY(M_ACT)
  1295.             //
  1296.             // M_ACT is set up which is a FILTER type condition
  1297.             //
  1298.             M_FILTER = M_FILTER + ".AND.CLIPROFESS=M_ACT"
  1299.          ENDIF
  1300.          //
  1301.          // Fax ?
  1302.          //
  1303.          IF M_Fax = 'O'
  1304.             M_FILTER = M_FILTER+".AND.CLIFAX<>SCRAMBLE(SPACE(15),"+;
  1305.                                       "RANDOM(REC_SEED (SEED), 30, 31))"
  1306.          ENDIF
  1307.          //
  1308.          // Client/Prospect ?
  1309.          //
  1310.          IF M_CLIP <> ' '
  1311.             M_FILTER = M_FILTER+".AND.CLIREF=M_CLIP"
  1312.          ENDIF
  1313.          //
  1314.          // Taille Mini ?
  1315.          //
  1316.          IF T_Min > 0
  1317.             M_FILTER = M_FILTER+".AND.VAL(CLITAILLE)>=T_Min"
  1318.          ENDIF
  1319.          //
  1320.          // Gamme MEFRAN ?
  1321.          IF .NOT. EMPTY(M_Gam)
  1322.             SET EXACT OFF
  1323.             i = ASCAN(PADR(M_Gam, LEN(Mix_Array[1])), Mix_Array)
  1324.             SET EXACT ON
  1325.             IF I<>0
  1326.                M_FILTER = M_FILTER+".AND.Q_"+STR(I,1)+"<>0"
  1327.             ENDIF
  1328.          ENDIF
  1329.          IF M_REL='O'
  1330.             M_FILTER=M_FILTER+".AND.RELANCE>=M_R_S.AND.RELANCE<M_R_E"
  1331.          ENDIF
  1332.          IF M_Dat1>M_Dat_Base
  1333.             M_FILTER=M_FILTER+".AND.DERNVISIT<M_Dat1"
  1334.          ENDIF
  1335.          IF M_Dat2>M_Dat_Base
  1336.             M_FILTER=M_FILTER+".AND.DCANNEE<M_Dat2"
  1337.          ENDIF
  1338.       ENDIF
  1339.    ENDIF
  1340.    CLIN=ALLTRIM(CLIN)
  1341.    MCP=ALLTRIM(MCP)
  1342.    SET EXACT OFF
  1343.    Mret = 1
  1344.    //
  1345.    // Select the search method and complete the filter condition
  1346.    //
  1347.    IF .NOT. EMPTY(CLIN)
  1348.       //
  1349.       // Scramble the data so as to be the same as the file
  1350.       //
  1351.       CLIN = SCRAMBLE (IIF(LEN(CLIN)<= 5,CLIN,SUBSTR(CLIN,1,5)),F_Ran)
  1352.       //
  1353.       // Search by NAME
  1354.       //
  1355.       SET ORDER TO 2         // CLINOM
  1356.       IF .NOT. EMPTY(MCP)
  1357.          M_FILTER=M_FILTER+".AND.CLICP=MCP"
  1358.       ENDIF
  1359.       SEEK CLIN
  1360.       COPY TO C:TEMPCLIN FIELDS CLIREF FOR &M_FILTER WHILE CLIENT->CLINOM=CLIN
  1361.  
  1362.    ELSEIF .NOT. EMPTY(MCP)
  1363.       //
  1364.       // Search by C.P.
  1365.       //
  1366.       SET ORDER TO 3         // CLICP
  1367.       SEEK MCP
  1368.       COPY TO C:TEMPCLIN FIELDS CLIREF FOR &M_FILTER WHILE CLIENT->CLICP=MCP
  1369.  
  1370.    ELSE
  1371.       //
  1372.       // Search whole file
  1373.       //
  1374.       SET ORDER TO 0
  1375.       GO TOP
  1376.       COPY TO C:TEMPCLIN FIELDS CLIREF FOR &M_FILTER
  1377.    ENDIF
  1378.    EXIT
  1379.  
  1380. ENDDO
  1381.  
  1382. SET ORDER TO 1                 // Whatever happened
  1383. IF Mret <> 0 .AND. Mret <> 2   // Client not selected
  1384.    NET_USE (S_TEMP2, "C:TEMPCLIN", .T., 0, "", "")
  1385.    IF RECCOUNT() = 0
  1386.       oDlg : close()
  1387.       oDlg : Destroy()
  1388.       Alarm("Vide")            // Error Message
  1389.       SELECT (La)
  1390.       RETURN-1
  1391.    ELSE
  1392.       COUNT TO N_Cli FOR CLIREF<>"P"
  1393.       N_Rec=RECCOUNT()
  1394.       GO TOP
  1395.       SET RELATION TO CLIREF INTO CLIENT
  1396.    ENDIF
  1397. ENDIF
  1398. SET EXACT ON
  1399. SET SOFTSEEK OFF
  1400.  
  1401. oDlg : close()
  1402. oDlg : Destroy()
  1403.  
  1404. SELECT (La)
  1405. RETURN Mret
  1406.  
  1407. *
  1408. ***************************
  1409. *
  1410. FUNCTION R_CLI2 ()
  1411. //
  1412. LOCAL La, aFields := {},  cOldColor, nRecSel, FREF
  1413.  
  1414. La=SELECT()
  1415. SELECT TEMPCLIN
  1416. IF RECCOUNT()=0               // Was a single record which has been deleted
  1417.    SELECT (La)
  1418.    RETURN ""
  1419. ENDIF
  1420. F_Ran= RANDOM (SEED, 5, 31)   // Generate 5 random n°s between 1 and 31
  1421. cOldColor := SetColor()
  1422. AADD(aFields, {" REF",   {||IIF(CLIENT->CLIRISQUE<>" ",;
  1423.                               "*"+CLIREF,;
  1424.                               " "+CLIREF)}, 6 } )
  1425. AADD(aFields, {"NOM" ,  {||UNS_NOM(CLIENT->CLINOM)}, 18 } )
  1426. AADD(aFields, {"C.P.",  {||CLIENT->CLICP }, 3 } )
  1427. AADD(aFields, {"VILLE", {||UNS_NOM(SUBSTR(CLIENT->CLIVILLE,1,20))}, 13} )
  1428. AADD(aFields, {"TEL",   {||UNS_FIELD(CLIENT->CLIPHONE) }, 8 } )
  1429. AADD(aFields, {"PROF",  {||CLIENT->CLIPROFESS }, 3 } )
  1430. AADD(aFields, {"F.J.",  {||CLIENT->CLIABV }, 3 } )
  1431. SET EXACT OFF
  1432. SET SOFTSEEK OFF
  1433.  
  1434. nRecSel:= CL_BRWSWHL(aFields)
  1435.  
  1436. FREF = DECODE_REPLY (nRecSel)
  1437. SET EXACT ON
  1438. SELECT (La)
  1439. SetColor (cOldColor)
  1440. RETURN FREF
  1441. *
  1442. //
  1443. //-------------------------------------------------------------------------
  1444. //
  1445. FUNCTION DECODE_REPLY (nRecSel)
  1446. //
  1447. LOCAL mbuff:=""
  1448.  
  1449. DO CASE
  1450.    CASE  nRecSel == 0
  1451.       RETURN ""        // No record selected (Esc)
  1452.    CASE nRecSel < 0    // No matching Record
  1453.        Alarm ("Vide")
  1454. *      DO HLON
  1455. *      do win with 18,1,20,78,mbuff,"VIDE"
  1456. *      do while INKEY(0) <> K_ESC
  1457. *      enddo
  1458. *      DO HLOFF WITH LCD
  1459.       RETURN ""
  1460.    OTHERWISE
  1461.       RETURN CLIENT->CLIREF
  1462. ENDCASE
  1463. RETURN ""
  1464. //
  1465. //-------------------------------------------------------------------------
  1466. //
  1467. FUNCTION UNS_NOM(Nom)
  1468. //
  1469. // Returns an unscrambled client name or VILLE. Used by R_CLI
  1470. //
  1471. LOCAL M, La
  1472. //
  1473. // Set up global variables
  1474. //
  1475. // F_Ran already set up by R_CLI
  1476. La=SELECT()
  1477. SELECT CLIENT
  1478. V_Ran= RANDOM(REC_SEED (SEED), LEN(Nom)-5, 31)    // 25 codes.
  1479. M    = UNSCRAMBLE (SUBSTR(Nom,1,5), F_Ran)
  1480. M = M +  UNSCRAMBLE (SUBSTR(Nom, 6, LEN(Nom)-5), V_Ran)
  1481. SELECT(La)
  1482. RETURN M
  1483. //
  1484. //-------------------------------------------------------------------------
  1485. //
  1486. FUNCTION UNS_FIELD(Nom)
  1487. //
  1488. // Returns an unscrambled field
  1489. //
  1490. LOCAL M, La
  1491. //
  1492. // Set up global variables
  1493. //
  1494. // F_Ran already set up by R_CLI
  1495. La=SELECT()
  1496. SELECT CLIENT
  1497. V_Ran= RANDOM(REC_SEED (SEED), LEN(Nom), 31)    // 25 codes.
  1498. M    = UNSCRAMBLE (Nom, V_Ran)
  1499. SELECT(La)
  1500. RETURN M
  1501. //
  1502. ********************************
  1503.  
  1504. *
  1505. FUNCTION V_Proff(Proff)
  1506. //
  1507. // Validates the Profession Code in the current record
  1508. // Uses the string ValidProff from PARAMS
  1509. //
  1510. RETURN EMPTY(Proff) .OR. Proff+"," $ ValidProff
  1511. //
  1512. //--------------------------------------------
  1513. //
  1514. FUNCTION SIRET (Code)
  1515. LOCAL I:=1, J, Tot:=0
  1516.  
  1517. Code = ALLTRIM (Code)
  1518. IF EMPTY(Code)
  1519.    RETURN .T.
  1520. ENDIF
  1521. IF LEN(Code) <> 14
  1522.    RETURN .F.
  1523. ENDIF
  1524. //
  1525. // For the time being ......
  1526. //
  1527. return .T.
  1528. //
  1529. DO WHILE I < 14
  1530.    J=VAL(SUBSTR(Code,I,1))*2
  1531.    J=IIF(J>10, J-9, J)
  1532.    Tot = Tot + J + VAL(SUBSTR(Code, I+1, 1))
  1533.    I=I+2
  1534. ENDDO
  1535. RETURN MOD(Tot, 10) = 0
  1536. //
  1537. /* ------------------------------------------------------------------- */
  1538. //
  1539. FUNCTION CL_BRWSWHL(aFields)
  1540.  
  1541. LOCAL nEvent, mp1, mp2, oXbp, oBut, oBrowse, aSize, i
  1542. LOCAL oLdWin,  TheElement
  1543. PRIVATE ChosenClient:=0
  1544.  
  1545.    oXbp := GuiStdDialog( "Sélection CLIENT/PROSPECT", {10,100}, {675,400})
  1546.  
  1547.    oBut := XbpPushButton():new( oXbp:drawingArea, , {295,3}, {84,24},;
  1548.                                 { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE }, { XBP_PP_FGCLR, -58 } } )
  1549.    oBut:caption := "Impression"
  1550.    oBut:tabStop := .T.
  1551.    oBut:create()
  1552.    oBut:activate := {|| PRINT_CLI() }
  1553.  
  1554.    // create browser in window
  1555.    aSize = oXbp:drawingarea:currentsize()
  1556.    aSize[2] = aSize[2] - 30
  1557.    oBrowse := GuiBrowseDb( oXbp:drawingArea, {0,30}, aSize )
  1558.  
  1559.    FOR i = 1 TO LEN(aFields)
  1560.  
  1561.       /* make the new column  - Contents, size, header*/
  1562.       oBrowse:addColumn(aFields[i, 2],aFields[i, 3] , aFields[i, 1] )
  1563.    NEXT
  1564.    oBrowse:CursorMode:=XBPBRW_CURSOR_ROW
  1565.    // overload resize that browser fills the window
  1566.    oXbp:drawingArea:resize := ;
  1567.        {|mp1,mp2,obj| obj:childList()[1]:setSize(mp2) }
  1568.  
  1569.    oXbp:show()
  1570.    oBrowse:show()
  1571.    oldWin = SetAppFocus(oBrowse)
  1572.  
  1573.    ChosenClient = 0
  1574.    
  1575.    DO WHILE nEvent <> xbeP_Close
  1576.       nEvent := AppEvent( @mp1, @mp2, @TheElement,0 )
  1577.       TheElement:handleEvent( nEvent, mp1, mp2 )
  1578.    ENDDO
  1579.    
  1580.    oXbp:hide()
  1581.    oBrowse:destroy()
  1582.    oXbp:destroy()
  1583.    SetAppFocus( oldWin )
  1584.  
  1585. RETURN ChosenClient
  1586.  
  1587. ******************************************************************
  1588. * Create GUI Browser with navigation codeblocks
  1589. ******************************************************************
  1590. FUNCTION GuiBrowseDB( oParent, aPos, aSize )
  1591.    LOCAL oBrowse
  1592.  
  1593.    oBrowse := XbpBrowse():new( oParent,, aPos, aSize,, .F. ):create()
  1594.  
  1595.    // navigation codeblocks for the browser
  1596.    oBrowse:skipBlock     := {|n| DbSkipper(n) }
  1597.    oBrowse:goTopBlock    := {| | DbGoTop()    }
  1598.    oBrowse:goBottomBlock := {| | DbGoBottom() }
  1599.    oBrowse:phyPosBlock   := {| | Recno()      }
  1600.    oBrowse:phyPosBlock   := {| | Recno()      }
  1601.    oBrowse:ItemSelected  := {| | ChosenClient:=Recno(), PostAppEvent (xbeP_Close) }
  1602.    // Code blocks for the vertical scrollbar.
  1603.    // Note: DbPosition() returns values in the range from 0 to 100.
  1604.    // We multiply this with 10 to increase the granularity of
  1605.    // the vertical scrollbar.
  1606.    oBrowse:posBlock      := {| | DbPosition()*10    }
  1607.    oBrowse:goPosBlock    := {|n| DbGoPosition(n/10) } 
  1608.    oBrowse:lastPosBlock  := {| | 1000               }
  1609.    oBrowse:firstPosBlock := {| | 0                  }
  1610.  
  1611. RETURN oBrowse
  1612.  
  1613.  
  1614. ******************************************************************
  1615. * Create std dialog window hidden
  1616. ******************************************************************
  1617. FUNCTION GuiStdDialog( cTitle, aPos, aSize )
  1618.    LOCAL oDlg
  1619.  
  1620.    DEFAULT cTitle TO "Standard Dialog Window"
  1621.  
  1622.    oDlg          := XbpDialog():new( AppDesktop(),,aPos, aSize,, .F. )
  1623.    oDlg:icon     := 1
  1624.    oDlg:taskList := .T.
  1625.    oDlg:title    := cTitle
  1626. *   oDlg:titlebar := .F.
  1627.    oDlg:drawingArea:ClipChildren := .T.
  1628.    oDlg:create()
  1629.    oDlg:drawingArea:setFontCompoundName( FONT_DEFPROP_SMALL )
  1630.  
  1631. RETURN oDlg
  1632. //
  1633. //------------------------------------------------------------
  1634. //
  1635. FUNCTION PRINT_CLI ()
  1636. //
  1637. LOCAL La:=SELECT(), M_choice, NRec
  1638.  
  1639. SELECT TEMPCLIN
  1640. NRec=RECNO()    // In TEMPCLIN
  1641.  
  1642. DO WHILE .T.
  1643.    //
  1644.    // DO allows multiple outputs of the same list
  1645.    //
  1646.    IF .NOT. Ini_Print (@M_choice)
  1647.       EXIT
  1648.    ELSE
  1649.       Print_Temp (M_choice)
  1650.    ENDIF
  1651. ENDDO
  1652.  
  1653. DCPRINT OFF
  1654. SET EXACT ON
  1655. SELECT TEMPCLIN
  1656. GO NRec
  1657. SELECT(La)
  1658. RETURN .T.
  1659. //
  1660. //-----------------------------------------------
  1661. //
  1662. FUNCTION Ini_Print ( m_choice )
  1663.  
  1664. LOCAL oBtn, oDlg,  oXbp, nEvent, mp1, mp2
  1665. LOCAL Ans:= .F.
  1666.  
  1667. /*
  1668. Ans = Alert( "Choisir format d'impression", {"Sommaire", "Détail", "Annuler"} )
  1669. IF Ans = <> 1 .AND. Ans = <> 2
  1670.    RETURN .F.
  1671. ENDIF
  1672. m_Choice = IIF(Ans = 1, "S", "D")
  1673. RETURN .T.
  1674. */   
  1675.  
  1676. oDlg := GuiStdDialog( "Impression", {50,200}, {200,150})
  1677. oDlg:setModalState(XBP_DISP_APPMODAL)
  1678. oDlg:show()
  1679. SetAppFocus(oDlg)
  1680. // 
  1681. // Create push buttons 
  1682. //
  1683.  
  1684. oBtn:= XbpPushButton():new( oDlg:drawingArea,,{25,70},{100,30} ) 
  1685. oBtn:caption := "Sommaire" 
  1686. oBtn:tabStop := .T. 
  1687. oBtn:activate := {|| Ini_Print_But(@m_choice, "S", @Ans), PostAppEvent( xbeP_Close )  }
  1688. oBtn:create()
  1689.  
  1690. oBtn:= XbpPushButton():new( oDlg:drawingArea,, {25,40},{100,30}  ) 
  1691. oBtn:caption := "Détail" 
  1692. oBtn:tabStop := .T. 
  1693. oBtn:activate := {|| Ini_Print_But(@m_choice, "D", @Ans), Ans = "Hello", PostAppEvent( xbeP_Close ) }
  1694. oBtn:create()
  1695.  
  1696. oBtn:= XbpPushButton():new( oDlg:drawingArea,, {25,10},{100,30}  ) 
  1697. oBtn:caption := "Cancel" 
  1698. oBtn:cancel  := .T. 
  1699. oBtn:tabStop := .T. 
  1700. oBtn:activate := {|| Ans=.F., PostAppEvent( xbeP_Close ) }
  1701. oBtn:create()
  1702.  
  1703. nEvent := xbe_None
  1704. DO WHILE nEvent <> xbeP_Close
  1705.    nEvent := AppEvent( @mp1, @mp2, @oXbp )
  1706.    oXbp:handleEvent( nEvent, mp1, mp2 )
  1707. ENDDO
  1708. oDlg:hide()
  1709. oDlg:destroy()
  1710.  
  1711. RETURN Ans
  1712. //
  1713. FUNCTION Ini_Print_But (choice,valeur,Reponse)
  1714. choice=valeur
  1715. reponse=.T.
  1716. RETURN .T.
  1717. //
  1718. //-----------------------------------------------
  1719. //
  1720. FUNCTION Print_Temp (R_Type)
  1721. LOCAL Mb,La, P_Pos, P_Mem :="<><><>"
  1722. PRIVATE oPrinter
  1723. La=SELECT()
  1724.  
  1725. Mb=""
  1726.  
  1727. SELECT TEMPCLIN
  1728. GO TOP
  1729. CLEAR
  1730. IF R_Type = "S"
  1731.    //
  1732.    // Print summary report
  1733.    //
  1734.    INDEX ON CLIENT->CLIPROFESS TO TEMP
  1735.  
  1736.    DCPRINT ON TO oPrinter FONT "8.Lucida Console" PREVIEW 
  1737.    
  1738.    DCPRINT ?"CLIENT"+SPACE(72)+"TELEPHONE"
  1739.    DO WHILE .NOT. EOF()
  1740.       SELECT CLIENT
  1741.       REC_LOCK()
  1742.       REC_LOCK()        //Ha Ha !
  1743.       UNSCRAM_CLI (SEED)
  1744.       IF CLIPROFESS <> P_Mem
  1745.          IF DC_PRINTERROW() > 48
  1746.             DCPRINT EJECT
  1747.          ENDIF
  1748.          DCPRINT ?
  1749.          DCPRINT ?
  1750.          DCPRINT ? "ACTIVITE " + CLIPROFESS
  1751.          DCPRINT ? "-------------"
  1752.          P_Mem = CLIPROFESS
  1753.       ENDIF
  1754.       DCPRINT ? CLIREF+" "+SUBSTR(CLINOM,1,28)+" "+CLICP+" "+CLIVILLE+" "+" "+CLIPHONE+" "+CLIPHONED
  1755.       SCRAM_CLI (SEED)
  1756.       UNLOCK
  1757.       IF DC_PRINTERROW() > 55
  1758.          DCPRINT EJECT
  1759.       ENDIF
  1760.       SELECT TEMPCLIN
  1761.       SKIP
  1762.    ENDDO
  1763.    EJECT
  1764.  
  1765.    DCPRINT OFF
  1766.    SET INDEX TO
  1767.    ERASE TEMP.NTX
  1768. ELSE
  1769.    //
  1770.    // Print detail report
  1771.  
  1772.    DCPRINT ON TO oPrinter FONT "8.Lucida Console" PREVIEW
  1773.    P_Pos = 2
  1774.  
  1775.    DO WHILE .NOT. EOF()
  1776.       DET_OUT(P_Pos)           // Print the report
  1777.  
  1778.       IF DC_PRINTERROW() < 30
  1779.          P_Pos = 33
  1780.          @ P_Pos -2,1 DCPRINT SAY REPLICATE("-",78)
  1781.       ELSE
  1782.          DCPRINT EJECT
  1783.          P_Pos = 2
  1784.       ENDIF
  1785.       //
  1786.       // Allow the User to kill it!
  1787.       //
  1788.       IF INKEY() = K_ESC .OR. LASTKEY() = K_ESC
  1789.         EXIT
  1790.       ENDIF
  1791.       SKIP
  1792.  
  1793.    ENDDO
  1794.  
  1795.    DCPRINT OFF
  1796. ENDIF
  1797. SELECT(La)
  1798.  
  1799.  
  1800. RETURN .T.
  1801. //
  1802. //-----------------------------------------------
  1803. //
  1804. FUNCTION Det_Out(Lin, Scram)
  1805. LOCAL ML:=0, L_CNT, MPL, La, V_String
  1806. DEFAULT Scram to .T.
  1807.  
  1808. La:=SELECT()
  1809. SELECT CLIENT
  1810. IF SCRAM
  1811.    REC_LOCK()       // Need lock to unscramble
  1812.    REC_LOCK()
  1813.    UNSCRAM_CLI(SEED)
  1814. ENDIF
  1815. @  Lin,    4  DCPRINT SAY  CLIREF
  1816. @  Lin,   15  DCPRINT SAY  CLINOM
  1817. @  Lin,   46  DCPRINT SAY  CLIABV
  1818. @  Lin,   53  DCPRINT SAY "Contact"
  1819. @  Lin,   61  DCPRINT SAY CLICONTACT
  1820. @  Lin+2,  4  DCPRINT SAY  CLIRUE
  1821. @  Lin+2, 57  DCPRINT SAY "BANQUE"
  1822. @  Lin+3,  4  DCPRINT SAY  CLIADS
  1823. @  Lin+3, 51  DCPRINT SAY  CLIBANK
  1824. @  Lin+4,  4  DCPRINT SAY  CLICP
  1825. @  Lin+4, 11  DCPRINT SAY  CLIVILLE
  1826. @  Lin+4, 51  DCPRINT SAY  CLIBCODE
  1827. @  Lin+4, 57  DCPRINT SAY  CLIBCGUI
  1828. @  Lin+4, 63  DCPRINT SAY  CLIBNCPT
  1829. @  Lin+4, 75  DCPRINT SAY  CLIBRIB
  1830.  
  1831. @  Lin+6 ,  4  DCPRINT SAY "Tél BUR  : " + CLIPHONE
  1832. @  Lin+6 , 40  DCPRINT SAY "Dom   : "  + CLIPHONED
  1833. @  Lin+7,   4  DCPRINT SAY "   Voit  : " + CLIPHONEV
  1834. @  Lin+7,  40  DCPRINT SAY "Fax   : " + CLIFAX
  1835.  
  1836. @  Lin+8,   4  DCPRINT SAY "Activité : " + CLIPROFESS
  1837. @  Lin+8,  40  DCPRINT SAY "Siret : "  + CLISIRET
  1838.  
  1839. @  Lin+9 ,  4   DCPRINT SAY "Dern. Cde:"
  1840. @  Lin+9 , 15  DCPRINT SAY  DCANNEE
  1841. @  Lin+9 , 24  DCPRINT SAY "TAILLE : " + CLITAILLE
  1842. @  Lin+9 , 41  DCPRINT SAY "Date de Création (MMAA):"
  1843. @  Lin+9 , 66  DCPRINT SAY DATE_CRE PICTURE '9999'
  1844.  
  1845. Lin=Lin+11
  1846. IF .NOT. EMPTY(COMMENTAIR)
  1847.    @  Lin,  4  DCPRINT SAY "COMMENTAIRE"
  1848.    L_CNT=MLCOUNT(COMMENTAIR, 62, 4, .T.)
  1849.    FOR ML=1 TO L_CNT
  1850.       MPL=MEMOLINE(COMMENTAIR,62,ML,4,.T.)
  1851.       @ ML+Lin,4 DCPRINT SAY MPL
  1852.    NEXT
  1853. ENDIF
  1854.  
  1855. Lin=Lin+ML+2
  1856. @ Lin,  4 DCPRINT SAY "DERNIERE VISITE : "
  1857. @ Lin, 22 DCPRINT SAY  CLIENT->DERNVISIT
  1858. @ Lin, 35 DCPRINT SAY "ACTION AVANT LE : "
  1859. @ Lin, 53 DCPRINT SAY CLIENT->RELANCE
  1860.  
  1861. V_String = LAST_VISIT(0,0,.T.)
  1862. IF .NOT. EMPTY(V_String)
  1863.    L_CNT=MLCOUNT(V_String, 62, 4, .T.)
  1864.    FOR ML=1 TO L_CNT
  1865.       MPL=MEMOLINE(V_String, 62, ML, 4, .T.)
  1866.       @ ML+Lin,4 DCPRINT SAY MPL
  1867.    NEXT
  1868. ENDIF
  1869.  
  1870. IF SCRAM
  1871.    SCRAM_CLI(SEED)
  1872.    UNLOCK
  1873. ENDIF
  1874.  
  1875. SELECT(La)
  1876. RETURN .T.
  1877.  
  1878. //
  1879. //----------------------------------------------------------------
  1880. //
  1881. FUNCTION COMC (BONTYPE)   //BONTYPE set in menu ="1" for normal fixed price
  1882.  
  1883. * Auteur...: R M ALCOCK
  1884. * Date.....: 6/3/95
  1885. * Copyright: (c) 1992, R M ALCOCK, Tous droits réservés
  1886. * Notes....: PROGRAMME DE ENREGISTREMENT COMMANDE
  1887. *          : called by COMMENU (MAINMENU)
  1888. *          : MEFRAN MEFRAN
  1889. *          : no PORT in the header
  1890. *          : includes risque, New_Tarif starred out
  1891. *          ;
  1892. DEFAULT BONTYPE TO "1"
  1893. SAVE ALL LIKE BONTYPE TO C:BT
  1894. *
  1895. DO WHILE .T.
  1896.    RESTORE FROM C:BT ADDITIVE     // Clears Local parameters, restores BONTYPE
  1897.    CLEAR
  1898.    MT = CONAME+" - SAISIE COMMANDE"
  1899.    @ 2,40-LEN(MT)/2 SAY MT
  1900.    @ 1,40-2-LEN(MT)/2 TO 3,40+2+LEN(MT)/2 DOUBLE
  1901.    IF .NOT. R_CLI(.T.)
  1902.       RETURN .T.
  1903.    ENDIF
  1904.    CLEAR
  1905.    @ 2,40-LEN(MT)/2 SAY MT
  1906.    @ 1,40-2-LEN(MT)/2 TO 3,40+2+LEN(MT)/2 DOUBLE
  1907.    SELECT CLIENT
  1908.    @ 4,2 SAY CLINOM+" "+CODEPOSTE+" "+VILLE
  1909.    *
  1910.    DO S_COMM WITH BONTYPE
  1911. ENDDO
  1912. RETURN .T.
  1913. *******
  1914.  
  1915. FUNCTION S_COMM (BONTYPE)
  1916. LOCAL t,l,b,r,m_tva:="O"
  1917. *
  1918. *Client is selected and databases open.
  1919. *
  1920. * All saisie comes in here so check risque
  1921. IF CLIENT->CLIRISQUE ="E"
  1922.    ALARM("RISQUE CODE E - COMPTE BLOQUE")
  1923.    RETURN .T.
  1924. ENDIF
  1925. *
  1926. *New_Tarif:=CONFIRM (21,4,"N","NOUVEAUX PRIX")
  1927. New_Tarif:=.F.
  1928. //
  1929. *
  1930. NET_USE (S_COM, "COM",    .F., 30, "COM,COMCL", "BON")
  1931. NET_USE (S_FACTA, "FACTA",  .F., 30, "FACTR", "")
  1932.  
  1933. t=0
  1934. l=0
  1935. b=23
  1936. r=79
  1937. zbuff=" "
  1938. do win with t,l,b,r,zbuff,"SAISIE COMMANDE",""
  1939. //
  1940. SELECT BON
  1941. *
  1942. DO WHILE .T.
  1943.    @ t+1,l+1 CLEAR TO b-1,r-1
  1944.    MCOMM=SPACE(5)
  1945.    @ 2,4 SAY "COMMANDE : " GET MComm ;
  1946.               PICTURE REPLICATE('9',LEN(MComm))
  1947.    READ
  1948.    IF EMPTY(MCOMM)
  1949.       RETURN .T.
  1950.    ENDIF
  1951.    IF X_REF("C"+Mcomm,"BON")
  1952.       ALARM ("COMMANDE EXISTE DEJA")
  1953.       LOOP
  1954.    ENDIF
  1955.    IF .NOT. CONFIRM (21,,"O","CONFIRMATION SAISIE : ")
  1956.       RETURN .T.
  1957.    ENDIF
  1958.    EXIT
  1959. ENDDO
  1960. ADD_REC(0)
  1961. REPLACE COMMANDE WITH "C"+MComm, EXPORT WITH 1, ;
  1962.         D_COMM WITH DATE(), REFCLI WITH CLIENT->CLIREF,;
  1963.         C_STATUS WITH "00", REGION WITH M_Reg
  1964. @ 2,30 SAY CLIENT->CLINOM
  1965. DO WHILE .T.
  1966.    @ 3,2 CLEAR TO 20,78
  1967.    @ 3,4 SAY "Remise EXCEPTIONNELLE (%):" GET REM_SUP RANGE 0,25
  1968.    @ 4,4 SAY "TVA (O/N)                :" GET M_TVA PICTURE '@!';
  1969.                                                     VALID M_TVA $ "ON"
  1970.    @ 6,4 SAY "ATTENTION - TVA et Remise EXCEPTIONNELLE ne peuvent pas être modifiées"
  1971.    READ
  1972.    IF REM_SUP<>0.AND..NOT.CONFIRM(10,,"N","Confirmation REMISE EXCEPTIONNELLE")
  1973.       LOOP
  1974.    ENDIF
  1975.    IF M_TVA='N'.AND..NOT.CONFIRM(10,,"N","Confirmation FACTURATION HORS TAXE")
  1976.       LOOP
  1977.    ENDIF
  1978.    EXIT
  1979. ENDDO
  1980. SELECT BON
  1981. REPLACE COMMENT WITH "TEL:"+CLIENT->CLIPHONE, EXPORT WITH IIF(M_TVA="O",1,0)
  1982. *
  1983. SELECT FACTA
  1984. ADD_REC(0)
  1985. REPLACE FACTURE WITH BON->COMMANDE,LIGNE WITH "99",ARTICLE WITH "+",;
  1986.        TYPE WITH BONTYPE
  1987. UNLOCK
  1988.  
  1989. DO LINESM
  1990.  
  1991. CLEAR
  1992.  
  1993. DO COMM_OUT WITH .T.,.F.
  1994.  
  1995. SELECT BON
  1996.  
  1997. DO RESET_SOLDE WITH "+"
  1998.  
  1999. SELECT BON
  2000. COMMIT
  2001. USE
  2002. SELECT FACTA
  2003. USE
  2004. RETURN .T.
  2005. *
  2006. ************
  2007. //
  2008. //----------------------------------------------------------------
  2009. //
  2010. * Programme: COMMPROC.PRG
  2011. * Auteur...: R M ALCOCK
  2012. * Date.....: 13/01/94
  2013. * Copyright: (c) 1992, R M ALCOCK, Tous droits réservés
  2014. * Notes....: PROCEDURES FOR COMMANDE SAISIE/MODIF
  2015. *          : !!!!!!!!!  line 147 *ed out for test (okflag always .T.)
  2016. *          : PRIXREEL now QUANTITE*PRIXREEL
  2017. *
  2018. *
  2019. FUNCTION ENTETE
  2020. //
  2021. //  SOLDEE and LIMITT set up in COMC
  2022. //
  2023. LOCAL Re
  2024. SELECT BON
  2025.  
  2026. Re=1-BON->REM_SUP/100
  2027.  
  2028. @ 1,0 SAY REFCLI
  2029. @ 1,12 SAY CLIENT->CLINOM
  2030. @ 1,43 SAY IIF (AVOIR,"   AVOIR REF","COMMANDE REF ")
  2031. @ 1,57 SAY COMMANDE
  2032. @ 2,0 SAY "HT : "
  2033. @ 2,5 SAY TOTHT*Re PICTURE '999999.99'
  2034. @ 2,16 SAY "TVA : "
  2035. @ 2,22 SAY TVATOT*Re PICTURE '999999.99'
  2036. IF .NOT. AVOIR
  2037.    @ 2,34 SAY "SOLDE :"
  2038.    @ 2,42 SAY (CLISOLDEE+TOTHT*Re) PICTURE '9999999.99'
  2039.    @ 2,54 SAY "LIMITE :"
  2040.    @ 2,63 SAY ENCOURSMAX PICTURE '999999999.99'
  2041.    IF CLISOLDEE+(TOTHT*Re) > ENCOURSMAX
  2042.      ?CHR(7)
  2043.    ENDIF
  2044. ENDIF
  2045. @ 3,0 SAY REPLICATE("-",75)
  2046. @ 4,0 SAY "ART   LIBELLE                      *  QTE.   PRIX U REM. R PRIX NET     TOTAL HT"
  2047.  
  2048. RETURN .T.
  2049. *
  2050. *****
  2051. **************************
  2052. *
  2053. FUNCTION ECROUT
  2054. PRIVATE I
  2055. IF LN < 18 .AND. .NOT. FORCE
  2056.    RETURN .T.
  2057. ENDIF
  2058. La=SELECT()
  2059. SELECT FACTA
  2060. MF=FACTURE
  2061. @ 5,0 CLEAR
  2062. LN = 0
  2063. IF NSKIP + NLIGNE >=0
  2064.    SKIP NSKIP
  2065. ELSE
  2066.    SKIP -NLIGNE
  2067. ENDIF
  2068. DO WHILE .T.
  2069.    DO LINEOUT
  2070.    SKIP
  2071.    LN=LN+1
  2072.    IF LN >= 5 .OR. EOF() .OR. FACTURE <> MF
  2073.       EXIT
  2074.    ENDIF
  2075. ENDDO
  2076. IF FORCE
  2077.    LN=LN-1
  2078.    SKIP-1
  2079. ENDIF
  2080. SELECT (La)
  2081. RETURN .T.
  2082. *
  2083. ******************************
  2084. *
  2085. FUNCTION LINEOUT
  2086. *
  2087. @ 5+LN,2 SAY ARTICLE
  2088. @ 5+LN,9 SAY LIB PICTURE REPLICATE("X",23)
  2089. I=SUBSTR(ARTICLE,1,1)
  2090. IF I<>"*" .AND. I<>"+" .AND. I<>"-"
  2091.    @ 5+LN,33 SAY QUANTITE
  2092.    @ 5+LN,39 SAY PU
  2093.    @ 5+LN,49 SAY REM_LINE
  2094.    @ 5+LN,54 SAY IIF(REPORT=98,"N","O")
  2095.    @ 5+LN,57 SAY ROUND(PRIXREEL/QUANTITE,2) PICTURE '999999.99'
  2096.    @ 5+LN,69 SAY PRIXREEL PICTURE '999999.99'
  2097.    WAIT
  2098. ENDIF
  2099. RETURN .T.
  2100. *******************************
  2101. *
  2102. FUNCTION LIGNEIN
  2103. * this is only used by AVOC
  2104. *
  2105. * LN = NUMERO LIGNE COURANTE
  2106. * SAISIE LIGNE ARTICLE :
  2107. *
  2108. La=SELECT()
  2109. SELECT FACTA
  2110. Fa=SELECT()
  2111. *CTYPE IS NOT "C" FOR THE FIRST ADDITIONAL LINE ON MODIFICATION
  2112. IF CTYPE = "C"
  2113.    ADD_REC(0)
  2114.  ELSE
  2115.    CTYPE = "C"
  2116. ENDIF
  2117. REC_LOCK(0)
  2118. MART=R_ART (5+LN,0)
  2119. REPLACE FACTURE WITH BON->COMMANDE, TYPE WITH BONTYPE,;
  2120.         ARTICLE WITH MART ,REPORT WITH 60
  2121. DO R_LINE
  2122. SELECT(La)
  2123. RETURN .T.
  2124. *******************************
  2125. *
  2126. FUNCTION R_LINE
  2127. PRIVATE  M_Q, M_R, MTXT, M_RPX
  2128. *
  2129. * Used by both LIGNEIN and LIGNEMOD
  2130. *
  2131. SET ESCAPE OFF
  2132. DO WHILE .T.
  2133.    *LOOP ALLOWS ARTICLE REFERENCE TO BE CHANGED
  2134.    SELECT (Fa)
  2135.    IF SUBSTR(ARTICLE,1,1)="+"
  2136.       REPLACE LIGNE WITH "99"
  2137.       ENDIT = .T.
  2138.       EXIT
  2139.    ENDIF
  2140.    REPLACE LIGNE WITH STR(NLIGNE+1,2)
  2141.    IF ARTICLE = "*"
  2142.       @ 5+LN,2 SAY ARTICLE
  2143.       @ 5+LN,9 GET LIB PICTURE "@S23"
  2144.       READ
  2145.       EXIT
  2146.    ENDIF
  2147.    *
  2148.    IF ARTICLE="-"
  2149.       EXIT
  2150.    ENDIF
  2151.    *
  2152.    *ARTICLE=STFAM+STREF OR = CODE_DIVERS
  2153.    AREF=ARTICLE
  2154.    IF ARTICLE <> CODE_DIVERS
  2155.       *
  2156.       *REAL ARTICLE REFERENCE
  2157.       SELECT STOCK
  2158.       SEEK AREF
  2159.       OKFLAG=.T.
  2160.       IF FOUND()
  2161.         *THE ARTICLE EXISTS IN THE STOCK FILE
  2162.          MPU=IIF(New_Tarif, STPRIXVNEW, STPRIXV)
  2163.  
  2164.          PPROMO = GET_PPROMO()     // returns prix promo (0 if no promotion)
  2165.          IF PPROMO > 0
  2166.             MPU=PPROMO
  2167.             ALARM("PRIX PROMOTION" )
  2168.          ENDIF
  2169.          OKFLAG=.T.
  2170.       ELSE
  2171.          * NON REFERENCED ARTICLE
  2172.          OKFLAG=.F.
  2173.       ENDIF
  2174.       SELECT (Fa)
  2175.       IF OKFLAG
  2176.           REPLACE LIB WITH STOCK->STLIB,;
  2177.             PU WITH MPU,LINETVA WITH STOCK->STTVA,;
  2178.             REM_LINE WITH "00",;
  2179.             FAM_PROD WITH STOCK->STFAM_PROD,REPORT WITH 0
  2180.             //
  2181.           ARTPDS=STOCK->POIDS
  2182.        ELSE
  2183.           AREF = "ERROR"
  2184.           REPLACE ARTICLE WITH ' ',LINETVA WITH 1,REM_LINE WITH "00"
  2185.           ARTPDS=0
  2186.        ENDIF
  2187.    ELSE
  2188.       * ARTICLE IS CODE_DIVERS
  2189.       ARTPDS=0
  2190.       REPLACE LINETVA WITH 1 ,REM_LINE WITH "00"
  2191.    ENDIF
  2192.    *APPLIES TO ALL ARTICLES IN THE CATALOGUE OR NOT
  2193.  
  2194.    DO LINEOUT
  2195.  
  2196.    REPLACE ARTICLE WITH R_ART(5+LN,2,ARTICLE)
  2197.  
  2198.    IF ARTICLE = AREF .AND. AREF <> "ERROR"
  2199.       @ 5+LN,09 GET LIB PICTURE "@S23"
  2200.       @ 5+LN,33 GET QUANTITE VALID QUANTITE > 0 .AND. UPDPRXREEL()
  2201.       @ 5+LN,39 GET PU VALID UPDPRXREEL()
  2202.       @ 5+LN,49 GET REM_LINE PICTURE '99' VALID VAL(REM_LINE) <= MAXREMLN;
  2203.                                                 .AND. UPDPRXREEL()
  2204.       IF .NOT. AVOIR
  2205.          // REPORT used for articles not to be delivered
  2206.          M_RPX = IIF(REPORT=98,"N","O")
  2207.          @ 5+LN, 54 GET M_RPX PICTURE '@!' VALID M_RPX $ "ON"
  2208.          READ
  2209.       ENDIF
  2210.       READ
  2211.       REPLACE REPORT WITH IIF(M_RPX="N",98,0)
  2212.       // you must do this every time
  2213.       UPDPRXREEL()
  2214.       // displays it as well
  2215.  
  2216.       IF BON->EXPORT = 0
  2217.          VALUETVA = 0
  2218.       ELSE
  2219.          IF LINETVA=2
  2220.             VALUETVA = TVARED
  2221.          ELSE
  2222.             VALUETVA = TVARATE
  2223.          ENDIF
  2224.       ENDIF
  2225.       IF .NOT. AVOIR
  2226.          IF ARTICLE = CODE_DIVERS
  2227.             PREFACT = .T.
  2228.          ELSE
  2229.             M_Q=QUANTITE
  2230.             M_R=ARTICLE
  2231.  
  2232.      *       DO CHK_STOK WITH M_R , M_Q
  2233.  
  2234.             * here only reset STPORT if operating on FACTA (ie saisie)
  2235.             IF ALIAS()="FACTA"
  2236.                PREFACT = .T.
  2237.                DO SETPF WITH STOCK->REF,M_Q,.T.,.F.  // incl composes
  2238.                                                            // only STPORT
  2239.             ENDIF
  2240.          ENDIF
  2241.       ENDIF
  2242.       SELECT STOCK
  2243.       UNLOCK
  2244.       SELECT (Fa)
  2245.       ARTTOT=PRIXREEL
  2246.          TOTHT=TOTHT+ARTTOT
  2247.          TOTPDS=TOTPDS+(QUANTITE*ARTPDS)
  2248.          TVATOT = TVATOT +(ARTTOT*VALUETVA)
  2249.       MMQTE=QUANTITE
  2250.       EXIT
  2251.    ENDIF
  2252. ENDDO
  2253. SELECT (Fa)
  2254. UNLOCK
  2255. SET ESCAPE ON
  2256. LN=LN+1
  2257. NLIGNE=NLIGNE+1
  2258. RETURN .T.
  2259. *
  2260. ************
  2261. *
  2262. FUNCTION UPDPRXREEL
  2263.  
  2264. REPLACE PRIXREEL WITH CALCPU(PU) *QUANTITE
  2265. @ 5+LN,57 SAY ROUND(PRIXREEL/QUANTITE,2) PICTURE '999999.99'
  2266. @ 5+LN,69 SAY PRIXREEL PICTURE '999999.99'
  2267.  
  2268. RETURN .T.
  2269. *
  2270. ******
  2271. *
  2272. FUNCTION CALCPU
  2273.  
  2274. PRIVATE mprix
  2275.  
  2276. MPRIX=PU*(100-VAL(REM_LINE))/100
  2277.  
  2278. RETURN MPRIX
  2279.  
  2280. *****************
  2281. *
  2282. FUNCTION GET_PPROMO()           // CLIENT  and STOCK positioned
  2283.                                 // works on today's date
  2284. LOCAL La,MCLREF,MSREF,PP
  2285. La=SELECT()
  2286. SELECT TARIFT
  2287. USE
  2288. NET_USE (S_PROMOS, "PROMOS", .F., 0, "PROMOS", "")
  2289. MCLREF=CLIENT->CLIREF
  2290. MSREF=STOCK->STCOMMREF
  2291. PP=0
  2292. SEEK MSREF+MCLREF
  2293. IF FOUND() .AND.  D_FIN>=SYSDATE() .AND. D_DEBUT<=DATE()
  2294.    PP=PRIXPROMO
  2295. ENDIF
  2296. NET_USE (S_TARIFT,"TARIFT", .F., 0, "TARIFT", "")         // restore TARIFT
  2297. SELECT (La)                     // restore entry conditions
  2298. RETURN PP                       // prom prix or 0
  2299. ******************
  2300. *
  2301. FUNCTION LIGNEMOD
  2302. LOCAL La, OLDART
  2303. *
  2304. * LN = NUMERO LIGNE COURANTE
  2305. * MODIFY LIGNE ARTICLE :
  2306. *
  2307. La=SELECT()
  2308. SELECT TEMPLN
  2309. Fa=SELECT()
  2310. OLDART=ARTICLE
  2311. OLDN = QUANTITE
  2312. OLDP = QUANTITE * PU
  2313. OLDREP = REPORT
  2314. BONTYPE=TYPE
  2315. LN=ROW()-5             // Offset of 4 in R_LINE
  2316. CTYPE="M"
  2317. REC_LOCK(0)
  2318. MC=COL()
  2319. *@ ROW(),0 CLEAR TO ROW(),79
  2320. MART=R_ART(5+LN,2)                  // Get new reference
  2321. IF MART=SPACE(LEN(STOCK->STCOMMREF)).OR.MART=OLDART
  2322.    UNLOCK
  2323.    RETURN .T.
  2324. ENDIF
  2325. REPLACE ARTICLE WITH MART
  2326. *
  2327. IF LIGNE="99"
  2328.    IF SUBSTR(ARTICLE,1,1)="-"
  2329.       REPLACE ARTICLE WITH "+"      // Can't delete last line!
  2330.    ELSE
  2331.       ** Replace last record i.e. add a new one
  2332.       RN=RECNO()
  2333.       ADD_REC(0)
  2334.       REPLACE FACTURE WITH BON->COMMANDE, TYPE WITH BONTYPE,;
  2335.               LIGNE WITH "99", ARTICLE WITH "+"
  2336.       GO RN
  2337.       REPLACE LIGNE WITH STR(RN,2)
  2338.    ENDIF
  2339. ENDIF
  2340. IF AT(SUBSTR(ARTICLE,1,1),"-+")=0   // Deleted Article or last line
  2341.    NLIGNE=VAL(LIGNE)-1              // Reset by R_LINE
  2342.    DO R_LINE
  2343. ENDIF
  2344. *
  2345. CHANGED = .T.
  2346. *
  2347. SELECT(La)
  2348. RETURN .T.
  2349. *
  2350. *******************************
  2351. *
  2352. FUNCTION C_TOTPDS
  2353. *
  2354. *  TOTPDS already zero from calling prog, and  first line  is selected
  2355.  
  2356. LOCAL La,mp
  2357. La=SELECT()
  2358.  
  2359. DO WHILE FACTURE=BON->COMMANDE .AND. .NOT. EOF()
  2360. *   IF REPORT =0
  2361.       AREF=ARTICLE
  2362.       SELECT STOCK
  2363.       SEEK AREF
  2364.       IF FOUND()
  2365.          mp=POIDS
  2366.       ELSE
  2367.          mp=0
  2368.       ENDIF
  2369.       SELECT (La)
  2370.       TOTPDS = TOTPDS+(QUANTITE*mp)
  2371. *   ENDIF
  2372.    SKIP
  2373. ENDDO
  2374. SELECT (La)
  2375. RETURN .T.
  2376. *
  2377. ****************
  2378. *
  2379. FUNCTION UPSTATS
  2380. LOCAL La
  2381. *
  2382. *RESETS TOT_POIDS  only in BON
  2383. *
  2384. La=SELECT()
  2385. SELECT BON
  2386. REPLACE TOT_POIDS WITH TOTPDS
  2387. SELECT (La)
  2388. RETURN .T.
  2389. *
  2390. **********************************
  2391. *
  2392. FUNCTION RESET_SOLDE (SIGN)                   // of client
  2393. // assumes client locked
  2394. LOCAL La, MAJVAL
  2395. La=SELECT()
  2396.  
  2397. SELECT BON
  2398. MAJVAL = MONTANT*(1-(REM_SUP/100))   // val now in BON
  2399. SELECT CLIENT
  2400. IF SIGN="+"
  2401.    REPLACE CLISOLDE WITH CLISOLDE + MAJVAL
  2402. ELSE
  2403.    REPLACE CLISOLDE WITH CLISOLDE - MAJVAL
  2404. ENDIF
  2405. SELECT (La)
  2406. RETURN .T.
  2407. *
  2408. ********************
  2409. *
  2410. FUNCTION COMM_OUT (MAJ,MODCLI)    // .T. if update allowed, .T. if you can
  2411.  
  2412. * this is called by saisie/modify commande and PFACT, and AVOC
  2413. * MONTANT is the TTC FROM SAISIE LINES
  2414. * need to know if refcli is changeable so second param exists
  2415. * for saisie MODCLI is .F. . You can't modify the client from the comm system
  2416. * MODCLI is only .T. for modify from mainmenu , or PFACT , or AVOC
  2417. * can't change the commande ref. or the montant
  2418.  
  2419. LOCAL ro, MREF,MREFCLI,TXT
  2420. SET ESCAPE OFF
  2421. IF PCOUNT()=0
  2422.    MAJ    =.F.
  2423.    MODCLI =.F.
  2424. ENDIF
  2425. IF PCOUNT()=1
  2426.    MODCLI =.F.
  2427. ENDIF
  2428. *
  2429. SELECT BON
  2430. IF .NOT. MAJ
  2431.    SET INTENSITY OFF
  2432. ELSE
  2433.    REC_LOCK()
  2434. ENDIF
  2435. *
  2436. *
  2437. IF SELECT("BON")=S_AVO
  2438.    TXT = "AVOIR"
  2439. ELSEIF SELECT("BON")=S_FACT
  2440.    TXT = "FACT."
  2441. ELSE
  2442.    TXT = "COMM."
  2443. ENDIF
  2444. @ 2,4 SAY TXT +"  : "+COMMANDE
  2445. IF MAJ .AND. MODCLI
  2446.    DO WHILE .T.
  2447.       MREFCLI=REFCLI
  2448.       @ 2,29 SAY "CLIENT :" GET MREFCLI
  2449.       READ
  2450.       IF VAL(MREFCLI)=VAL(REFCLI)
  2451.          EXIT
  2452.       ENDIF
  2453.       SELECT CLIENT
  2454.  
  2455.       MREF =MREFCLI
  2456.  
  2457.       SEEK MREF
  2458.       IF .NOT. FOUND()
  2459.          ALARM("CLIENT INCONNU")
  2460.          SELECT BON
  2461.          LOOP
  2462.       ELSE
  2463.          SELECT BON
  2464.          REPLACE REFCLI WITH MREF
  2465.          EXIT
  2466.       ENDIF
  2467.    ENDDO
  2468.    CLEAR GETS
  2469.    SET INTENSITY ON
  2470. ENDIF
  2471. // loop which follows is to check the integrity of the ttc and the echeances
  2472. //
  2473. DO WHILE .T.
  2474.   @ 2,29 SAY "CLIENT : " +REFCLI
  2475.   @ ROW(),COL()+2 SAY  CLIENT->CLINOM
  2476.   @ ROW()+1,25 SAY "CLIENT REF : " GET CLI_COMM
  2477.   ro=ROW()
  2478.   scolor=SETCOLOR()
  2479.   IF CLIENT->CLIRISQUE <>" "
  2480.      SETCOLOR("*"+scolor)
  2481.      @ 22,74 SAY "RISQ"
  2482.      IF MAJ
  2483.        ?CHR(7)
  2484.      ENDIF
  2485.   ELSE
  2486.      @ 22,74 SAY "    "
  2487.   ENDIF
  2488.   SETCOLOR(scolor)
  2489. *  @ ro+2,4 SAY " STATUS   : "+C_STATUS
  2490.   IF SELECT("BON")=S_AVO .OR. SELECT("BON")=S_FACT
  2491.      @ ro+2,4 SAY "DATE "+TXT+":" GET D_COMM  RANGE ;
  2492.       CTOD("01/" + STR(MONTH(SYSDATE()),2) +"/" + STR(YEAR(SYSDATE())-1900,2)),;
  2493.       SYSDATE()
  2494.   ELSE
  2495.      @ ro+2,4 SAY "DATE "+TXT+" :" GET D_COMM
  2496.   ENDIF
  2497.  
  2498.   @ ROW(),COL()+8 SAY "DATE DEPART   : " GET D_LIVR
  2499.   @ ROW()+1,4 SAY " TVA (O/N):  " + IIF(BON->EXPORT=0,"N","O")
  2500.   @ ROW(),COL()+4 SAY " % REMISE SUP :"
  2501.   @ ROW(),COL()+1 SAY REM_SUP
  2502. *  IF SELECT("BON")<>S_AVO
  2503. *    @ ROW(),COL()+10 SAY  "REGL. GROUPE   :" GET REGL_GRP PICTURE "@!" ;
  2504. *                                         VALID AT(REGL_GRP,"G ")>0
  2505. *  ENDIF
  2506.   @ ROW()+1,8 SAY "VRP   : " GET REGION VALID REGION<>SPACE(4)
  2507.   @ ROW(),COL()+2 SAY " MONTANT TTC :"
  2508.   @ ROW(),COL()+1 SAY STR(MONTANT*(1-REM_SUP/100),10,2)  PICTURE '9999999.99'
  2509.   @ ROW()+2,4 SAY "LIVRAISON :" GET LIVR_NOM
  2510.   @ ROW()+1,16 GET LIVR_RUE
  2511.   @ ROW()+1,16 GET LIVR_ADS
  2512.   @ ROW()+1,16 GET LIVR_CP
  2513.   @ ROW(),COL()+3 GET LIVR_VILLE
  2514.   IF SELECT("BON")=S_AVO
  2515.     IF MAJ
  2516.       READ
  2517.       UNLOCK
  2518.     ELSE
  2519.       CLEAR GETS
  2520.     ENDIF
  2521.     EXIT
  2522.   ENDIF
  2523.   // not for avoirs
  2524.   @ ROW()+2,4 SAY "Remarques :" GET COMMENT
  2525.   @ ROW()+1,4 SAY "Remarques :" GET COMMENT2
  2526.  
  2527.   @ ROW()+2, 4 SAY "ECHEANCES :"
  2528.  
  2529.   @ ROW()+1,4      GET MECH1
  2530.   @ ROW(),COL()+2  GET CP1   VALID IIF(MECH1=0, CP1=" ", CP1$"0235679")
  2531.   @ ROW(),COL()+2  GET DECH1 VALID (EMPTY(DECH1).AND. MECH1=0) .OR.;
  2532.                              ( DECH1>=D_COMM .AND. DECH1<D_COMM+120 )
  2533.  
  2534.   @ ROW(),COL()+3  GET MECH2
  2535.   @ ROW(),COL()+2  GET CP2   VALID IIF(MECH2=0, CP2=" ", CP2$"0235679")
  2536.   @ ROW(),COL()+2  GET DECH2 VALID (EMPTY(DECH2).AND. MECH2=0) .OR.;
  2537.                              ( DECH2>=D_COMM .AND. DECH2<D_COMM+120 )
  2538.  
  2539.   @ ROW(),COL()+3  GET MECH3
  2540.   @ ROW(),COL()+2  GET CP3   VALID IIF(MECH3=0, CP3=" ", CP3$"0235679")
  2541.   @ ROW(),COL()+2  GET DECH3 VALID (EMPTY(DECH3).AND. MECH3=0) .OR.;
  2542.                              ( DECH3>=D_COMM .AND. DECH3<D_COMM+120 )
  2543.  
  2544.   @ ROW()+1,4      GET MECH4
  2545.   @ ROW(),COL()+2  GET CP4   VALID IIF(MECH4=0, CP4=" ", CP4$"0235679")
  2546.   @ ROW(),COL()+2  GET DECH4 VALID (EMPTY(DECH4).AND. MECH4=0) .OR.;
  2547.                              ( DECH4>=D_COMM .AND. DECH4<D_COMM+120 )
  2548.  
  2549.   @ ROW(),COL()+3  GET MECH5
  2550.   @ ROW(),COL()+2  GET CP5   VALID IIF(MECH5=0, CP5=" ", CP5$"0235679")
  2551.   @ ROW(),COL()+2  GET DECH5 VALID (EMPTY(DECH5).AND. MECH5=0) .OR.;
  2552.                              ( DECH5>=D_COMM .AND. DECH5<D_COMM+120 )
  2553.  
  2554.   @ ROW(),COL()+3  GET MECH6
  2555.   @ ROW(),COL()+2  GET CP6   VALID IIF(MECH6=0, CP6=" ", CP6$"0235679")
  2556.   @ ROW(),COL()+2  GET DECH6 VALID (EMPTY(DECH6).AND. MECH6=0) .OR.;
  2557.                              ( DECH6>=D_COMM .AND. DECH6<D_COMM+120 )
  2558.  
  2559.   @ ROW()+1,4      GET MECH7
  2560.   @ ROW(),COL()+2  GET CP7   VALID IIF(MECH7=0, CP7=" ", CP7$"0235679")
  2561.   @ ROW(),COL()+2  GET DECH7 VALID (EMPTY(DECH7).AND. MECH7=0) .OR.;
  2562.                              ( DECH7>=D_COMM .AND. DECH7<D_COMM+120 )
  2563.  
  2564.   @ ROW(),COL()+3  GET MECH8
  2565.   @ ROW(),COL()+2  GET CP8   VALID IIF(MECH8=0, CP8=" ", CP8$"0235679")
  2566.   @ ROW(),COL()+2  GET DECH8 VALID (EMPTY(DECH8).AND. MECH8=0) .OR.;
  2567.                              ( DECH8>=D_COMM .AND. DECH8<D_COMM+120 )
  2568.  
  2569.   @ ROW(),COL()+3  GET MECH9
  2570.   @ ROW(),COL()+2  GET CP9   VALID IIF(MECH9=0, CP9=" ", CP9$"0235679")
  2571.   @ ROW(),COL()+2  GET DECH9 VALID (EMPTY(DECH9).AND. MECH9=0) .OR.;
  2572.                              ( DECH9>=D_COMM .AND. DECH9<D_COMM+120 )
  2573.  
  2574.   @ ROW()+1,4      GET MECH10
  2575.   @ ROW(),COL()+2  GET CP10   VALID IIF(MECH10=0, CP10=" ", CP10$"0235679")
  2576.   @ ROW(),COL()+2  GET DECH10 VALID (EMPTY(DECH10).AND. MECH10=0) .OR.;
  2577.                              ( DECH10>=D_COMM .AND. DECH10<D_COMM+120 )
  2578.  
  2579.   @ ROW(),COL()+3  GET MECH11
  2580.   @ ROW(),COL()+2  GET CP11   VALID IIF(MECH11=0, CP11=" ", CP11$"0235679")
  2581.   @ ROW(),COL()+2  GET DECH11 VALID (EMPTY(DECH11).AND. MECH11=0) .OR.;
  2582.                              ( DECH11>=D_COMM .AND. DECH11<D_COMM+120 )
  2583.  
  2584.   @ ROW(),COL()+3  GET MECH12
  2585.   @ ROW(),COL()+2  GET CP12   VALID IIF(MECH12=0, CP12=" ", CP12$"0235679")
  2586.   @ ROW(),COL()+2  GET DECH12 VALID (EMPTY(DECH12).AND. MECH12=0) .OR.;
  2587.                              ( DECH12>=D_COMM .AND. DECH12<D_COMM+120 )
  2588.  
  2589.   IF MAJ
  2590.      READ
  2591.      IF .NOT. CHK_TTC()
  2592.          LOOP
  2593.      ENDIF
  2594.      UNLOCK
  2595.      SELECT CLIENT
  2596.      REPLACE DCANNEE WITH BON->D_COMM,;
  2597.              CLISTATUS WITH "1"      // Force update to Florensac
  2598.      SELECT BON
  2599.      EXIT
  2600.   ELSE
  2601.      CLEAR GETS
  2602.      EXIT
  2603.   ENDIF
  2604. ENDDO
  2605. SET INTENSITY ON
  2606. SET ESCAPE ON
  2607. *
  2608. RETURN .T.
  2609. *
  2610. *************
  2611. FUNCTION CHK_TTC
  2612. LOCAL Totech,Mval
  2613. Totech=MECH1+MECH2+MECH3+MECH4+MECH5+MECH6+MECH7+MECH8+MECH9+MECH10+;
  2614.             MECH11+MECH12 
  2615. IF Totech=0 .AND. MONTANT=0
  2616.    RETURN .T.
  2617. ENDIF
  2618. Mval= ROUND(MONTANT*(1-REM_SUP/100),2)
  2619. IF ABS(Mval-Totech)>0.001
  2620.     @ 0,0 SAY " "
  2621.     ALARM("Total des echéances = " + STR(Totech,10,2)+" TTC = "+STR(Mval,10,2))
  2622.     // this is OK if reglement is grouped only
  2623.     IF REGL_GRP="G"
  2624.        RETURN .T.
  2625.     ELSE
  2626.        RETURN .F.
  2627.     ENDIF
  2628. ENDIF
  2629. RETURN .T.
  2630. *
  2631. //
  2632. //-----------------------------------------------------------------
  2633. //
  2634. * Programme: LITPROC.PRG
  2635. * Auteur...: R M ALCOCK
  2636. * Date.....: 13 MAY
  2637. * Copyright: (c) 1992, R M ALCOCK, Tous droits réservés
  2638. * Notes....: PROCEDURES for LITIGE system
  2639. *
  2640. *
  2641. FUNCTION LIT_INIT
  2642. *
  2643. NET_USE (S_LITIGE, "LITIGE", .T., 30, "", "")
  2644. IF .NOT. FILE("LITIGE.NTX")
  2645.    INDEX ON CODE TO LITIGE
  2646. ENDIF
  2647. IF .NOT. FILE("LITDATE.NTX")
  2648.    INDEX ON A_DATE TO LITDATE
  2649. ENDIF
  2650. IF .NOT. FILE("LITCLI.NTX")
  2651.    INDEX ON CLIENT TO LITCLI
  2652. ENDIF
  2653. NET_USE (S_LITIGE, "LITIGE", .F., 30, "", "")
  2654. FIL_LOCK(0)
  2655. SET INDEX TO LITIGE,LITDATE,LITCLI
  2656. UNLOCK
  2657. NET_USE (S_LITREG, "LITREG", .F., 0, "", "")
  2658. NET_USE (S_LITCOD, "LITCOD", .F., 0, "", "")
  2659. SELECT LITIGE
  2660. RETURN .T.
  2661. *
  2662. **************************************
  2663. *
  2664. FUNCTION CRELIT
  2665. *
  2666. LOCAL HM:="C O N T A C T  - CREATION", MCODE, M_Type
  2667. SELECT LITCOD
  2668. M_Type = RMAMENU(HM,MRCODE,LCD)      // Get Type of record
  2669. DO HLOFF WITH LCD
  2670. CLEAR
  2671. M_Type = ALLTRIM(LIBELLE)
  2672. //
  2673. IF M_Type<>""
  2674.  
  2675.    NET_USE (S_ATTACH, "ATTACH", .T., 0, "", "")
  2676.    MCODE = "95"+PAD(STR(VISITNUM,4) , 4)
  2677.    REPLACE VISITNUM WITH IIF(VISITNUM<9999, VISITNUM+1, 1)
  2678.    USE
  2679.  
  2680.    SELECT LITIGE
  2681.    ADD_REC(0)
  2682.    REPLACE REGION WITH M_Reg, D_ECR WITH DATE(), CODE WITH MCODE,;
  2683.                     RESP WITH M_Resp, CLIENT WITH MCLI, TYPE WITH M_Type
  2684.    DO LITFMT WITH 1           // Read date, Label, Memo
  2685. *   READ
  2686.    //
  2687.    // Create an EVENT record and attach it to the client
  2688.    //
  2689.    SELECT EVENT
  2690.    ADD_REC (0)
  2691.    STORE_EVENT()
  2692.    SELECT CLIENT
  2693.    REPLACE DERNVISIT WITH LITIGE->D_ECR,;
  2694.            RELANCE   WITH LITIGE->A_DATE,;
  2695.            CLISTATUS WITH "1"
  2696.    ALARM ("CONTACT ENREGISTRE")
  2697.  
  2698. ENDIF
  2699. SELECT LITIGE
  2700. USE
  2701. SELECT LITCOD
  2702. USE
  2703. SELECT LITREG
  2704. USE
  2705.  
  2706. RETURN .T.
  2707. *
  2708. ******
  2709. FUNCTION LECRAN
  2710. *
  2711. * Used by LITFMT to display a record
  2712.  
  2713. *
  2714. DO HLON
  2715. @  2, 2  SAY  "DATE   : "
  2716. @  2,12  SAY  D_ECR
  2717. @  2, 40  SAY "ACTION AVANT LE :"
  2718. DO HLOFF WITH LCD
  2719. @  2, 58  SAY  LITIGE->A_DATE
  2720. @  4, 2  SAY  "CLIENT :"
  2721. @  4, 11  SAY  LITIGE->CLIENT
  2722. IF .NOT. EMPTY(LITIGE->CLIENT)
  2723.   @  4, 23  SAY CLIENT->CLIABV+" "+CLIENT->CLINOM
  2724. ENDIF
  2725. @  6,  2  SAY "VRP    :"
  2726. @  6, 11  SAY  LITIGE->REGION
  2727. @  6, 17  SAY "CODE :"
  2728. @  6, 24  SAY  LITIGE->CODE
  2729. @  6, 32  SAY "TYPE :"
  2730. @  6, 39  SAY  LITIGE->TYPE
  2731.  
  2732. IF LITIGE->TYPE $ "IMPAYEE,LITIGE"
  2733.    @  8, 2   SAY "FACTURE:"
  2734.    @  8, 11  SAY  LITIGE->FACTURE
  2735.    @  8, 22  SAY "MONTANT:"
  2736.    @  8, 31  SAY LITIGE->MONTANT
  2737. ENDIF
  2738. @ 11,  1  SAY "COMMENTAIRE :"
  2739. *
  2740. RETURN .T.
  2741. *
  2742. //
  2743. //------------------------------------------------------------------------
  2744. //
  2745. FUNCTION PRINT_L
  2746. *
  2747. @  2, 2  DCPRINT SAY  "DATE   : "
  2748. @  2,12  DCPRINT SAY  D_ECR
  2749. @  2,40  DCPRINT SAY "ACTION AVANT LE :"
  2750. @  2,58  DCPRINT SAY  LITIGE->A_DATE
  2751. @  4, 2  DCPRINT SAY  "CLIENT :"
  2752. @  4,11  DCPRINT SAY  LITIGE->CLIENT
  2753. IF .NOT. EMPTY(LITIGE->CLIENT)
  2754.   @  4, 23  DCPRINT SAY CLIENT->CLIABV+" "+CLIENT->CLINOM
  2755. ENDIF
  2756. @  6,  2  DCPRINT SAY "VRP    :"
  2757. @  6, 11  DCPRINT SAY  LITIGE->REGION
  2758. @  6, 17  DCPRINT SAY "CODE :"
  2759. @  6, 24  DCPRINT SAY  LITIGE->CODE
  2760. @  6, 32  DCPRINT SAY "TYPE :"
  2761. @  6, 39  DCPRINT SAY  LITIGE->TYPE
  2762.  
  2763. IF LITIGE->TYPE $ "IMPAYEE,LITIGE"
  2764.    @  8, 2   DCPRINT SAY "FACTURE:"
  2765.    @  8, 11  DCPRINT SAY  LITIGE->FACTURE
  2766.    @  8, 22  DCPRINT SAY "MONTANT:"
  2767.    @  8, 31  DCPRINT SAY LITIGE->MONTANT
  2768. ENDIF
  2769. @ 11,  1  DCPRINT SAY "COMMENTAIRE :"
  2770. *
  2771. RETURN .T.
  2772. *
  2773. //
  2774. //--------------------------------------------------------------------------------
  2775. //
  2776. FUNCTION LITFMT (CONTROL)
  2777. *
  2778. * Control = 1   Creation, don't read REGION, CODE, RESP
  2779. * Control = 2   Modif, all parameters except D_ECR and CODE can be changed
  2780. * Control = 3   Deletion, no read
  2781. *
  2782. LOCAL abuff
  2783. REC_LOCK(0)
  2784.  
  2785. IF Control=1
  2786.    // Create
  2787.    do win with 0,0,23,79,abuff, "CREATION "+ALLTRIM(EVENT->TYPE)
  2788. ENDIF
  2789.  
  2790. DO LECRAN                        // OUTPUT Screen Format
  2791. @ 12,  1  TO 12, 10
  2792. MEMOEDIT(LITIGE->COMMENTAIR,13,1,21,78,.F.,.F.,74)
  2793. IF CONTROL=3                     // CONTROL=3 No Gets
  2794.    RETURN .T.
  2795. ENDIF
  2796. @  2, 12  GET  LITIGE->D_ECR  RANGE DATE()-300, DATE()
  2797. @  2, 58  GET  LITIGE->A_DATE RANGE DATE(),DATE()+500
  2798. IF LITIGE->TYPE $ "IMPAYEE,LITIGE"
  2799.    @  8, 11  GET  LITIGE->FACTURE
  2800.    @  8, 31  GET  LITIGE->MONTANT
  2801. ENDIF
  2802. READ
  2803.  
  2804. IF LASTKEY()<>K_ESC
  2805.    // Operate on Memo field
  2806.    @ 11,18 CLEAR TO 21,78
  2807.    DO HLON
  2808.    @ 23,31 SAY "   F1 pour Aide   " //spaces to overwrite old message
  2809.    DO HLOFF WITH LCD
  2810.    ED_MEMO()         // FUNCTION used so that HELP can decode situation
  2811. ENDIF
  2812.  
  2813. IF UPDATED()
  2814.  
  2815.    IF LITIGE->D_ECR > CLIENT->DERNVISIT
  2816.       REPLACE CLIENT->DERNVISIT WITH LITIGE->D_ECR,;
  2817.               CLIENT->CLISTATUS WITH "1"
  2818.    ENDIF
  2819.    IF CLIENT->RELANCE > LITIGE->A_DATE
  2820.       REPLACE CLIENT->RELANCE   WITH LITIGE->A_DATE,;
  2821.               CLIENT->CLISTATUS WITH "1"
  2822.    ENDIF
  2823.  
  2824.    SELECT EVENT
  2825.    SEEK LITIGE->CODE
  2826.    IF FOUND()
  2827.       STORE_EVENT()
  2828.    ENDIF
  2829. ENDIF
  2830.  
  2831. UNLOCK
  2832. IF Control=1
  2833.    // Create
  2834.    do wout with 0,0,23,79,abuff
  2835. ENDIF
  2836.  
  2837. RETURN .T.
  2838. ***
  2839. FUNCTION LITCLI()
  2840. LOCAL La,R:=.T.
  2841. La=SELECT()
  2842. IF EMPTY(LITIGE->CLIENT)
  2843.    RETURN .T.
  2844. ENDIF
  2845. SELECT CLIENT
  2846. SEEK LITIGE->CLIENT
  2847. IF .NOT. FOUND()
  2848.   R= .F.
  2849. ELSE
  2850.   DO LECRAN
  2851. ENDIF
  2852. SELECT (La)
  2853. RETURN R
  2854. ****
  2855. //
  2856. //------------------------------
  2857. //
  2858. FUNCTION STORE_EVENT()
  2859. //
  2860. LOCAL M_Sel:=SELECT()
  2861. SELECT LITCOD
  2862. LOCATE FOR CODE = EVENT->TYPE
  2863. SELECT EVENT
  2864. REPLACE REFCLI WITH LITIGE->CLIENT,;
  2865.         D_CRE  WITH LITIGE->D_ECR,;
  2866.         TYPE   WITH LITIGE->TYPE,;
  2867.         BONREF WITH LITIGE->CODE
  2868. SELECT (M_Sel)
  2869. RETURN .T.
  2870. //
  2871. //------------------------------
  2872. //
  2873. FUNCTION ED_MEMO()
  2874. LOCAL bBlock
  2875. //
  2876. // Only exists so the HELP system will work !!!
  2877. //
  2878. bBlock = SetKey( K_F1, { || help_me ( ProcName(), ProcLine(), "COMMENTAIR" ) } )
  2879. REPLACE COMMENTAIR WITH MEMOEDIT(COMMENTAIR,13,1,21,78,.T.)
  2880. SetKey ( K_F1, bBlock)
  2881. RETURN .T.
  2882. //
  2883. //-----------------------------------------------------------
  2884. //
  2885.  
  2886. * Programme: COMMENT. PRG   (was proc T_COMMENT in MAIN)
  2887. * Auteur...: R M ALCOCK
  2888. * Date.....: 3/3/95
  2889. * Copyright: (c) 1995, R M ALCOCK, Tous droits réservés
  2890. * Notes....: Used by MAIN and MAINMENU
  2891. *
  2892. *
  2893. FUNCTION T_COMMENT (CONTROL)
  2894.  
  2895. LOCAL La,MA[4],MBUFF1:="",MBuff2:="",MCHOIX
  2896. LOCAL t:=17,l:=57,b:=22,r:=75             // Menu Position
  2897. LOCAL TL:=5, LM:=5, RM:=76, BM:=23        // Comment Screen
  2898. LOCAL oPrinter, bBlock
  2899.  
  2900. La=SELECT()
  2901. SELECT CLIENT
  2902. MA[1]="RETOUR   "
  2903. MA[2]="Modifier "
  2904. MA[3]="Imprimer "
  2905. MA[4]="Supprimer"
  2906. *
  2907. DO WIN WITH TL,LM,BM,RM,MBUFF2,"COMMENTAIRE",""   // Preserve outside screen
  2908.  
  2909. MEMOEDIT(COMMENTAIR,TL+1,LM+2,BM-1,RM-2,.F.,.F.)  // Display the memo
  2910. bBlock = SetKey( K_F1, { || help_me ( ProcName(), ProcLine(), "COMMENTAIR" ) } )
  2911. *
  2912. DO WHILE .T.
  2913.    DO WIN WITH t,l,b,r,MBUFF1,"COMMENTAIRE",""    // Preserve the memo
  2914.    IF CONTROL=1                          // Creation
  2915.       MCHOIX=2                           // Force an edit
  2916.       CONTROL=0                          // Normal next time
  2917.    ELSE
  2918.       SET COLOR TO &MENUCLR
  2919.       MCHOIX=ACHOICE(t+1,l+2,b-1,r-1,MA)
  2920.       DO HLOFF WITH LCD                  // Get Colour back
  2921.    ENDIF
  2922.    DO WOUT WITH t,l,b,r,MBUFF1           // Get back memo without menu
  2923.    DO CASE
  2924.       CASE MCHOIX=0.OR.MCHOIX=1          // RETOUR
  2925.          SELECT(La)
  2926.          EXIT
  2927.       CASE MCHOIX=2                      // Modifier
  2928.          @ 23,34 SAY "F1 pour Aide"
  2929.          REPLACE COMMENTAIR WITH MEMOEDIT(COMMENTAIR,TL+1,LM+2,BM-1,RM-2,.T.)
  2930.          REPLACE CLISTATUS WITH "1"      // Force update to Florensac
  2931.  
  2932.       CASE MCHOIX=3                      // Imprimer
  2933.  
  2934.          DCPRINT ON TO oPrinter
  2935.  
  2936.          @ 2,4 DCPRINT SAY "COMMENTAIRE Client : " +CLIENT->CLIREF
  2937.          @ PROW(),PCOL()+2 DCPRINT SAY CLINOM
  2938.          L_CNT=MLCOUNT(COMMENTAIR, 62, 4, .T.)
  2939.          FOR ML=1 TO L_CNT
  2940.              MPL=MEMOLINE(COMMENTAIR,62,ML,4,.T.)
  2941.              @ ML+4,4 DCPRINT SAY MPL
  2942.          NEXT
  2943.          DCPRINT EJECT
  2944.          
  2945.          DCPRINT OFF
  2946.          
  2947.  
  2948.       CASE MCHOIX=4                      // Efface memo
  2949.          IF CONFIRM (21,3,"N","EFFACE COMMENTAIRE : ")
  2950.             REPLACE COMMENTAIR WITH ""
  2951.             REPLACE CLISTATUS WITH "1"   // Force update to Florensac
  2952.          ENDIF
  2953.          @ 21,3 CLEAR TO 21,79
  2954.       OTHERWISE
  2955.    ENDCASE
  2956. ENDDO
  2957. DO WOUT WITH TL,LM,BM,RM,MBUFF2
  2958. SetKey ( K_F1, bBlock)
  2959. SELECT (La)
  2960. RETURN .T.
  2961. //
  2962. //----------------------------------------------------------------
  2963. //
  2964. FUNCTION COMM
  2965. * Auteur...: R M ALCOCK
  2966. * Date.....: 6/3/95
  2967. * Copyright: (c) 1992, R M ALCOCK, Tous droits réservés
  2968. * Notes....: Modification Command (MEFRAN)
  2969. *                         ---
  2970. *
  2971. * First Choose the Commande
  2972. *
  2973. DO WHILE .T.
  2974.    CLEAR
  2975.    SELECT BON
  2976.    SET CURSOR ON
  2977.    MCOM=SPACE(LEN(COMMANDE))
  2978.    MT = CONAME+" - MODIFICATION COMMANDE"
  2979.    @ 2,40-LEN(MT)/2 SAY MT
  2980.    @ 1,40-2-LEN(MT)/2 TO 3,40+2+LEN(MT)/2 DOUBLE
  2981.  
  2982.    @ ROW()+6,14 SAY "Commande REFERENCE :";
  2983.                 GET MCOM
  2984.    READ
  2985.    IF MCOM=SPACE(LEN(COMMANDE))
  2986.       RETURN .T.
  2987.    ENDIF
  2988.    *
  2989.    *
  2990.    SET ORDER TO 1
  2991.    SEEK MCOM
  2992.    IF .NOT. FOUND()
  2993.       @ 12,14 SAY "COMMANDE N'EXISTE PAS - Tapez une touche"
  2994.       WAIT " "
  2995.       LOOP
  2996.    ENDIF
  2997.    * Commande Selected, do Modif.
  2998.    t=0
  2999.    l=0
  3000.    b=23
  3001.    r=79
  3002.    zbuff=" "
  3003.    REC_LOCK(0)
  3004.    * as in ZCC
  3005.    do win with t,l,b,r,zbuff,"COMMANDE"
  3006.    * client is not yet selected
  3007.    SELECT CLIENT
  3008.    SEEK BON->REFCLI
  3009.    SELECT BON
  3010.    DO COMM_OUT
  3011.    SET CURSOR OFF
  3012.    DO COMMMENU
  3013.    do wout with t,l,b,r,zbuff
  3014. ENDDO
  3015. RETURN .T.
  3016. *
  3017. ****************************************
  3018. *
  3019. FUNCTION COMMMENU (MODCLI)
  3020. *.......................................
  3021. *
  3022. LOCAL MA[4],MBUFF1,t,l,b,r,MCHOIX,MSEL,DEL:=.F.
  3023. MODCLI=IIF (PCOUNT()=0,.T.,.F.)
  3024.                    // If called from F2 in Commercial system PCOUNT
  3025.                    // can never be zero because it is automatically set
  3026.                    // to the name of the calling routine, therefore
  3027.                    // if not set, the call is from COMM
  3028. *
  3029. MCHOIX=1           // Selction Code in Menu
  3030. MSEL=SELECT()
  3031. SELECT BON
  3032. *
  3033. do keysoff
  3034. t=12
  3035. l=52
  3036. b=17
  3037. r=72
  3038. MBUFF1=""
  3039. MA[1]="RETOUR   "
  3040. MA[2]="Modifier En-tête"
  3041. MA[3]="         Lignes"
  3042. MA[4]="Supprimer"
  3043. DO WHILE .T.
  3044.    DO WIN WITH t,l,b,r,MBUFF1,"",""
  3045.    SET COLOR TO &MENUCLR
  3046.    //
  3047.    // Should test the status here to deal with blocked commandes - STATUS 40
  3048.    //
  3049.    MCHOIX=ACHOICE(t+1,l+2,b-1,r-1,MA)
  3050.    DO WOUT WITH t,l,b,r,MBUFF1
  3051.    DO HLOFF WITH LCD
  3052.    DO CASE
  3053.       CASE MCHOIX=0.OR.MCHOIX=1
  3054.          SELECT(MSEL)
  3055.          IF .NOT. MODCLI
  3056.             set key K_F2 to COMMMENU  // If MODCLI=.F. called from MAIN
  3057.          ENDIF
  3058.          RETURN .T.
  3059.       CASE MCHOIX=2
  3060.          SET CURSOR ON
  3061.          IF VAL(BON->C_STATUS)=40
  3062.            ALARM("COMMANDE BLOQUEE")
  3063.          ELSE
  3064.            IF VAL(BON->C_STATUS)>9
  3065.              ALARM("ATTENTION!! DEJA FACTUREE")
  3066.            ENDIF
  3067.          ENDIF
  3068.          DO COMM_OUT WITH .T.,MODCLI
  3069.          SET CURSOR OFF
  3070.       CASE MCHOIX=3
  3071.          SET CURSOR ON
  3072.          IF VAL(BON->C_STATUS)<>0
  3073.             ALARM("BON DEJA ENVOYEE A FLORENSAC")
  3074.          ENDIF
  3075. *         IF VAL(BON->C_STATUS)=10
  3076. *            ALARM("ATTENTION!! DEJA FACTUREE")
  3077. *         ENDIF
  3078.          IF VAL(BON->C_STATUS)=40
  3079.            ALARM("COMMANDE BLOQUEE")
  3080.          ENDIF
  3081.          DO LINESM                   // Modification Lines
  3082.          IF Changed .AND. VAL(BON->C_STATUS)=0
  3083.             CLEAR
  3084.             DO COMM_OUT WITH .T., .F.
  3085.          ENDIF
  3086.          SET CURSOR OFF
  3087.       CASE MCHOIX=4                  // DELETE
  3088.                                      // only packs COM, FACTA packed at FDM
  3089.          IF VAL(C_STATUS)<>09
  3090.             ALARM("COMMANDE DEJA ENVOYEE A FLORENSAC - ANNULATION INTERDIT")
  3091.          ELSE
  3092.             @ b-3,l+1 TO b-1,l+19 DOUBLE
  3093.             IF CONFIRM (20,,"N","CONFIRMATION SUPPRESSION COMMANDE ? ")
  3094.                IF MONTH(D_COMM)=MONTH(MDAT_MAX)
  3095.                   DEL =.T.                         // this month's cde
  3096.                ENDIF
  3097.                DO RESET_SOLDE WITH "-"
  3098.                SELECT BON
  3099.                AREF=COMMANDE
  3100.                REC_LOCK(0)
  3101.                IF DEL
  3102.                  DELETE
  3103.                ELSE
  3104.                 * REPLACE C_STATUS WITH "99"    always delete for now,
  3105.                  DELETE
  3106.                ENDIF
  3107.                UNLOCK
  3108.                SELECT FACTA
  3109.                SEEK AREF
  3110.                DO WHILE FACTURE=AREF .AND. .NOT. EOF()
  3111.                   REC_LOCK(0)
  3112.                   IF SUBSTR(ARTICLE,1,1)<>"+"
  3113.                      OLDART=ARTICLE
  3114.                      OLDQTE=QUANTITE
  3115.                      OLDREP=REPORT
  3116.                      REPLACE REPORT WITH 99       // so as not to do SETPF
  3117.                      DO RESETPF
  3118.                   ENDIF
  3119.                   IF DEL
  3120.                     DELETE
  3121.                   ENDIF
  3122.                   UNLOCK
  3123.                   SKIP
  3124.                ENDDO
  3125.                UNLOCK
  3126.                SELECT(MSEL)
  3127.                DO WOUT WITH t,l,b,r,MBUFF1
  3128.                KEYBOARD CHR(27)+CHR(27)     //Force Terminate
  3129.                RETURN .T.
  3130.             ENDIF
  3131.          ENDIF
  3132.    ENDCASE
  3133.    SET CURSOR OFF
  3134.    Do HLON                     // Equivalent of WIN to make correct Frame
  3135.    @ 0,0 clear to 23,79
  3136.    @ 0,0 to 23,79 double
  3137.    @ 0,32 say "COMMANDE"
  3138.    @ 23,31 SAY "Esc pour terminer"
  3139.    Do HLOFF WITH LCD
  3140.    DO COMM_OUT WITH .F.        // Visualise
  3141. ENDDO
  3142. RETURN .T.
  3143. *
  3144. ****************************************
  3145. *
  3146. FUNCTION LINESM
  3147. *.......................................
  3148. *
  3149. Local Blq:=.F.,MAJMONT,TOTHT,TOTTARIF
  3150.  
  3151. CLEAR
  3152. SELECT BON
  3153. AREF=COMMANDE
  3154. SELECT FACTA
  3155. SEEK AREF
  3156. COPY TO C:TEMPLN WHILE FACTURE=AREF
  3157. UNLOCK
  3158. NET_USE (S_TEMPLN, "C:TEMPLN",  .T., 30, "", "")
  3159. MREC=RECCOUNT()
  3160. Fa=SELECT()
  3161. *
  3162. *FIRST SELECT THE RECORD
  3163. *
  3164. PRIVATE fbuff[8],tbuff[8],sbuff[8]
  3165. Fbuff[1]="ARTICLE"
  3166. Fbuff[2]="LIB"
  3167. Fbuff[3]="QUANTITE"
  3168. Fbuff[4]="PU"
  3169. Fbuff[5]="REM_LINE"
  3170. Fbuff[6]="IIF(REPORT=98,'N','O')"
  3171. Fbuff[7]="PRIXREEL/QUANTITE"
  3172. Fbuff[8]="PRIXREEL"
  3173.    *
  3174. Tbuff[1]="ART"
  3175. Tbuff[2]="LIBELLE"
  3176. Tbuff[3]=" QTE."
  3177. Tbuff[4]="   PRIX U"
  3178. Tbuff[5]="REM "
  3179. Tbuff[6]="LI"
  3180. Tbuff[7]=" PRIX NET"
  3181. Tbuff[8]="  TOTAL NET"
  3182. *
  3183. Sbuff[2]="@S23 "
  3184. Sbuff[3]="9999"
  3185. Sbuff[5]="99"
  3186. Sbuff[7]="@Z ######.##"
  3187. Sbuff[8]="@Z ########.##"
  3188. *
  3189. PUBLIC Changed,PREFACT,TOTPDS,Recalc
  3190. //
  3191. Recalc=.F.
  3192. Changed=.F.
  3193. PREFACT=.F.
  3194. TOTPDS =0                    // in fact TOTPDS is recalculated if MAJ
  3195. SET CURSOR OFF
  3196. IF SELECT("BON")=S_AVO
  3197.    @ 1,0 SAY "AVOIR    : " +AREF
  3198. ELSE
  3199.    @ 1,0 SAY "COMMANDE : " +AREF
  3200. ENDIF
  3201.  
  3202. @ 1,20 SAY CLIENT->CLINOM
  3203. *
  3204. My_DBEDIT(3,0,21,79,Fbuff,"RMAED",Sbuff,Tbuff,"-"," ")
  3205. //
  3206. SUM PRIXREEL TO TOTHT FOR AT(SUBSTR(ARTICLE,1,1),"-*")=0
  3207. * .AND. REPORT=0
  3208. TOTHT=TOTHT*(1-BON->REM_SUP/100)
  3209. SUM PU*QUANTITE TO TOTTARIF FOR AT(SUBSTR(ARTICLE,1,1),"-*")=0
  3210. * .AND. REPORT=0
  3211. *
  3212. TVATOT =IIF(BON->EXPORT=0,0,TOTHT*TVARATE)
  3213. TVATTOT=IIF(BON->EXPORT=0,0,TOTTARIF*TVARATE)
  3214. IF BON->MONTANT=0
  3215.    // remise is  TARIF-NET which is not O if there is a remise line
  3216.    // or a rem sup
  3217.    Remis=(TOTTARIF-TOTHT)/TOTTARIF
  3218. ELSE
  3219.    Remis=(TVATTOT+TOTTARIF-(BON->MONTANT*(1-BON->REM_SUP/100)));
  3220.           /(TVATTOT+TOTTARIF)
  3221. ENDIF
  3222. //  must come out of the next bit with majmont set up
  3223. SET CURSOR ON
  3224. @ 20,0 CLEAR TO 20,79
  3225. IF BON->REM_SUP>0
  3226.   ALARM("Remise exceptionnelle sur la commande = " +STR(BON->REM_SUP,5,2) +" %")
  3227. ENDIF
  3228. @ 20, 1      SAY "TARIF TTC :" +STR(TVATTOT+TOTTARIF,10,2)
  3229. @ 20,COL()+2 SAY "NET TTC :"   +STR(TVATOT+TOTHT,10,2)
  3230. @ 20,COL()+2 SAY "NET HT :"    +STR(TOTHT,10,2)
  3231. @ 20,65      SAY "Remise :"    +STR(Remis*100,5,1)+"%"
  3232. //
  3233. // now proposes in the box either the sum of all prixreels after remsup
  3234. // or the previous montant after rem_sup
  3235. //
  3236. MM=IIF(BON->MONTANT=0,TVATOT+TOTHT,;
  3237.                       ROUND(BON->MONTANT*(1-BON->REM_SUP/100),2))
  3238. Remis=(TVATTOT+TOTTARIF-MM)/(TVATTOT+TOTTARIF)
  3239.  
  3240. IF VAL(BON->C_STATUS)=0 .AND.(Remis*100 > MAXREM1 .OR.;
  3241.      .NOT. CONFIRM (21,,"N","Montant TTC à facturer ? " + STR(MM,11,2)))
  3242.  
  3243.     DO WHILE .T.
  3244.        Blq=.F.
  3245.        @ 22,65 CLEAR TO 23,79
  3246.        SET ESCAPE OFF
  3247.        @ 21,10 SAY "Tapez le montant à facturer :" GET MM PICTURE '99999999.99'
  3248.        READ
  3249.        Remis=(TVATTOT+TOTTARIF-MM)/(TVATTOT+TOTTARIF)
  3250.        @ 20,65      SAY "Remise :"    +STR(Remis*100,5,1)+"%"
  3251.        IF SELECT("BON")<>S_AVO
  3252.           IF Remis*100 > MAXREM1
  3253.              ALARM("REMISE EN DEPASSEMENT")
  3254.              Blq=.T.
  3255.           ENDIF
  3256.        ENDIF
  3257.        ANS="N"
  3258.        @ 22,10 SAY "Confirmation ? (O/N)? " GET ANS
  3259.        READ
  3260.        IF UPPER(ANS)="O"
  3261.           MAJMONT=MM
  3262.           IF Blq
  3263.              ALARM("LA COMMANDE SERA BLOQUEE")
  3264.              Changed =.T.
  3265.           ENDIF
  3266.           EXIT
  3267.        ELSE
  3268.           @ 21,0 CLEAR TO 23,79
  3269.           LOOP
  3270.        ENDIF
  3271.     ENDDO
  3272. ENDIF
  3273. MAJMONT=MM
  3274. SET ESCAPE ON
  3275.  
  3276. IF  MAJMONT<>BON->MONTANT*(1-BON->REM_SUP/100)
  3277.     Changed=.T.
  3278.     Recalc=.T.
  3279. ENDIF
  3280. IF Changed
  3281.    Ln=IIF(RECCOUNT()>15,21,RECCOUNT()+5)
  3282.    DO HLON
  3283.    @ Ln,25 TO Ln+3,54 DOUBLE
  3284.    DO HLOFF WITH LCD
  3285.    CHOIX=1
  3286.    @ Ln+1,28 PROMPT "Mise à jour des fichiers"
  3287.    @ Ln+2,28 PROMPT "Abandon sans mise à jour"
  3288.    MENU TO CHOIX
  3289.    *
  3290.    @ Ln+1,28 CLEAR TO Ln+2,53
  3291.    @ Ln+1,28 SAY "Patientez S.V.P. ......"
  3292.    *
  3293.    IF CHOIX=2                     // abandon
  3294.       Changed = .F.
  3295.    ELSE                           // M A J
  3296.       SELECT BON                  //moved 27/1
  3297.       REC_LOCK(0)
  3298.       REPLACE MONTANT WITH MAJMONT/(1-REM_SUP/100)
  3299.       UNLOCK
  3300.       SELECT TEMPLN
  3301.       DO RECALCPR                 // Mod of 3/1/95 ....
  3302.  
  3303.       TOTPDS=0
  3304.       GO TOP
  3305.       DO C_TOTPDS                  // calcs TOTPDS for all lines report=0 or not
  3306.                                    // whether in TEMPLN or FACTA
  3307.       IF Blq
  3308.          SELECT BON
  3309.          REC_LOCK(0)
  3310.          REPLACE C_STATUS WITH "40"
  3311.          UNLOCK
  3312.       ENDIF
  3313.       SELECT TEMPLN
  3314.       SET RELATION TO FACTURE+LIGNE INTO FACTA
  3315.       GO TOP
  3316.       DO WHILE RECNO()<MREC
  3317.         * CLEAR
  3318.          SELECT FACTA
  3319.          REC_LOCK()
  3320.          REC_LOCK()
  3321.          OLDQTE=QUANTITE
  3322.          OLDART=ARTICLE
  3323.          OLDREP=REPORT
  3324.          REPLACE  ARTICLE WITH TEMPLN->ARTICLE, QUANTITE WITH TEMPLN->QUANTITE,;
  3325.                LIB WITH TEMPLN->LIB, PU WITH TEMPLN->PU
  3326.          REPLACE REPORT WITH TEMPLN->REPORT,PRIXREEL WITH TEMPLN->PRIXREEL,;
  3327.                 TYPE WITH TEMPLN->TYPE,REM_LINE WITH TEMPLN->REM_LINE,;
  3328.                 LINETVA WITH TEMPLN->LINETVA
  3329.          UNLOCK
  3330.          IF  OLDQTE<>QUANTITE .OR. OLDART<>ARTICLE .OR. OLDREP<>REPORT
  3331.             IF OLDREP<>REPORT .AND. REPORT=0
  3332.                // something has changed from delai to immed
  3333.                    PREFACT=.T.
  3334.             ENDIF
  3335.             IF REPORT=0 .AND. SUBSTR(OLDART,1,1)="+" .AND.;
  3336.                 AT(SUBSTR(ARTICLE,1,1),"-*")=0
  3337.                 // last line been changed to a real immediate thing
  3338.                 PREFACT=.T.
  3339.             ENDIF
  3340.             IF REPORT=0 .AND. SUBSTR(OLDART,1,1)="*" .AND.;
  3341.               AT(SUBSTR(ARTICLE,1,1),"-*+")=0
  3342.               // a comment line has been changed to a real immediate thing
  3343.               PREFACT=.T.
  3344.             ENDIF
  3345.  
  3346.             IF SELECT("BON")<>S_AVO
  3347.                  DO RESETPF                   // which does SETPF as well
  3348.             ENDIF
  3349.          ENDIF        // change with "ACTION"
  3350.          SELECT TEMPLN
  3351.          SKIP
  3352.       ENDDO
  3353.       *
  3354.       IF RECCOUNT()>MREC          // Records have been added
  3355.          GO TOP
  3356.          DELETE NEXT MREC-1       // The old "+" record is now re-used
  3357.          GO TOP
  3358.          DELETE FOR SUBSTR(ARTICLE,1,1)="+"
  3359.          PACK
  3360.          IF SELECT("BON")<>S_AVO
  3361.             Fa=SELECT()
  3362.             GO TOP
  3363.             OLDART=SPACE(6)
  3364.             OLDQTE=0
  3365.             DO WHILE .NOT. EOF()
  3366.               IF AT(SUBSTR(ARTICLE,1,1),"+-*")=0
  3367.                  DO RESETPF
  3368.               ENDIF
  3369.               SKIP
  3370.            ENDDO
  3371.          ELSE
  3372.            // Avoirs, do nothing
  3373.          ENDIF
  3374.          USE                  // releases templn
  3375.          SELECT FACTA
  3376.          APPEND FROM C:TEMPLN       // Just the additions
  3377.          SELECT (Fa)               // templn
  3378.       ENDIF          // of added lines in TEMPLN
  3379.  
  3380.       // next bit deals with PREFACT
  3381.  
  3382.       IF PREFACT .AND. (BON->C_STATUS="09" .OR. BON->C_STATUS="10")
  3383.         // at least one line of an entirely delayed commande is to be delivered
  3384.         // and the bon did not come out last time
  3385.          // or this commande is already factured for a partial delivery
  3386.         SELECT BON
  3387.         REC_LOCK()
  3388.         REPLACE C_STATUS WITH "00"
  3389.         UNLOCK
  3390.         SELECT  (Fa)           // dummy
  3391.       ENDIF
  3392.       //
  3393.       // now the bottom bit
  3394.       //
  3395.         SELECT (Fa)      // need this
  3396.    ENDIF     // maj fich
  3397. ENDIF        // of changed
  3398. SELECT(Fa)
  3399. USE           // release templn
  3400. *
  3401.  
  3402. SET CURSOR ON
  3403. ERASE C:TEMPLN.DBF
  3404. CLEAR TYPEAHEAD
  3405. RETURN .T.
  3406.  
  3407. *
  3408. ********
  3409. FUNCTION RECALCPR
  3410. // starts off by resetting ALL prixreels
  3411. // takes the ttc and resets PRIXREEL proportionally in FACTA or TEMPLN
  3412. // with rounding so that the sum of all the lines=ttc/1.186
  3413. // BON is COM AND THE RIGHT DATABASE MUST BE SELECTED  !!!!!!!
  3414.  
  3415. Local La,Re,Diff,Remis,FRED,R_MEM
  3416. La=SELECT()
  3417. *SELECT FACTA              // Mod of 3/1/95 ....
  3418. R_MEM=RECNO()
  3419. GO TOP                     // Mod of 3/1/95 ....
  3420. *SEEK BON->COMMANDE        // Mod of 3/1/95 ....
  3421. Re=RECNO()
  3422. DO WHILE FACTURE=BON->COMMANDE .AND. .NOT. EOF()
  3423.    REC_LOCK()
  3424.    IF AT(SUBSTR(ARTICLE,1,1),"*-+")>0
  3425.       REPLACE PRIXREEL WITH 0,REM_LINE WITH "00",PU WITH 0,QUANTITE WITH 0
  3426.    ELSE
  3427.       REPLACE PRIXREEL WITH CALCPU(PU)*QUANTITE
  3428.    ENDIF
  3429.    UNLOCK
  3430.    SKIP
  3431. ENDDO
  3432. GO Re
  3433. SUM REST PRIXREEL TO MREEL WHILE FACTURE=BON->COMMANDE
  3434. FRED=IIF(BON->EXPORT=0,0,TVARATE)
  3435. MREEL=MREEL*(1-BON->REM_SUP/100)
  3436. MNETHT=ROUND(BON->MONTANT*(1-BON->REM_SUP/100)/(1+FRED),2)
  3437. IF MREEL<>MNETHT
  3438.    // PRIXREEL NEEDS ADJUSTING
  3439.    Remis=(MREEL-MNETHT)/MREEL
  3440.    GO Re
  3441.    DO WHILE .NOT. EOF() .AND. FACTURE=BON->COMMANDE
  3442.      IF AT(SUBSTR(ARTICLE,1,1),"+-*")=0
  3443.         REC_LOCK(0)
  3444.         REPLACE PRIXREEL WITH ROUND(PRIXREEL*(1-Remis),2)
  3445.         UNLOCK
  3446.      ENDIF
  3447.      SKIP
  3448.    ENDDO
  3449.    // check it
  3450.    GO re
  3451.    SUM REST PRIXREEL TO MREEL  WHILE FACTURE=BON->COMMANDE
  3452.    IF MREEL<>MNETHT
  3453.       Diff=MREEL - MNETHT
  3454.       IF ABS(Diff)>0.005
  3455.          ALARM("RECTIFICATION PRIX REEL (en francs)= " +STR(DIFF,9,2))
  3456.       ENDIF
  3457.       GO Re
  3458.       IF AT(SUBSTR(ARTICLE,1,1),"+*-")=0
  3459.         LOCATE REST FOR PRIXREEL>0 WHILE FACTURE=BON->COMMANDE
  3460.           // get the first one
  3461.       ENDIF
  3462.       REC_LOCK(0)
  3463.       REPLACE PRIXREEL WITH PRIXREEL-Diff
  3464.       UNLOCK
  3465.    ENDIF
  3466.    GO Re
  3467. ENDIF
  3468. GO R_MEM     // Position FACTA on the original record
  3469. SELECT(La)
  3470. RETURN .T.
  3471. *
  3472.  
  3473. **************
  3474. FUNCTION RESETPF
  3475.  
  3476. * resets STPORT for OLDART AND OLDQTE (modified lines)
  3477. * irrespective of changes in REPORT
  3478. * All commandes are in STPORT for ANJOU
  3479. * you know it must be done or else you wouldn't be here.
  3480. * never changes the STREEL
  3481.  
  3482. LOCAL Fa
  3483. PRIVATE NEWART,NEWQTE
  3484. RETURN .T.         // Not needed for Portables
  3485. Fa=SELECT()
  3486. NEWART=ARTICLE
  3487. NEWQTE=QUANTITE
  3488. SELECT STOCK
  3489. IF OLDART<>SPACE(6).AND. OLDART<>CODE_DIVERS .AND.(AT(SUBSTR(OLDART,1,1),"-*")=0)
  3490.     SEEK OLDART
  3491.     REC_LOCK(0)
  3492.     REPLACE STPORT WITH STPORT-OLDQTE
  3493.     UNLOCK
  3494. ENDIF
  3495. *
  3496. SELECT (Fa)
  3497. DO SETPF WITH NEWART,NEWQTE,.T.,.F.         // for NEWQTE of modif or saisie
  3498. RETURN .T.
  3499. *
  3500. ****************
  3501.  
  3502. FUNCTION RMAED
  3503. PARAMETERS status, fld_ptr
  3504. PRIVATE a_request,ARTTOT,OLDART,OLDN,OLDP,OLDREM,OLDRP,TOTHT,TVATOT,;
  3505.         CTYPE,NLIGNE,ENDIT,AVOIR
  3506. * PREFACT = .F.
  3507. AVOIR = .F.
  3508. TOTHT = 0
  3509. TVATOT= 0
  3510. *TOTPDS=0
  3511. LN=0
  3512. NLIGNE=0
  3513. ENDIT = .F.
  3514. *CTYPE SET FOR LIGNEIN
  3515. *CTYPE="C"
  3516. key_stroke=LASTKEY()
  3517. DO CASE
  3518.    CASE status=0
  3519.       a_request=1
  3520.    CASE status=1
  3521.       a_request=1
  3522.    CASE status=2
  3523.       a_request=1
  3524.    CASE status=3
  3525.       a_request=1
  3526.    CASE status=4
  3527.       a_request=KeyExcept(key_stroke)
  3528. ENDCASE
  3529. RETURN a_request
  3530. *
  3531. FUNCTION KeyExcept (action_key)
  3532. LOCAL M_RPX
  3533. *
  3534. DO CASE
  3535.    CASE action_key=K_ESC.OR.action_key=K_F9
  3536.       RETURN 0                             // Terminate DBEDIT
  3537.  
  3538.    otherwise
  3539.       IF fld_ptr>=7                        // Can't edit PRIXREEL or TOTAL
  3540.          TONE(100,1)
  3541.          RETURN 1
  3542.       ENDIF
  3543.       IF SUBSTR(ARTICLE,1,1)="-"
  3544.          TONE(100,1)                       // Can't edit deleted article
  3545.          RETURN 1
  3546.       ENDIF
  3547.  
  3548.       if action_key <> K_ENTER
  3549.          keyboard CHR(action_key)
  3550.       endif
  3551.  
  3552.       IF fld_ptr<>1
  3553.          SET CURSOR ON
  3554.          OLDLIB=LIB
  3555.          OLDQTE=QUANTITE
  3556.          OLDPU=PU
  3557.          OLDRP=REPORT
  3558.          OLDREM=REM_LINE
  3559.          MREF=ARTICLE
  3560.          IF fld_ptr=6
  3561.             // REPORT used for articles not to be delivered
  3562.             M_RPX = IIF(OLDRP=98,"N","O")
  3563.             @ROW(),COL() GET M_RPX PICTURE '@!' VALID M_RPX $ "ON"
  3564.             READ
  3565.             REPLACE REPORT WITH IIF(M_RPX="N",98,0)
  3566.          ELSE
  3567.             field_name=Fbuff[fld_ptr]
  3568.             @ROW(),COL() GET &field_name PICTURE Sbuff[fld_ptr]
  3569.             READ
  3570.          ENDIF
  3571.          SET CURSOR OFF
  3572.          IF OLDQTE<>QUANTITE.OR.PU<>OLDPU.OR.OLDRP<>REPORT.OR.OLDREM<>REM_LINE
  3573.             Changed=.T.
  3574.             Recalc=.T.   // set marker to recalculate PRIXREEL
  3575.             REPLACE PRIXREEL WITH CALCPU(PU)*QUANTITE
  3576.          ENDIF
  3577.          IF OLDLIB<>LIB
  3578.             Changed=.T.
  3579.          ENDIF
  3580.          RETURN 2
  3581.       ELSE
  3582.           *
  3583.           * It is the Article
  3584.           SET CURSOR ON
  3585.           DO LIGNEMOD
  3586.           SET CURSOR OFF
  3587.           RETURN 2
  3588.           *
  3589.       ENDIF
  3590.  
  3591. ENDCASE
  3592. RETURN 0
  3593. //
  3594. //-------------------------------------------------------------------
  3595. //
  3596. FUNCTION  FACT (MAJ,Av)
  3597.  
  3598. * Auteur...: R M ALCOCK
  3599. * Date.....: August 31
  3600. * Copyright: (c) 1992, R M ALCOCK, Tous droits réservés
  3601. * Notes....: FACTURE /AVOIR (not FACTURATION !) visu / modif
  3602. *          : now a file by itself and not a procedure file
  3603. *
  3604.  
  3605. LOCAL La
  3606. La=SELECT()
  3607. SELECT BON
  3608.  
  3609. DEFAULT MAJ TO .F.
  3610. DEFAULT Av  TO .F.
  3611.  
  3612. IF .NOT. MAJ
  3613.    SET INTENSITY OFF
  3614. ELSE
  3615.    REC_LOCK()
  3616. ENDIF
  3617. *
  3618. *
  3619. IF Av
  3620.    @ 3,4 SAY " AVOIR    : "+FACTURE  +"  du  "
  3621.    @ ROW(), COL() GET DFACT RANGE  ;
  3622.       CTOD("01/" + STR(MONTH(SYSDATE()),2) +"/" + STR(YEAR(SYSDATE())-1900,2)),;
  3623.        SYSDATE()
  3624.  
  3625. ELSE
  3626.  
  3627.    @ 3,4 SAY " FACTURE  : "+FACTURE+"/"+ECH+"  du  "
  3628.    @ ROW(), COL() GET DFACT  RANGE  ;
  3629.       CTOD("01/" + STR(MONTH(SYSDATE()),2) +"/" + STR(YEAR(SYSDATE())-1900,2)),;
  3630.        SYSDATE()
  3631.  
  3632. ENDIF
  3633. @ ROW()+2,4 SAY " V.R.P.   :" GET REGION
  3634. @ ROW()+1,4 SAY " COMMANDE :" GET COMMANDE
  3635. @ ROW(),COL()+4 SAY "CLIENT :"+REFCLI+"  "+ CLIENT->CLINOM
  3636. @ ROW()+1,4 SAY " STATUS   : "
  3637. IF VAL(C_STATUS)>0
  3638.    @ ROW(),COL() GET C_STATUS
  3639. ELSE
  3640.    @ ROW(),COL() SAY C_STATUS
  3641. ENDIF
  3642. IF .NOT. Av
  3643.   @ ROW(),COL()+4 SAY "DATE COMMANDE  :" GET D_COMM
  3644. ENDIF
  3645. @ ROW(),COL()+4 SAY "REF :" GET CLI_COMM
  3646. @ ROW()+1,4 SAY " EXPORT   :" GET FACT->EXPORT
  3647. @ ROW(),COL()+5 SAY "DATE LIVRAISON :" GET D_LIVR
  3648. @ ROW(),COL()+4 SAY " % REMISE SUP :" GET REM_SUP
  3649. @ ROW()+1,4 SAY " POIDS    :"
  3650. @ ROW(),COL() GET TOT_POIDS
  3651. *@ ROW(),COL()+6 SAY " PORT  :" GET PORT
  3652. @ ROW()+2,4 SAY "LIVRAISON :" GET LIVR_NOM
  3653. @ ROW()+1,16 GET LIVR_RUE
  3654. @ ROW()+1,16 GET LIVR_ADS
  3655. @ ROW()+1,16 GET LIVR_CP
  3656. @ ROW(),COL()+3 GET LIVR_VILLE
  3657.  
  3658. @ ROW()+2,4 SAY "TOTAL TTC : "
  3659. @ ROW(),COL()+1 GET MONTANT RANGE 0,9999999
  3660. IF .NOT. Av
  3661. *   @ ROW(),COL()+4 SAY "   NOMBRE ECH. :" GET NUM_ECH
  3662.    @ ROW(),COL()+4 SAY "CODE PAIEMENT  :" GET CP1
  3663.  
  3664.    @ ROW()+2,4 SAY "ECHEANCE  : "
  3665.    @ ROW(),COL()+1 GET MECH1 RANGE 0,9999999
  3666.    @ ROW(),COL()+4 SAY " DATE ECHEANCE : "
  3667.    @ ROW(),COL()+1 GET DECH1
  3668. ENDIF
  3669. @ ROW(),COL()+6 SAY "REGLE : "
  3670. IF VAL(C_STATUS)>0
  3671.    @ ROW(),COL()+1 GET RECH1 PICTURE "Y"
  3672. ELSE
  3673.    @ ROW(),COL()+1 SAY RECH1
  3674. ENDIF
  3675. IF MAJ
  3676.    READ
  3677.    UNLOCK
  3678. ELSE
  3679.    CLEAR GETS
  3680. ENDIF
  3681.  
  3682. SET INTENSITY ON
  3683.  
  3684. SELECT (La)
  3685. RETURN .T.
  3686.  
  3687. //
  3688. //-------------------------------------------------------------------
  3689. //
  3690.  
  3691. FUNCTION SETPF (NEWART,NEWQTE,DOSTPORT,DOSTREEL)
  3692.  
  3693. * Auteur...: R M ALCOCK
  3694. * Date.....: 22 April 1994
  3695. * Copyright: (c) 1994, R M ALCOCK, Tous droits réservés
  3696. * Notes....: Procedure which was in COMPROC and now is here for the facturation
  3697. *          : STOCK and STCOMP must be opened
  3698. *
  3699. LOCAL Fa
  3700. //
  3701. // If DOSTPORT it ADDS NEWQTE to STPORT
  3702. // If DOSTREEL then it ADDS NEWQTE to STREEL, this is for avoirs with maj stock
  3703. // locks and unlocks
  3704. // FACTA must be selected
  3705. //
  3706. Fa = SELECT ()
  3707. SELECT STOCK
  3708. IF NEWART<>CODE_DIVERS .AND. SUBSTR(NEWART,1,1)<>"-".AND. SUBSTR(NEWART,1,1)<>"*"
  3709.    SEEK NEWART
  3710.    IF FOUND()
  3711.       REC_LOCK(0)
  3712.       IF DOSTPORT
  3713.           REPLACE STPORT WITH STPORT+NEWQTE
  3714.       ENDIF
  3715.       IF DOSTREEL .AND. STTYP="S"             // S for stocked articles ANJOU
  3716.          REPLACE STREEL WITH STREEL + NEWQTE
  3717.       ENDIF
  3718.       UNLOCK
  3719.    ENDIF
  3720. ENDIF
  3721.  
  3722. SELECT(Fa)
  3723. RETURN .T.
  3724. //
  3725. //--------------------------------------------------------------------------
  3726. //
  3727. * Programme: HELPPRG.PRG
  3728. * Auteur...: R M ALCOCK
  3729. * Date.....: 26/11/93
  3730. * Copyright: (c) 1993, R M ALCOCK, Tous droits réservés
  3731. * Notes....: HELP system
  3732. *
  3733. *
  3734. FUNCTION help_me ( mproc,The_line,The_var )
  3735. local t,l:=0,b,r:=79, zbuff:="", mr,mcol,mht:= {}, choix:=1
  3736. LOCAL C_String
  3737.  
  3738. mr=row()                            // Save current cursor posn.
  3739. mcol=col()
  3740. ml=1                                // Most help just one line
  3741. * Get rid of alias from The_Var
  3742. The_Var = IIF (at(">",The_Var)=0, The_Var, substr(The_Var, at(">",The_Var)+1, len(The_Var)))
  3743. //
  3744. // Handle COMMENT as a special case
  3745. //
  3746. IF mproc="T_COMMENT".OR. The_Var="COMMENTAIR" .OR. mproc="ED_MEMO"
  3747.    //
  3748.    // C_String is pairs of control characters to send to MEMOEDIT
  3749.    //
  3750.    C_String :=         CHR(0)+CHR(0)  +CHR(23)+CHR(27) +CHR(27)+CHR(27)
  3751.    C_String=C_String + CHR(25)+CHR(0) +CHR(20)+CHR(0)  +CHR(2)+CHR(0)
  3752.  
  3753.    t=15
  3754.    l=48
  3755.    b=22
  3756.    do win with t,l,b,r,zbuff,"AIDE"
  3757.  
  3758.    @ t+1,     l+3 PROMPT "Continuer la modification"
  3759.    @ ROW()+1, L+3 PROMPT "Sauve et Terminer"
  3760.    @ ROW()+1, L+3 PROMPT "Terminer sans sauvegarde"
  3761.    @ ROW()+1, L+3 PROMPT "Efface Ligne"
  3762.    @ ROW()+1, L+3 PROMPT "Efface Mot"
  3763.    @ ROW()+1, L+3 PROMPT "Reformatage Paragraphe"
  3764.    MENU TO CHOIX
  3765.  
  3766.    CHOIX=CHOIX*2-1
  3767.    KEYBOARD SUBSTR(C_String, CHOIX, 2)
  3768.  
  3769.    do wout with t,l,b,r,zbuff
  3770.    @mr,mcol say ""                     // Reset cursor position
  3771.    return .T.
  3772. ENDIF
  3773.  
  3774. ALARM (mproc+" "+str(The_line)+" "+The_var)
  3775.  
  3776.  
  3777. t=10
  3778. l=4
  3779. b=t+10
  3780. r=l+40
  3781. do win with t,l,b,r,zbuff,"AIDE"
  3782.  
  3783. @ t+1,     l+3 PROMPT "Sélection CLient(s)"
  3784. @ ROW()+1, L+3 PROMPT "Profession / Activité"
  3785. @ ROW()+1, L+3 PROMPT "Choisir un article"
  3786. @ ROW()+1, L+3 PROMPT "Modification Ligne de commande"
  3787. @ ROW()+1, L+3 PROMPT "Code Paiement"
  3788. @ ROW()+1, L+3 PROMPT "Reformatage Paragraphe"
  3789. MENU TO CHOIX
  3790.  
  3791. do wout with t,l,b,r,zbuff
  3792. IF LASTKEY() = K_ESC
  3793.    RETURN .F.
  3794. ENDIF   
  3795.  
  3796. DO CASE
  3797.   //
  3798.    CASE CHOIX = 1
  3799.      AADD (MHT, "Recherche par Code Postale ou Nom = Tapez les premiers chiffres")
  3800.      AADD (MHT, "Numéro Client = Cxxxxxxxxx pour un client ou Pxxxxxxxx pour un prospect")
  3801.      AADD (MHT, "")
  3802.      AADD (MHT, "Pour créer un client/prospect, renseignez les zones 'NOM' et 'Code Postale'")
  3803.      AADD (MHT, "              et mettre '*' à gauche en zone 'NUMERO' (Création prospect)")
  3804.      AADD (MHT, "                          ou son numéro (Cxxxxxxxxx)  (Création Client)")
  3805.  
  3806.   CASE CHOIX = 2
  3807.      AADD (MHT, SUBSTR(ValidProff,1,60))
  3808.      AADD (MHT, SUBSTR(ValidProff,61))
  3809.  
  3810.    CASE CHOIX = 3
  3811.      AADD (MHT, "F5 pour le catalogue / tarif")
  3812.  
  3813.    CASE CHOIX = 4
  3814.      AADD (MHT, [Si vous voulez changer l'article, selectionnez "ART" avec <-])
  3815.      AADD (MHT, "vous pouvez ensuite tapez F5 pour obtenir le tarif / catalogue")
  3816.      AADD (MHT, "")
  3817.      AADD (MHT, "Sélectionnez le '+' pour ajouter une ligne")
  3818.      AADD (MHT, "")
  3819.      AADD (MHT, [les zones :])
  3820.      AADD (MHT, [  "LI"      est "O" si la ligne est à livrée sinon "N"])
  3821.      AADD (MHT, [  "PRIX U"  est normalement le prix tarif, mais vous pouvez le modifier])
  3822.      AADD (MHT, [  "REM"     est la % remise a appliquer à cette ligne])
  3823.      AADD (MHT, "")
  3824.      AADD (MHT, "Tapez Esc pour terminer la saisie")
  3825.  
  3826.   CASE CHOIX = 5
  3827.      AADD (MHT, "CODE PAIEMENT  - Si Montant = 0, Code = Espace , sinon:")
  3828.      AADD (MHT, "0 - Déjà reglé")
  3829.      AADD (MHT, "2 - Traite à la livraison")
  3830.      AADD (MHT, "3 - Cheque joint")
  3831.      AADD (MHT, "5 - Cheque à la livraison")
  3832.      AADD (MHT, "6 - Traite à l'acceptation")
  3833.      AADD (MHT, "7 - Traite acceptée (L.C.R.)")
  3834.      AADD (MHT, "9 - Financement")
  3835.  
  3836.   CASE The_Var="CLIABV"
  3837.      AADD (MHT, "Forme juridique,  S.A., SARL, ENT .....")
  3838.  
  3839.   CASE The_Var="CLICONTACT"
  3840.      AADD (MHT, "Entrez le nom du client si différent du nom société")
  3841.  
  3842.   CASE The_Var="CLITAILLE"
  3843.      AADD (MHT, "Nombre de personnes dans l'entreprise")
  3844.  
  3845.   CASE The_Var="CLIRUE" .OR. The_Var="CLIADS" .OR. The_Var="CLICP" .OR. The_Var="CLIVILLE"
  3846.      AADD (MHT, "Adresse du client")
  3847.  
  3848.   CASE The_Var="CLIBANK" .OR. The_Var="CLIBANKADS"
  3849.      AADD (MHT, "Nom et adresse de la Banque du client")
  3850.  
  3851.   CASE The_Var="CLIBCGUI" .OR. The_Var="CLIBCODE" .OR.;
  3852.        The_Var="CLIBNCPT" .OR. The_Var="CLIBRIB"
  3853.      AADD (MHT, "RIB du client - CODE BANQUE, GUICHET, COMPTE, CLE")
  3854.  
  3855.   CASE SUBSTR(The_Var,1,3) = "QL_"
  3856.      AADD (MHT, "Nom et unité du matériel concurrent")
  3857.  
  3858.   CASE SUBSTR(The_Var,1,3) = "QC_"
  3859.      AADD (MHT, "Quantité de matériel concurrent")
  3860.  
  3861.   CASE The_Var="CLI_COMM"
  3862.      AADD (MHT, "Référence donné par le client à cette commande")
  3863.  
  3864.   CASE The_Var="REM_SUP"
  3865.      AADD (MHT, "Remise a appliquer sur cette commande")
  3866.  
  3867.   CASE The_Var = "EXPORT"
  3868.      AADD (MHT, "1 = France     0=Export (TVA=0)")
  3869.  
  3870.   CASE SUBSTR(The_Var,1,4)="DECH"
  3871.      AADD (MHT, "Date d'echéance")
  3872.  
  3873.    OTHERWISE
  3874. *     // next bit of code is useful for debugging
  3875. *     AADD (MHT, "MPROC = " + MPROC)
  3876. *     AADD (MHT, "LINE  = " + STR(LINE))
  3877. *     AADD (MHT, "The_Var   = " + The_Var)
  3878.      AADD (MHT, "Aide n'est pas disponible")
  3879. ENDCASE
  3880. *
  3881. t=22-LEN(MHT)
  3882. b=t+1+LEN(MHT)
  3883. l=0
  3884. r=79
  3885. do win with t,l,b,r,zbuff,"AIDE"
  3886. FOR I=1 TO LEN(MHT)
  3887.    @ T+I,l+3 say MHT[I]
  3888. NEXT
  3889. //
  3890. do while INKEY(0) <> K_ESC
  3891. enddo
  3892. do wout with t,l,b,r,zbuff
  3893. @mr,mcol say ""                     // Reset cursor position
  3894. return .T.
  3895. *
  3896. //
  3897. //------------------------------------------------------------------------
  3898. //
  3899. FUNCTION ENCODE (CONTROL)
  3900. * Auteur...: R M ALCOCK
  3901. * Date.....: 26/2/95
  3902. * Copyright: (c) 1995, R M ALCOCK, Tous droits réservés
  3903. * Notes....: Subroutines to encode data
  3904. *
  3905. *
  3906. LOCAL SEED,C
  3907. DEFAULT CONTROL TO ""
  3908. *
  3909. SET CONFIRM     ON
  3910. SET DATE        FRENCH
  3911. SET DELETED     ON
  3912. SET EXACT       ON
  3913. SET EXCLUSIVE   OFF
  3914. SET FIXED       OFF
  3915. SET SCOREBOARD  ON
  3916. SET TALK        OFF
  3917. SET BELL        OFF
  3918. SET EPOCH TO 1980
  3919.  
  3920. PUBLIC LCD:=.T., M_Control
  3921.  
  3922. CLOSE DATABASES
  3923. SELECT 1
  3924. USE ATTACH
  3925. M_Control = PCON         // Password Control
  3926.  
  3927. USE CLIENT EXCLUSIVE
  3928.  
  3929. SEED=VAL(READ_SEED(6,5,;
  3930.          IIF (CONTROL="", "DECRYPTAGE FICHIER", "CODAGE FICHIER")))
  3931. @ 6,0 CLEAR
  3932.  
  3933. IF CONTROL = ""
  3934.    // Should be unscramble
  3935.    GO TOP
  3936.    COUNT NEXT 10 FOR CLISCRAMBL TO C
  3937.    IF C < 10 .AND. .NOT. CONFIRM (5,,"N","CONFIRM DECRYPTAGE")
  3938.          QUIT
  3939.    ENDIF
  3940.    //
  3941.    GO TOP
  3942.    @ 6,0 SAY "DECRYPTAGE FICHIER"
  3943.  
  3944.    DO WHILE .NOT. EOF()
  3945.       SPEEDO (8,RECCOUNT())
  3946.       UNSCRAM_CLI(SEED)
  3947.       SKIP
  3948.    ENDDO
  3949.    //
  3950. ELSE
  3951.    //
  3952.    @ 6,0 SAY "CODAGE FICHIER"
  3953.  
  3954.    DO WHILE .NOT. EOF()
  3955.       SPEEDO (8,RECCOUNT())
  3956.       SCRAM_CLI(SEED)
  3957.       SKIP
  3958.    ENDDO
  3959. ENDIF
  3960. ?"Indexation REF"
  3961. INDEX ON CLIREF TO CLIREF
  3962. ?"Indexation CODE POSTALE"
  3963. INDEX ON CLICP+SUBSTR(CLIVILLE,1,5) TO CLICP
  3964. ?"Indexation NOM"
  3965. INDEX ON CLINOM TO CLINOM
  3966. //
  3967. //
  3968. RETURN .T.
  3969. //
  3970. //
  3971. //-------------------------------------------------------------------------
  3972. //
  3973. // Function scrambles a CLIENT record
  3974. //
  3975. FUNCTION SCRAM_CLI (SEED)
  3976. //
  3977. // SEED is the seed for the random number generator
  3978. //
  3979. LOCAL M_FIX:= RANDOM (SEED, 5, 31)   // Generate 5 random n°s between 1 and 31
  3980. LOCAL M_VAR:= RANDOM(REC_SEED (SEED), 30, 31)    // 30 codes.
  3981. LOCAL M,N
  3982. //
  3983. // M_FIX is used for those variables which are indexed and therefore must
  3984. // use the same translation for all
  3985. //
  3986. // M_VAR increases the degree of randomness because the seed is different
  3987. // for each record. Hence the translation is different for the same
  3988. // parameters in different records
  3989. //
  3990. //
  3991. IF CLISCRAMBL
  3992.    RETURN .T.        // Already scrambled
  3993. ENDIF
  3994. //
  3995. // Scramble CLINOM and VILLE  using fixed translation for the first 5 chars
  3996. // and variable translation for the rest. All others are variable
  3997. //
  3998. M =   SCRAMBLE (SUBSTR(CLINOM,1,5), M_FIX)
  3999. M=M + SCRAMBLE (SUBSTR(CLINOM, 6, LEN(CLINOM)-5), M_VAR)
  4000. N=    SCRAMBLE (SUBSTR(CLIVILLE, 1, 5), M_FIX)
  4001. N=N + SCRAMBLE (SUBSTR(CLIVILLE, 6, LEN(CLIVILLE)-5), M_VAR)
  4002. REPLACE CLINOM     WITH M,;
  4003.         CLIVILLE   WITH N,;
  4004.         CLIRUE     WITH SCRAMBLE (CLIRUE,     M_VAR),;
  4005.         CLIADS     WITH SCRAMBLE (CLIADS,     M_VAR),;
  4006.         CLISIRET   WITH SCRAMBLE (CLISIRET,   M_VAR),;
  4007.         CLICONTACT WITH SCRAMBLE (CLICONTACT, M_VAR),;
  4008.         CLICONTAC2 WITH SCRAMBLE (CLICONTAC2, M_VAR)
  4009.  
  4010. REPLACE CLIPHONE  WITH SCRAMBLE (CLIPHONE,  M_VAR),;
  4011.         CLIPHONED WITH SCRAMBLE (CLIPHONED, M_VAR),;
  4012.         CLIPHONEV WITH SCRAMBLE (CLIPHONEV, M_VAR),;
  4013.         CLIFAX    WITH SCRAMBLE (CLIFAX,    M_VAR),;
  4014.         CLIBNCPT  WITH SCRAMBLE (CLIBNCPT,  M_VAR),;
  4015.         CNTRL     WITH SCRAMBLE (CNTRL,     M_VAR),;
  4016.         CLISCRAMBL WITH .T.
  4017. RETURN .T.
  4018. //
  4019. //
  4020. //-------------------------------------------------------------------------
  4021. //
  4022. // Function unscrambles a CLIENT record
  4023. //
  4024. FUNCTION UNSCRAM_CLI (SEED)
  4025. //
  4026. LOCAL M_FIX:= RANDOM (SEED, 5, 31)   // Generate 5 random n°s between 1 and 31
  4027. LOCAL M_VAR:= RANDOM(REC_SEED (SEED), 30, 31)    // 30 codes.
  4028. LOCAL M, N
  4029. //
  4030. // See comments on SCRAM_CLI
  4031. //
  4032. IF .NOT. CLISCRAMBL
  4033.    RETURN .T.        // Already unscrambled
  4034. ENDIF
  4035. M =   UNSCRAMBLE (SUBSTR(CLINOM,1,5), M_FIX)
  4036. M=M + UNSCRAMBLE (SUBSTR(CLINOM, 6, LEN(CLINOM)-5), M_VAR)
  4037. N=    UNSCRAMBLE (SUBSTR(CLIVILLE, 1, 5), M_FIX)
  4038. N=N + UNSCRAMBLE (SUBSTR(CLIVILLE, 6, LEN(CLIVILLE)-5), M_VAR)
  4039.  
  4040. REPLACE CLINOM     WITH M,;
  4041.         CLIVILLE   WITH N,;
  4042.         CLIRUE     WITH UNSCRAMBLE (CLIRUE,     M_VAR),;
  4043.         CLIADS     WITH UNSCRAMBLE (CLIADS,     M_VAR),;
  4044.         CLISIRET   WITH UNSCRAMBLE (CLISIRET,   M_VAR),;
  4045.         CLICONTACT WITH UNSCRAMBLE (CLICONTACT, M_VAR),;
  4046.         CLICONTAC2 WITH UNSCRAMBLE (CLICONTAC2, M_VAR)
  4047.  
  4048. REPLACE CLIPHONE   WITH UNSCRAMBLE (CLIPHONE,  M_VAR),;
  4049.         CLIPHONED  WITH UNSCRAMBLE (CLIPHONED, M_VAR),;
  4050.         CLIPHONEV  WITH UNSCRAMBLE (CLIPHONEV, M_VAR),;
  4051.         CLIFAX     WITH UNSCRAMBLE (CLIFAX,    M_VAR),;
  4052.         CLIBNCPT   WITH UNSCRAMBLE (CLIBNCPT,  M_VAR),;
  4053.         CNTRL      WITH UNSCRAMBLE (CNTRL,     M_VAR),;
  4054.         CLISCRAMBL WITH .F.
  4055. RETURN .T.
  4056. //
  4057. //
  4058. //-------------------------------------------------------------------------
  4059. //
  4060. // Function creates a seed from a fixed seed (1000 - 9999) and RECNO()
  4061. //
  4062. FUNCTION REC_SEED (SEED)
  4063. //
  4064. IF SEED >= 0                  // If not, it is the SERVER - leave alone
  4065.    SEED = RECNO() * 10000 + SEED
  4066.    DO WHILE SEED > 9999
  4067.       SEED = SEED / 7         // Largest prime under 10
  4068.    ENDDO
  4069. ENDIF
  4070. RETURN SEED
  4071. //
  4072. //-------------------------------------------------------------------------
  4073. //
  4074. // Function scrambles a string
  4075. //
  4076. // Each character of R_STRING (a series of random numbers between 1 and 31) is
  4077. // added to its equivalent character in A_STRING so as to scramble it
  4078. //
  4079. FUNCTION SCRAMBLE (A_String, R_String)
  4080. //
  4081. LOCAL I,Ans:=""
  4082. //
  4083. IF LEN(A_String) > 0
  4084.    FOR I=1 TO LEN (A_String)
  4085.       Ans=Ans+CHR(ASC(SUBSTR(A_String,I,1))+ASC(SUBSTR(R_String,I,1)))
  4086.    NEXT
  4087. ENDIF
  4088. RETURN Ans
  4089. //
  4090. //
  4091. //-------------------------------------------------------------------------
  4092. //
  4093. // Function unscrambles a string
  4094. //
  4095. // Each character of R_STRING (a series of random numbers between 1 and 31) is
  4096. // subtracted from its equivalent character in A_STRING so as to unscramble it
  4097. //
  4098. FUNCTION UNSCRAMBLE (A_String, R_String)
  4099. //
  4100. LOCAL I,Ans:=""
  4101.  
  4102. IF LEN(A_String) > 0
  4103.    FOR I=1 TO LEN (A_STRING)
  4104.       Ans=Ans+CHR(ASC(SUBSTR(A_String,I,1))-ASC(SUBSTR(R_String,I,1)))
  4105.    NEXT
  4106. ENDIF
  4107. RETURN Ans
  4108. //
  4109. //-------------------------------------------------------------------------
  4110. //
  4111. // Function generates an string full of random characters
  4112. //
  4113. // PARAMETERS: SEED  = a 4 digit number used to seed the generator
  4114. //             No    = the number of random characters required
  4115. //             Max   = the maximum character value
  4116. //                     i.e. each character is between 1 and Max inclusive
  4117. //
  4118. //     Returns Ans   = A string of length No containing the random chacters
  4119. //
  4120. FUNCTION RANDOM (SEED, No, Max)
  4121. //
  4122. LOCAL Ans:="", IC, MF, MC, MS
  4123.  
  4124. IF SEED < 0                 // No Coding required
  4125.    RETURN REPLICATE(CHR(0),No)
  4126. ENDIF
  4127.  
  4128. FOR IC = 1 TO No
  4129.  
  4130.    // Make sure that the seed does not have an exact square root !!!
  4131.    //
  4132.    DO WHILE .T.
  4133.       MS=SQRT (SEED)
  4134.       MS=(MS * 10000 - INT(MS * 10000)) // Take off 1st 4 digits of fraction
  4135.       IF MS <> 0                        // There is still a fractional part
  4136.          EXIT                           // so it is O.K.
  4137.       ENDIF
  4138.       SEED = SEED+1                     // Try the next integer up
  4139.    ENDDO
  4140.  
  4141.    MF = SQRT(SEED)-INT(SQRT(SEED))      // Fractional part of square root
  4142.    MC = INT( MF * Max )                 // Range is 0 to Max-1
  4143.    Ans = Ans + CHR(MC+1)                // Add to answer string
  4144.    SEED = INT(MF * 10000)               // New seed (4 digits)
  4145.  
  4146. NEXT
  4147. RETURN Ans
  4148. //
  4149. //-------------------------------------------------------------------------
  4150. //
  4151. FUNCTION SPEEDO(MRow,Mlong)
  4152. *
  4153. @ MRow, 79*RECNO()/Mlong SAY "▌"
  4154. RETURN .T.
  4155. //
  4156. //-------------------------------------------------------------------------
  4157. //
  4158. FUNCTION READ_SEED (MROW,MCOL, MT, M_Reg)
  4159.  
  4160. // The equivalent of PASSWD()
  4161. // Requires a GLOBAL variable M_Control containing the 6 character
  4162. // control field from ATTACH->PCON
  4163.  
  4164.  
  4165. LOCAL MPW, I:=0, C
  4166. *
  4167. DO HLOFF WITH LCD
  4168. CLEAR
  4169.  
  4170. FOR i=1 TO 9999
  4171.    MPW = STR(i,4,0)
  4172.    IF M_Control == RANDOM(VAL(MPW),6,31)
  4173.       RETURN MPW  // Password is O.K.
  4174.    ENDIF
  4175. NEXT
  4176. ALARM ("ACCES INTERDIT")
  4177. QUIT
  4178. RETURN 0
  4179.  
  4180.  
  4181. @ 2,40-LEN(MT)/2 SAY MT
  4182. @ 1,40-LEN(MT)/2-2 TO 3,40+LEN(MT)/2+2 DOUBLE
  4183. IF PCOUNT() > 3
  4184.    @ 5,5 SAY "NUMERO VRP   : "+M_Reg
  4185. ENDIF
  4186.  
  4187. @ 23,75 SAY "V9.1"
  4188.  
  4189. DO WHILE I < 3
  4190.  
  4191.    CLEAR TYPEAHEAD
  4192.    MPW=""
  4193.    @ MROW,0 CLEAR TO MROW,79
  4194.    @ MROW,MCOL SAY "MOT DE PASSE ? "
  4195.    //
  4196.    // DO Reads in the user's attempt at the password
  4197.    //
  4198.    DO WHILE .T.
  4199.       C=INKEY(0)
  4200.       DO CASE
  4201.       CASE C=13
  4202.          EXIT
  4203.       CASE C>31.AND.C<127
  4204.          @ ROW(),COL() SAY "*"
  4205.          MPW=MPW+CHR(C)
  4206.       CASE (C=8.OR.C=19).AND.LEN(MPW)>0    // Backspace or left arrow
  4207.          @ROW(),COL()-1 SAY " "
  4208.          @ROW(),COL()-1 SAY ""
  4209.          MPW=SUBSTR(MPW,1,LEN(MPW)-1)
  4210.       ENDCASE
  4211.    ENDDO
  4212.    //
  4213. *   // !!!!!!!!!!!!!!!!!!!!!
  4214. *   //
  4215. *   SELECT 2
  4216. *   USE ATTACH EXCLUSIVE
  4217. *   REPLACE PCON WITH RANDOM(VAL(MPW),6,31)
  4218. *   SELECT CLIENT
  4219. *   RETURN MPW
  4220. *   //
  4221. *   //!!!!!!!!!!!!!!!!!!!!!!!
  4222. *   //
  4223.    IF EMPTY(MPW)
  4224. *      RETURN "-1" // File is not coded
  4225.    ELSEIF M_Control == RANDOM(VAL(MPW),6,31)
  4226.       RETURN MPW  // Password is O.K.
  4227.    ENDIF
  4228.  
  4229.    I=I+1
  4230. ENDDO
  4231.  
  4232. ALARM ("ACCES INTERDIT")
  4233. QUIT
  4234. RETURN .F.
  4235. //
  4236. //-------------------------------------------------------------------
  4237. //
  4238. FUNCTION REINDEX (M_ALL)
  4239. * Auteur...: R M ALCOCK
  4240. * Date.....: 15/2/93
  4241. * Copyright: (c) 1992, R M ALCOCK, Tous droits réservés
  4242. * Notes....: RE-INDEX PROGRAM
  4243. *            Intended to create NTX type Indexes
  4244. *            Link File uses RMALIBX which has no references to DBFNDX
  4245. *
  4246. *
  4247. LOCAL MT:=CONAME+" - INDEX FICHIERS"
  4248. LOCAL MP:=40-LEN(MT)/2
  4249. LOCAL NumFiles := 15                //Number of Databases !!!
  4250. LOCAL I, CHOIX
  4251.  
  4252. *SET DEFAULT TO F:
  4253. SET CONFIRM     ON
  4254. SET DATE        FRENCH
  4255. SET DELETED     ON
  4256. SET EXACT       ON
  4257. SET EXCLUSIVE   OFF
  4258. SET FIXED       OFF
  4259. SET SCOREBOARD  OFF
  4260. SET WRAP        ON
  4261. SET EPOCH TO    1980
  4262. *
  4263. CLEAR
  4264. *
  4265. IF PCOUNT()=0
  4266.    M_ALL = .F.
  4267. ELSE
  4268.    M_ALL = IIF ( M_ALL<> "*", .F., .T.)
  4269. ENDIF
  4270. IF M_ALL
  4271.    @ 0,MP SAY MT
  4272.    @ 5,5 SAY "Index tous les fichiers !!!"
  4273.    FOR I=1 TO NumFiles
  4274.       R_IND (I)
  4275.    NEXT
  4276. ELSE
  4277.    DO WHILE .T.
  4278.       CLEAR
  4279.       @ 0,MP SAY MT
  4280.       @ 2,2 PROMPT "Q U I T T E R"
  4281.       @ ROW()+1,2 PROMPT "TARIF"
  4282.       @ ROW()+1,2 PROMPT "VRPS"
  4283.       @ ROW()+1,2 PROMPT "CLIENTS"
  4284.       @ ROW()+1,2 PROMPT "FAMILLES"
  4285.       @ ROW()+1,2 PROMPT "COMMANDES CLIENTS"
  4286.       @ ROW()+1,2 PROMPT "FACTURES Clients"
  4287.       @ ROW()+1,2 PROMPT "LIGNES de Facturation / Avoirs / Commandes"
  4288.       @ ROW()+1,2 PROMPT "EVENEMENTS / LITIGES / VISITES Clients"
  4289.       @ ROW()+1,2 PROMPT "PROMOTIONS"
  4290.       MENU TO CHOIX
  4291.       IF CHOIX=1
  4292.          RETURN .T.
  4293.       ENDIF
  4294.       R_IND(CHOIX-1)
  4295.       WAIT
  4296.    ENDDO
  4297. ENDIF
  4298. RETURN .T.
  4299. *
  4300. ******************************
  4301. *
  4302. FUNCTION R_IND(CHOIX)
  4303.  
  4304. DO CASE
  4305.  
  4306. CASE CHOIX = 1
  4307. *   NET_USE (1, "STOCK", .T., 30, "", "")
  4308. *   ANNOUNCE_IT()
  4309. *   INDEX ON STCOMMREF TO STCREF
  4310. *   INDEX ON STFAM_PROD+STCOMMREF TO STREF
  4311. *   NET_USE (1, "STCOMP", .T., 30, "", "")
  4312.  *  ANNOUNCE_IT()
  4313.  *  INDEX ON cref TO STCOMP
  4314.  
  4315. CASE CHOIX = 2
  4316.    IF FILE("VRPS.DBF")
  4317.       NET_USE (1, "VRPS", .T., 30, "", "")
  4318.       ANNOUNCE_IT()
  4319.       INDEX ON VRP TO VRPS
  4320.       INDEX ON EQUIPE+VRP TO VRPREG
  4321. *      NET_USE (1, "VRPSTOCK", .T., 30, "", "")
  4322. *      ANNOUNCE_IT()
  4323. *      INDEX ON VRP TO VRPSTOCK
  4324.  
  4325.    ENDIF
  4326.  
  4327. CASE CHOIX = 3
  4328.    NET_USE (1, "CLIENT", .T., 30, "", "")
  4329.    ANNOUNCE_IT()
  4330.    INDEX ON CLIREF TO CLIREF
  4331.    INDEX ON CLICP+SUBSTR(CLIVILLE,1,5) TO CLICP
  4332.    INDEX ON SUBSTR(CLINOM,1,5) TO CLINOM
  4333.  
  4334. CASE CHOIX = 4
  4335.    NET_USE (1, "TARIFT", .T., 30, "", "")
  4336.    ANNOUNCE_IT()
  4337.    INDEX ON CODE TO TARIFT
  4338.  
  4339.    NET_USE (1, "DOC", .T., 30, "", "")
  4340.    ANNOUNCE_IT()
  4341.    INDEX ON STR(PAGE,2)+STR(SECT,2)+STR(LINE,2) TO DOC
  4342.  
  4343.    NET_USE (1, "SECT", .T., 30, "", "")
  4344.    ANNOUNCE_IT()
  4345.    INDEX ON FM+SF+PAGE+SECT TO SECTFM
  4346.    INDEX ON PAGE+SECT TO SECT
  4347.  
  4348. CASE CHOIX = 5
  4349.    NET_USE (1, "COM", .T., 30, "", "")
  4350.    ANNOUNCE_IT()
  4351.    INDEX ON commande TO COM
  4352.    INDEX ON refcli TO COMCL
  4353.  
  4354. CASE CHOIX = 6
  4355.    NET_USE (1, "FACT", .T., 30, "", "")
  4356.    ANNOUNCE_IT()
  4357.    INDEX ON REFCLI TO FACCL
  4358.    INDEX ON FACTURE+ECH TO FACT
  4359.  
  4360. CASE CHOIX = 7
  4361.    NET_USE (1, "FACTA", .T., 30, "", "")
  4362.    ANNOUNCE_IT()
  4363.    INDEX ON facture+ligne TO FACTR
  4364.  
  4365. CASE CHOIX = 8
  4366.    NET_USE (1, "LITIGE", .T., 30, "", "")
  4367.    ANNOUNCE_IT()
  4368.    INDEX ON CODE TO LITIGE
  4369.    INDEX ON A_DATE TO LITDATE
  4370.    INDEX ON CLIENT TO LITCLI
  4371.    NET_USE (1, "EVENT", .T., 30, "", "")
  4372.    ANNOUNCE_IT()
  4373. *   INDEX ON REFCLI+STR(CTOD('01/01/79')-D_CRE,5) TO EVENT
  4374.    INDEX ON REFCLI+DTOS(D_CRE) TO EVENT DESCENDING
  4375.    INDEX ON BONREF TO EVECODE
  4376.  
  4377. CASE CHOIX = 10
  4378.    NET_USE (1, "PROMOS", .T., 30, "", "")
  4379.    ANNOUNCE_IT()
  4380.    INDEX ON PROMOS->ARTICLE + PROMOS->CLIENT TO PROMOS
  4381.    *
  4382. ENDCASE
  4383.  
  4384. RETURN .T.
  4385. *
  4386. ******************************
  4387. *
  4388. FUNCTION ANNOUNCE_IT
  4389. *
  4390. CLEAR
  4391. @ 5,5 SAY "INDEX FICHIER : " + ALIAS(1)
  4392. RETURN .T.
  4393. //
  4394. //---------------------------------------------------------------------
  4395. //
  4396. ///////////////////////////////////////////////////////////////////////////////
  4397. //
  4398. //  Function-oriented code created by the Xbase++ FormDesigner
  4399. //    Creation date: 14/02/2007 Time: 16:07:40
  4400. //
  4401. ///////////////////////////////////////////////////////////////////////////////
  4402. /*
  4403. #
  4404. */
  4405. #PRAGMA LIBRARY( "ASCOM10.LIB" )
  4406.  
  4407. FUNCTION Window_Cli(Control)
  4408.  
  4409.    LOCAL nEvent, mp1, mp2
  4410.    LOCAL oDlg, oXbp, drawingArea, aEditControls := {}, oXbp1, oXbp2
  4411.    LOCAL oTab1, oTab2, oTab3
  4412.  
  4413.    PUBLIC The_Menu_Bar
  4414.    
  4415.    oDlg := XbpDialog():new( AppDesktop(), , {10,100}, {819,656}, , .F.)
  4416.    oDlg:taskList := .T.
  4417.    oDlg:title := "CLIENT / PROSPECT"
  4418.    oDlg:create()
  4419.  
  4420.    The_Menu_Bar := oDlg:menuBar()     // Set up the Menu system PUBLIC variable   
  4421.    MAIN_MENU()
  4422.  
  4423.    drawingArea := oDlg:drawingArea
  4424.    drawingArea:setFontCompoundName( "8.Arial" )
  4425.  
  4426.    oTab1:= XbpTabPage():new( drawingArea, , {12,48}, {780,516}, { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE } } )
  4427.    oTab1:caption := "Général"
  4428.    oTab1:minimized := .F.
  4429.    oTab1:tabStop := .T.
  4430.    oTab1:create()
  4431.    oTab1:DropZone := .T.
  4432.    oTab1:TabActivate := ; 
  4433.           {|| oTab2:minimize(), oTab3:minimize(), oTab1:maximize() } 
  4434.  
  4435.    oTab2:= XbpTabPage():new( drawingArea, , {12,48}, {780,516}, { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE } } )
  4436.    oTab2:caption := "Finance"
  4437.    oTab2:preOffset := 20
  4438.    oTab2:postOffset := 60
  4439.    oTab2:minimized := .T.
  4440.    oTab2:tabStop := .T.
  4441.    oTab2:create()
  4442.    oTab2:TabActivate := ; 
  4443.           {|| oTab1:minimize(), oTab3:minimize(), oTab2:maximize() } 
  4444.  
  4445.    oTab3:= XbpTabPage():new( drawingArea, , {12,48}, {780,516}, { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE } } )
  4446.    oTab3:caption := "Commentaire"
  4447.    oTab3:minimized := .F.
  4448.    oTab3:preOffset := 40
  4449.    oTab3:postOffset := 40
  4450.    oTab2:minimized := .T.
  4451.    oTab3:tabStop := .T.
  4452.    oTab3:create()
  4453.    oTab3:TabActivate := ; 
  4454.           {|| oTab1:minimize(), oTab2:minimize(),  oTab3:maximize() } 
  4455.  
  4456.    oXbp := XbpPushButton():new( drawingArea, , {252,12}, {84,24},;
  4457.                                 { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE }, { XBP_PP_FGCLR, -58 } } )
  4458.    oXbp:caption := "Suivant"
  4459.    oXbp:tabStop := .T.
  4460.    oXbp:create()
  4461.    oXbp:activate := {|| Gather( aEditControls ), Pg_Dn(), Scatter ( aEditControls ) }
  4462.  
  4463.    oXbp := XbpPushButton():new( drawingArea, , {156,12}, {84,24},;
  4464.                                 { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE }, { XBP_PP_FGCLR, -58 } } )
  4465.    oXbp:caption := "Precédant"
  4466.    oXbp:tabStop := .T.
  4467.    oXbp:create()
  4468.    oXbp:activate := {|| Gather( aEditControls ), Pg_Up(), Scatter ( aEditControls ) }
  4469.  
  4470.    oXbp := XbpPushButton():new( drawingArea, , {24,12}, {84,24},;
  4471.                                 { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE }, { XBP_PP_FGCLR, -58 } } )
  4472.    oXbp:caption := "Annul"
  4473.    oXbp:tabStop := .T.
  4474.    oXbp:create()
  4475.    oXbp:activate := {|| PostAppEvent( xbeP_Close ) }
  4476.  
  4477.    oTab2:minimize()
  4478.    oTab3:minimize()
  4479.    oTab1:maximize()
  4480.  
  4481.    oXbp := XbpSLE():new( oTab1, , {72,456}, {72,24},;
  4482.                 { { XBP_PP_BGCLR, GRA_CLR_CYAN },;
  4483.                   { XBP_PP_DISABLED_BGCLR, GRA_CLR_CYAN } ,;
  4484.                   { XBP_PP_FGCLR, GRA_CLR_BLACK } } )
  4485.    oXbp:bufferLength := 10
  4486.    oXbp:editable := .F.
  4487.    oXbp:tabStop := .T.
  4488.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIREF ), CLIENT->CLIREF := x ) }
  4489.    oXbp:create():setData()
  4490.    AAdd ( aEditControls, oXbp )
  4491.  
  4492.    oXbp := XbpSLE():new( oTab1, , {156,456}, {192,24}, { { XBP_PP_BGCLR, GRA_CLR_CYAN }, { XBP_PP_FGCLR, GRA_CLR_BLACK } } )
  4493.    oXbp:bufferLength := 30
  4494.    oXbp:editable := .T.
  4495.    oXbp:tabStop := .T.
  4496.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLINOM ), CLIENT->CLINOM := x ) }
  4497.    oXbp:create():setData()
  4498.    AAdd ( aEditControls, oXbp )
  4499.  
  4500.    oXbp := XbpSLE():new( oTab1, , {432,456}, {96,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4501.    oXbp:bufferLength := 17
  4502.    oXbp:tabStop := .T.
  4503.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLICONTACT ), CLIENT->CLICONTACT := x ) }
  4504.    oXbp:create():setData()
  4505.    AAdd ( aEditControls, oXbp )
  4506.  
  4507.    oXbp := XbpStatic():new( oTab1, , {372,456}, {48,24} )
  4508.    oXbp:caption := "Contact:"
  4509.    oXbp:clipSiblings := .T.
  4510.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  4511.    oXbp:create()
  4512.  
  4513.    oXbp1 := XbpStatic():new( oTab1, , {72,312}, {264,132} )
  4514.    oXbp1:caption := "Addresse"
  4515.    oXbp1:clipSiblings := .T.
  4516.    oXbp1:type := XBPSTATIC_TYPE_GROUPBOX
  4517.    oXbp1:create()
  4518.  
  4519.    oXbp := XbpSLE():new( oXbp1, , {12,84}, {180,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4520.    oXbp:bufferLength := 30
  4521.    oXbp:tabStop := .T.
  4522.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIRUE ), CLIENT->CLIRUE := x ) }
  4523.    oXbp:create():setData()
  4524.    AAdd ( aEditControls, oXbp )
  4525.  
  4526.    oXbp := XbpSLE():new( oXbp1, , {12,48}, {180,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4527.    oXbp:bufferLength := 30
  4528.    oXbp:tabStop := .T.
  4529.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIADS ), CLIENT->CLIADS := x ) }
  4530.    oXbp:create():setData()
  4531.    AAdd ( aEditControls, oXbp )
  4532.  
  4533.    oXbp := XbpSLE():new( oXbp1, , {12,12}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4534.    oXbp:bufferLength := 5
  4535.    oXbp:tabStop := .T.
  4536.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLICP ), CLIENT->CLICP := x ) }
  4537.    oXbp:create():setData()
  4538.    AAdd ( aEditControls, oXbp )
  4539.  
  4540.    oXbp := XbpSLE():new( oXbp1, , {60,12}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4541.    oXbp:bufferLength := 30
  4542.    oXbp:tabStop := .T.
  4543.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIVILLE ), CLIENT->CLIVILLE := x ) }
  4544.    oXbp:create():setData()
  4545.    AAdd ( aEditControls, oXbp )
  4546.  
  4547.    oXbp2 := XbpStatic():new( oTab1, , {372,348}, {360,96} )
  4548.    oXbp2:caption := "Téléphone"
  4549.    oXbp2:clipSiblings := .T.
  4550.    oXbp2:type := XBPSTATIC_TYPE_GROUPBOX
  4551.    oXbp2:create()
  4552.  
  4553.    oXbp := XbpStatic():new( oXbp2, , {12,48}, {48,24} )
  4554.    oXbp:caption := "Bureau:"
  4555.    oXbp:clipSiblings := .T.
  4556.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  4557.    oXbp:create()
  4558.  
  4559.    oXbp := XbpSLE():new( oXbp2, , {72,48}, {96,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4560.    oXbp:bufferLength := 15
  4561.    oXbp:tabStop := .T.
  4562.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIPHONE ), CLIENT->CLIPHONE := x ) }
  4563.    oXbp:create():setData()
  4564.    AAdd ( aEditControls, oXbp )
  4565.  
  4566.    oXbp := XbpStatic():new( oXbp2, , {180,48}, {48,24} )
  4567.    oXbp:caption := "Dom:"
  4568.    oXbp:clipSiblings := .T.
  4569.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  4570.    oXbp:create()
  4571.  
  4572.    oXbp := XbpSLE():new( oXbp2, , {240,48}, {84,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4573.    oXbp:bufferLength := 15
  4574.    oXbp:tabStop := .T.
  4575.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIPHONED ), CLIENT->CLIPHONED := x ) }
  4576.    oXbp:create():setData()
  4577.    AAdd ( aEditControls, oXbp )
  4578.  
  4579.    oXbp := XbpStatic():new( oXbp2, , {12,12}, {48,24} )
  4580.    oXbp:caption := "Portable:"
  4581.    oXbp:clipSiblings := .T.
  4582.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  4583.    oXbp:create()
  4584.  
  4585.    oXbp := XbpSLE():new( oXbp2, , {72,12}, {96,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4586.    oXbp:bufferLength := 15
  4587.    oXbp:tabStop := .T.
  4588.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIPHONEV ), CLIENT->CLIPHONEV := x ) }
  4589.    oXbp:create():setData()
  4590.    AAdd ( aEditControls, oXbp )
  4591.  
  4592.    oXbp := XbpStatic():new( oXbp2, , {180,12}, {48,24} )
  4593.    oXbp:caption := "Fax:"
  4594.    oXbp:clipSiblings := .T.
  4595.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  4596.    oXbp:create()
  4597.  
  4598.    oXbp := XbpSLE():new( oXbp2, , {240,12}, {108,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4599.    oXbp:bufferLength := 15
  4600.    oXbp:tabStop := .T.
  4601.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIFAX ), CLIENT->CLIFAX := x ) }
  4602.    oXbp:create():setData()
  4603.    AAdd ( aEditControls, oXbp )
  4604.  
  4605.    oXbp := XbpStatic():new( oTab1, , {384,300}, {48,24} )
  4606.    oXbp:caption := "Activité:"
  4607.    oXbp:clipSiblings := .T.
  4608.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  4609.    oXbp:create()
  4610.  
  4611.    oXbp := XbpSLE():new( oTab1, , {432,300}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4612.    oXbp:bufferLength := 4
  4613.    oXbp:tabStop := .T.
  4614.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIPROFESS ), CLIENT->CLIPROFESS := x ) }
  4615.    oXbp:create():setData()
  4616.    AAdd ( aEditControls, oXbp )
  4617.  
  4618.    oXbp := XbpStatic():new( oTab1, , {72,264}, {84,24} )
  4619.    oXbp:caption := "Dernière Visite:"
  4620.    oXbp:clipSiblings := .T.
  4621.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  4622.    oXbp:create()
  4623.  
  4624.    oXbp := XbpSLE():new( oTab1, , {156,264}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4625.    oXbp:bufferLength := 8
  4626.    oXbp:tabStop := .T.
  4627.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, DtoC( CLIENT->DERNVISIT ), CLIENT->DERNVISIT := CtoD(x) ) }
  4628.    oXbp:create():setData()
  4629.    AAdd ( aEditControls, oXbp )
  4630.  
  4631.    oXbp := XbpStatic():new( oTab1, , {240,264}, {84,24} )
  4632.    oXbp:caption := "Action avant le :"
  4633.    oXbp:clipSiblings := .T.
  4634.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  4635.    oXbp:create()
  4636.  
  4637.    oXbp := XbpSLE():new( oTab1, , {324,264}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4638.    oXbp:bufferLength := 8
  4639.    oXbp:tabStop := .T.
  4640.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, DtoC( CLIENT->RELANCE ), CLIENT->RELANCE := CtoD(x) ) }
  4641.    oXbp:create():setData()
  4642.    AAdd ( aEditControls, oXbp )
  4643.  
  4644.    oXbp := XbpStatic():new( oTab1, , {480,300}, {36,24} )
  4645.    oXbp:caption := "Taille:"
  4646.    oXbp:clipSiblings := .T.
  4647.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  4648.    oXbp:create()
  4649.  
  4650.    oXbp := XbpSLE():new( oTab1, , {516,300}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4651.    oXbp:bufferLength := 4
  4652.    oXbp:tabStop := .T.
  4653.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLITAILLE ), CLIENT->CLITAILLE := x ) }
  4654.    oXbp:create():setData()
  4655.    AAdd ( aEditControls, oXbp )
  4656.  
  4657.    oXbp := XbpStatic():new( oTab1, , {564,300}, {96,24} )
  4658.    oXbp:caption := "Créa&tion (MMYY):"
  4659.    oXbp:clipSiblings := .T.
  4660.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  4661.    oXbp:create()
  4662.  
  4663.    oXbp := XbpSLE():new( oTab1, , {660,300}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4664.    oXbp:bufferLength := 4
  4665.    oXbp:tabStop := .T.
  4666.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->DATE_CRE, '@N' ), CLIENT->DATE_CRE := Val(x) ) }
  4667.    oXbp:create():setData()
  4668.    AAdd ( aEditControls, oXbp )
  4669.  
  4670.    oXbp := XbpMLE():new( oTab1, , {84,168}, {648,84}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4671.    oXbp:tabStop := .T.
  4672.    oXbp:create()
  4673.  
  4674. //
  4675. //----------------------------------------------------------------------
  4676. //
  4677. //  FINANCE PAGE
  4678.  
  4679.  
  4680.    oXbp := XbpSLE():new( oTab2, , {72,456}, {72,24},;
  4681.                 { { XBP_PP_BGCLR, GRA_CLR_CYAN },;
  4682.                   { XBP_PP_DISABLED_BGCLR, GRA_CLR_CYAN } ,;
  4683.                   { XBP_PP_FGCLR, GRA_CLR_BLACK } } )
  4684.    oXbp:bufferLength := 10
  4685.    oXbp:editable := .F.
  4686.    oXbp:tabStop := .T.
  4687.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIREF ), CLIENT->CLIREF := x ) }
  4688.    oXbp:create():setData()
  4689.    AAdd ( aEditControls, oXbp )
  4690.  
  4691.    oXbp := XbpSLE():new( oTab2, , {156,456}, {192,24}, { { XBP_PP_BGCLR, GRA_CLR_CYAN }, { XBP_PP_FGCLR, GRA_CLR_BLACK } } )
  4692.    oXbp:bufferLength := 30
  4693.    oXbp:editable := .T.
  4694.    oXbp:tabStop := .T.
  4695.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLINOM ), CLIENT->CLINOM := x ) }
  4696.    oXbp:create():setData()
  4697.    AAdd ( aEditControls, oXbp )
  4698.  
  4699.    oXbp := XbpStatic():new( oTab2, , {432,456}, {36,24} )
  4700.    oXbp:caption := "Siret :"
  4701.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  4702.    oXbp:create()
  4703.  
  4704.    oXbp := XbpSLE():new( oTab2, , {480,456}, {84,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4705.    oXbp:bufferLength := 14
  4706.    oXbp:tabStop := .T.
  4707.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLISIRET ), CLIENT->CLISIRET := x ) }
  4708.    oXbp:create():setData()
  4709.    AAdd ( aEditControls, oXbp )
  4710.  
  4711.    oXbp1 := XbpStatic():new( oTab2, , {72,384}, {420,60} )
  4712.    oXbp1:caption := "Banque"
  4713.    oXbp1:clipSiblings := .T.
  4714.    oXbp1:type := XBPSTATIC_TYPE_GROUPBOX
  4715.    oXbp1:create()
  4716.  
  4717.    oXbp := XbpSLE():new( oXbp1, , {12,12}, {84,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4718.    oXbp:bufferLength := 24
  4719.    oXbp:tabStop := .T.
  4720.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIBANK ), CLIENT->CLIBANK := x ) }
  4721.    oXbp:create():setData()
  4722.    AAdd ( aEditControls, oXbp )
  4723.  
  4724.    oXbp := XbpSLE():new( oXbp1, , {96,12}, {120,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4725.    oXbp:bufferLength := 24
  4726.    oXbp:tabStop := .T.
  4727.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIBANKADS ), CLIENT->CLIBANKADS := x ) }
  4728.    oXbp:create():setData()
  4729.    AAdd ( aEditControls, oXbp )
  4730.  
  4731.    oXbp := XbpSLE():new( oXbp1, , {240,12}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4732.    oXbp:bufferLength := 5
  4733.    oXbp:tabStop := .T.
  4734.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIBCODE ), CLIENT->CLIBCODE := x ) }
  4735.    oXbp:create():setData()
  4736.    AAdd ( aEditControls, oXbp )
  4737.  
  4738.    oXbp := XbpSLE():new( oXbp1, , {276,12}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4739.    oXbp:bufferLength := 5
  4740.    oXbp:tabStop := .T.
  4741.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIBCGUI ), CLIENT->CLIBCGUI := x ) }
  4742.    oXbp:create():setData()
  4743.    AAdd ( aEditControls, oXbp )
  4744.  
  4745.    oXbp := XbpSLE():new( oXbp1, , {312,12}, {72,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4746.    oXbp:bufferLength := 11
  4747.    oXbp:tabStop := .T.
  4748.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIBNCPT ), CLIENT->CLIBNCPT := x ) }
  4749.    oXbp:create():setData()
  4750.    AAdd ( aEditControls, oXbp )
  4751.  
  4752.    oXbp := XbpSLE():new( oXbp1, , {384,12}, {24,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4753.    oXbp:bufferLength := 2
  4754.    oXbp:tabStop := .T.
  4755.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIBRIB ), CLIENT->CLIBRIB := x ) }
  4756.    oXbp:create():setData()
  4757.    AAdd ( aEditControls, oXbp )
  4758.  
  4759.    oXbp2 := XbpStatic():new( oTab2, , {288,132}, {276,228} )
  4760.    oXbp2:caption := "EQUIVALENT CONCURRENT                      Quantité"
  4761.    oXbp2:clipSiblings := .T.
  4762.    oXbp2:type := XBPSTATIC_TYPE_GROUPBOX
  4763.    oXbp2:create()
  4764.  
  4765.    oXbp := XbpSLE():new( oXbp2, , {12,180}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4766.    oXbp:bufferLength := 12
  4767.    oXbp:tabStop := .T.
  4768.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_1 ), CLIENT->QL_1 := x ) }
  4769.    oXbp:create():setData()
  4770.    AAdd ( aEditControls, oXbp )
  4771.  
  4772.    oXbp := XbpSLE():new( oXbp2, , {12,156}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4773.    oXbp:bufferLength := 12
  4774.    oXbp:tabStop := .T.
  4775.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_2 ), CLIENT->QL_2 := x ) }
  4776.    oXbp:create():setData()
  4777.    AAdd ( aEditControls, oXbp )
  4778.  
  4779.    oXbp := XbpSLE():new( oXbp2, , {12,132}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4780.    oXbp:bufferLength := 12
  4781.    oXbp:tabStop := .T.
  4782.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_3 ), CLIENT->QL_3 := x ) }
  4783.    oXbp:create():setData()
  4784.    AAdd ( aEditControls, oXbp )
  4785.  
  4786.    oXbp := XbpSLE():new( oXbp2, , {12,108}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4787.    oXbp:bufferLength := 12
  4788.    oXbp:tabStop := .T.
  4789.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_4 ), CLIENT->QL_4 := x ) }
  4790.    oXbp:create():setData()
  4791.    AAdd ( aEditControls, oXbp )
  4792.  
  4793.    oXbp := XbpSLE():new( oXbp2, , {12,84}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4794.    oXbp:bufferLength := 12
  4795.    oXbp:tabStop := .T.
  4796.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_5 ), CLIENT->QL_5 := x ) }
  4797.    oXbp:create():setData()
  4798.    AAdd ( aEditControls, oXbp )
  4799.  
  4800.    oXbp := XbpSLE():new( oXbp2, , {12,60}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4801.    oXbp:bufferLength := 12
  4802.    oXbp:tabStop := .T.
  4803.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_6 ), CLIENT->QL_6 := x ) }
  4804.    oXbp:create():setData()
  4805.    AAdd ( aEditControls, oXbp )
  4806.  
  4807.    oXbp := XbpSLE():new( oXbp2, , {12,36}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4808.    oXbp:bufferLength := 12
  4809.    oXbp:tabStop := .T.
  4810.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_7 ), CLIENT->QL_7 := x ) }
  4811.    oXbp:create():setData()
  4812.    AAdd ( aEditControls, oXbp )
  4813.  
  4814.    oXbp := XbpSLE():new( oXbp2, , {12,12}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4815.    oXbp:bufferLength := 12
  4816.    oXbp:tabStop := .T.
  4817.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_8 ), CLIENT->QL_8 := x ) }
  4818.    oXbp:create():setData()
  4819.    AAdd ( aEditControls, oXbp )
  4820.  
  4821.    oXbp := XbpSLE():new( oXbp2, , {216,180}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4822.    oXbp:bufferLength := 6
  4823.    oXbp:tabStop := .T.
  4824.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_1, '@N' ), CLIENT->QC_1 := Val(x) ) }
  4825.    oXbp:create():setData()
  4826.    AAdd ( aEditControls, oXbp )
  4827.  
  4828.    oXbp := XbpSLE():new( oXbp2, , {216,156}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4829.    oXbp:bufferLength := 6
  4830.    oXbp:tabStop := .T.
  4831.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_2, '@N' ), CLIENT->QC_2 := Val(x) ) }
  4832.    oXbp:create():setData()
  4833.    AAdd ( aEditControls, oXbp )
  4834.  
  4835.    oXbp := XbpSLE():new( oXbp2, , {216,132}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4836.    oXbp:bufferLength := 6
  4837.    oXbp:tabStop := .T.
  4838.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_3, '@N' ), CLIENT->QC_3 := Val(x) ) }
  4839.    oXbp:create():setData()
  4840.    AAdd ( aEditControls, oXbp )
  4841.  
  4842.    oXbp := XbpSLE():new( oXbp2, , {216,108}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4843.    oXbp:bufferLength := 6
  4844.    oXbp:tabStop := .T.
  4845.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_4, '@N' ), CLIENT->QC_4 := Val(x) ) }
  4846.    oXbp:create():setData()
  4847.    AAdd ( aEditControls, oXbp )
  4848.  
  4849.    oXbp := XbpSLE():new( oXbp2, , {216,84}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4850.    oXbp:bufferLength := 6
  4851.    oXbp:tabStop := .T.
  4852.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_5, '@N' ), CLIENT->QC_5 := Val(x) ) }
  4853.    oXbp:create():setData()
  4854.    AAdd ( aEditControls, oXbp )
  4855.  
  4856.    oXbp := XbpSLE():new( oXbp2, , {216,60}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4857.    oXbp:bufferLength := 6
  4858.    oXbp:tabStop := .T.
  4859.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_6, '@N' ), CLIENT->QC_6 := Val(x) ) }
  4860.    oXbp:create():setData()
  4861.    AAdd ( aEditControls, oXbp )
  4862.  
  4863.    oXbp := XbpSLE():new( oXbp2, , {216,36}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4864.    oXbp:bufferLength := 6
  4865.    oXbp:tabStop := .T.
  4866.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_7, '@N' ), CLIENT->QC_7 := Val(x) ) }
  4867.    oXbp:create():setData()
  4868.    AAdd ( aEditControls, oXbp )
  4869.  
  4870.    oXbp := XbpSLE():new( oXbp2, , {216,12}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4871.    oXbp:bufferLength := 6
  4872.    oXbp:tabStop := .T.
  4873.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_8, '@N' ), CLIENT->QC_8 := Val(x) ) }
  4874.    oXbp:create():setData()
  4875.    AAdd ( aEditControls, oXbp )
  4876.  
  4877.    oXbp3 := XbpStatic():new( oTab2, , {72,132}, {168,228} )
  4878.    oXbp3:caption := "MATERIEL MEFRAN    Quantité"
  4879.    oXbp3:clipSiblings := .T.
  4880.    oXbp3:type := XBPSTATIC_TYPE_GROUPBOX
  4881.    oXbp3:create()
  4882.  
  4883.    oXbp := XbpStatic():new( oXbp3, , {12,180}, {84,24} )
  4884.    oXbp:caption := "49-900"
  4885.    oXbp:clipSiblings := .T.
  4886.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  4887.    oXbp:create()
  4888.  
  4889.    oXbp := XbpStatic():new( oXbp3, , {12,156}, {84,24} )
  4890.    oXbp:caption := "SECURIFRAN"
  4891.    oXbp:clipSiblings := .T.
  4892.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  4893.    oXbp:create()
  4894.  
  4895.    oXbp := XbpStatic():new( oXbp3, , {12,132}, {84,24} )
  4896.    oXbp:caption := "42-700"
  4897.    oXbp:clipSiblings := .T.
  4898.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  4899.    oXbp:create()
  4900.  
  4901.    oXbp := XbpStatic():new( oXbp3, , {12,108}, {84,24} )
  4902.    oXbp:caption := "ROULANTS"
  4903.    oXbp:clipSiblings := .T.
  4904.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  4905.    oXbp:create()
  4906.  
  4907.    oXbp := XbpStatic():new( oXbp3, , {12,84}, {84,24} )
  4908.    oXbp:caption := "CH49/AUTO."
  4909.    oXbp:clipSiblings := .T.
  4910.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  4911.    oXbp:create()
  4912.  
  4913.    oXbp := XbpStatic():new( oXbp3, , {12,60}, {84,24} )
  4914.    oXbp:caption := "PLANCHERS"
  4915.    oXbp:clipSiblings := .T.
  4916.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  4917.    oXbp:create()
  4918.  
  4919.    oXbp := XbpStatic():new( oXbp3, , {12,36}, {84,24} )
  4920.    oXbp:caption := "DIFFUSION"
  4921.    oXbp:clipSiblings := .T.
  4922.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  4923.    oXbp:create()
  4924.  
  4925.    oXbp := XbpStatic():new( oXbp3, , {12,12}, {84,24} )
  4926.    oXbp:caption := "DIVERS"
  4927.    oXbp:clipSiblings := .T.
  4928.    oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
  4929.    oXbp:create()
  4930.  
  4931.    oXbp := XbpSLE():new( oXbp3, , {108,12}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4932.    oXbp:bufferLength := 6
  4933.    oXbp:tabStop := .T.
  4934.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_8, '@N' ), CLIENT->Q_8 := Val(x) ) }
  4935.    oXbp:create():setData()
  4936.    AAdd ( aEditControls, oXbp )
  4937.  
  4938.    oXbp := XbpSLE():new( oXbp3, , {108,36}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4939.    oXbp:bufferLength := 6
  4940.    oXbp:tabStop := .T.
  4941.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_7, '@N' ), CLIENT->Q_7 := Val(x) ) }
  4942.    oXbp:create():setData()
  4943.    AAdd ( aEditControls, oXbp )
  4944.  
  4945.    oXbp := XbpSLE():new( oXbp3, , {108,60}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4946.    oXbp:bufferLength := 6
  4947.    oXbp:tabStop := .T.
  4948.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_6, '@N' ), CLIENT->Q_6 := Val(x) ) }
  4949.    oXbp:create():setData()
  4950.    AAdd ( aEditControls, oXbp )
  4951.  
  4952.    oXbp := XbpSLE():new( oXbp3, , {108,84}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4953.    oXbp:bufferLength := 6
  4954.    oXbp:tabStop := .T.
  4955.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_5, '@N' ), CLIENT->Q_5 := Val(x) ) }
  4956.    oXbp:create():setData()
  4957.    AAdd ( aEditControls, oXbp )
  4958.  
  4959.    oXbp := XbpSLE():new( oXbp3, , {108,108}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4960.    oXbp:bufferLength := 6
  4961.    oXbp:tabStop := .T.
  4962.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_4, '@N' ), CLIENT->Q_4 := Val(x) ) }
  4963.    oXbp:create():setData()
  4964.    AAdd ( aEditControls, oXbp )
  4965.  
  4966.    oXbp := XbpSLE():new( oXbp3, , {108,132}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4967.    oXbp:bufferLength := 6
  4968.    oXbp:tabStop := .T.
  4969.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_3, '@N' ), CLIENT->Q_3 := Val(x) ) }
  4970.    oXbp:create():setData()
  4971.    AAdd ( aEditControls, oXbp )
  4972.  
  4973.    oXbp := XbpSLE():new( oXbp3, , {108,156}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4974.    oXbp:bufferLength := 6
  4975.    oXbp:tabStop := .T.
  4976.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_2, '@N' ), CLIENT->Q_2 := Val(x) ) }
  4977.    oXbp:create():setData()
  4978.    AAdd ( aEditControls, oXbp )
  4979.  
  4980.    oXbp := XbpSLE():new( oXbp3, , {108,180}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  4981.    oXbp:bufferLength := 6
  4982.    oXbp:tabStop := .T.
  4983.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_1, '@N' ), CLIENT->Q_1 := Val(x) ) }
  4984.    oXbp:create():setData()
  4985.    AAdd ( aEditControls, oXbp )
  4986.  
  4987.  
  4988.  
  4989. //
  4990. //----------------------------------------------------------------------
  4991. //
  4992. //  COMMENT PAGE
  4993.  
  4994.  
  4995.    oXbp := XbpSLE():new( oTab3, , {72,456}, {72,24},;
  4996.                 { { XBP_PP_BGCLR, GRA_CLR_CYAN },;
  4997.                   { XBP_PP_DISABLED_BGCLR, GRA_CLR_CYAN } ,;
  4998.                   { XBP_PP_FGCLR, GRA_CLR_BLACK } } )
  4999.    oXbp:bufferLength := 10
  5000.    oXbp:editable := .F.
  5001.    oXbp:tabStop := .T.
  5002.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIREF ), CLIENT->CLIREF := x ) }
  5003.    oXbp:create():setData()
  5004.    AAdd ( aEditControls, oXbp )
  5005.  
  5006.    oXbp := XbpSLE():new( oTab3, , {156,456}, {192,24}, { { XBP_PP_BGCLR, GRA_CLR_CYAN }, { XBP_PP_FGCLR, GRA_CLR_BLACK } } )
  5007.    oXbp:bufferLength := 30
  5008.    oXbp:editable := .T.
  5009.    oXbp:tabStop := .T.
  5010.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLINOM ), CLIENT->CLINOM := x ) }
  5011.    oXbp:create():setData()
  5012.    AAdd ( aEditControls, oXbp )
  5013.  
  5014.    oXbp := XbpMle():new( oTab3, , {84,68}, {588,328}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
  5015.    oXbp:wordWrap :=.T.
  5016.    oXbp:horizScroll := .F.
  5017.    oXbp:editable:=.T.    
  5018.    oXbp:setFontCompoundName( "10.Arial" )
  5019.    oXbp:tabStop := .T.
  5020.    oXbp:dataLink := {|x| IIf( PCOUNT()==0, CLIENT->COMMENTAIR, CLIENT->COMMENTAIR := x ) }
  5021.    oXbp:create():setData()
  5022.    AAdd ( aEditControls, oXbp )
  5023.  
  5024.    oDlg:show()
  5025.    SetAppFocus(oDlg)
  5026.  
  5027.    nEvent := xbe_None
  5028.    DO WHILE nEvent <> xbeP_Close
  5029.       nEvent := AppEvent( @mp1, @mp2, @oXbp )
  5030.       oXbp:handleEvent( nEvent, mp1, mp2 )
  5031.    ENDDO
  5032.    oDlg:hide()
  5033.    oDlg:destroy()
  5034. RETURN .T.
  5035.  
  5036. //
  5037. //--------------------------------------------------------
  5038. //
  5039. FUNCTION MAIN_MENU ()
  5040.  
  5041.  
  5042. LOCAL LL, CHOICE, cSaveScrn, PromptList
  5043. LOCAL The_Prompts :=  {}, SM := {}, The_Codes :=  {}
  5044.  
  5045. The_Prompts :=  { ;
  5046.                 "MENU",;
  5047.                     {"Historique",           {||Dispatcher ("MH")},; 
  5048.                      "@",, ;
  5049.                      "Impression",           {||Dispatcher ("IM")},;
  5050.                      "@",, ;
  5051.                      "Saisie Commande",      {||Dispatcher ("CC")},;
  5052.                      "Modification Commande",{||Dispatcher ("CM")},;
  5053.                      "Commandes en cours",   {||Dispatcher ("EC")},;
  5054.                      "@",, ;
  5055.                      "Suppression",          {||Dispatcher ("S")},;
  5056.                      "@",, ;
  5057.                      "Catalogue",            {||Dispatcher ("SM")},;
  5058.                      "@",, ;
  5059.                      "RETOUR",               {||QUIT_IT()}   },;
  5060.                 "?",;
  5061.                     {"Général",      {||HELP_ME("01")},;
  5062.                      "Recherche",    {||HELP_ME("02")},;
  5063.                      "Catégories",   {||HELP_ME("03")} };
  5064.                   }
  5065.                       
  5066.    CREATE_MENU (The_Prompts)
  5067.    RETURN .T.
  5068. //
  5069. //----------------------------------------------------------
  5070. //
  5071. FUNCTION QUIT_IT()
  5072.  
  5073. PostAppEvent (xbeP_Close)
  5074.  
  5075. RETURN .T.
  5076. //
  5077. //-----------------------------------------------------------------------------------------------
  5078. //
  5079. FUNCTION CREATE_MENU(The_Choices)
  5080. LOCAL i, j, oMenu, Menu_Items, oSubMenu, SM, k
  5081.  
  5082. FOR i = 1 TO LEN (The_Choices) STEP 2
  5083.  
  5084.    oMenu    := XbpMenu():new( The_Menu_Bar )  // New MENU object
  5085.    oMenu:title := The_Choices[i]              // Menu Name 
  5086.    oMenu:setName(i * 100)                     // Code for this menu   
  5087.    oMenu:create()
  5088.  
  5089.    Menu_Items = The_Choices[i+1]
  5090.    FOR j = 1 TO LEN (Menu_Items) -1 STEP 2
  5091.       IF ValType (Menu_Items [j]) = "A"
  5092.       
  5093.          SM = Menu_Items [j]
  5094.          oSubMenu       := XbpMenu():new( oMenu )
  5095.          oSubMenu:title := SM[1]   
  5096.          oSubMenu:create()
  5097.  
  5098.          SM = SM[2]
  5099.          FOR k = 1 TO LEN(SM)-1 STEP 2
  5100.             IF (SM [k]) = "@"
  5101.                oSubMenu:addItem( {NIL, NIL, XBPMENUBAR_MIS_SEPARATOR, 0} )
  5102.             ELSE
  5103.                oSubMenu:addItem( { SM[k], SM[k+1] } )
  5104.             ENDIF   
  5105.          NEXT k
  5106.          
  5107.          oMenu:addItem( { oSubMenu, NIL } )
  5108.  
  5109.       ELSEIF (Menu_Items [j]) = "@"
  5110.          oMenu:addItem( {NIL, NIL, XBPMENUBAR_MIS_SEPARATOR, 0} )
  5111.       ELSE
  5112.          oMenu:addItem( {Menu_Items [j] , Menu_Items [j+1]},  )   
  5113.       ENDIF   
  5114.    NEXT j
  5115.  
  5116.    The_Menu_Bar:addItem( {oMenu, NIL} )     // Create the Menu
  5117.  
  5118. NEXT i
  5119.  
  5120. RETURN .T.
  5121. //
  5122. //-----------------------------------------------------
  5123. //
  5124. FUNCTION Dispatcher (Control)
  5125.  
  5126.  
  5127. Menu_On_Off (.F.)             // disable other menu choices
  5128. The_Menu_Bar:enableItem(The_Menu_Bar:numItems())    // Except HELP
  5129.  
  5130. DO CASE
  5131.    CASE Control = "MH"   // Historique
  5132.       DO EV  
  5133.          
  5134.    CASE Control = "IM"   // Impression
  5135.       i=1  
  5136.    CASE Control = "CC"   // Saisie Commande
  5137.       SET CURSOR ON
  5138.       DO S_COMM WITH "1"
  5139.       
  5140.    CASE Control = "CM"   // Modif. Cde  
  5141.       i=1     
  5142.          
  5143.    CASE Control = "EC"   // Cdes en Cours 
  5144.       DO CC     
  5145.       
  5146.    CASE Control = "S"    // Suppression
  5147.       i=1     
  5148.       
  5149.    CASE Control = "SM"   // Stock
  5150.      DO ST WITH 4
  5151.       
  5152.    
  5153. ENDCASE
  5154.  
  5155. Menu_On_Off (.T.)             // enable menu choices
  5156. RETURN .T.
  5157. //
  5158. //-----------------------------------------------------------------------------------------------
  5159. //
  5160.  
  5161. FUNCTION Menu_On_Off(CONTROL)
  5162. LOCAL oMenu ,I,J
  5163.  
  5164. FOR i = 1 TO The_Menu_Bar:numItems()      // Number of main menu items
  5165.    IF Control
  5166.       The_Menu_Bar:enableItem( i ) 
  5167.    ELSE
  5168.       The_Menu_Bar:disableItem( i ) 
  5169.    ENDIF   
  5170. NEXT 
  5171. RETURN .T.
  5172.  
  5173. //
  5174. //-----------------------------------------------------------------------------------------------
  5175. //
  5176. //
  5177. //////////////////////////////////////////////////////////////////////
  5178. //
  5179. //  APPSYS.PRG
  5180. //
  5181. //  Copyright:
  5182. //      Alaska Software, (c) 1997-2002. All rights reserved.         
  5183. //  
  5184. //  Contents:
  5185. //      AppSys() - Creates default application window
  5186. //   
  5187. //  Remarks:
  5188. //      This file is part of the XppRt0.lib.
  5189. //   
  5190. //  Syntax:
  5191. //      The function AppSys() is called automatically during 
  5192. //      the programm startup.
  5193. //   
  5194. //////////////////////////////////////////////////////////////////////
  5195.  
  5196. #include "xbp.ch"
  5197.  
  5198. ****************************************************************************
  5199. * Function AppSys() to create default output devices
  5200. ****************************************************************************
  5201.  
  5202. FUNCTION AppSys()
  5203.  
  5204. #define DEF_ROWS       30
  5205. #define DEF_COLS       80
  5206.  
  5207. LOCAL oCrt, nAppType := AppType()
  5208. LOCAL aSizeDesktop, aPos
  5209. LOCAL DEF_FONTHEIGHT:= 16
  5210. LOCAL DEF_FONTWIDTH:=  8
  5211.  
  5212. PUBLIC aWindow[3], The_Menu_Bar
  5213.  
  5214. // Compute window position (center window 
  5215. // on the Desktop)
  5216. aSizeDesktop    := AppDesktop():currentSize()
  5217.  
  5218. *IF aSizeDesktop[1] > 800
  5219. *   DEF_FONTHEIGHT:= 22
  5220. *   DEF_FONTWIDTH:=  12
  5221. *ENDIF          
  5222.  
  5223. aPos            := { (aSizeDesktop[1]-(DEF_COLS * DEF_FONTWIDTH))  /2, ;
  5224.                      (aSizeDesktop[2]-(DEF_ROWS * DEF_FONTHEIGHT)) /2  }
  5225.  
  5226. // Create XbpCRT object
  5227. oCrt := XbpCrt():New ( NIL, NIL, aPos, DEF_ROWS, DEF_COLS )
  5228. oCrt:FontWidth  := DEF_FONTWIDTH
  5229. oCrt:FontHeight := DEF_FONTHEIGHT
  5230. oCrt:title      := "MEDEF - REPERTOIRE DES AIDES"
  5231.  
  5232. IF aSizeDesktop[1] <= 800
  5233.    oCrt:FontName   := "Alaska Crt"
  5234. ELSE 
  5235.    oCrt:FontName   := "Lucida Console"
  5236. ENDIF   
  5237.  
  5238. oCrt:Create()
  5239. aWindow[1] := oCrt
  5240. *The_Menu_Bar := oCrt:menuBar()     // Set up the Menu system PUBLIC variable
  5241. *MAIN_MENU () 
  5242.  
  5243. oCrt:setpos(apos) 
  5244.  
  5245. // Init Presentation Space
  5246. oCrt:PresSpace()
  5247.  
  5248. // XbpCrt gets active window and output device
  5249. SetAppWindow ( oCrt )
  5250. SETCOLOR ("n/w")
  5251. CLEAR
  5252.  
  5253.  
  5254. //
  5255. // Help Window
  5256. //
  5257. aWindow[2] := XbpCrt():new(AppDesktop(), NIL, {50, 100}, 24, 80, "ASSISTANCE" ) 
  5258. aWindow[2]:FontWidth  := 8
  5259. aWindow[2]:FontHeight := 16
  5260. aWindow[2]:create() 
  5261. aWindow[2]:setModalState (XBP_DISP_APPMODAL)
  5262. aWindow[2]:PresSpace()
  5263.  
  5264. SetAppWindow( aWindow[2] )
  5265. SETCOLOR ('n/w,r/w')
  5266. CLS
  5267. aWindow[2]:hide()
  5268. //
  5269. // Mot_Clé window
  5270. //
  5271. aWindow[3] := XbpCrt():new(AppDesktop(), NIL, {50, 100}, 5, 20, "" ) 
  5272. aWindow[3]:FontWidth  := DEF_FONTWIDTH
  5273. aWindow[3]:FontHeight := DEF_FONTHEIGHT
  5274. aWindow[3]:Border := XBPDLG_NO_BORDER
  5275. aWindow[3]:Closeable := .F.
  5276. aWindow[3]:titleBar := .F.    
  5277. aWindow[3]:FontName   := "Arial"
  5278. aWindow[3]:create() 
  5279. aWindow[3]:PresSpace()
  5280. SetAppWindow( aWindow[3] )
  5281. SETCOLOR ('n/w,r/w')
  5282. CLS
  5283. aWindow[3]:hide()
  5284.  
  5285. SetAppWindow ( oCrt )
  5286. oBMP2:= XbpBitmap():new():create( oCrt )  // Logo for display
  5287. oBMP2:loadfile( "LOGO2.BMP" )
  5288. oBMP2:draw( NIL, {100 ,100} )             // Draw the logo
  5289. SetAppFocus(oCrt)
  5290.  
  5291. RETURN .T.
  5292.  
  5293.  
  5294.  
  5295.  
  5296.  
  5297.  
  5298.  
  5299.