home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
mail.altrad.com
/
2015.02.mail.altrad.com.tar
/
mail.altrad.com
/
TEST
/
COMMERC_72_53OLD
/
commerc
/
PROGSOLD
/
temp.PRG
< prev
next >
Wrap
Text File
|
2014-04-02
|
150KB
|
5,286 lines
PROCEDURE MAIN ()
* Auteur...: R M ALCOCK
* Date.....: 4 JAN 1998
* Copyright: (c) 1995, R M ALCOCK, Tous droits réservés
* Notes....: Commercial Interface for VRP portables
*
*
#include "Inkey.ch"
#include "Setcurs.ch"
#include "Params"
#include "Directry.ch" // For DIRECTORY function
#include "DCDIALOG.CH"
#include "DCPRINT.CH"
#include "FONT.CH"
#include "Appevent.ch"
#include "Gra.ch"
#include "Xbp.ch"
#include "Nls.ch"
#include "DCbitmap.ch"
*
LOCAL Mret, Last_Date, VolName
SETCURSOR(SC_NORMAL)
*
SET CONFIRM ON
SET DATE FRENCH
SET DELETED ON
SET EXACT ON
SET EXCLUSIVE OFF
SET FIXED OFF
SET SCOREBOARD OFF
SET WRAP ON
SET EPOCH TO 1980
*SET DEFAULT TO F:
*NationMsg("fr")
SetLocale( NLS_SCURRENCY, Chr(213) ) // Two lines to activate the euro symbol
SetLocale( NLS_ICURRENCYEURO, "1" )
LANGUAGE = "fr"
*
*EXTERNAL WIN,WOUT,HLON,HLOFF,PASSWD,RMAMENU,keysoff,RA_BRWSWHL
*
public mbuff, fb[10], fref, MENUCLR, PICKCLR
PUBLIC MTVA, MMONTANT, REMTOT, MFACTOT, TOTTTC, DPAY, MMQTE
// MMQTE added for PROFESS
PUBLIC New_Tarif:=.F., MDAT_MAX, M_Reg, M_Resp, MCLI, MRCODE, HCODE
PUBLIC F_Ran, V_Ran, SEED, M_Control
PUBLIC LCD
public M_FILTER:="", M_Browse, cKey, N_Cli, N_Rec
PUBLIC M_CLIC,M_TEL,M_ACT,CLIN,MCP,M_CLIP,T_Min,M_Dat1,M_Dat2,M_R_S,M_R_E
PUBLIC GetList:={}
PUBLIC ChosenClient
//
NET_USE (S_ATTACH, "ATTACH", .T., 0, "", "")
MDAT_MAX = ATTACH->DATE_MAX
M_Reg = ATTACH->REGION
M_Resp = ATTACH->OWNER
M_Control = ATTACH->PCON
LCD = ATTACH->LCD_SCREEN
USE
IF ISCOLOR()
MENUCLR = D_MenuClr // From PARAMS
PICKCLR = D_PickClr
ELSE
MENUCLR=SETCOLOR()
PICKCLR="W/N,N/W,W/N,N/BG,W/N"
ENDIF
CLEAR
MT=CONAME+" - SYSTEM COMMERCIAL"
SEED=VAL(READ_SEED(6,5, MT, M_Reg)) // In file ENCODE.PRG
F_Ran = RANDOM (SEED, 5, 31) // Generate 100 random n°s between 1 and 31
//
//
IF FILE ("XFER\NEWCLI.DBF")
NET_USE (S_TEMP1, "XFER\NEWCLI", .F., 0, "", "")
Last_Date = CTOD(DTOC(LUPDATE())) + 360 // Must ring Florensac every 60 days
// temporarily very long !!!!!
USE
ELSE
Last_Date = CTOD("01/12/10") // For the time being
ENDIF
//
VolName := DIRECTORY("C:", "V") // Read the label
//
// If PWD.MEM exists when prog is restarted, something is wrong !
IF (FILE ("C:\PWD.MEM");
.OR. DATE() > Last_Date;
.OR. VolName [1,F_NAME] <> "ALTRAD");
.AND. SEED <> -1
CLEAR
@ 7,2 SAY ""
TEXT
La dernière fois que l'ordinateur était arreté, vous n'aviez pas
quitté le programme. Par consequent, il est nécessaire de réparer
les fichiers. Il est aussi possible que les dernières modifications
(et/ou saisie) n'ont pas été enregistrées.
Patientez S.V.P.
ENDTEXT
NET_USE (S_CLIENT, "CLIENT", .T., 20, "", "")
IF DATE() > Last_Date;
.OR. VolName [1,F_NAME] <> "ALTRAD"
do while .f.
//
// Exterminate, Exterminate .......
//
GO BOTT
SKIP -1
COPY NEXT 1 TO TEMP
USE
* SWPRUNCMD("COPY CLIENT.DBF AZ.DBF>FRED",0, "", "")
* SWPRUNCMD("COPY CLIENT.DBT AZ.DBT>FRED",0, "", "")
COPY FILE CLIENT.DBF TO AZ.DBF
COPY FILE CLIENT.DBT TO AZ.DBT
NET_USE (S_CLIENT, "CLIENT", .T., 20, "", "")
ZAP
APPEND FROM TEMP
APPEND FROM AZ
NET_USE (S_TEMP1, "AZ", .T., 20, "", "")
ZAP
USE
* SWPRUNCMD("DEL TEMP.DB?",0, "", "")
* SWPRUNCMD("DEL AZ.DB?",0, "", "")
ERASE TEMP.DBF
ERASE TEMP.DBT
ERASE AZ.DBF
ERASE AZ.DBT
enddo
ELSE
// Check if any records are in the wrong state
LOCATE FOR .NOT. CLISCRAMBL
IF FOUND()
DO WHILE.NOT.EOF()
SCRAM_CLI (SEED)
CONTINUE
ENDDO
// Re-Index everything
USE
* SWPRUNCMD("PROGS\REINDEX *",0, "", "")
DO REINDEX WITH "*"
ENDIF
ENDIF
ENDIF
//
SAVE ALL LIKE M_Control TO C:\PWD // Create the file to detect illegal termination
//
ERRORLEVEL(0)
NET_USE (S_CLIENT, "CLIENT", .F., 20, "", "")
SET INDEX TO CLIREF,CLINOM,CLICP
NET_USE (S_STOCK, "STOCK", .F., 20, "STCREF,STRLIB", "")
*
DO WHILE .T.
bBlock = SetKey( K_F1, { || help_me ( ProcName(), ProcLine(), "" ) } )
SetMouse(.T.)
DO HLOFF WITH LCD
CLEAR
SELECT CLIENT
GO TOP
SET ORDER TO 1
SET FILTER TO
DO HLON
@ 23,35 SAY "F1 : Aide"
DO HLOFF WITH LCD
*
Mret=R_CLI(.T.) // Select Client, Allow creation
IF Mret <= 0 // Vide
IF SELECT ("TEMPCLIN") <> 0
SELECT TEMPCLIN
USE
ENDIF
IF Mret < 0
LOOP
ENDIF
IF ConfirmBox( , ;
"Voulez vous terminer le programme ?", ;
"Quitter", ;
XBPMB_YESNO , ;
XBPMB_QUESTION+XBPMB_APPMODAL+XBPMB_MOVEABLE, ;
XBPMB_DEFBUTTON2 ) = XBPMB_RET_NO
LOOP
ENDIF
CLEAR
ERASE C:\PWD.MEM // To confirm correct exit
RETURN // No Client selected
ENDIF
DO WHILE .T.
IF Mret=1 // Need to search
FREF = R_CLI2()
IF EMPTY(FREF)
SELECT TEMPCLIN
USE
EXIT
ENDIF
ELSE
FREF = CLIREF
ENDIF
//
// Client is selected
//
CLEAR
IF .NOT. REC_LOCK(30) // Need lock to unscramble
RETURN
ENDIF
UNSCRAM_CLI(SEED)
Window_cli(4) // Display Client Details
SET CURSOR ON
SCRAM_CLI(SEED)
UNLOCK
IF Mret=2 // Only one client
EXIT
ENDIF
ENDDO
ENDDO
RETURN
*
****************************************
*
FUNCTION CC
*.......................................
*
*COMMANDES
*
//
*
LOCAL aFields := {}, cKey, cOldColor, nRecSel
*
NET_USE (S_FACTA, "FACTA", .F., 30, "FACTR", "")
NET_USE (S_COM, "COM", .F., 30, "COM,COMCL", "BON")
SET ORDER TO 2
do keysoff
*
cKey=fref
cOldColor := SetColor("W/B")
AADD(aFields, {"REF", {||BON->COMMANDE} } )
AADD(aFields, {"ST" , {||BON->C_STATUS} } )
AADD(aFields, {"DATE", {||BON->D_COMM } } )
AADD(aFields, {"MONTANT", {||ROUND(BON->MONTANT*(1-BON->REM_SUP/100),2)} } )
DO WHILE .T.
nRecSel := RA_BRWSWHL(aFields, {||BON->REFCLI = cKey}, cKey, 0, PICKCLR,;
8, 1, 22, MaxCol()-1, "F9 - ZOOM COMMANDE",, )
DO CASE
CASE nRecSel == 0
EXIT // No record selected (Esc)
CASE nRecSel < 0 // No matching Record
do none with 18,1,20,78,mbuff
EXIT
OTHERWISE
do ZCC
ENDCASE
ENDDO
SetColor(cOldColor)
CLEAR SCREEN
SELECT BON
use
SELECT FACTA
USE
select CLIENT
do kon
RETURN .T.
*
****************************************
*
FUNCTION CC2
*.......................................
*
*Lines on COMMANDE
*
*
LOCAL aFields := {}, cKey, cOldColor, nRecSel, mbuff
*
NET_USE (S_FACTA, "FACTA", .F., 30, "FACTR", "")
NET_USE (S_COM, "COM", .F., 30, "COM,COMCL", "BON")
SET ORDER TO 2
set exact off
SET RELATION TO COMMANDE INTO FACTA
do keysoff
*
cKey=fref
seek cKey
locate rest for val(c_status)<10
if .not. found()
do none with 18,1,20,78,mbuff
else
select FACTA
copy rest to c:temp1 while facture=bon->commande
net_use (S_TEMP1, "c:temp1", .T., 0, "", "")
select bon
continue
do while refcli=fref
select FACTA
copy rest to c:temp2 while facture=bon->commande
select temp1
append from c:temp2
select bon
continue
enddo
erase c:temp2.dbf
select bon
set relation to
set order to 1
select temp1
delete for substr(article,1,1) $ "+-*"
pack
index on article to c:temp1
set relation to facture into bon
go top
cKey=article
cOldColor := SetColor("W/B")
AADD(aFields, {"REF", {||TEMP1->ARTICLE} } )
AADD(aFields, {"DESIG.",{||TEMP1->LIB } } )
AADD(aFields, {"QUANTITE" , {||TEMP1->QUANTITE } } )
AADD(aFields, {"DATE", {||BON->D_COMM } } )
DO WHILE .T.
nRecSel := RA_BRWSWHL(aFields, {||.T.}, cKey, 0, PICKCLR,;
8, 1, 22, MaxCol()-1, "ARTICLES EN COMMANDE",, )
DO CASE
CASE nRecSel == 0
EXIT // No record selected (Esc)
CASE nRecSel < 0 // No matching Record
do none with 18,1,20,78,mbuff
EXIT
OTHERWISE
ENDCASE
ENDDO
select temp1
use
erase c:temp1.dbf
erase c:temp1.ntx
endif
SetColor(cOldColor)
CLEAR SCREEN
SELECT BON
use
SELECT FACTA
USE
select CLIENT
do kon
set exact on
RETURN .T.
*
***
*
FUNCTION ZCC
LOCAL zbuff:="", t:=0, l:=0, b:=23, r:=79
//
// Need rec_lock here because two people could try to change the lines at once
// which would work because the lines are in TEMP not FACTA. Sort of deadly
// embrace. LOCK should sort this out because it effectively locks both
// the header and the lines. Need to make sure the same logic holds in the
// MENU version of the program.
//
REC_LOCK(0)
DO HLOFF WITH LCD
do keysoff
do win with t,l,b,r,zbuff,"COMMANDE"
DO COMM_OUT
@ 24,0 CLEAR TO 24,79
DO HLON
mt= "F1-HELP F2-MENU"
@ 24,40-len(mt)/2 SAY mt
DO HLOFF WITH LCD
SET CURSOR OFF
@ 22,10 SAY""
DO WHILE LASTKEY()<>27
set key K_F2 to COMMMENU
wait "" // Wait allows function key actvation
ENDDO
SET CURSOR OFF
do wout with t,l,b,r,zbuff
@ 24,0 CLEAR TO 24,79
set key K_F2 to
*keyboard CHR(K_ESC) // Force Exit
RETURN .T.
*
****************************************
*
FUNCTION EV
*.......................................
*
*EVENTS
*
//
*
LOCAL aFields := {}, La:=SELECT(), mst, aSort[6], aSaveSort, aPres, bEval
*
NET_USE (S_EVENT, "EVENT", .F., 30, "EVENT,EVECODE", "")
SEEK CLIENT->CLIREF
IF .NOT. FOUND() .OR. LASTREC() == 0
do none with 18,1,20,78,mbuff
RETURN .T.
ENDIF
do keysoff
COPY TO "TEMPEV" WHILE EVENT->REFCLI = CLIENT->CLIREF
NET_USE (S_EVENT, "TEMPEV", .T., 0, "", "EVENT")
INDEX ON DTOS(D_CRE)TO TEVDAT
INDEX ON BONREF TO TEVCODE
INDEX ON TYPE TO TEVTYPE
SET INDEX TO TEVDAT, TEVCODE, TEVTYPE
*
aSort[1] := GRA_CLR_WHITE // Sort Selected Color (Foreground)
aSort[2] := GRA_CLR_RED // Sort Selected Color (Background)
aSort[3] := GRA_CLR_WHITE // Sort Unselected Color (Foreground)
aSort[4] := GRA_CLR_DARKGRAY // Sort Unselected Color (Background)
aSort[5] := BITMAP_RD_UP_RED // Sort UP Bitmap
aSort[6] := BITMAP_RD_DOWN_RED // Sort DOWN Bitmap
aSaveSort := DC_FindBrowseSort(aSort)
aPres := ;
{ { XBP_PP_COL_HA_FGCLR, GRA_CLR_WHITE }, ;
{ XBP_PP_COL_HA_BGCLR, GRA_CLR_DARKGRAY }, ;
{ XBP_PP_COL_DA_FGCLR, GRA_CLR_BLACK }, ;
{ XBP_PP_COL_DA_BGCLR, GRA_CLR_WHITE } }
aPres := ;
{ { XBP_PP_COL_HA_FGCLR, GRA_CLR_WHITE }, ;
{ XBP_PP_COL_HA_BGCLR, GRA_CLR_DARKGRAY }, ;
{ XBP_PP_COL_DA_FGCLR, GRA_CLR_BLACK }, ;
{ XBP_PP_COL_DA_BGCLR, GRA_CLR_WHITE } }
aFields := ;
{ ; // field Header Width Index Prompt
{ {||EVENT->D_CRE}, 'Date', 10, "TEVDAT", 'Date' } , ;
{ {||EVENT->TYPE}, 'Libellé', 25, "TEVTYPE", 'Type' }, ;
{ {||EVENT->BONREF}, 'N° Bon', 6, "TEVCODE", 'Bon' } ;
}
bEval := {|o|o:drawingArea:setColorBG(GRA_CLR_CYAN)}
mst = DC_FindBrowse( aFields, nil, nil, nil, 90, 20, ;
"HISTORIQUE (Cliquer Droit sur en-tête pour changer l'index)", ;
nil, nil, nil, nil, nil, bEval, ;
{ aPres, { GRA_CLR_DARKGRAY, GRA_CLR_RED } }, ;
nil, nil, nil, .5 )
DC_FindBrowseSort(aSaveSort)
IF Mst
do ZEV
ENDIF
CLEAR SCREEN
SELECT EVENT
USE
SELECT(La)
do kon
RETURN .T.
***
*
FUNCTION ZEV
LOCAL zbuff:="", t:=0, l:=0, b:=23, r:=79, mt
//
DO HLOFF WITH LCD
do win with t,l,b,r,zbuff, ALLTRIM(EVENT->TYPE)
SELECT EVENT
DO CASE
CASE EVENT->TYPE = "FACTURE"
NET_USE (S_FACT, "FACT", .F., 0, "FACT", "BON")
SEEK SUBSTR(EVENT->BONREF,1,6)+SUBSTR(EVENT->BONREF,8,2)
IF .NOT. FOUND().OR. REFCLI<>EVENT->REFCLI
ALARM ("ERREUR SYSTEME 02 "+REFCLI+" "+EVENT->REFCLI)
ELSE
DO FACT WITH .F., .F.
ENDIF
USE
CASE EVENT->TYPE = "AVOIR"
NET_USE (S_AVO, "AVO", .F., 0, "AVREF", "BON")
SEEK SUBSTR(EVENT->BONREF, 1, LEN(BON->FACTURE))
IF .NOT. FOUND().OR. REFCLI<>EVENT->REFCLI
ALARM ("ERREUR SYSTEME 03 "+REFCLI+" "+EVENT->REFCLI)
ELSE
DO FACT WITH .F., .T.
ENDIF
USE
CASE EVENT->TYPE = "COMMANDE"
NET_USE (S_COM, "COM", .F., 0, "COM", "BON")
SEEK SUBSTR(EVENT->BONREF, 1, LEN(BON->COMMANDE))
IF .NOT. FOUND().OR. REFCLI<>EVENT->REFCLI
ALARM ("ERREUR SYSTEME 04 "+REFCLI+" "+EVENT->REFCLI)
ELSE
DO COMM_OUT
ENDIF
USE
OTHERWISE
DO LIT_INIT
SEEK SUBSTR(EVENT->BONREF, 1, LEN(LITIGE->CODE))
// On CDV's machine, may be several visits with the same number
LOCATE REST FOR CLIENT = EVENT->REFCLI;
WHILE CODE = SUBSTR(EVENT->BONREF, 1, LEN(LITIGE->CODE))
IF .NOT. FOUND()
ALARM ("ERREUR SYSTEME 01 "+CLIENT+" "+EVENT->REFCLI)
ELSE
DO WHILE LASTKEY()<>27
DO LITFMT WITH 3 // normally delete but doesn't matter
DO HLON
mt= "F1-HELP F2-MENU"
@ 24,0 CLEAR TO 24,79
@ 24,40-len(mt)/2 SAY mt
DO HLOFF WITH LCD
SET CURSOR OFF
@ 22,10 SAY""
set key K_F2 to LITMENU
wait "" // Wait allows function key actvation
ENDDO
SET CURSOR OFF
@ 24,0 CLEAR TO 24,79
set key K_F2 to
keyboard CHR(K_ESC) // Force Exit
ENDIF
USE
ENDCASE
DO WHILE INKEY()<>27
ENDDO
do wout with t,l,b,r,zbuff
@ 24,0 CLEAR TO 24,79
SELECT EVENT
RETURN .T.
*
****************************************
*
FUNCTION LITMENU
*.......................................
*
LOCAL MA:= {}, MBUFF1:="", MSel:=SELECT()
LOCAL l:=50, b:=22
LOCAL t,r:=l+22
LOCAL L_CNT, ML, MPL
PRIVATE oPrinter
do keysoff
@ 24,0 CLEAR
AADD (MA, "RETOUR")
AADD (MA, "Modifier")
AADD (MA, "Imprimer")
AADD (MA, "Supprimer")
t=b-len(MA)-1
DO WIN WITH t,l,b,r,MBUFF1,"",""
SET COLOR TO &MENUCLR
SET WRAP ON
MCHOIX=ACHOICE(t+1,l+2,b-1,r-2,MA)
DO WOUT WITH t,l,b,r,MBUFF1
DO HLOFF WITH LCD // Get colour right again
DO CASE
CASE MCHOIX=2
SET CURSOR ON
DO LITFMT WITH 2 // Modify
SET CURSOR OFF
CASE MCHOIX=3 // Imprimer
* SETPRC(0,0)
* Default_Printer
* SET DEVICE TO PRINT
DCPRINT ON TO oPrinter
DO PRINT_L
@ DC_PRINTERROW()+1,0 DCPRINT SAY ""
L_CNT=MLCOUNT(COMMENTAIR, 62, 4, .T.)
FOR ML=1 TO L_CNT
MPL=MEMOLINE(COMMENTAIR,62,ML,4,.T.)
@ DC_PRINTERROW()+1, 4 DCPRINT SAY MPL
IF DC_PRINTERROW() > 53
DCPRINT EJECT
ENDIF
NEXT
DCPRINT EJECT
DCPRINT OFF
* Default_Printer
* SET DEVICE TO SCREEN
CASE MCHOIX=4 // Delete
IF CONFIRM (18,, "N", "CONFIRMATION SUPPRESSION")
SELECT EVENT
REC_LOCK()
DELETE
UNLOCK
SELECT LITIGE
REC_LOCK()
DELETE
UNLOCK
SELECT(MSel)
keyboard CHR(K_ESC) // Force Exit
RETURN .T.
ENDIF
ENDCASE
keyboard " " // Force Exit from wait
SELECT(MSel)
RETURN .T.
//
//-----------------------------------------------------------------
//
FUNCTION kon
*.......................................
RETURN .T.
**
//
//-----------------------------------------------------------------
//
FUNCTION NONE
*.......................................
parameters t,l,b,r,abuff
*
Alert( "VIDE")
/*DO HLON
do win with t,l,b,r,abuff,"VIDE"
do while INKEY(0) <> K_ESC
enddo
DO HLOFF WITH LCD
do wout with t,l,b,r,abuff
*/
RETURN .T.
*
//
//-----------------------------------------------------------------
//
FUNCTION Pg_Up
*.......................................
SCRAM_CLI(SEED)
UNLOCK
SELECT TEMPCLIN
SKIP -1
IF BOF()
Tone(800)
GO TOP
ENDIF
SELECT CLIENT
REC_LOCK(0) // Need lock to unscramble
REC_LOCK(0)
UNSCRAM_CLI(SEED)
FREF=CLIENT->CLIREF
RETURN .T.
//
//-----------------------------------------------------------------
//
FUNCTION Pg_Dn
*.......................................
SCRAM_CLI(SEED)
UNLOCK
SELECT TEMPCLIN
SKIP
IF EOF()
Tone(500)
GO BOTT
ENDIF
SELECT CLIENT
REC_LOCK(0) // Need lock to unscramble
REC_LOCK(0)
UNSCRAM_CLI(SEED)
FREF=CLIENT->CLIREF
RETURN .T.
//
//-----------------------------------------------------------------
//
FUNCTION Imp_FICHE
*.......................................
DCPRINT ON TO oPrinter
Det_Out (2,.F.) // Line 3, Don't unscramble/scramble
DCPRINT Eject
DCPRINT OFF
RETURN .T.
//
//---------------------------------------------------
//
FUNCTION ST // Choose a Stock Item from a browsed list
LOCAL La, mst, aFields := {}, cKey, cOldColor, nRecSel, nOrder
LOCAL t:=0,l:=0,b:=24,r:=79,Zbuff:=""
LOCAL aPres, aSort[6], aSaveSort, bEval
PARAMETERS ZOOMON,CONTROL // ZOOMON = .F. does not allow a zoom to full article
// details (e.g. when called from R_ART)
*
*
IF PCOUNT()<>1 // When ST is called on a FN key, PCOUNT=3
// Otherwise it is 1 (with param) or 0 (no para.)
ZOOMON=.T. // Default=.T. ( MODIFY STOCK gives PCOUNT()= 1)
ENDIF
IF PCOUNT()<>2
CONTROL=4 // default is NOT READ
ENDIF
IF PCOUNT()<>3
FROMSTM=.T. // Called by R_ART, Client may not be set up
ENDIF
*
DO KEYSOFF
La=SELECT()
select STOCK
nOrder=INDEXORD()
GO TOP
aSort[1] := GRA_CLR_WHITE // Sort Selected Color (Foreground)
aSort[2] := GRA_CLR_RED // Sort Selected Color (Background)
aSort[3] := GRA_CLR_WHITE // Sort Unselected Color (Foreground)
aSort[4] := GRA_CLR_DARKGRAY // Sort Unselected Color (Background)
aSort[5] := BITMAP_RD_UP_RED // Sort UP Bitmap
aSort[6] := BITMAP_RD_DOWN_RED // Sort DOWN Bitmap
aSaveSort := DC_FindBrowseSort(aSort)
aPres := ;
{ { XBP_PP_COL_HA_FGCLR, GRA_CLR_WHITE }, ;
{ XBP_PP_COL_HA_BGCLR, GRA_CLR_DARKGRAY }, ;
{ XBP_PP_COL_DA_FGCLR, GRA_CLR_BLACK }, ;
{ XBP_PP_COL_DA_BGCLR, GRA_CLR_WHITE } }
aPres := ;
{ { XBP_PP_COL_HA_FGCLR, GRA_CLR_WHITE }, ;
{ XBP_PP_COL_HA_BGCLR, GRA_CLR_DARKGRAY }, ;
{ XBP_PP_COL_DA_FGCLR, GRA_CLR_BLACK }, ;
{ XBP_PP_COL_DA_BGCLR, GRA_CLR_WHITE } }
aFields := ;
{ ; // field Header Width Index Prompt
{ {||STOCK->STCOMMREF}, 'Réf', 5, "STCREF", 'Référence' } , ;
{ {||STOCK->STLIB}, 'Libellé', 25, "STRLIB", "Libellé" }, ;
{ {||STOCK->STPRIXVTR}, 'Prix Tarif', 5, nil, nil }, ;
{ {||STOCK->STCESSTR}, 'Cession', 5, nil, nil }, ;
{ {||STOCK->POIDS}, 'Poids', 4, nil, nil } ;
}
bEval := {|o|o:drawingArea:setColorBG(GRA_CLR_CYAN)}
mst = DC_FindBrowse( aFields, nil, nil, nil, 90, 20, ;
"A R T I C L E S (Cliquer Droit sur en-tête pour changer l'index)", ;
nil, nil, nil, nil, nil, bEval, ;
{ aPres, { GRA_CLR_DARKGRAY, GRA_CLR_RED } }, ;
nil, nil, nil, .5 )
DC_FindBrowseSort(aSaveSort)
SELECT(La)
RETURN .T.
**********************************
*
FUNCTION R_ART ( R,C,MART )
LOCAL La
La=SELECT()
SELECT STOCK
IF PCOUNT()<3
MART=SPACE(LEN(STOCK->STCOMMREF))
ENDIF
SET KEY K_F5 TO ZRART // F5 for tarift pick list
@ R,C GET MART
READ
SET KEY K_F5 TO
IF LEN(TRIM(MART))>0 .AND. VAL(MART)<>0
MART=PAD(MART,LEN(MART))
ENDIF
SELECT(La)
RETURN MART
******
FUNCTION ZRART
CLEAR GETS
DO ST WITH .F. // no ZOOMON
IF LASTKEY()<>K_ESC
MART=STCOMMREF
ENDIF
RETURN .T.
//
//-----------------------------------------------------
//
FUNCTION LAST_VISIT (Ro, Co, Print)
// Finds the last visit to the client.
// If called by display (Print = .F.) displays info
// if called from print (Print = .T.) RETURNs the memo or nothing
LOCAL La:=SELECT(), LVis:=0, MRet := ""
DEFAULT Print TO .F.
IF .NOT. Print
@ Ro, 1 SAY "DERNIERE VISITE : "
@ ROW(), COL() SAY CLIENT->DERNVISIT
@ ROW(), COL()+3 SAY "ACTION AVANT LE : "
@ ROW(), COL() GET CLIENT->RELANCE
ENDIF
NET_USE (S_EVENT, "EVENT", .F., 30, "EVENT", "")
SEEK CLIENT->CLIREF
IF FOUND()
DO WHILE REFCLI = CLIENT->CLIREF .AND. .NOT. EOF()
IF ALLTRIM(EVENT->TYPE) $ "VISITETELEPHONE"
LVis=RECNO() // Find the last visit
exit // Index now in descending order
ENDIF
SKIP
ENDDO
IF LVis <> 0
GO LVis
DO LIT_INIT
SEEK SUBSTR(EVENT->BONREF, 1, LEN(LITIGE->CODE))
// On CDV's machine, may be several visits with the same number
LOCATE REST FOR CLIENT = EVENT->REFCLI;
WHILE CODE = SUBSTR(EVENT->BONREF, 1, LEN(LITIGE->CODE))
IF Print
MRet = IF(FOUND(), LITIGE->COMMENTAIR, "")
ELSE
IF .NOT. FOUND()
ALARM ("ERREUR SYSTEME 01 "+CLIENT+" "+EVENT->REFCLI)
ELSE
MEMOEDIT(LITIGE->COMMENTAIR,Ro+1,Co,22,74,.F.,.F.) // Browse
ENDIF
//
// CLose files opened by LIT_INIT
//
SELECT LITIGE
USE
SELECT LITREG
USE
SELECT LITCOD
USE
ENDIF
ENDIF
ENDIF
SELECT EVENT
USE
SELECT(La)
RETURN MRet
//
//-----------------------------------------------------
//
FUNCTION R_CLI(CRE_CLI)
LOCAL nEvent, mp1, mp2
LOCAL oDlg, oXbp, drawingArea, aEditControls := {}, oXbp1
LOCAL ActiBox, GamBox, oXbpFax, oXbpRel, oRb1, oRb2, oRb3
LOCAL MREF, M_Gam, M_Fax, M_T_Min
LOCAL M_REL, Mix_Array := {}
LOCAL M_Dat_Base := CTOD("01/01/89")
LOCAL La := SELECT(), i
// M_FILTER, M_CLIC, M_TEL, M_ACT, CLIN, MCP, M_CLIP, T_Min
// M_Dat1, M_Dat2, M_R_S, M_R_E
// are all defined as PUBLIC in MAIN
IF PCOUNT()=0
CRE_CLI=.F.
ENDIF
F_Ran= RANDOM (SEED, 5, 31) // Generate 5 random n°s between 1 and 31
AADD (Mix_Array, "49-900 ")
AADD (Mix_Array, "SECURIFRAN")
AADD (Mix_Array, "42-700 ")
AADD (Mix_Array, "ROULANT ")
AADD (Mix_Array, "CH49/AUTO ")
AADD (Mix_Array, "PLANCHERS ")
AADD (Mix_Array, "DIFFUSION ")
AADD (Mix_Array, "DIVERS ")
DO WHILE .T.
SET FILTER TO
Mret = 1 // RETURN Value
M_FILTER = "VAL(CLISTATUS)<3" // Initialise the selection
SELECT CLIENT
SET ORDER TO 1 // Index by Reference
GO TOP
MFREF=SPACE(LEN(CLIREF))
CLIN= SPACE(LEN(CLINOM))
MCP= SPACE(LEN(CLICP))
M_CLIC= SPACE(LEN(CLICONTACT))
M_TEL = SPACE(LEN(CLIPHONE))
M_ACT = SPACE(LEN(CLIPROFESS))
M_Gam=''
M_Fax='N'
M_T_Min = ""
M_CLIP =''
M_REL = 'N'
M_Dat1 = M_Dat_Base
M_Dat2 = M_Dat1
M_R_S = CTOD("01/01/89")
M_R_E = DATE() + 30
oDlg := XbpDialog():new( AppDesktop(), , {353,205}, {600,400}, , .F.)
oDlg:taskList := .T.
oDlg:title := "SELECTION"
oDlg:create()
drawingArea := oDlg:drawingArea
drawingArea:setFontCompoundName( "8.Arial" )
oXbp1 := XbpStatic():new( drawingArea, , {40,252}, {348,108} )
oXbp1:caption := ""
oXbp1:clipSiblings := .T.
oXbp1:type := XBPSTATIC_TYPE_GROUPBOX
oXbp1:create()
oXbp := XbpStatic():new( oXbp1, , {12,60}, {120,24} )
oXbp:caption := "NOM DU CLIENT :"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( oXbp1, , {144,60}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 30
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIN ), CLIN := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
SetAppFocus(oXbp)
oXbp := XbpStatic():new( oXbp1, , {24,36}, {108,24} )
oXbp:caption := "CODE POSTALE :"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( oXbp1, , {144,36}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 5
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( MCP ), MCP := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpStatic():new( oXbp1, , {36,12}, {96,24} )
oXbp:caption := "NUMERO CLIENT :"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( oXbp1, , {144,12}, {72,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 10
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( MFREF ), MFREF := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpPushButton():new( drawingArea, , {420,252}, {84,24},;
{ { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE }, { XBP_PP_FGCLR, -58 } } )
oXbp:caption := "GO"
oXbp:tabStop := .T.
oXbp:create()
oXbp:activate := {|| Gather( aEditControls ), PostAppEvent( xbeP_Quit ) }
oXbp := XbpStatic():new( drawingArea, , {108,216}, {120,24} )
oXbp:caption := "CONTACT :"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( drawingArea, , {240,216}, {108,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 17
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( M_CLIC ), M_CLIC := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpStatic():new( drawingArea, , {108,192}, {120,24} )
oXbp:caption := "ACTIVITE :"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
ActiBox := XbpCombobox():new( drawingArea, , {240,132}, {74,84}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
ActiBox:tabstop := .T.
ActiBox:create()
ActiBox:Additem ("MACO")
ActiBox:Additem ("COUV")
ActiBox:Additem ("PEIN")
ActiBox:Additem ("FACA")
ActiBox:Additem ("CHAR")
ActiBox:Additem ("ISOL")
ActiBox:Additem ("PLAT")
ActiBox:Additem ("INDU")
ActiBox:Additem ("LOCA")
ActiBox:Additem ("DIVS")
ActiBox:Additem ("CETC")
oXbp := XbpStatic():new( drawingArea, , {96,168}, {132,24} )
oXbp:caption := "EQUIPEE FAX :"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbpFax := XbpCheckBox():new( drawingArea, , {240,168}, {96,24} )
oXbpFax:tabStop := .T.
oXbpFax:create()
oXbpFax:setData (.F.)
oXbpFax:selected := {|| NIL }
oXbp := XbpStatic():new( drawingArea, , {84,144}, {144,24} )
oXbp:caption := "CLIENT/PROSPECT/TOUS :"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oRb1 := XbpRadioButton():new( drawingArea, , {240,144}, {48,24} )
oRb1:caption := "Client"
oRb1:tabStop := .T.
oRb1:create()
oRb1:selected := {|| NIL }
oRb2 := XbpRadioButton():new( drawingArea, , {288,144}, {60,24} )
oRb2:caption := "Prospect"
oRb2:tabStop := .T.
oRb2:create()
oRb2:selected := {|| NIL }
oRb3 := XbpRadioButton():new( drawingArea, , {360,144}, {120,24} )
oRb3:caption := "Tous"
oRb3:tabStop := .T.
oRb3:selection := .T.
oRb3:create()
oRb3:selected := {|| NIL }
oXbp := XbpStatic():new( drawingArea, , {132,120}, {96,24} )
oXbp:caption := "TAILLE MINIMUM :"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( drawingArea, , {240,120}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 4
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, M_T_Min, M_T_Min := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpStatic():new( drawingArea, , {84,96}, {144,24} )
oXbp:caption := "GAMME MEFRAN :"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
GamBox := XbpCombobox():new( drawingArea, , {240,36}, {94,84}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
GamBox:tabstop := .T.
GamBox:create()
FOR i = 1 TO LEN(Mix_Array)
GamBox:Additem (Mix_Array[i])
NEXT
oXbp := XbpStatic():new( drawingArea, , {84,72}, {144,24} )
oXbp:caption := "A RELANCER :"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbpRel := XbpCheckBox():new( drawingArea, , {240,72}, {24,24} )
oXbpRel:tabStop := .T.
oXbpRel:create()
oXbpRel:selected := {|| NIL }
oXbp := XbpStatic():new( drawingArea, , {264,72}, {72,24} )
oXbp:caption := " AVANT LE :"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( drawingArea, , {336,72}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, DtoC( M_R_E ), M_R_E := CtoD(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpStatic():new( drawingArea, , {396,72}, {60,24} )
oXbp:caption := "APRES LE :"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( drawingArea, , {456,72}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, DtoC( M_R_S ), M_R_S := CtoD(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpStatic():new( drawingArea, , {84,48}, {144,24} )
oXbp:caption := "PAS VISITE DEPUIS :"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( drawingArea, , {240,48}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 10
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, DtoC( M_Dat1 ), M_Dat1 := CtoD(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpStatic():new( drawingArea, , {84,24}, {144,24} )
oXbp:caption := "PAS COMMANDE DEPUIS :"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( drawingArea, , {240,24}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 10
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, DtoC( M_Dat2 ), M_Dat2 := CtoD(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oDlg:show()
nEvent := xbe_None
DO WHILE nEvent <> xbeP_Close .AND. nEvent <>xbeP_Quit
nEvent := AppEvent( @mp1, @mp2, @oXbp )
oXbp:handleEvent( nEvent, mp1, mp2 )
ENDDO
IF LastAppEvent()= xbeP_Close
Mret=0 // Client not selected
EXIT
ENDIF
//
// Get the data and see if the user has specified anything interesting
//
M_Act = ALLTRIM(ActiBox:xbpSLE:getdata())
M_Gam = ALLTRIM(GamBox:xbpSLE:getdata())
M_Fax = IIF(oXbpFax:GetData(), "O", "N")
M_Rel = IIF(oXbpRel:GetData(), "O", "N")
T_Min = INT(VAL(M_T_Min))
// Radio Buttons
IF oRB3:GetData()
M_Clip = ""
ELSEIF oRB2:GetData()
M_Clip = "P"
ELSE
M_Clip = "C"
ENDIF
IF .NOT. EMPTY (MFREF)
//
// If the reference is specified, all other parameters are irrelevant,
// but if they are specified, the user may want to create a new client
//
IF .NOT. EMPTY(CLIN).AND. .NOT. EMPTY(MCP);
.AND. CRE_CLI .AND. SUBSTR(MFREF,1,1)="*"
IF CONFIRM (11,5,"O","Créer un prospect ? ")
//
// Create a new prospect: a prospect becomes a
// client when he orders something
//
NET_USE (S_ATTACH, "ATTACH", .T., 0, "", "")
DO WHILE .T.
SELECT ATTACH
// Allocate next number
FREF=SUBSTR(MCP,1,2) + SUBSTR(M_Resp,2,2) + PAD(STR(NUM_CLI),5)
REPLACE NUM_CLI WITH NUM_CLI+1
SELECT CLIENT
SEEK "C"+FREF
IF FOUND()
LOOP // Try the next available prospect number
ENDIF
SEEK "P" + FREF
IF .NOT. FOUND()
FREF= "P" + FREF
Mret = 1
EXIT // O.K. found a valid number
ENDIF
ENDDO
SELECT ATTACH
USE
SELECT CLIENT
ADD_REC(0)
REPLACE CLIREF WITH FREF,;
CLINOM WITH CLIN,;
CLICP WITH MCP,;
CLIREGION WITH M_Resp,;
CLISCRAMBLE WITH .F.
Window_Cli (1)
SCRAM_CLI (SEED)
LOOP
ENDIF
ELSE
//
// Not Prospect creation, try to find client
//
SET ORDER TO 1 // CLREF
SEEK MFREF
IF FOUND() .AND. VAL(CLISTATUS)<3 // Not deleted
Mret=2 // straight to client
EXIT
ENDIF
FREF= "P" + SUBSTR(MFREF,2,LEN(CLIENT->CLIREF)-1)
SEEK FREF
IF FOUND() .AND. VAL(CLISTATUS) < 3
ALARM ("ATTENTION - C'est un PROSPECT pas un CLIENT")
Mret=2 // straight to client
EXIT
ENDIF
ALARM ("NUMERO CLIENT INEXISTANT OU CLIENT SUPPRIME")
// Shouldn't normally create a client because
// he should previously have been a prospect.
// Nevertheless, allow creation if the user insists!
IF .NOT. EMPTY(CLIN) .AND. .NOT. EMPTY(MCP);
.AND. CRE_CLI .AND. CONFIRM (11,5,"O","Créer un Client ? ")
SELECT CLIENT
ADD_REC(0)
REPLACE CLIREF WITH MFREF,;
CLINOM WITH CLIN,;
CLICP WITH MCP,;
CLIREGION WITH M_Resp,;
CLISCRAMBLE WITH .F.
Window_Cli (1)
SCRAM_CLI (SEED)
ENDIF
LOOP
ENDIF
ELSE
//
// FREF not specified, try the other keys
//
//
// Now set up filter or choose client
//
IF .NOT. EMPTY(M_CLIC) // "CLIENT"-type condition
SET ORDER TO 0
LOCATE FOR CLICONTACT = SCRAMBLE (M_CLIC,;
RANDOM(REC_SEED (SEED), 30, 31));
.AND. VAL(CLISTATUS) < 3
IF FOUND()
SET ORDER TO 1
Mret=2 // straight to client
EXIT
ENDIF
ALARM ("CLIENT INEXISTANT OU SUPPRIME")
LOOP
ELSE
IF .NOT. EMPTY(M_ACT)
//
// M_ACT is set up which is a FILTER type condition
//
M_FILTER = M_FILTER + ".AND.CLIPROFESS=M_ACT"
ENDIF
//
// Fax ?
//
IF M_Fax = 'O'
M_FILTER = M_FILTER+".AND.CLIFAX<>SCRAMBLE(SPACE(15),"+;
"RANDOM(REC_SEED (SEED), 30, 31))"
ENDIF
//
// Client/Prospect ?
//
IF M_CLIP <> ' '
M_FILTER = M_FILTER+".AND.CLIREF=M_CLIP"
ENDIF
//
// Taille Mini ?
//
IF T_Min > 0
M_FILTER = M_FILTER+".AND.VAL(CLITAILLE)>=T_Min"
ENDIF
//
// Gamme MEFRAN ?
IF .NOT. EMPTY(M_Gam)
SET EXACT OFF
i = ASCAN(PADR(M_Gam, LEN(Mix_Array[1])), Mix_Array)
SET EXACT ON
IF I<>0
M_FILTER = M_FILTER+".AND.Q_"+STR(I,1)+"<>0"
ENDIF
ENDIF
IF M_REL='O'
M_FILTER=M_FILTER+".AND.RELANCE>=M_R_S.AND.RELANCE<M_R_E"
ENDIF
IF M_Dat1>M_Dat_Base
M_FILTER=M_FILTER+".AND.DERNVISIT<M_Dat1"
ENDIF
IF M_Dat2>M_Dat_Base
M_FILTER=M_FILTER+".AND.DCANNEE<M_Dat2"
ENDIF
ENDIF
ENDIF
CLIN=ALLTRIM(CLIN)
MCP=ALLTRIM(MCP)
SET EXACT OFF
Mret = 1
//
// Select the search method and complete the filter condition
//
IF .NOT. EMPTY(CLIN)
//
// Scramble the data so as to be the same as the file
//
CLIN = SCRAMBLE (IIF(LEN(CLIN)<= 5,CLIN,SUBSTR(CLIN,1,5)),F_Ran)
//
// Search by NAME
//
SET ORDER TO 2 // CLINOM
IF .NOT. EMPTY(MCP)
M_FILTER=M_FILTER+".AND.CLICP=MCP"
ENDIF
SEEK CLIN
COPY TO C:TEMPCLIN FIELDS CLIREF FOR &M_FILTER WHILE CLIENT->CLINOM=CLIN
ELSEIF .NOT. EMPTY(MCP)
//
// Search by C.P.
//
SET ORDER TO 3 // CLICP
SEEK MCP
COPY TO C:TEMPCLIN FIELDS CLIREF FOR &M_FILTER WHILE CLIENT->CLICP=MCP
ELSE
//
// Search whole file
//
SET ORDER TO 0
GO TOP
COPY TO C:TEMPCLIN FIELDS CLIREF FOR &M_FILTER
ENDIF
EXIT
ENDDO
SET ORDER TO 1 // Whatever happened
IF Mret <> 0 .AND. Mret <> 2 // Client not selected
NET_USE (S_TEMP2, "C:TEMPCLIN", .T., 0, "", "")
IF RECCOUNT() = 0
oDlg : close()
oDlg : Destroy()
Alarm("Vide") // Error Message
SELECT (La)
RETURN-1
ELSE
COUNT TO N_Cli FOR CLIREF<>"P"
N_Rec=RECCOUNT()
GO TOP
SET RELATION TO CLIREF INTO CLIENT
ENDIF
ENDIF
SET EXACT ON
SET SOFTSEEK OFF
oDlg : close()
oDlg : Destroy()
SELECT (La)
RETURN Mret
*
***************************
*
FUNCTION R_CLI2 ()
//
LOCAL La, aFields := {}, cOldColor, nRecSel, FREF
La=SELECT()
SELECT TEMPCLIN
IF RECCOUNT()=0 // Was a single record which has been deleted
SELECT (La)
RETURN ""
ENDIF
F_Ran= RANDOM (SEED, 5, 31) // Generate 5 random n°s between 1 and 31
cOldColor := SetColor()
AADD(aFields, {" REF", {||IIF(CLIENT->CLIRISQUE<>" ",;
"*"+CLIREF,;
" "+CLIREF)}, 6 } )
AADD(aFields, {"NOM" , {||UNS_NOM(CLIENT->CLINOM)}, 18 } )
AADD(aFields, {"C.P.", {||CLIENT->CLICP }, 3 } )
AADD(aFields, {"VILLE", {||UNS_NOM(SUBSTR(CLIENT->CLIVILLE,1,20))}, 13} )
AADD(aFields, {"TEL", {||UNS_FIELD(CLIENT->CLIPHONE) }, 8 } )
AADD(aFields, {"PROF", {||CLIENT->CLIPROFESS }, 3 } )
AADD(aFields, {"F.J.", {||CLIENT->CLIABV }, 3 } )
SET EXACT OFF
SET SOFTSEEK OFF
nRecSel:= CL_BRWSWHL(aFields)
FREF = DECODE_REPLY (nRecSel)
SET EXACT ON
SELECT (La)
SetColor (cOldColor)
RETURN FREF
*
//
//-------------------------------------------------------------------------
//
FUNCTION DECODE_REPLY (nRecSel)
//
LOCAL mbuff:=""
DO CASE
CASE nRecSel == 0
RETURN "" // No record selected (Esc)
CASE nRecSel < 0 // No matching Record
Alarm ("Vide")
* DO HLON
* do win with 18,1,20,78,mbuff,"VIDE"
* do while INKEY(0) <> K_ESC
* enddo
* DO HLOFF WITH LCD
RETURN ""
OTHERWISE
RETURN CLIENT->CLIREF
ENDCASE
RETURN ""
//
//-------------------------------------------------------------------------
//
FUNCTION UNS_NOM(Nom)
//
// Returns an unscrambled client name or VILLE. Used by R_CLI
//
LOCAL M, La
//
// Set up global variables
//
// F_Ran already set up by R_CLI
La=SELECT()
SELECT CLIENT
V_Ran= RANDOM(REC_SEED (SEED), LEN(Nom)-5, 31) // 25 codes.
M = UNSCRAMBLE (SUBSTR(Nom,1,5), F_Ran)
M = M + UNSCRAMBLE (SUBSTR(Nom, 6, LEN(Nom)-5), V_Ran)
SELECT(La)
RETURN M
//
//-------------------------------------------------------------------------
//
FUNCTION UNS_FIELD(Nom)
//
// Returns an unscrambled field
//
LOCAL M, La
//
// Set up global variables
//
// F_Ran already set up by R_CLI
La=SELECT()
SELECT CLIENT
V_Ran= RANDOM(REC_SEED (SEED), LEN(Nom), 31) // 25 codes.
M = UNSCRAMBLE (Nom, V_Ran)
SELECT(La)
RETURN M
//
********************************
*
FUNCTION V_Proff(Proff)
//
// Validates the Profession Code in the current record
// Uses the string ValidProff from PARAMS
//
RETURN EMPTY(Proff) .OR. Proff+"," $ ValidProff
//
//--------------------------------------------
//
FUNCTION SIRET (Code)
LOCAL I:=1, J, Tot:=0
Code = ALLTRIM (Code)
IF EMPTY(Code)
RETURN .T.
ENDIF
IF LEN(Code) <> 14
RETURN .F.
ENDIF
//
// For the time being ......
//
return .T.
//
DO WHILE I < 14
J=VAL(SUBSTR(Code,I,1))*2
J=IIF(J>10, J-9, J)
Tot = Tot + J + VAL(SUBSTR(Code, I+1, 1))
I=I+2
ENDDO
RETURN MOD(Tot, 10) = 0
//
/* ------------------------------------------------------------------- */
//
FUNCTION CL_BRWSWHL(aFields)
LOCAL nEvent, mp1, mp2, oXbp, oBut, oBrowse, aSize, i
LOCAL oLdWin, TheElement
PRIVATE ChosenClient:=0
oXbp := GuiStdDialog( "Sélection CLIENT/PROSPECT", {10,100}, {675,400})
oBut := XbpPushButton():new( oXbp:drawingArea, , {295,3}, {84,24},;
{ { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE }, { XBP_PP_FGCLR, -58 } } )
oBut:caption := "Impression"
oBut:tabStop := .T.
oBut:create()
oBut:activate := {|| PRINT_CLI() }
// create browser in window
aSize = oXbp:drawingarea:currentsize()
aSize[2] = aSize[2] - 30
oBrowse := GuiBrowseDb( oXbp:drawingArea, {0,30}, aSize )
FOR i = 1 TO LEN(aFields)
/* make the new column - Contents, size, header*/
oBrowse:addColumn(aFields[i, 2],aFields[i, 3] , aFields[i, 1] )
NEXT
oBrowse:CursorMode:=XBPBRW_CURSOR_ROW
// overload resize that browser fills the window
oXbp:drawingArea:resize := ;
{|mp1,mp2,obj| obj:childList()[1]:setSize(mp2) }
oXbp:show()
oBrowse:show()
oldWin = SetAppFocus(oBrowse)
ChosenClient = 0
DO WHILE nEvent <> xbeP_Close
nEvent := AppEvent( @mp1, @mp2, @TheElement,0 )
TheElement:handleEvent( nEvent, mp1, mp2 )
ENDDO
oXbp:hide()
oBrowse:destroy()
oXbp:destroy()
SetAppFocus( oldWin )
RETURN ChosenClient
******************************************************************
* Create GUI Browser with navigation codeblocks
******************************************************************
FUNCTION GuiBrowseDB( oParent, aPos, aSize )
LOCAL oBrowse
oBrowse := XbpBrowse():new( oParent,, aPos, aSize,, .F. ):create()
// navigation codeblocks for the browser
oBrowse:skipBlock := {|n| DbSkipper(n) }
oBrowse:goTopBlock := {| | DbGoTop() }
oBrowse:goBottomBlock := {| | DbGoBottom() }
oBrowse:phyPosBlock := {| | Recno() }
oBrowse:phyPosBlock := {| | Recno() }
oBrowse:ItemSelected := {| | ChosenClient:=Recno(), PostAppEvent (xbeP_Close) }
// Code blocks for the vertical scrollbar.
// Note: DbPosition() returns values in the range from 0 to 100.
// We multiply this with 10 to increase the granularity of
// the vertical scrollbar.
oBrowse:posBlock := {| | DbPosition()*10 }
oBrowse:goPosBlock := {|n| DbGoPosition(n/10) }
oBrowse:lastPosBlock := {| | 1000 }
oBrowse:firstPosBlock := {| | 0 }
RETURN oBrowse
******************************************************************
* Create std dialog window hidden
******************************************************************
FUNCTION GuiStdDialog( cTitle, aPos, aSize )
LOCAL oDlg
DEFAULT cTitle TO "Standard Dialog Window"
oDlg := XbpDialog():new( AppDesktop(),,aPos, aSize,, .F. )
oDlg:icon := 1
oDlg:taskList := .T.
oDlg:title := cTitle
* oDlg:titlebar := .F.
oDlg:drawingArea:ClipChildren := .T.
oDlg:create()
oDlg:drawingArea:setFontCompoundName( FONT_DEFPROP_SMALL )
RETURN oDlg
//
//------------------------------------------------------------
//
FUNCTION PRINT_CLI ()
//
LOCAL La:=SELECT(), M_choice, NRec
SELECT TEMPCLIN
NRec=RECNO() // In TEMPCLIN
DO WHILE .T.
//
// DO allows multiple outputs of the same list
//
IF .NOT. Ini_Print (@M_choice)
EXIT
ELSE
Print_Temp (M_choice)
ENDIF
ENDDO
DCPRINT OFF
SET EXACT ON
SELECT TEMPCLIN
GO NRec
SELECT(La)
RETURN .T.
//
//-----------------------------------------------
//
FUNCTION Ini_Print ( m_choice )
LOCAL oBtn, oDlg, oXbp, nEvent, mp1, mp2
LOCAL Ans:= .F.
oDlg := GuiStdDialog( "Impression", {50,200}, {200,150})
oDlg:setModalState(XBP_DISP_APPMODAL)
oDlg:show()
SetAppFocus(oDlg)
//
// Create push buttons
//
oBtn:= XbpPushButton():new( oDlg:drawingArea,,{25,70},{100,30} )
oBtn:caption := "Sommaire"
oBtn:tabStop := .T.
oBtn:activate := {|| Ini_Print_But(@m_choice, "S", @Ans), PostAppEvent( xbeP_Close ) }
oBtn:create()
oBtn:= XbpPushButton():new( oDlg:drawingArea,, {25,40},{100,30} )
oBtn:caption := "Détail"
oBtn:tabStop := .T.
oBtn:activate := {|| Ini_Print_But(@m_choice, "D", @Ans), Ans = "Hello", PostAppEvent( xbeP_Close ) }
oBtn:create()
oBtn:= XbpPushButton():new( oDlg:drawingArea,, {25,10},{100,30} )
oBtn:caption := "Cancel"
oBtn:cancel := .T.
oBtn:tabStop := .T.
oBtn:activate := {|| Ans=.F., PostAppEvent( xbeP_Close ) }
oBtn:create()
nEvent := xbe_None
DO WHILE nEvent <> xbeP_Close
nEvent := AppEvent( @mp1, @mp2, @oXbp )
oXbp:handleEvent( nEvent, mp1, mp2 )
ENDDO
oDlg:hide()
oDlg:destroy()
RETURN Ans
//
FUNCTION Ini_Print_But (choice,valeur,Reponse)
choice=valeur
reponse=.T.
RETURN .T.
//
//-----------------------------------------------
//
FUNCTION Print_Temp (R_Type)
LOCAL Mb,La, P_Pos, P_Mem :="<><><>"
PRIVATE oPrinter
La=SELECT()
Mb=""
SELECT TEMPCLIN
GO TOP
CLEAR
IF R_Type = "S"
//
// Print summary report
//
INDEX ON CLIENT->CLIPROFESS TO TEMP
DCPRINT ON TO oPrinter FONT "8.Lucida Console" PREVIEW
DCPRINT ?"CLIENT"+SPACE(72)+"TELEPHONE"
DO WHILE .NOT. EOF()
SELECT CLIENT
REC_LOCK()
REC_LOCK() //Ha Ha !
UNSCRAM_CLI (SEED)
IF CLIPROFESS <> P_Mem
IF DC_PRINTERROW() > 48
DCPRINT EJECT
ENDIF
DCPRINT ?
DCPRINT ?
DCPRINT ? "ACTIVITE " + CLIPROFESS
DCPRINT ? "-------------"
P_Mem = CLIPROFESS
ENDIF
DCPRINT ? CLIREF+" "+SUBSTR(CLINOM,1,28)+" "+CLICP+" "+CLIVILLE+" "+" "+CLIPHONE+" "+CLIPHONED
SCRAM_CLI (SEED)
UNLOCK
IF DC_PRINTERROW() > 55
DCPRINT EJECT
ENDIF
SELECT TEMPCLIN
SKIP
ENDDO
EJECT
DCPRINT OFF
SET INDEX TO
ERASE TEMP.NTX
ELSE
//
// Print detail report
DCPRINT ON TO oPrinter FONT "8.Lucida Console" PREVIEW
P_Pos = 2
DO WHILE .NOT. EOF()
DET_OUT(P_Pos) // Print the report
IF DC_PRINTERROW() < 30
P_Pos = 33
@ P_Pos -2,1 DCPRINT SAY REPLICATE("-",78)
ELSE
DCPRINT EJECT
P_Pos = 2
ENDIF
//
// Allow the User to kill it!
//
IF INKEY() = K_ESC .OR. LASTKEY() = K_ESC
EXIT
ENDIF
SKIP
ENDDO
DCPRINT OFF
ENDIF
SELECT(La)
RETURN .T.
//
//-----------------------------------------------
//
FUNCTION Det_Out(Lin, Scram)
LOCAL ML:=0, L_CNT, MPL, La, V_String
DEFAULT Scram to .T.
La:=SELECT()
SELECT CLIENT
IF SCRAM
REC_LOCK() // Need lock to unscramble
REC_LOCK()
UNSCRAM_CLI(SEED)
ENDIF
@ Lin, 4 DCPRINT SAY CLIREF
@ Lin, 15 DCPRINT SAY CLINOM
@ Lin, 46 DCPRINT SAY CLIABV
@ Lin, 53 DCPRINT SAY "Contact"
@ Lin, 61 DCPRINT SAY CLICONTACT
@ Lin+2, 4 DCPRINT SAY CLIRUE
@ Lin+2, 57 DCPRINT SAY "BANQUE"
@ Lin+3, 4 DCPRINT SAY CLIADS
@ Lin+3, 51 DCPRINT SAY CLIBANK
@ Lin+4, 4 DCPRINT SAY CLICP
@ Lin+4, 11 DCPRINT SAY CLIVILLE
@ Lin+4, 51 DCPRINT SAY CLIBCODE
@ Lin+4, 57 DCPRINT SAY CLIBCGUI
@ Lin+4, 63 DCPRINT SAY CLIBNCPT
@ Lin+4, 75 DCPRINT SAY CLIBRIB
@ Lin+6 , 4 DCPRINT SAY "Tél BUR : " + CLIPHONE
@ Lin+6 , 40 DCPRINT SAY "Dom : " + CLIPHONED
@ Lin+7, 4 DCPRINT SAY " Voit : " + CLIPHONEV
@ Lin+7, 40 DCPRINT SAY "Fax : " + CLIFAX
@ Lin+8, 4 DCPRINT SAY "Activité : " + CLIPROFESS
@ Lin+8, 40 DCPRINT SAY "Siret : " + CLISIRET
@ Lin+9 , 4 DCPRINT SAY "Dern. Cde:"
@ Lin+9 , 15 DCPRINT SAY DCANNEE
@ Lin+9 , 24 DCPRINT SAY "TAILLE : " + CLITAILLE
@ Lin+9 , 41 DCPRINT SAY "Date de Création (MMAA):"
@ Lin+9 , 66 DCPRINT SAY DATE_CRE PICTURE '9999'
Lin=Lin+11
IF .NOT. EMPTY(COMMENTAIR)
@ Lin, 4 DCPRINT SAY "COMMENTAIRE"
L_CNT=MLCOUNT(COMMENTAIR, 62, 4, .T.)
FOR ML=1 TO L_CNT
IF DC_PRINTERROW() > 60
DCPRINT EJECT
ENDIF
MPL=MEMOLINE(COMMENTAIR,62,ML,4,.T.)
@ ML+Lin,4 DCPRINT SAY MPL
NEXT
ENDIF
Lin=Lin+ML+2
@ Lin, 4 DCPRINT SAY "DERNIERE VISITE : "
@ Lin, 22 DCPRINT SAY CLIENT->DERNVISIT
@ Lin, 35 DCPRINT SAY "ACTION AVANT LE : "
@ Lin, 53 DCPRINT SAY CLIENT->RELANCE
V_String = LAST_VISIT(0,0,.T.)
IF .NOT. EMPTY(V_String)
L_CNT=MLCOUNT(V_String, 62, 4, .T.)
FOR ML=1 TO L_CNT
IF DC_PRINTERROW() > 60
DCPRINT EJECT
ENDIF
MPL=MEMOLINE(V_String, 62, ML, 4, .T.)
@ ML+Lin,4 DCPRINT SAY MPL
NEXT
ENDIF
IF SCRAM
SCRAM_CLI(SEED)
UNLOCK
ENDIF
SELECT(La)
RETURN .T.
//
//----------------------------------------------------------------
//
FUNCTION COMC (BONTYPE) //BONTYPE set in menu ="1" for normal fixed price
* Auteur...: R M ALCOCK
* Date.....: 6/3/95
* Copyright: (c) 1992, R M ALCOCK, Tous droits réservés
* Notes....: PROGRAMME DE ENREGISTREMENT COMMANDE
* : called by COMMENU (MAINMENU)
* : MEFRAN MEFRAN
* : no PORT in the header
* : includes risque, New_Tarif starred out
* ;
DEFAULT BONTYPE TO "1"
SAVE ALL LIKE BONTYPE TO C:BT
*
DO WHILE .T.
RESTORE FROM C:BT ADDITIVE // Clears Local parameters, restores BONTYPE
CLEAR
MT = CONAME+" - SAISIE COMMANDE"
@ 2,40-LEN(MT)/2 SAY MT
@ 1,40-2-LEN(MT)/2 TO 3,40+2+LEN(MT)/2 DOUBLE
IF .NOT. R_CLI(.T.)
RETURN .T.
ENDIF
CLEAR
@ 2,40-LEN(MT)/2 SAY MT
@ 1,40-2-LEN(MT)/2 TO 3,40+2+LEN(MT)/2 DOUBLE
SELECT CLIENT
@ 4,2 SAY CLINOM+" "+CODEPOSTE+" "+VILLE
*
DO S_COMM WITH BONTYPE
ENDDO
RETURN .T.
*******
FUNCTION S_COMM (BONTYPE)
LOCAL t,l,b,r,m_tva:="O"
*
*Client is selected and databases open.
*
* All saisie comes in here so check risque
IF CLIENT->CLIRISQUE ="E"
ALARM("RISQUE CODE E - COMPTE BLOQUE")
RETURN .T.
ENDIF
*
*New_Tarif:=CONFIRM (21,4,"N","NOUVEAUX PRIX")
New_Tarif:=.F.
//
*
NET_USE (S_COM, "COM", .F., 30, "COM,COMCL", "BON")
NET_USE (S_FACTA, "FACTA", .F., 30, "FACTR", "")
t=0
l=0
b=23
r=79
zbuff=" "
do win with t,l,b,r,zbuff,"SAISIE COMMANDE",""
//
SELECT BON
*
DO WHILE .T.
@ t+1,l+1 CLEAR TO b-1,r-1
MCOMM=SPACE(5)
@ 2,4 SAY "COMMANDE : " GET MComm ;
PICTURE REPLICATE('9',LEN(MComm))
READ
IF EMPTY(MCOMM)
RETURN .T.
ENDIF
IF X_REF("C"+Mcomm,"BON")
ALARM ("COMMANDE EXISTE DEJA")
LOOP
ENDIF
IF .NOT. CONFIRM (21,,"O","CONFIRMATION SAISIE : ")
RETURN .T.
ENDIF
EXIT
ENDDO
ADD_REC(0)
REPLACE COMMANDE WITH "C"+MComm, EXPORT WITH 1, ;
D_COMM WITH DATE(), REFCLI WITH CLIENT->CLIREF,;
C_STATUS WITH "00", REGION WITH M_Reg
@ 2,30 SAY CLIENT->CLINOM
DO WHILE .T.
@ 3,2 CLEAR TO 20,78
@ 3,4 SAY "Remise EXCEPTIONNELLE (%):" GET REM_SUP RANGE 0,25
@ 4,4 SAY "TVA (O/N) :" GET M_TVA PICTURE '@!';
VALID M_TVA $ "ON"
@ 6,4 SAY "ATTENTION - TVA et Remise EXCEPTIONNELLE ne peuvent pas être modifiées"
READ
IF REM_SUP<>0.AND..NOT.CONFIRM(10,,"N","Confirmation REMISE EXCEPTIONNELLE")
LOOP
ENDIF
IF M_TVA='N'.AND..NOT.CONFIRM(10,,"N","Confirmation FACTURATION HORS TAXE")
LOOP
ENDIF
EXIT
ENDDO
SELECT BON
REPLACE COMMENT WITH "TEL:"+CLIENT->CLIPHONE, EXPORT WITH IIF(M_TVA="O",1,0)
*
SELECT FACTA
ADD_REC(0)
REPLACE FACTURE WITH BON->COMMANDE,LIGNE WITH "99",ARTICLE WITH "+",;
TYPE WITH BONTYPE
UNLOCK
DO LINESM
CLEAR
DO COMM_OUT WITH .T.,.F.
SELECT BON
DO RESET_SOLDE WITH "+"
SELECT BON
COMMIT
USE
SELECT FACTA
USE
RETURN .T.
*
************
//
//----------------------------------------------------------------
//
* Programme: COMMPROC.PRG
* Auteur...: R M ALCOCK
* Date.....: 13/01/94
* Copyright: (c) 1992, R M ALCOCK, Tous droits réservés
* Notes....: PROCEDURES FOR COMMANDE SAISIE/MODIF
* : !!!!!!!!! line 147 *ed out for test (okflag always .T.)
* : PRIXREEL now QUANTITE*PRIXREEL
*
*
FUNCTION ENTETE
//
// SOLDEE and LIMITT set up in COMC
//
LOCAL Re
SELECT BON
Re=1-BON->REM_SUP/100
@ 1,0 SAY REFCLI
@ 1,12 SAY CLIENT->CLINOM
@ 1,43 SAY IIF (AVOIR," AVOIR REF","COMMANDE REF ")
@ 1,57 SAY COMMANDE
@ 2,0 SAY "HT : "
@ 2,5 SAY TOTHT*Re PICTURE '999999.99'
@ 2,16 SAY "TVA : "
@ 2,22 SAY TVATOT*Re PICTURE '999999.99'
IF .NOT. AVOIR
@ 2,34 SAY "SOLDE :"
@ 2,42 SAY (CLISOLDEE+TOTHT*Re) PICTURE '9999999.99'
@ 2,54 SAY "LIMITE :"
@ 2,63 SAY ENCOURSMAX PICTURE '999999999.99'
IF CLISOLDEE+(TOTHT*Re) > ENCOURSMAX
?CHR(7)
ENDIF
ENDIF
@ 3,0 SAY REPLICATE("-",75)
@ 4,0 SAY "ART LIBELLE * QTE. PRIX U REM. R PRIX NET TOTAL HT"
RETURN .T.
*
*****
**************************
*
FUNCTION ECROUT
PRIVATE I
IF LN < 18 .AND. .NOT. FORCE
RETURN .T.
ENDIF
La=SELECT()
SELECT FACTA
MF=FACTURE
@ 5,0 CLEAR
LN = 0
IF NSKIP + NLIGNE >=0
SKIP NSKIP
ELSE
SKIP -NLIGNE
ENDIF
DO WHILE .T.
DO LINEOUT
SKIP
LN=LN+1
IF LN >= 5 .OR. EOF() .OR. FACTURE <> MF
EXIT
ENDIF
ENDDO
IF FORCE
LN=LN-1
SKIP-1
ENDIF
SELECT (La)
RETURN .T.
*
******************************
*
FUNCTION LINEOUT
*
@ 5+LN,2 SAY ARTICLE
@ 5+LN,9 SAY LIB PICTURE REPLICATE("X",23)
I=SUBSTR(ARTICLE,1,1)
IF I<>"*" .AND. I<>"+" .AND. I<>"-"
@ 5+LN,33 SAY QUANTITE
@ 5+LN,39 SAY PU
@ 5+LN,49 SAY REM_LINE
@ 5+LN,54 SAY IIF(REPORT=98,"N","O")
@ 5+LN,57 SAY ROUND(PRIXREEL/QUANTITE,2) PICTURE '999999.99'
@ 5+LN,69 SAY PRIXREEL PICTURE '999999.99'
WAIT
ENDIF
RETURN .T.
*******************************
*
FUNCTION LIGNEIN
* this is only used by AVOC
*
* LN = NUMERO LIGNE COURANTE
* SAISIE LIGNE ARTICLE :
*
La=SELECT()
SELECT FACTA
Fa=SELECT()
*CTYPE IS NOT "C" FOR THE FIRST ADDITIONAL LINE ON MODIFICATION
IF CTYPE = "C"
ADD_REC(0)
ELSE
CTYPE = "C"
ENDIF
REC_LOCK(0)
MART=R_ART (5+LN,0)
REPLACE FACTURE WITH BON->COMMANDE, TYPE WITH BONTYPE,;
ARTICLE WITH MART ,REPORT WITH 60
DO R_LINE
SELECT(La)
RETURN .T.
*******************************
*
FUNCTION R_LINE
PRIVATE M_Q, M_R, MTXT, M_RPX
*
* Used by both LIGNEIN and LIGNEMOD
*
SET ESCAPE OFF
DO WHILE .T.
*LOOP ALLOWS ARTICLE REFERENCE TO BE CHANGED
SELECT (Fa)
IF SUBSTR(ARTICLE,1,1)="+"
REPLACE LIGNE WITH "99"
ENDIT = .T.
EXIT
ENDIF
REPLACE LIGNE WITH STR(NLIGNE+1,2)
IF ARTICLE = "*"
@ 5+LN,2 SAY ARTICLE
@ 5+LN,9 GET LIB PICTURE "@S23"
READ
EXIT
ENDIF
*
IF ARTICLE="-"
EXIT
ENDIF
*
*ARTICLE=STFAM+STREF OR = CODE_DIVERS
AREF=ARTICLE
IF ARTICLE <> CODE_DIVERS
*
*REAL ARTICLE REFERENCE
SELECT STOCK
SEEK AREF
OKFLAG=.T.
IF FOUND()
*THE ARTICLE EXISTS IN THE STOCK FILE
MPU=IIF(New_Tarif, STPRIXVNEW, STPRIXV)
PPROMO = GET_PPROMO() // returns prix promo (0 if no promotion)
IF PPROMO > 0
MPU=PPROMO
ALARM("PRIX PROMOTION" )
ENDIF
OKFLAG=.T.
ELSE
* NON REFERENCED ARTICLE
OKFLAG=.F.
ENDIF
SELECT (Fa)
IF OKFLAG
REPLACE LIB WITH STOCK->STLIB,;
PU WITH MPU,LINETVA WITH STOCK->STTVA,;
REM_LINE WITH "00",;
FAM_PROD WITH STOCK->STFAM_PROD,REPORT WITH 0
//
ARTPDS=STOCK->POIDS
ELSE
AREF = "ERROR"
REPLACE ARTICLE WITH ' ',LINETVA WITH 1,REM_LINE WITH "00"
ARTPDS=0
ENDIF
ELSE
* ARTICLE IS CODE_DIVERS
ARTPDS=0
REPLACE LINETVA WITH 1 ,REM_LINE WITH "00"
ENDIF
*APPLIES TO ALL ARTICLES IN THE CATALOGUE OR NOT
DO LINEOUT
REPLACE ARTICLE WITH R_ART(5+LN,2,ARTICLE)
IF ARTICLE = AREF .AND. AREF <> "ERROR"
@ 5+LN,09 GET LIB PICTURE "@S23"
@ 5+LN,33 GET QUANTITE VALID QUANTITE > 0 .AND. UPDPRXREEL()
@ 5+LN,39 GET PU VALID UPDPRXREEL()
@ 5+LN,49 GET REM_LINE PICTURE '99' VALID VAL(REM_LINE) <= MAXREMLN;
.AND. UPDPRXREEL()
IF .NOT. AVOIR
// REPORT used for articles not to be delivered
M_RPX = IIF(REPORT=98,"N","O")
@ 5+LN, 54 GET M_RPX PICTURE '@!' VALID M_RPX $ "ON"
READ
ENDIF
READ
REPLACE REPORT WITH IIF(M_RPX="N",98,0)
// you must do this every time
UPDPRXREEL()
// displays it as well
IF BON->EXPORT = 0
VALUETVA = 0
ELSE
IF LINETVA=2
VALUETVA = TVARED
ELSE
VALUETVA = TVARATE
ENDIF
ENDIF
IF .NOT. AVOIR
IF ARTICLE = CODE_DIVERS
PREFACT = .T.
ELSE
M_Q=QUANTITE
M_R=ARTICLE
* DO CHK_STOK WITH M_R , M_Q
* here only reset STPORT if operating on FACTA (ie saisie)
IF ALIAS()="FACTA"
PREFACT = .T.
DO SETPF WITH STOCK->REF,M_Q,.T.,.F. // incl composes
// only STPORT
ENDIF
ENDIF
ENDIF
SELECT STOCK
UNLOCK
SELECT (Fa)
ARTTOT=PRIXREEL
TOTHT=TOTHT+ARTTOT
TOTPDS=TOTPDS+(QUANTITE*ARTPDS)
TVATOT = TVATOT +(ARTTOT*VALUETVA)
MMQTE=QUANTITE
EXIT
ENDIF
ENDDO
SELECT (Fa)
UNLOCK
SET ESCAPE ON
LN=LN+1
NLIGNE=NLIGNE+1
RETURN .T.
*
************
*
FUNCTION UPDPRXREEL
REPLACE PRIXREEL WITH CALCPU(PU) *QUANTITE
@ 5+LN,57 SAY ROUND(PRIXREEL/QUANTITE,2) PICTURE '999999.99'
@ 5+LN,69 SAY PRIXREEL PICTURE '999999.99'
RETURN .T.
*
******
*
FUNCTION CALCPU
PRIVATE mprix
MPRIX=PU*(100-VAL(REM_LINE))/100
RETURN MPRIX
*****************
*
FUNCTION GET_PPROMO() // CLIENT and STOCK positioned
// works on today's date
LOCAL La,MCLREF,MSREF,PP
La=SELECT()
SELECT TARIFT
USE
NET_USE (S_PROMOS, "PROMOS", .F., 0, "PROMOS", "")
MCLREF=CLIENT->CLIREF
MSREF=STOCK->STCOMMREF
PP=0
SEEK MSREF+MCLREF
IF FOUND() .AND. D_FIN>=SYSDATE() .AND. D_DEBUT<=DATE()
PP=PRIXPROMO
ENDIF
NET_USE (S_TARIFT,"TARIFT", .F., 0, "TARIFT", "") // restore TARIFT
SELECT (La) // restore entry conditions
RETURN PP // prom prix or 0
******************
*
FUNCTION LIGNEMOD
LOCAL La, OLDART
*
* LN = NUMERO LIGNE COURANTE
* MODIFY LIGNE ARTICLE :
*
La=SELECT()
SELECT TEMPLN
Fa=SELECT()
OLDART=ARTICLE
OLDN = QUANTITE
OLDP = QUANTITE * PU
OLDREP = REPORT
BONTYPE=TYPE
LN=ROW()-5 // Offset of 4 in R_LINE
CTYPE="M"
REC_LOCK(0)
MC=COL()
*@ ROW(),0 CLEAR TO ROW(),79
MART=R_ART(5+LN,2) // Get new reference
IF MART=SPACE(LEN(STOCK->STCOMMREF)).OR.MART=OLDART
UNLOCK
RETURN .T.
ENDIF
REPLACE ARTICLE WITH MART
*
IF LIGNE="99"
IF SUBSTR(ARTICLE,1,1)="-"
REPLACE ARTICLE WITH "+" // Can't delete last line!
ELSE
** Replace last record i.e. add a new one
RN=RECNO()
ADD_REC(0)
REPLACE FACTURE WITH BON->COMMANDE, TYPE WITH BONTYPE,;
LIGNE WITH "99", ARTICLE WITH "+"
GO RN
REPLACE LIGNE WITH STR(RN,2)
ENDIF
ENDIF
IF AT(SUBSTR(ARTICLE,1,1),"-+")=0 // Deleted Article or last line
NLIGNE=VAL(LIGNE)-1 // Reset by R_LINE
DO R_LINE
ENDIF
*
CHANGED = .T.
*
SELECT(La)
RETURN .T.
*
*******************************
*
FUNCTION C_TOTPDS
*
* TOTPDS already zero from calling prog, and first line is selected
LOCAL La,mp
La=SELECT()
DO WHILE FACTURE=BON->COMMANDE .AND. .NOT. EOF()
* IF REPORT =0
AREF=ARTICLE
SELECT STOCK
SEEK AREF
IF FOUND()
mp=POIDS
ELSE
mp=0
ENDIF
SELECT (La)
TOTPDS = TOTPDS+(QUANTITE*mp)
* ENDIF
SKIP
ENDDO
SELECT (La)
RETURN .T.
*
****************
*
FUNCTION UPSTATS
LOCAL La
*
*RESETS TOT_POIDS only in BON
*
La=SELECT()
SELECT BON
REPLACE TOT_POIDS WITH TOTPDS
SELECT (La)
RETURN .T.
*
**********************************
*
FUNCTION RESET_SOLDE (SIGN) // of client
// assumes client locked
LOCAL La, MAJVAL
La=SELECT()
SELECT BON
MAJVAL = MONTANT*(1-(REM_SUP/100)) // val now in BON
SELECT CLIENT
IF SIGN="+"
REPLACE CLISOLDE WITH CLISOLDE + MAJVAL
ELSE
REPLACE CLISOLDE WITH CLISOLDE - MAJVAL
ENDIF
SELECT (La)
RETURN .T.
*
********************
*
FUNCTION COMM_OUT (MAJ,MODCLI) // .T. if update allowed, .T. if you can
* this is called by saisie/modify commande and PFACT, and AVOC
* MONTANT is the TTC FROM SAISIE LINES
* need to know if refcli is changeable so second param exists
* for saisie MODCLI is .F. . You can't modify the client from the comm system
* MODCLI is only .T. for modify from mainmenu , or PFACT , or AVOC
* can't change the commande ref. or the montant
LOCAL ro, MREF,MREFCLI,TXT
SET ESCAPE OFF
IF PCOUNT()=0
MAJ =.F.
MODCLI =.F.
ENDIF
IF PCOUNT()=1
MODCLI =.F.
ENDIF
*
SELECT BON
IF .NOT. MAJ
SET INTENSITY OFF
ELSE
REC_LOCK()
ENDIF
*
*
IF SELECT("BON")=S_AVO
TXT = "AVOIR"
ELSEIF SELECT("BON")=S_FACT
TXT = "FACT."
ELSE
TXT = "COMM."
ENDIF
@ 2,4 SAY TXT +" : "+COMMANDE
IF MAJ .AND. MODCLI
DO WHILE .T.
MREFCLI=REFCLI
@ 2,29 SAY "CLIENT :" GET MREFCLI
READ
IF VAL(MREFCLI)=VAL(REFCLI)
EXIT
ENDIF
SELECT CLIENT
MREF =MREFCLI
SEEK MREF
IF .NOT. FOUND()
ALARM("CLIENT INCONNU")
SELECT BON
LOOP
ELSE
SELECT BON
REPLACE REFCLI WITH MREF
EXIT
ENDIF
ENDDO
CLEAR GETS
SET INTENSITY ON
ENDIF
// loop which follows is to check the integrity of the ttc and the echeances
//
DO WHILE .T.
@ 2,29 SAY "CLIENT : " +REFCLI
@ ROW(),COL()+2 SAY CLIENT->CLINOM
@ ROW()+1,25 SAY "CLIENT REF : " GET CLI_COMM
ro=ROW()
scolor=SETCOLOR()
IF CLIENT->CLIRISQUE <>" "
SETCOLOR("*"+scolor)
@ 22,74 SAY "RISQ"
IF MAJ
?CHR(7)
ENDIF
ELSE
@ 22,74 SAY " "
ENDIF
SETCOLOR(scolor)
* @ ro+2,4 SAY " STATUS : "+C_STATUS
IF SELECT("BON")=S_AVO .OR. SELECT("BON")=S_FACT
@ ro+2,4 SAY "DATE "+TXT+":" GET D_COMM RANGE ;
CTOD("01/" + STR(MONTH(SYSDATE()),2) +"/" + STR(YEAR(SYSDATE())-1900,2)),;
SYSDATE()
ELSE
@ ro+2,4 SAY "DATE "+TXT+" :" GET D_COMM
ENDIF
@ ROW(),COL()+8 SAY "DATE DEPART : " GET D_LIVR
@ ROW()+1,4 SAY " TVA (O/N): " + IIF(BON->EXPORT=0,"N","O")
@ ROW(),COL()+4 SAY " % REMISE SUP :"
@ ROW(),COL()+1 SAY REM_SUP
* IF SELECT("BON")<>S_AVO
* @ ROW(),COL()+10 SAY "REGL. GROUPE :" GET REGL_GRP PICTURE "@!" ;
* VALID AT(REGL_GRP,"G ")>0
* ENDIF
@ ROW()+1,8 SAY "VRP : " GET REGION VALID REGION<>SPACE(4)
@ ROW(),COL()+2 SAY " MONTANT TTC :"
@ ROW(),COL()+1 SAY STR(MONTANT*(1-REM_SUP/100),10,2) PICTURE '9999999.99'
@ ROW()+2,4 SAY "LIVRAISON :" GET LIVR_NOM
@ ROW()+1,16 GET LIVR_RUE
@ ROW()+1,16 GET LIVR_ADS
@ ROW()+1,16 GET LIVR_CP
@ ROW(),COL()+3 GET LIVR_VILLE
IF SELECT("BON")=S_AVO
IF MAJ
READ
UNLOCK
ELSE
CLEAR GETS
ENDIF
EXIT
ENDIF
// not for avoirs
@ ROW()+2,4 SAY "Remarques :" GET COMMENT
@ ROW()+1,4 SAY "Remarques :" GET COMMENT2
@ ROW()+2, 4 SAY "ECHEANCES :"
@ ROW()+1,4 GET MECH1
@ ROW(),COL()+2 GET CP1 VALID IIF(MECH1=0, CP1=" ", CP1$"0235679")
@ ROW(),COL()+2 GET DECH1 VALID (EMPTY(DECH1).AND. MECH1=0) .OR.;
( DECH1>=D_COMM .AND. DECH1<D_COMM+120 )
@ ROW(),COL()+3 GET MECH2
@ ROW(),COL()+2 GET CP2 VALID IIF(MECH2=0, CP2=" ", CP2$"0235679")
@ ROW(),COL()+2 GET DECH2 VALID (EMPTY(DECH2).AND. MECH2=0) .OR.;
( DECH2>=D_COMM .AND. DECH2<D_COMM+120 )
@ ROW(),COL()+3 GET MECH3
@ ROW(),COL()+2 GET CP3 VALID IIF(MECH3=0, CP3=" ", CP3$"0235679")
@ ROW(),COL()+2 GET DECH3 VALID (EMPTY(DECH3).AND. MECH3=0) .OR.;
( DECH3>=D_COMM .AND. DECH3<D_COMM+120 )
@ ROW()+1,4 GET MECH4
@ ROW(),COL()+2 GET CP4 VALID IIF(MECH4=0, CP4=" ", CP4$"0235679")
@ ROW(),COL()+2 GET DECH4 VALID (EMPTY(DECH4).AND. MECH4=0) .OR.;
( DECH4>=D_COMM .AND. DECH4<D_COMM+120 )
@ ROW(),COL()+3 GET MECH5
@ ROW(),COL()+2 GET CP5 VALID IIF(MECH5=0, CP5=" ", CP5$"0235679")
@ ROW(),COL()+2 GET DECH5 VALID (EMPTY(DECH5).AND. MECH5=0) .OR.;
( DECH5>=D_COMM .AND. DECH5<D_COMM+120 )
@ ROW(),COL()+3 GET MECH6
@ ROW(),COL()+2 GET CP6 VALID IIF(MECH6=0, CP6=" ", CP6$"0235679")
@ ROW(),COL()+2 GET DECH6 VALID (EMPTY(DECH6).AND. MECH6=0) .OR.;
( DECH6>=D_COMM .AND. DECH6<D_COMM+120 )
@ ROW()+1,4 GET MECH7
@ ROW(),COL()+2 GET CP7 VALID IIF(MECH7=0, CP7=" ", CP7$"0235679")
@ ROW(),COL()+2 GET DECH7 VALID (EMPTY(DECH7).AND. MECH7=0) .OR.;
( DECH7>=D_COMM .AND. DECH7<D_COMM+120 )
@ ROW(),COL()+3 GET MECH8
@ ROW(),COL()+2 GET CP8 VALID IIF(MECH8=0, CP8=" ", CP8$"0235679")
@ ROW(),COL()+2 GET DECH8 VALID (EMPTY(DECH8).AND. MECH8=0) .OR.;
( DECH8>=D_COMM .AND. DECH8<D_COMM+120 )
@ ROW(),COL()+3 GET MECH9
@ ROW(),COL()+2 GET CP9 VALID IIF(MECH9=0, CP9=" ", CP9$"0235679")
@ ROW(),COL()+2 GET DECH9 VALID (EMPTY(DECH9).AND. MECH9=0) .OR.;
( DECH9>=D_COMM .AND. DECH9<D_COMM+120 )
@ ROW()+1,4 GET MECH10
@ ROW(),COL()+2 GET CP10 VALID IIF(MECH10=0, CP10=" ", CP10$"0235679")
@ ROW(),COL()+2 GET DECH10 VALID (EMPTY(DECH10).AND. MECH10=0) .OR.;
( DECH10>=D_COMM .AND. DECH10<D_COMM+120 )
@ ROW(),COL()+3 GET MECH11
@ ROW(),COL()+2 GET CP11 VALID IIF(MECH11=0, CP11=" ", CP11$"0235679")
@ ROW(),COL()+2 GET DECH11 VALID (EMPTY(DECH11).AND. MECH11=0) .OR.;
( DECH11>=D_COMM .AND. DECH11<D_COMM+120 )
@ ROW(),COL()+3 GET MECH12
@ ROW(),COL()+2 GET CP12 VALID IIF(MECH12=0, CP12=" ", CP12$"0235679")
@ ROW(),COL()+2 GET DECH12 VALID (EMPTY(DECH12).AND. MECH12=0) .OR.;
( DECH12>=D_COMM .AND. DECH12<D_COMM+120 )
IF MAJ
READ
IF .NOT. CHK_TTC()
LOOP
ENDIF
UNLOCK
SELECT CLIENT
REPLACE DCANNEE WITH BON->D_COMM,;
CLISTATUS WITH "1" // Force update to Florensac
SELECT BON
EXIT
ELSE
CLEAR GETS
EXIT
ENDIF
ENDDO
SET INTENSITY ON
SET ESCAPE ON
*
RETURN .T.
*
*************
FUNCTION CHK_TTC
LOCAL Totech,Mval
Totech=MECH1+MECH2+MECH3+MECH4+MECH5+MECH6+MECH7+MECH8+MECH9+MECH10+;
MECH11+MECH12
IF Totech=0 .AND. MONTANT=0
RETURN .T.
ENDIF
Mval= ROUND(MONTANT*(1-REM_SUP/100),2)
IF ABS(Mval-Totech)>0.001
@ 0,0 SAY " "
ALARM("Total des echéances = " + STR(Totech,10,2)+" TTC = "+STR(Mval,10,2))
// this is OK if reglement is grouped only
IF REGL_GRP="G"
RETURN .T.
ELSE
RETURN .F.
ENDIF
ENDIF
RETURN .T.
*
//
//-----------------------------------------------------------------
//
* Programme: LITPROC.PRG
* Auteur...: R M ALCOCK
* Date.....: 13 MAY
* Copyright: (c) 1992, R M ALCOCK, Tous droits réservés
* Notes....: PROCEDURES for LITIGE system
*
*
FUNCTION LIT_INIT
*
NET_USE (S_LITIGE, "LITIGE", .T., 30, "", "")
IF .NOT. FILE("LITIGE.NTX")
INDEX ON CODE TO LITIGE
ENDIF
IF .NOT. FILE("LITDATE.NTX")
INDEX ON A_DATE TO LITDATE
ENDIF
IF .NOT. FILE("LITCLI.NTX")
INDEX ON CLIENT TO LITCLI
ENDIF
NET_USE (S_LITIGE, "LITIGE", .F., 30, "", "")
FIL_LOCK(0)
SET INDEX TO LITIGE,LITDATE,LITCLI
UNLOCK
NET_USE (S_LITREG, "LITREG", .F., 0, "", "")
NET_USE (S_LITCOD, "LITCOD", .F., 0, "", "")
SELECT LITIGE
RETURN .T.
*
**************************************
*
FUNCTION CRELIT
*
LOCAL HM:="C O N T A C T - CREATION", MCODE, M_Type
SELECT LITCOD
M_Type = RMAMENU(HM,MRCODE,LCD) // Get Type of record
DO HLOFF WITH LCD
CLEAR
M_Type = ALLTRIM(LIBELLE)
//
IF M_Type<>""
NET_USE (S_ATTACH, "ATTACH", .T., 0, "", "")
MCODE = "95"+PAD(STR(VISITNUM,4) , 4)
REPLACE VISITNUM WITH IIF(VISITNUM<9999, VISITNUM+1, 1)
USE
SELECT LITIGE
ADD_REC(0)
REPLACE REGION WITH M_Reg, D_ECR WITH DATE(), CODE WITH MCODE,;
RESP WITH M_Resp, CLIENT WITH MCLI, TYPE WITH M_Type
DO LITFMT WITH 1 // Read date, Label, Memo
* READ
//
// Create an EVENT record and attach it to the client
//
SELECT EVENT
ADD_REC (0)
STORE_EVENT()
SELECT CLIENT
REPLACE DERNVISIT WITH LITIGE->D_ECR,;
RELANCE WITH LITIGE->A_DATE,;
CLISTATUS WITH "1"
ALARM ("CONTACT ENREGISTRE")
ENDIF
SELECT LITIGE
USE
SELECT LITCOD
USE
SELECT LITREG
USE
RETURN .T.
*
******
FUNCTION LECRAN
*
* Used by LITFMT to display a record
*
DO HLON
@ 2, 2 SAY "DATE : "
@ 2,12 SAY D_ECR
@ 2, 40 SAY "ACTION AVANT LE :"
DO HLOFF WITH LCD
@ 2, 58 SAY LITIGE->A_DATE
@ 4, 2 SAY "CLIENT :"
@ 4, 11 SAY LITIGE->CLIENT
IF .NOT. EMPTY(LITIGE->CLIENT)
@ 4, 23 SAY CLIENT->CLIABV+" "+CLIENT->CLINOM
ENDIF
@ 6, 2 SAY "VRP :"
@ 6, 11 SAY LITIGE->REGION
@ 6, 17 SAY "CODE :"
@ 6, 24 SAY LITIGE->CODE
@ 6, 32 SAY "TYPE :"
@ 6, 39 SAY LITIGE->TYPE
IF LITIGE->TYPE $ "IMPAYEE,LITIGE"
@ 8, 2 SAY "FACTURE:"
@ 8, 11 SAY LITIGE->FACTURE
@ 8, 22 SAY "MONTANT:"
@ 8, 31 SAY LITIGE->MONTANT
ENDIF
@ 11, 1 SAY "COMMENTAIRE :"
*
RETURN .T.
*
//
//------------------------------------------------------------------------
//
FUNCTION PRINT_L
*
@ 2, 2 DCPRINT SAY "DATE : "
@ 2,12 DCPRINT SAY D_ECR
@ 2,40 DCPRINT SAY "ACTION AVANT LE :"
@ 2,58 DCPRINT SAY LITIGE->A_DATE
@ 4, 2 DCPRINT SAY "CLIENT :"
@ 4,11 DCPRINT SAY LITIGE->CLIENT
IF .NOT. EMPTY(LITIGE->CLIENT)
@ 4, 23 DCPRINT SAY CLIENT->CLIABV+" "+CLIENT->CLINOM
ENDIF
@ 6, 2 DCPRINT SAY "VRP :"
@ 6, 11 DCPRINT SAY LITIGE->REGION
@ 6, 17 DCPRINT SAY "CODE :"
@ 6, 24 DCPRINT SAY LITIGE->CODE
@ 6, 32 DCPRINT SAY "TYPE :"
@ 6, 39 DCPRINT SAY LITIGE->TYPE
IF LITIGE->TYPE $ "IMPAYEE,LITIGE"
@ 8, 2 DCPRINT SAY "FACTURE:"
@ 8, 11 DCPRINT SAY LITIGE->FACTURE
@ 8, 22 DCPRINT SAY "MONTANT:"
@ 8, 31 DCPRINT SAY LITIGE->MONTANT
ENDIF
@ 11, 1 DCPRINT SAY "COMMENTAIRE :"
*
RETURN .T.
*
//
//--------------------------------------------------------------------------------
//
FUNCTION LITFMT (CONTROL)
*
* Control = 1 Creation, don't read REGION, CODE, RESP
* Control = 2 Modif, all parameters except D_ECR and CODE can be changed
* Control = 3 Deletion, no read
*
LOCAL abuff
REC_LOCK(0)
IF Control=1
// Create
do win with 0,0,23,79,abuff, "CREATION "+ALLTRIM(EVENT->TYPE)
ENDIF
DO LECRAN // OUTPUT Screen Format
@ 12, 1 TO 12, 10
MEMOEDIT(LITIGE->COMMENTAIR,13,1,21,78,.F.,.F.,74)
IF CONTROL=3 // CONTROL=3 No Gets
RETURN .T.
ENDIF
@ 2, 12 GET LITIGE->D_ECR RANGE DATE()-300, DATE()
@ 2, 58 GET LITIGE->A_DATE RANGE DATE(),DATE()+500
IF LITIGE->TYPE $ "IMPAYEE,LITIGE"
@ 8, 11 GET LITIGE->FACTURE
@ 8, 31 GET LITIGE->MONTANT
ENDIF
READ
IF LASTKEY()<>K_ESC
// Operate on Memo field
@ 11,18 CLEAR TO 21,78
DO HLON
@ 23,31 SAY " F1 pour Aide " //spaces to overwrite old message
DO HLOFF WITH LCD
ED_MEMO() // FUNCTION used so that HELP can decode situation
ENDIF
IF UPDATED()
IF LITIGE->D_ECR > CLIENT->DERNVISIT
REPLACE CLIENT->DERNVISIT WITH LITIGE->D_ECR,;
CLIENT->CLISTATUS WITH "1"
ENDIF
IF CLIENT->RELANCE > LITIGE->A_DATE
REPLACE CLIENT->RELANCE WITH LITIGE->A_DATE,;
CLIENT->CLISTATUS WITH "1"
ENDIF
SELECT EVENT
SEEK LITIGE->CODE
IF FOUND()
STORE_EVENT()
ENDIF
ENDIF
UNLOCK
IF Control=1
// Create
do wout with 0,0,23,79,abuff
ENDIF
RETURN .T.
***
FUNCTION LITCLI()
LOCAL La,R:=.T.
La=SELECT()
IF EMPTY(LITIGE->CLIENT)
RETURN .T.
ENDIF
SELECT CLIENT
SEEK LITIGE->CLIENT
IF .NOT. FOUND()
R= .F.
ELSE
DO LECRAN
ENDIF
SELECT (La)
RETURN R
****
//
//------------------------------
//
FUNCTION STORE_EVENT()
//
LOCAL M_Sel:=SELECT()
SELECT LITCOD
LOCATE FOR CODE = EVENT->TYPE
SELECT EVENT
REPLACE REFCLI WITH LITIGE->CLIENT,;
D_CRE WITH LITIGE->D_ECR,;
TYPE WITH LITIGE->TYPE,;
BONREF WITH LITIGE->CODE
SELECT (M_Sel)
RETURN .T.
//
//------------------------------
//
FUNCTION ED_MEMO()
LOCAL bBlock
//
// Only exists so the HELP system will work !!!
//
bBlock = SetKey( K_F1, { || help_me ( ProcName(), ProcLine(), "COMMENTAIR" ) } )
REPLACE COMMENTAIR WITH MEMOEDIT(COMMENTAIR,13,1,21,78,.T.)
SetKey ( K_F1, bBlock)
RETURN .T.
//
//-----------------------------------------------------------
//
* Programme: COMMENT. PRG (was proc T_COMMENT in MAIN)
* Auteur...: R M ALCOCK
* Date.....: 3/3/95
* Copyright: (c) 1995, R M ALCOCK, Tous droits réservés
* Notes....: Used by MAIN and MAINMENU
*
*
FUNCTION T_COMMENT (CONTROL)
LOCAL La,MA[4],MBUFF1:="",MBuff2:="",MCHOIX
LOCAL t:=17,l:=57,b:=22,r:=75 // Menu Position
LOCAL TL:=5, LM:=5, RM:=76, BM:=23 // Comment Screen
LOCAL oPrinter, bBlock
La=SELECT()
SELECT CLIENT
MA[1]="RETOUR "
MA[2]="Modifier "
MA[3]="Imprimer "
MA[4]="Supprimer"
*
DO WIN WITH TL,LM,BM,RM,MBUFF2,"COMMENTAIRE","" // Preserve outside screen
MEMOEDIT(COMMENTAIR,TL+1,LM+2,BM-1,RM-2,.F.,.F.) // Display the memo
bBlock = SetKey( K_F1, { || help_me ( ProcName(), ProcLine(), "COMMENTAIR" ) } )
*
DO WHILE .T.
DO WIN WITH t,l,b,r,MBUFF1,"COMMENTAIRE","" // Preserve the memo
IF CONTROL=1 // Creation
MCHOIX=2 // Force an edit
CONTROL=0 // Normal next time
ELSE
SET COLOR TO &MENUCLR
MCHOIX=ACHOICE(t+1,l+2,b-1,r-1,MA)
DO HLOFF WITH LCD // Get Colour back
ENDIF
DO WOUT WITH t,l,b,r,MBUFF1 // Get back memo without menu
DO CASE
CASE MCHOIX=0.OR.MCHOIX=1 // RETOUR
SELECT(La)
EXIT
CASE MCHOIX=2 // Modifier
@ 23,34 SAY "F1 pour Aide"
REPLACE COMMENTAIR WITH MEMOEDIT(COMMENTAIR,TL+1,LM+2,BM-1,RM-2,.T.)
REPLACE CLISTATUS WITH "1" // Force update to Florensac
CASE MCHOIX=3 // Imprimer
DCPRINT ON TO oPrinter
@ 2,4 DCPRINT SAY "COMMENTAIRE Client : " +CLIENT->CLIREF
@ PROW(),PCOL()+2 DCPRINT SAY CLINOM
L_CNT=MLCOUNT(COMMENTAIR, 62, 4, .T.)
FOR ML=1 TO L_CNT
MPL=MEMOLINE(COMMENTAIR,62,ML,4,.T.)
@ ML+4,4 DCPRINT SAY MPL
NEXT
DCPRINT EJECT
DCPRINT OFF
CASE MCHOIX=4 // Efface memo
IF CONFIRM (21,3,"N","EFFACE COMMENTAIRE : ")
REPLACE COMMENTAIR WITH ""
REPLACE CLISTATUS WITH "1" // Force update to Florensac
ENDIF
@ 21,3 CLEAR TO 21,79
OTHERWISE
ENDCASE
ENDDO
DO WOUT WITH TL,LM,BM,RM,MBUFF2
SetKey ( K_F1, bBlock)
SELECT (La)
RETURN .T.
//
//----------------------------------------------------------------
//
FUNCTION COMM
* Auteur...: R M ALCOCK
* Date.....: 6/3/95
* Copyright: (c) 1992, R M ALCOCK, Tous droits réservés
* Notes....: Modification Command (MEFRAN)
* ---
*
* First Choose the Commande
*
DO WHILE .T.
CLEAR
SELECT BON
SET CURSOR ON
MCOM=SPACE(LEN(COMMANDE))
MT = CONAME+" - MODIFICATION COMMANDE"
@ 2,40-LEN(MT)/2 SAY MT
@ 1,40-2-LEN(MT)/2 TO 3,40+2+LEN(MT)/2 DOUBLE
@ ROW()+6,14 SAY "Commande REFERENCE :";
GET MCOM
READ
IF MCOM=SPACE(LEN(COMMANDE))
RETURN .T.
ENDIF
*
*
SET ORDER TO 1
SEEK MCOM
IF .NOT. FOUND()
@ 12,14 SAY "COMMANDE N'EXISTE PAS - Tapez une touche"
WAIT " "
LOOP
ENDIF
* Commande Selected, do Modif.
t=0
l=0
b=23
r=79
zbuff=" "
REC_LOCK(0)
* as in ZCC
do win with t,l,b,r,zbuff,"COMMANDE"
* client is not yet selected
SELECT CLIENT
SEEK BON->REFCLI
SELECT BON
DO COMM_OUT
SET CURSOR OFF
DO COMMMENU
do wout with t,l,b,r,zbuff
ENDDO
RETURN .T.
*
****************************************
*
FUNCTION COMMMENU (MODCLI)
*.......................................
*
LOCAL MA[4],MBUFF1,t,l,b,r,MCHOIX,MSEL,DEL:=.F.
MODCLI=IIF (PCOUNT()=0,.T.,.F.)
// If called from F2 in Commercial system PCOUNT
// can never be zero because it is automatically set
// to the name of the calling routine, therefore
// if not set, the call is from COMM
*
MCHOIX=1 // Selction Code in Menu
MSEL=SELECT()
SELECT BON
*
do keysoff
t=12
l=52
b=17
r=72
MBUFF1=""
MA[1]="RETOUR "
MA[2]="Modifier En-tête"
MA[3]=" Lignes"
MA[4]="Supprimer"
DO WHILE .T.
DO WIN WITH t,l,b,r,MBUFF1,"",""
SET COLOR TO &MENUCLR
//
// Should test the status here to deal with blocked commandes - STATUS 40
//
MCHOIX=ACHOICE(t+1,l+2,b-1,r-1,MA)
DO WOUT WITH t,l,b,r,MBUFF1
DO HLOFF WITH LCD
DO CASE
CASE MCHOIX=0.OR.MCHOIX=1
SELECT(MSEL)
IF .NOT. MODCLI
set key K_F2 to COMMMENU // If MODCLI=.F. called from MAIN
ENDIF
RETURN .T.
CASE MCHOIX=2
SET CURSOR ON
IF VAL(BON->C_STATUS)=40
ALARM("COMMANDE BLOQUEE")
ELSE
IF VAL(BON->C_STATUS)>9
ALARM("ATTENTION!! DEJA FACTUREE")
ENDIF
ENDIF
DO COMM_OUT WITH .T.,MODCLI
SET CURSOR OFF
CASE MCHOIX=3
SET CURSOR ON
IF VAL(BON->C_STATUS)<>0
ALARM("BON DEJA ENVOYEE A FLORENSAC")
ENDIF
* IF VAL(BON->C_STATUS)=10
* ALARM("ATTENTION!! DEJA FACTUREE")
* ENDIF
IF VAL(BON->C_STATUS)=40
ALARM("COMMANDE BLOQUEE")
ENDIF
DO LINESM // Modification Lines
IF Changed .AND. VAL(BON->C_STATUS)=0
CLEAR
DO COMM_OUT WITH .T., .F.
ENDIF
SET CURSOR OFF
CASE MCHOIX=4 // DELETE
// only packs COM, FACTA packed at FDM
IF VAL(C_STATUS)<>09
ALARM("COMMANDE DEJA ENVOYEE A FLORENSAC - ANNULATION INTERDIT")
ELSE
@ b-3,l+1 TO b-1,l+19 DOUBLE
IF CONFIRM (20,,"N","CONFIRMATION SUPPRESSION COMMANDE ? ")
IF MONTH(D_COMM)=MONTH(MDAT_MAX)
DEL =.T. // this month's cde
ENDIF
DO RESET_SOLDE WITH "-"
SELECT BON
AREF=COMMANDE
REC_LOCK(0)
IF DEL
DELETE
ELSE
* REPLACE C_STATUS WITH "99" always delete for now,
DELETE
ENDIF
UNLOCK
SELECT FACTA
SEEK AREF
DO WHILE FACTURE=AREF .AND. .NOT. EOF()
REC_LOCK(0)
IF SUBSTR(ARTICLE,1,1)<>"+"
OLDART=ARTICLE
OLDQTE=QUANTITE
OLDREP=REPORT
REPLACE REPORT WITH 99 // so as not to do SETPF
DO RESETPF
ENDIF
IF DEL
DELETE
ENDIF
UNLOCK
SKIP
ENDDO
UNLOCK
SELECT(MSEL)
DO WOUT WITH t,l,b,r,MBUFF1
KEYBOARD CHR(27)+CHR(27) //Force Terminate
RETURN .T.
ENDIF
ENDIF
ENDCASE
SET CURSOR OFF
Do HLON // Equivalent of WIN to make correct Frame
@ 0,0 clear to 23,79
@ 0,0 to 23,79 double
@ 0,32 say "COMMANDE"
@ 23,31 SAY "Esc pour terminer"
Do HLOFF WITH LCD
DO COMM_OUT WITH .F. // Visualise
ENDDO
RETURN .T.
*
****************************************
*
FUNCTION LINESM
*.......................................
*
Local Blq:=.F.,MAJMONT,TOTHT,TOTTARIF
CLEAR
SELECT BON
AREF=COMMANDE
SELECT FACTA
SEEK AREF
COPY TO C:TEMPLN WHILE FACTURE=AREF
UNLOCK
NET_USE (S_TEMPLN, "C:TEMPLN", .T., 30, "", "")
MREC=RECCOUNT()
Fa=SELECT()
*
*FIRST SELECT THE RECORD
*
PRIVATE fbuff[8],tbuff[8],sbuff[8]
Fbuff[1]="ARTICLE"
Fbuff[2]="LIB"
Fbuff[3]="QUANTITE"
Fbuff[4]="PU"
Fbuff[5]="REM_LINE"
Fbuff[6]="IIF(REPORT=98,'N','O')"
Fbuff[7]="PRIXREEL/QUANTITE"
Fbuff[8]="PRIXREEL"
*
Tbuff[1]="ART"
Tbuff[2]="LIBELLE"
Tbuff[3]=" QTE."
Tbuff[4]=" PRIX U"
Tbuff[5]="REM "
Tbuff[6]="LI"
Tbuff[7]=" PRIX NET"
Tbuff[8]=" TOTAL NET"
*
Sbuff[2]="@S23 "
Sbuff[3]="9999"
Sbuff[5]="99"
Sbuff[7]="@Z ######.##"
Sbuff[8]="@Z ########.##"
*
PUBLIC Changed,PREFACT,TOTPDS,Recalc
//
Recalc=.F.
Changed=.F.
PREFACT=.F.
TOTPDS =0 // in fact TOTPDS is recalculated if MAJ
SET CURSOR OFF
IF SELECT("BON")=S_AVO
@ 1,0 SAY "AVOIR : " +AREF
ELSE
@ 1,0 SAY "COMMANDE : " +AREF
ENDIF
@ 1,20 SAY CLIENT->CLINOM
*
My_DBEDIT(3,0,21,79,Fbuff,"RMAED",Sbuff,Tbuff,"-"," ")
//
SUM PRIXREEL TO TOTHT FOR AT(SUBSTR(ARTICLE,1,1),"-*")=0
* .AND. REPORT=0
TOTHT=TOTHT*(1-BON->REM_SUP/100)
SUM PU*QUANTITE TO TOTTARIF FOR AT(SUBSTR(ARTICLE,1,1),"-*")=0
* .AND. REPORT=0
*
TVATOT =IIF(BON->EXPORT=0,0,TOTHT*TVARATE)
TVATTOT=IIF(BON->EXPORT=0,0,TOTTARIF*TVARATE)
IF BON->MONTANT=0
// remise is TARIF-NET which is not O if there is a remise line
// or a rem sup
Remis=(TOTTARIF-TOTHT)/TOTTARIF
ELSE
Remis=(TVATTOT+TOTTARIF-(BON->MONTANT*(1-BON->REM_SUP/100)));
/(TVATTOT+TOTTARIF)
ENDIF
// must come out of the next bit with majmont set up
SET CURSOR ON
@ 20,0 CLEAR TO 20,79
IF BON->REM_SUP>0
ALARM("Remise exceptionnelle sur la commande = " +STR(BON->REM_SUP,5,2) +" %")
ENDIF
@ 20, 1 SAY "TARIF TTC :" +STR(TVATTOT+TOTTARIF,10,2)
@ 20,COL()+2 SAY "NET TTC :" +STR(TVATOT+TOTHT,10,2)
@ 20,COL()+2 SAY "NET HT :" +STR(TOTHT,10,2)
@ 20,65 SAY "Remise :" +STR(Remis*100,5,1)+"%"
//
// now proposes in the box either the sum of all prixreels after remsup
// or the previous montant after rem_sup
//
MM=IIF(BON->MONTANT=0,TVATOT+TOTHT,;
ROUND(BON->MONTANT*(1-BON->REM_SUP/100),2))
Remis=(TVATTOT+TOTTARIF-MM)/(TVATTOT+TOTTARIF)
IF VAL(BON->C_STATUS)=0 .AND.(Remis*100 > MAXREM1 .OR.;
.NOT. CONFIRM (21,,"N","Montant TTC à facturer ? " + STR(MM,11,2)))
DO WHILE .T.
Blq=.F.
@ 22,65 CLEAR TO 23,79
SET ESCAPE OFF
@ 21,10 SAY "Tapez le montant à facturer :" GET MM PICTURE '99999999.99'
READ
Remis=(TVATTOT+TOTTARIF-MM)/(TVATTOT+TOTTARIF)
@ 20,65 SAY "Remise :" +STR(Remis*100,5,1)+"%"
IF SELECT("BON")<>S_AVO
IF Remis*100 > MAXREM1
ALARM("REMISE EN DEPASSEMENT")
Blq=.T.
ENDIF
ENDIF
ANS="N"
@ 22,10 SAY "Confirmation ? (O/N)? " GET ANS
READ
IF UPPER(ANS)="O"
MAJMONT=MM
IF Blq
ALARM("LA COMMANDE SERA BLOQUEE")
Changed =.T.
ENDIF
EXIT
ELSE
@ 21,0 CLEAR TO 23,79
LOOP
ENDIF
ENDDO
ENDIF
MAJMONT=MM
SET ESCAPE ON
IF MAJMONT<>BON->MONTANT*(1-BON->REM_SUP/100)
Changed=.T.
Recalc=.T.
ENDIF
IF Changed
Ln=IIF(RECCOUNT()>15,21,RECCOUNT()+5)
DO HLON
@ Ln,25 TO Ln+3,54 DOUBLE
DO HLOFF WITH LCD
CHOIX=1
@ Ln+1,28 PROMPT "Mise à jour des fichiers"
@ Ln+2,28 PROMPT "Abandon sans mise à jour"
MENU TO CHOIX
*
@ Ln+1,28 CLEAR TO Ln+2,53
@ Ln+1,28 SAY "Patientez S.V.P. ......"
*
IF CHOIX=2 // abandon
Changed = .F.
ELSE // M A J
SELECT BON //moved 27/1
REC_LOCK(0)
REPLACE MONTANT WITH MAJMONT/(1-REM_SUP/100)
UNLOCK
SELECT TEMPLN
DO RECALCPR // Mod of 3/1/95 ....
TOTPDS=0
GO TOP
DO C_TOTPDS // calcs TOTPDS for all lines report=0 or not
// whether in TEMPLN or FACTA
IF Blq
SELECT BON
REC_LOCK(0)
REPLACE C_STATUS WITH "40"
UNLOCK
ENDIF
SELECT TEMPLN
SET RELATION TO FACTURE+LIGNE INTO FACTA
GO TOP
DO WHILE RECNO()<MREC
* CLEAR
SELECT FACTA
REC_LOCK()
REC_LOCK()
OLDQTE=QUANTITE
OLDART=ARTICLE
OLDREP=REPORT
REPLACE ARTICLE WITH TEMPLN->ARTICLE, QUANTITE WITH TEMPLN->QUANTITE,;
LIB WITH TEMPLN->LIB, PU WITH TEMPLN->PU
REPLACE REPORT WITH TEMPLN->REPORT,PRIXREEL WITH TEMPLN->PRIXREEL,;
TYPE WITH TEMPLN->TYPE,REM_LINE WITH TEMPLN->REM_LINE,;
LINETVA WITH TEMPLN->LINETVA
UNLOCK
IF OLDQTE<>QUANTITE .OR. OLDART<>ARTICLE .OR. OLDREP<>REPORT
IF OLDREP<>REPORT .AND. REPORT=0
// something has changed from delai to immed
PREFACT=.T.
ENDIF
IF REPORT=0 .AND. SUBSTR(OLDART,1,1)="+" .AND.;
AT(SUBSTR(ARTICLE,1,1),"-*")=0
// last line been changed to a real immediate thing
PREFACT=.T.
ENDIF
IF REPORT=0 .AND. SUBSTR(OLDART,1,1)="*" .AND.;
AT(SUBSTR(ARTICLE,1,1),"-*+")=0
// a comment line has been changed to a real immediate thing
PREFACT=.T.
ENDIF
IF SELECT("BON")<>S_AVO
DO RESETPF // which does SETPF as well
ENDIF
ENDIF // change with "ACTION"
SELECT TEMPLN
SKIP
ENDDO
*
IF RECCOUNT()>MREC // Records have been added
GO TOP
DELETE NEXT MREC-1 // The old "+" record is now re-used
GO TOP
DELETE FOR SUBSTR(ARTICLE,1,1)="+"
PACK
IF SELECT("BON")<>S_AVO
Fa=SELECT()
GO TOP
OLDART=SPACE(6)
OLDQTE=0
DO WHILE .NOT. EOF()
IF AT(SUBSTR(ARTICLE,1,1),"+-*")=0
DO RESETPF
ENDIF
SKIP
ENDDO
ELSE
// Avoirs, do nothing
ENDIF
USE // releases templn
SELECT FACTA
APPEND FROM C:TEMPLN // Just the additions
SELECT (Fa) // templn
ENDIF // of added lines in TEMPLN
// next bit deals with PREFACT
IF PREFACT .AND. (BON->C_STATUS="09" .OR. BON->C_STATUS="10")
// at least one line of an entirely delayed commande is to be delivered
// and the bon did not come out last time
// or this commande is already factured for a partial delivery
SELECT BON
REC_LOCK()
REPLACE C_STATUS WITH "00"
UNLOCK
SELECT (Fa) // dummy
ENDIF
//
// now the bottom bit
//
SELECT (Fa) // need this
ENDIF // maj fich
ENDIF // of changed
SELECT(Fa)
USE // release templn
*
SET CURSOR ON
ERASE C:TEMPLN.DBF
CLEAR TYPEAHEAD
RETURN .T.
*
********
FUNCTION RECALCPR
// starts off by resetting ALL prixreels
// takes the ttc and resets PRIXREEL proportionally in FACTA or TEMPLN
// with rounding so that the sum of all the lines=ttc/1.186
// BON is COM AND THE RIGHT DATABASE MUST BE SELECTED !!!!!!!
Local La,Re,Diff,Remis,FRED,R_MEM
La=SELECT()
*SELECT FACTA // Mod of 3/1/95 ....
R_MEM=RECNO()
GO TOP // Mod of 3/1/95 ....
*SEEK BON->COMMANDE // Mod of 3/1/95 ....
Re=RECNO()
DO WHILE FACTURE=BON->COMMANDE .AND. .NOT. EOF()
REC_LOCK()
IF AT(SUBSTR(ARTICLE,1,1),"*-+")>0
REPLACE PRIXREEL WITH 0,REM_LINE WITH "00",PU WITH 0,QUANTITE WITH 0
ELSE
REPLACE PRIXREEL WITH CALCPU(PU)*QUANTITE
ENDIF
UNLOCK
SKIP
ENDDO
GO Re
SUM REST PRIXREEL TO MREEL WHILE FACTURE=BON->COMMANDE
FRED=IIF(BON->EXPORT=0,0,TVARATE)
MREEL=MREEL*(1-BON->REM_SUP/100)
MNETHT=ROUND(BON->MONTANT*(1-BON->REM_SUP/100)/(1+FRED),2)
IF MREEL<>MNETHT
// PRIXREEL NEEDS ADJUSTING
Remis=(MREEL-MNETHT)/MREEL
GO Re
DO WHILE .NOT. EOF() .AND. FACTURE=BON->COMMANDE
IF AT(SUBSTR(ARTICLE,1,1),"+-*")=0
REC_LOCK(0)
REPLACE PRIXREEL WITH ROUND(PRIXREEL*(1-Remis),2)
UNLOCK
ENDIF
SKIP
ENDDO
// check it
GO re
SUM REST PRIXREEL TO MREEL WHILE FACTURE=BON->COMMANDE
IF MREEL<>MNETHT
Diff=MREEL - MNETHT
IF ABS(Diff)>0.005
ALARM("RECTIFICATION PRIX REEL (en francs)= " +STR(DIFF,9,2))
ENDIF
GO Re
IF AT(SUBSTR(ARTICLE,1,1),"+*-")=0
LOCATE REST FOR PRIXREEL>0 WHILE FACTURE=BON->COMMANDE
// get the first one
ENDIF
REC_LOCK(0)
REPLACE PRIXREEL WITH PRIXREEL-Diff
UNLOCK
ENDIF
GO Re
ENDIF
GO R_MEM // Position FACTA on the original record
SELECT(La)
RETURN .T.
*
**************
FUNCTION RESETPF
* resets STPORT for OLDART AND OLDQTE (modified lines)
* irrespective of changes in REPORT
* All commandes are in STPORT for ANJOU
* you know it must be done or else you wouldn't be here.
* never changes the STREEL
LOCAL Fa
PRIVATE NEWART,NEWQTE
RETURN .T. // Not needed for Portables
Fa=SELECT()
NEWART=ARTICLE
NEWQTE=QUANTITE
SELECT STOCK
IF OLDART<>SPACE(6).AND. OLDART<>CODE_DIVERS .AND.(AT(SUBSTR(OLDART,1,1),"-*")=0)
SEEK OLDART
REC_LOCK(0)
REPLACE STPORT WITH STPORT-OLDQTE
UNLOCK
ENDIF
*
SELECT (Fa)
DO SETPF WITH NEWART,NEWQTE,.T.,.F. // for NEWQTE of modif or saisie
RETURN .T.
*
****************
FUNCTION RMAED
PARAMETERS status, fld_ptr
PRIVATE a_request,ARTTOT,OLDART,OLDN,OLDP,OLDREM,OLDRP,TOTHT,TVATOT,;
CTYPE,NLIGNE,ENDIT,AVOIR
* PREFACT = .F.
AVOIR = .F.
TOTHT = 0
TVATOT= 0
*TOTPDS=0
LN=0
NLIGNE=0
ENDIT = .F.
*CTYPE SET FOR LIGNEIN
*CTYPE="C"
key_stroke=LASTKEY()
DO CASE
CASE status=0
a_request=1
CASE status=1
a_request=1
CASE status=2
a_request=1
CASE status=3
a_request=1
CASE status=4
a_request=KeyExcept(key_stroke)
ENDCASE
RETURN a_request
*
FUNCTION KeyExcept (action_key)
LOCAL M_RPX
*
DO CASE
CASE action_key=K_ESC.OR.action_key=K_F9
RETURN 0 // Terminate DBEDIT
otherwise
IF fld_ptr>=7 // Can't edit PRIXREEL or TOTAL
TONE(100,1)
RETURN 1
ENDIF
IF SUBSTR(ARTICLE,1,1)="-"
TONE(100,1) // Can't edit deleted article
RETURN 1
ENDIF
if action_key <> K_ENTER
keyboard CHR(action_key)
endif
IF fld_ptr<>1
SET CURSOR ON
OLDLIB=LIB
OLDQTE=QUANTITE
OLDPU=PU
OLDRP=REPORT
OLDREM=REM_LINE
MREF=ARTICLE
IF fld_ptr=6
// REPORT used for articles not to be delivered
M_RPX = IIF(OLDRP=98,"N","O")
@ROW(),COL() GET M_RPX PICTURE '@!' VALID M_RPX $ "ON"
READ
REPLACE REPORT WITH IIF(M_RPX="N",98,0)
ELSE
field_name=Fbuff[fld_ptr]
@ROW(),COL() GET &field_name PICTURE Sbuff[fld_ptr]
READ
ENDIF
SET CURSOR OFF
IF OLDQTE<>QUANTITE.OR.PU<>OLDPU.OR.OLDRP<>REPORT.OR.OLDREM<>REM_LINE
Changed=.T.
Recalc=.T. // set marker to recalculate PRIXREEL
REPLACE PRIXREEL WITH CALCPU(PU)*QUANTITE
ENDIF
IF OLDLIB<>LIB
Changed=.T.
ENDIF
RETURN 2
ELSE
*
* It is the Article
SET CURSOR ON
DO LIGNEMOD
SET CURSOR OFF
RETURN 2
*
ENDIF
ENDCASE
RETURN 0
//
//-------------------------------------------------------------------
//
FUNCTION FACT (MAJ,Av)
* Auteur...: R M ALCOCK
* Date.....: August 31
* Copyright: (c) 1992, R M ALCOCK, Tous droits réservés
* Notes....: FACTURE /AVOIR (not FACTURATION !) visu / modif
* : now a file by itself and not a procedure file
*
LOCAL La
La=SELECT()
SELECT BON
DEFAULT MAJ TO .F.
DEFAULT Av TO .F.
IF .NOT. MAJ
SET INTENSITY OFF
ELSE
REC_LOCK()
ENDIF
*
*
IF Av
@ 3,4 SAY " AVOIR : "+FACTURE +" du "
@ ROW(), COL() GET DFACT RANGE ;
CTOD("01/" + STR(MONTH(SYSDATE()),2) +"/" + STR(YEAR(SYSDATE())-1900,2)),;
SYSDATE()
ELSE
@ 3,4 SAY " FACTURE : "+FACTURE+"/"+ECH+" du "
@ ROW(), COL() GET DFACT RANGE ;
CTOD("01/" + STR(MONTH(SYSDATE()),2) +"/" + STR(YEAR(SYSDATE())-1900,2)),;
SYSDATE()
ENDIF
@ ROW()+2,4 SAY " V.R.P. :" GET REGION
@ ROW()+1,4 SAY " COMMANDE :" GET COMMANDE
@ ROW(),COL()+4 SAY "CLIENT :"+REFCLI+" "+ CLIENT->CLINOM
@ ROW()+1,4 SAY " STATUS : "
IF VAL(C_STATUS)>0
@ ROW(),COL() GET C_STATUS
ELSE
@ ROW(),COL() SAY C_STATUS
ENDIF
IF .NOT. Av
@ ROW(),COL()+4 SAY "DATE COMMANDE :" GET D_COMM
ENDIF
@ ROW(),COL()+4 SAY "REF :" GET CLI_COMM
@ ROW()+1,4 SAY " EXPORT :" GET FACT->EXPORT
@ ROW(),COL()+5 SAY "DATE LIVRAISON :" GET D_LIVR
@ ROW(),COL()+4 SAY " % REMISE SUP :" GET REM_SUP
@ ROW()+1,4 SAY " POIDS :"
@ ROW(),COL() GET TOT_POIDS
*@ ROW(),COL()+6 SAY " PORT :" GET PORT
@ ROW()+2,4 SAY "LIVRAISON :" GET LIVR_NOM
@ ROW()+1,16 GET LIVR_RUE
@ ROW()+1,16 GET LIVR_ADS
@ ROW()+1,16 GET LIVR_CP
@ ROW(),COL()+3 GET LIVR_VILLE
@ ROW()+2,4 SAY "TOTAL TTC : "
@ ROW(),COL()+1 GET MONTANT RANGE 0,9999999
IF .NOT. Av
* @ ROW(),COL()+4 SAY " NOMBRE ECH. :" GET NUM_ECH
@ ROW(),COL()+4 SAY "CODE PAIEMENT :" GET CP1
@ ROW()+2,4 SAY "ECHEANCE : "
@ ROW(),COL()+1 GET MECH1 RANGE 0,9999999
@ ROW(),COL()+4 SAY " DATE ECHEANCE : "
@ ROW(),COL()+1 GET DECH1
ENDIF
@ ROW(),COL()+6 SAY "REGLE : "
IF VAL(C_STATUS)>0
@ ROW(),COL()+1 GET RECH1 PICTURE "Y"
ELSE
@ ROW(),COL()+1 SAY RECH1
ENDIF
IF MAJ
READ
UNLOCK
ELSE
CLEAR GETS
ENDIF
SET INTENSITY ON
SELECT (La)
RETURN .T.
//
//-------------------------------------------------------------------
//
FUNCTION SETPF (NEWART,NEWQTE,DOSTPORT,DOSTREEL)
* Auteur...: R M ALCOCK
* Date.....: 22 April 1994
* Copyright: (c) 1994, R M ALCOCK, Tous droits réservés
* Notes....: Procedure which was in COMPROC and now is here for the facturation
* : STOCK and STCOMP must be opened
*
LOCAL Fa
//
// If DOSTPORT it ADDS NEWQTE to STPORT
// If DOSTREEL then it ADDS NEWQTE to STREEL, this is for avoirs with maj stock
// locks and unlocks
// FACTA must be selected
//
Fa = SELECT ()
SELECT STOCK
IF NEWART<>CODE_DIVERS .AND. SUBSTR(NEWART,1,1)<>"-".AND. SUBSTR(NEWART,1,1)<>"*"
SEEK NEWART
IF FOUND()
REC_LOCK(0)
IF DOSTPORT
REPLACE STPORT WITH STPORT+NEWQTE
ENDIF
IF DOSTREEL .AND. STTYP="S" // S for stocked articles ANJOU
REPLACE STREEL WITH STREEL + NEWQTE
ENDIF
UNLOCK
ENDIF
ENDIF
SELECT(Fa)
RETURN .T.
//
//--------------------------------------------------------------------------
//
* Programme: HELPPRG.PRG
* Auteur...: R M ALCOCK
* Date.....: 26/11/93
* Copyright: (c) 1993, R M ALCOCK, Tous droits réservés
* Notes....: HELP system
*
*
FUNCTION help_me ( mproc,The_line,The_var )
local t,l:=0,b,r:=79, zbuff:="", mr,mcol,mht:= {}, choix:=1
LOCAL C_String
mr=row() // Save current cursor posn.
mcol=col()
ml=1 // Most help just one line
* Get rid of alias from The_Var
The_Var = IIF (at(">",The_Var)=0, The_Var, substr(The_Var, at(">",The_Var)+1, len(The_Var)))
//
// Handle COMMENT as a special case
//
IF mproc="T_COMMENT".OR. The_Var="COMMENTAIR" .OR. mproc="ED_MEMO"
//
// C_String is pairs of control characters to send to MEMOEDIT
//
C_String := CHR(0)+CHR(0) +CHR(23)+CHR(27) +CHR(27)+CHR(27)
C_String=C_String + CHR(25)+CHR(0) +CHR(20)+CHR(0) +CHR(2)+CHR(0)
t=15
l=48
b=22
do win with t,l,b,r,zbuff,"AIDE"
@ t+1, l+3 PROMPT "Continuer la modification"
@ ROW()+1, L+3 PROMPT "Sauve et Terminer"
@ ROW()+1, L+3 PROMPT "Terminer sans sauvegarde"
@ ROW()+1, L+3 PROMPT "Efface Ligne"
@ ROW()+1, L+3 PROMPT "Efface Mot"
@ ROW()+1, L+3 PROMPT "Reformatage Paragraphe"
MENU TO CHOIX
CHOIX=CHOIX*2-1
KEYBOARD SUBSTR(C_String, CHOIX, 2)
do wout with t,l,b,r,zbuff
@mr,mcol say "" // Reset cursor position
return .T.
ENDIF
ALARM (mproc+" "+str(The_line)+" "+The_var)
t=10
l=4
b=t+10
r=l+40
do win with t,l,b,r,zbuff,"AIDE"
@ t+1, l+3 PROMPT "Sélection CLient(s)"
@ ROW()+1, L+3 PROMPT "Profession / Activité"
@ ROW()+1, L+3 PROMPT "Choisir un article"
@ ROW()+1, L+3 PROMPT "Modification Ligne de commande"
@ ROW()+1, L+3 PROMPT "Code Paiement"
@ ROW()+1, L+3 PROMPT "Reformatage Paragraphe"
MENU TO CHOIX
do wout with t,l,b,r,zbuff
IF LASTKEY() = K_ESC
RETURN .F.
ENDIF
DO CASE
//
CASE CHOIX = 1
AADD (MHT, "Recherche par Code Postale ou Nom = Tapez les premiers chiffres")
AADD (MHT, "Numéro Client = Cxxxxxxxxx pour un client ou Pxxxxxxxx pour un prospect")
AADD (MHT, "")
AADD (MHT, "Pour créer un client/prospect, renseignez les zones 'NOM' et 'Code Postale'")
AADD (MHT, " et mettre '*' à gauche en zone 'NUMERO' (Création prospect)")
AADD (MHT, " ou son numéro (Cxxxxxxxxx) (Création Client)")
CASE CHOIX = 2
AADD (MHT, SUBSTR(ValidProff,1,60))
AADD (MHT, SUBSTR(ValidProff,61))
CASE CHOIX = 3
AADD (MHT, "F5 pour le catalogue / tarif")
CASE CHOIX = 4
AADD (MHT, [Si vous voulez changer l'article, selectionnez "ART" avec <-])
AADD (MHT, "vous pouvez ensuite tapez F5 pour obtenir le tarif / catalogue")
AADD (MHT, "")
AADD (MHT, "Sélectionnez le '+' pour ajouter une ligne")
AADD (MHT, "")
AADD (MHT, [les zones :])
AADD (MHT, [ "LI" est "O" si la ligne est à livrée sinon "N"])
AADD (MHT, [ "PRIX U" est normalement le prix tarif, mais vous pouvez le modifier])
AADD (MHT, [ "REM" est la % remise a appliquer à cette ligne])
AADD (MHT, "")
AADD (MHT, "Tapez Esc pour terminer la saisie")
CASE CHOIX = 5
AADD (MHT, "CODE PAIEMENT - Si Montant = 0, Code = Espace , sinon:")
AADD (MHT, "0 - Déjà reglé")
AADD (MHT, "2 - Traite à la livraison")
AADD (MHT, "3 - Cheque joint")
AADD (MHT, "5 - Cheque à la livraison")
AADD (MHT, "6 - Traite à l'acceptation")
AADD (MHT, "7 - Traite acceptée (L.C.R.)")
AADD (MHT, "9 - Financement")
CASE The_Var="CLIABV"
AADD (MHT, "Forme juridique, S.A., SARL, ENT .....")
CASE The_Var="CLICONTACT"
AADD (MHT, "Entrez le nom du client si différent du nom société")
CASE The_Var="CLITAILLE"
AADD (MHT, "Nombre de personnes dans l'entreprise")
CASE The_Var="CLIRUE" .OR. The_Var="CLIADS" .OR. The_Var="CLICP" .OR. The_Var="CLIVILLE"
AADD (MHT, "Adresse du client")
CASE The_Var="CLIBANK" .OR. The_Var="CLIBANKADS"
AADD (MHT, "Nom et adresse de la Banque du client")
CASE The_Var="CLIBCGUI" .OR. The_Var="CLIBCODE" .OR.;
The_Var="CLIBNCPT" .OR. The_Var="CLIBRIB"
AADD (MHT, "RIB du client - CODE BANQUE, GUICHET, COMPTE, CLE")
CASE SUBSTR(The_Var,1,3) = "QL_"
AADD (MHT, "Nom et unité du matériel concurrent")
CASE SUBSTR(The_Var,1,3) = "QC_"
AADD (MHT, "Quantité de matériel concurrent")
CASE The_Var="CLI_COMM"
AADD (MHT, "Référence donné par le client à cette commande")
CASE The_Var="REM_SUP"
AADD (MHT, "Remise a appliquer sur cette commande")
CASE The_Var = "EXPORT"
AADD (MHT, "1 = France 0=Export (TVA=0)")
CASE SUBSTR(The_Var,1,4)="DECH"
AADD (MHT, "Date d'echéance")
OTHERWISE
* // next bit of code is useful for debugging
* AADD (MHT, "MPROC = " + MPROC)
* AADD (MHT, "LINE = " + STR(LINE))
* AADD (MHT, "The_Var = " + The_Var)
AADD (MHT, "Aide n'est pas disponible")
ENDCASE
*
t=22-LEN(MHT)
b=t+1+LEN(MHT)
l=0
r=79
do win with t,l,b,r,zbuff,"AIDE"
FOR I=1 TO LEN(MHT)
@ T+I,l+3 say MHT[I]
NEXT
//
do while INKEY(0) <> K_ESC
enddo
do wout with t,l,b,r,zbuff
@mr,mcol say "" // Reset cursor position
return .T.
*
//
//------------------------------------------------------------------------
//
FUNCTION ENCODE (CONTROL)
* Auteur...: R M ALCOCK
* Date.....: 26/2/95
* Copyright: (c) 1995, R M ALCOCK, Tous droits réservés
* Notes....: Subroutines to encode data
*
*
LOCAL SEED,C
DEFAULT CONTROL TO ""
*
SET CONFIRM ON
SET DATE FRENCH
SET DELETED ON
SET EXACT ON
SET EXCLUSIVE OFF
SET FIXED OFF
SET SCOREBOARD ON
SET TALK OFF
SET BELL OFF
SET EPOCH TO 1980
PUBLIC LCD:=.T., M_Control
CLOSE DATABASES
SELECT 1
USE ATTACH
M_Control = PCON // Password Control
USE CLIENT EXCLUSIVE
SEED=VAL(READ_SEED(6,5,;
IIF (CONTROL="", "DECRYPTAGE FICHIER", "CODAGE FICHIER")))
@ 6,0 CLEAR
IF CONTROL = ""
// Should be unscramble
GO TOP
COUNT NEXT 10 FOR CLISCRAMBL TO C
IF C < 10 .AND. .NOT. CONFIRM (5,,"N","CONFIRM DECRYPTAGE")
QUIT
ENDIF
//
GO TOP
@ 6,0 SAY "DECRYPTAGE FICHIER"
DO WHILE .NOT. EOF()
SPEEDO (8,RECCOUNT())
UNSCRAM_CLI(SEED)
SKIP
ENDDO
//
ELSE
//
@ 6,0 SAY "CODAGE FICHIER"
DO WHILE .NOT. EOF()
SPEEDO (8,RECCOUNT())
SCRAM_CLI(SEED)
SKIP
ENDDO
ENDIF
?"Indexation REF"
INDEX ON CLIREF TO CLIREF
?"Indexation CODE POSTALE"
INDEX ON CLICP+SUBSTR(CLIVILLE,1,5) TO CLICP
?"Indexation NOM"
INDEX ON CLINOM TO CLINOM
//
//
RETURN .T.
//
//
//-------------------------------------------------------------------------
//
// Function scrambles a CLIENT record
//
FUNCTION SCRAM_CLI (SEED)
//
// SEED is the seed for the random number generator
//
LOCAL M_FIX:= RANDOM (SEED, 5, 31) // Generate 5 random n°s between 1 and 31
LOCAL M_VAR:= RANDOM(REC_SEED (SEED), 30, 31) // 30 codes.
LOCAL M,N
//
// M_FIX is used for those variables which are indexed and therefore must
// use the same translation for all
//
// M_VAR increases the degree of randomness because the seed is different
// for each record. Hence the translation is different for the same
// parameters in different records
//
//
IF CLISCRAMBL
RETURN .T. // Already scrambled
ENDIF
//
// Scramble CLINOM and VILLE using fixed translation for the first 5 chars
// and variable translation for the rest. All others are variable
//
M = SCRAMBLE (SUBSTR(CLINOM,1,5), M_FIX)
M=M + SCRAMBLE (SUBSTR(CLINOM, 6, LEN(CLINOM)-5), M_VAR)
N= SCRAMBLE (SUBSTR(CLIVILLE, 1, 5), M_FIX)
N=N + SCRAMBLE (SUBSTR(CLIVILLE, 6, LEN(CLIVILLE)-5), M_VAR)
REPLACE CLINOM WITH M,;
CLIVILLE WITH N,;
CLIRUE WITH SCRAMBLE (CLIRUE, M_VAR),;
CLIADS WITH SCRAMBLE (CLIADS, M_VAR),;
CLISIRET WITH SCRAMBLE (CLISIRET, M_VAR),;
CLICONTACT WITH SCRAMBLE (CLICONTACT, M_VAR),;
CLICONTAC2 WITH SCRAMBLE (CLICONTAC2, M_VAR)
REPLACE CLIPHONE WITH SCRAMBLE (CLIPHONE, M_VAR),;
CLIPHONED WITH SCRAMBLE (CLIPHONED, M_VAR),;
CLIPHONEV WITH SCRAMBLE (CLIPHONEV, M_VAR),;
CLIFAX WITH SCRAMBLE (CLIFAX, M_VAR),;
CLIBNCPT WITH SCRAMBLE (CLIBNCPT, M_VAR),;
CNTRL WITH SCRAMBLE (CNTRL, M_VAR),;
CLISCRAMBL WITH .T.
RETURN .T.
//
//
//-------------------------------------------------------------------------
//
// Function unscrambles a CLIENT record
//
FUNCTION UNSCRAM_CLI (SEED)
//
LOCAL M_FIX:= RANDOM (SEED, 5, 31) // Generate 5 random n°s between 1 and 31
LOCAL M_VAR:= RANDOM(REC_SEED (SEED), 30, 31) // 30 codes.
LOCAL M, N
//
// See comments on SCRAM_CLI
//
IF .NOT. CLISCRAMBL
RETURN .T. // Already unscrambled
ENDIF
M = UNSCRAMBLE (SUBSTR(CLINOM,1,5), M_FIX)
M=M + UNSCRAMBLE (SUBSTR(CLINOM, 6, LEN(CLINOM)-5), M_VAR)
N= UNSCRAMBLE (SUBSTR(CLIVILLE, 1, 5), M_FIX)
N=N + UNSCRAMBLE (SUBSTR(CLIVILLE, 6, LEN(CLIVILLE)-5), M_VAR)
REPLACE CLINOM WITH M,;
CLIVILLE WITH N,;
CLIRUE WITH UNSCRAMBLE (CLIRUE, M_VAR),;
CLIADS WITH UNSCRAMBLE (CLIADS, M_VAR),;
CLISIRET WITH UNSCRAMBLE (CLISIRET, M_VAR),;
CLICONTACT WITH UNSCRAMBLE (CLICONTACT, M_VAR),;
CLICONTAC2 WITH UNSCRAMBLE (CLICONTAC2, M_VAR)
REPLACE CLIPHONE WITH UNSCRAMBLE (CLIPHONE, M_VAR),;
CLIPHONED WITH UNSCRAMBLE (CLIPHONED, M_VAR),;
CLIPHONEV WITH UNSCRAMBLE (CLIPHONEV, M_VAR),;
CLIFAX WITH UNSCRAMBLE (CLIFAX, M_VAR),;
CLIBNCPT WITH UNSCRAMBLE (CLIBNCPT, M_VAR),;
CNTRL WITH UNSCRAMBLE (CNTRL, M_VAR),;
CLISCRAMBL WITH .F.
RETURN .T.
//
//
//-------------------------------------------------------------------------
//
// Function creates a seed from a fixed seed (1000 - 9999) and RECNO()
//
FUNCTION REC_SEED (SEED)
//
IF SEED >= 0 // If not, it is the SERVER - leave alone
SEED = RECNO() * 10000 + SEED
DO WHILE SEED > 9999
SEED = SEED / 7 // Largest prime under 10
ENDDO
ENDIF
RETURN SEED
//
//-------------------------------------------------------------------------
//
// Function scrambles a string
//
// Each character of R_STRING (a series of random numbers between 1 and 31) is
// added to its equivalent character in A_STRING so as to scramble it
//
FUNCTION SCRAMBLE (A_String, R_String)
//
LOCAL I,Ans:=""
//
IF LEN(A_String) > 0
FOR I=1 TO LEN (A_String)
Ans=Ans+CHR(ASC(SUBSTR(A_String,I,1))+ASC(SUBSTR(R_String,I,1)))
NEXT
ENDIF
RETURN Ans
//
//
//-------------------------------------------------------------------------
//
// Function unscrambles a string
//
// Each character of R_STRING (a series of random numbers between 1 and 31) is
// subtracted from its equivalent character in A_STRING so as to unscramble it
//
FUNCTION UNSCRAMBLE (A_String, R_String)
//
LOCAL I,Ans:=""
IF LEN(A_String) > 0
FOR I=1 TO LEN (A_STRING)
Ans=Ans+CHR(ASC(SUBSTR(A_String,I,1))-ASC(SUBSTR(R_String,I,1)))
NEXT
ENDIF
RETURN Ans
//
//-------------------------------------------------------------------------
//
// Function generates an string full of random characters
//
// PARAMETERS: SEED = a 4 digit number used to seed the generator
// No = the number of random characters required
// Max = the maximum character value
// i.e. each character is between 1 and Max inclusive
//
// Returns Ans = A string of length No containing the random chacters
//
FUNCTION RANDOM (SEED, No, Max)
//
LOCAL Ans:="", IC, MF, MC, MS
IF SEED < 0 // No Coding required
RETURN REPLICATE(CHR(0),No)
ENDIF
FOR IC = 1 TO No
// Make sure that the seed does not have an exact square root !!!
//
DO WHILE .T.
MS=SQRT (SEED)
MS=(MS * 10000 - INT(MS * 10000)) // Take off 1st 4 digits of fraction
IF MS <> 0 // There is still a fractional part
EXIT // so it is O.K.
ENDIF
SEED = SEED+1 // Try the next integer up
ENDDO
MF = SQRT(SEED)-INT(SQRT(SEED)) // Fractional part of square root
MC = INT( MF * Max ) // Range is 0 to Max-1
Ans = Ans + CHR(MC+1) // Add to answer string
SEED = INT(MF * 10000) // New seed (4 digits)
NEXT
RETURN Ans
//
//-------------------------------------------------------------------------
//
FUNCTION SPEEDO(MRow,Mlong)
*
@ MRow, 79*RECNO()/Mlong SAY "▌"
RETURN .T.
//
//-------------------------------------------------------------------------
//
FUNCTION READ_SEED (MROW,MCOL, MT, M_Reg)
// The equivalent of PASSWD()
// Requires a GLOBAL variable M_Control containing the 6 character
// control field from ATTACH->PCON
LOCAL MPW, I:=0, C
*
DO HLOFF WITH LCD
CLEAR
FOR i=1 TO 9999
MPW = STR(i,4,0)
IF M_Control == RANDOM(VAL(MPW),6,31)
RETURN MPW // Password is O.K.
ENDIF
NEXT
ALARM ("ACCES INTERDIT")
QUIT
RETURN 0
@ 2,40-LEN(MT)/2 SAY MT
@ 1,40-LEN(MT)/2-2 TO 3,40+LEN(MT)/2+2 DOUBLE
IF PCOUNT() > 3
@ 5,5 SAY "NUMERO VRP : "+M_Reg
ENDIF
@ 23,75 SAY "V9.1"
DO WHILE I < 3
CLEAR TYPEAHEAD
MPW=""
@ MROW,0 CLEAR TO MROW,79
@ MROW,MCOL SAY "MOT DE PASSE ? "
//
// DO Reads in the user's attempt at the password
//
DO WHILE .T.
C=INKEY(0)
DO CASE
CASE C=13
EXIT
CASE C>31.AND.C<127
@ ROW(),COL() SAY "*"
MPW=MPW+CHR(C)
CASE (C=8.OR.C=19).AND.LEN(MPW)>0 // Backspace or left arrow
@ROW(),COL()-1 SAY " "
@ROW(),COL()-1 SAY ""
MPW=SUBSTR(MPW,1,LEN(MPW)-1)
ENDCASE
ENDDO
//
* // !!!!!!!!!!!!!!!!!!!!!
* //
* SELECT 2
* USE ATTACH EXCLUSIVE
* REPLACE PCON WITH RANDOM(VAL(MPW),6,31)
* SELECT CLIENT
* RETURN MPW
* //
* //!!!!!!!!!!!!!!!!!!!!!!!
* //
IF EMPTY(MPW)
* RETURN "-1" // File is not coded
ELSEIF M_Control == RANDOM(VAL(MPW),6,31)
RETURN MPW // Password is O.K.
ENDIF
I=I+1
ENDDO
ALARM ("ACCES INTERDIT")
QUIT
RETURN .F.
//
//-------------------------------------------------------------------
//
FUNCTION REINDEX (M_ALL)
* Auteur...: R M ALCOCK
* Date.....: 15/2/93
* Copyright: (c) 1992, R M ALCOCK, Tous droits réservés
* Notes....: RE-INDEX PROGRAM
* Intended to create NTX type Indexes
* Link File uses RMALIBX which has no references to DBFNDX
*
*
LOCAL MT:=CONAME+" - INDEX FICHIERS"
LOCAL MP:=40-LEN(MT)/2
LOCAL NumFiles := 15 //Number of Databases !!!
LOCAL I, CHOIX
*SET DEFAULT TO F:
SET CONFIRM ON
SET DATE FRENCH
SET DELETED ON
SET EXACT ON
SET EXCLUSIVE OFF
SET FIXED OFF
SET SCOREBOARD OFF
SET WRAP ON
SET EPOCH TO 1980
*
CLEAR
*
IF PCOUNT()=0
M_ALL = .F.
ELSE
M_ALL = IIF ( M_ALL<> "*", .F., .T.)
ENDIF
IF M_ALL
@ 0,MP SAY MT
@ 5,5 SAY "Index tous les fichiers !!!"
FOR I=1 TO NumFiles
R_IND (I)
NEXT
ELSE
DO WHILE .T.
CLEAR
@ 0,MP SAY MT
@ 2,2 PROMPT "Q U I T T E R"
@ ROW()+1,2 PROMPT "TARIF"
@ ROW()+1,2 PROMPT "VRPS"
@ ROW()+1,2 PROMPT "CLIENTS"
@ ROW()+1,2 PROMPT "FAMILLES"
@ ROW()+1,2 PROMPT "COMMANDES CLIENTS"
@ ROW()+1,2 PROMPT "FACTURES Clients"
@ ROW()+1,2 PROMPT "LIGNES de Facturation / Avoirs / Commandes"
@ ROW()+1,2 PROMPT "EVENEMENTS / LITIGES / VISITES Clients"
@ ROW()+1,2 PROMPT "PROMOTIONS"
MENU TO CHOIX
IF CHOIX=1
RETURN .T.
ENDIF
R_IND(CHOIX-1)
WAIT
ENDDO
ENDIF
RETURN .T.
*
******************************
*
FUNCTION R_IND(CHOIX)
DO CASE
CASE CHOIX = 1
* NET_USE (1, "STOCK", .T., 30, "", "")
* ANNOUNCE_IT()
* INDEX ON STCOMMREF TO STCREF
* INDEX ON STFAM_PROD+STCOMMREF TO STREF
* NET_USE (1, "STCOMP", .T., 30, "", "")
* ANNOUNCE_IT()
* INDEX ON cref TO STCOMP
CASE CHOIX = 2
IF FILE("VRPS.DBF")
NET_USE (1, "VRPS", .T., 30, "", "")
ANNOUNCE_IT()
INDEX ON VRP TO VRPS
INDEX ON EQUIPE+VRP TO VRPREG
* NET_USE (1, "VRPSTOCK", .T., 30, "", "")
* ANNOUNCE_IT()
* INDEX ON VRP TO VRPSTOCK
ENDIF
CASE CHOIX = 3
NET_USE (1, "CLIENT", .T., 30, "", "")
ANNOUNCE_IT()
INDEX ON CLIREF TO CLIREF
INDEX ON CLICP+SUBSTR(CLIVILLE,1,5) TO CLICP
INDEX ON SUBSTR(CLINOM,1,5) TO CLINOM
CASE CHOIX = 4
NET_USE (1, "TARIFT", .T., 30, "", "")
ANNOUNCE_IT()
INDEX ON CODE TO TARIFT
NET_USE (1, "DOC", .T., 30, "", "")
ANNOUNCE_IT()
INDEX ON STR(PAGE,2)+STR(SECT,2)+STR(LINE,2) TO DOC
NET_USE (1, "SECT", .T., 30, "", "")
ANNOUNCE_IT()
INDEX ON FM+SF+PAGE+SECT TO SECTFM
INDEX ON PAGE+SECT TO SECT
CASE CHOIX = 5
NET_USE (1, "COM", .T., 30, "", "")
ANNOUNCE_IT()
INDEX ON commande TO COM
INDEX ON refcli TO COMCL
CASE CHOIX = 6
NET_USE (1, "FACT", .T., 30, "", "")
ANNOUNCE_IT()
INDEX ON REFCLI TO FACCL
INDEX ON FACTURE+ECH TO FACT
CASE CHOIX = 7
NET_USE (1, "FACTA", .T., 30, "", "")
ANNOUNCE_IT()
INDEX ON facture+ligne TO FACTR
CASE CHOIX = 8
NET_USE (1, "LITIGE", .T., 30, "", "")
ANNOUNCE_IT()
INDEX ON CODE TO LITIGE
INDEX ON A_DATE TO LITDATE
INDEX ON CLIENT TO LITCLI
NET_USE (1, "EVENT", .T., 30, "", "")
ANNOUNCE_IT()
* INDEX ON REFCLI+STR(CTOD('01/01/79')-D_CRE,5) TO EVENT
INDEX ON REFCLI+DTOS(D_CRE) TO EVENT DESCENDING
INDEX ON BONREF TO EVECODE
CASE CHOIX = 10
NET_USE (1, "PROMOS", .T., 30, "", "")
ANNOUNCE_IT()
INDEX ON PROMOS->ARTICLE + PROMOS->CLIENT TO PROMOS
*
ENDCASE
RETURN .T.
*
******************************
*
FUNCTION ANNOUNCE_IT
*
CLEAR
@ 5,5 SAY "INDEX FICHIER : " + ALIAS(1)
RETURN .T.
//
//---------------------------------------------------------------------
//
///////////////////////////////////////////////////////////////////////////////
//
// Function-oriented code created by the Xbase++ FormDesigner
// Creation date: 14/02/2007 Time: 16:07:40
//
///////////////////////////////////////////////////////////////////////////////
/*
#
*/
#PRAGMA LIBRARY( "ASCOM10.LIB" )
FUNCTION Window_Cli(Control)
LOCAL nEvent, mp1, mp2
LOCAL oDlg, oXbp, drawingArea, aEditControls := {}, oXbp1, oXbp2
LOCAL oTab1, oTab2, oTab3
PUBLIC The_Menu_Bar
oDlg := XbpDialog():new( AppDesktop(), , {10,100}, {819,656}, , .F.)
oDlg:taskList := .T.
oDlg:title := "CLIENT / PROSPECT"
oDlg:create()
The_Menu_Bar := oDlg:menuBar() // Set up the Menu system PUBLIC variable
MAIN_MENU()
drawingArea := oDlg:drawingArea
drawingArea:setFontCompoundName( "8.Arial" )
oTab1:= XbpTabPage():new( drawingArea, , {12,48}, {780,516}, { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE } } )
oTab1:caption := "Général"
oTab1:minimized := .F.
oTab1:tabStop := .T.
oTab1:create()
oTab1:DropZone := .T.
oTab1:TabActivate := ;
{|| oTab2:minimize(), oTab3:minimize(), oTab1:maximize() }
oTab2:= XbpTabPage():new( drawingArea, , {12,48}, {780,516}, { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE } } )
oTab2:caption := "Finance"
oTab2:preOffset := 20
oTab2:postOffset := 60
oTab2:minimized := .T.
oTab2:tabStop := .T.
oTab2:create()
oTab2:TabActivate := ;
{|| oTab1:minimize(), oTab3:minimize(), oTab2:maximize() }
oTab3:= XbpTabPage():new( drawingArea, , {12,48}, {780,516}, { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE } } )
oTab3:caption := "Commentaire"
oTab3:minimized := .F.
oTab3:preOffset := 40
oTab3:postOffset := 40
oTab2:minimized := .T.
oTab3:tabStop := .T.
oTab3:create()
oTab3:TabActivate := ;
{|| oTab1:minimize(), oTab2:minimize(), oTab3:maximize() }
oXbp := XbpPushButton():new( drawingArea, , {252,12}, {84,24},;
{ { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE }, { XBP_PP_FGCLR, -58 } } )
oXbp:caption := "Suivant"
oXbp:tabStop := .T.
oXbp:create()
oXbp:activate := {|| Gather( aEditControls ), Pg_Dn(), Scatter ( aEditControls ) }
oXbp := XbpPushButton():new( drawingArea, , {156,12}, {84,24},;
{ { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE }, { XBP_PP_FGCLR, -58 } } )
oXbp:caption := "Precédant"
oXbp:tabStop := .T.
oXbp:create()
oXbp:activate := {|| Gather( aEditControls ), Pg_Up(), Scatter ( aEditControls ) }
oXbp := XbpPushButton():new( drawingArea, , {24,12}, {84,24},;
{ { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE }, { XBP_PP_FGCLR, -58 } } )
oXbp:caption := "Annul"
oXbp:tabStop := .T.
oXbp:create()
oXbp:activate := {|| PostAppEvent( xbeP_Close ) }
oTab2:minimize()
oTab3:minimize()
oTab1:maximize()
oXbp := XbpSLE():new( oTab1, , {72,456}, {72,24},;
{ { XBP_PP_BGCLR, GRA_CLR_CYAN },;
{ XBP_PP_DISABLED_BGCLR, GRA_CLR_CYAN } ,;
{ XBP_PP_FGCLR, GRA_CLR_BLACK } } )
oXbp:bufferLength := 10
oXbp:editable := .F.
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIREF ), CLIENT->CLIREF := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oTab1, , {156,456}, {192,24}, { { XBP_PP_BGCLR, GRA_CLR_CYAN }, { XBP_PP_FGCLR, GRA_CLR_BLACK } } )
oXbp:bufferLength := 30
oXbp:editable := .T.
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLINOM ), CLIENT->CLINOM := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oTab1, , {432,456}, {96,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 17
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLICONTACT ), CLIENT->CLICONTACT := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpStatic():new( oTab1, , {372,456}, {48,24} )
oXbp:caption := "Contact:"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp1 := XbpStatic():new( oTab1, , {72,312}, {264,132} )
oXbp1:caption := "Addresse"
oXbp1:clipSiblings := .T.
oXbp1:type := XBPSTATIC_TYPE_GROUPBOX
oXbp1:create()
oXbp := XbpSLE():new( oXbp1, , {12,84}, {180,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 30
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIRUE ), CLIENT->CLIRUE := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp1, , {12,48}, {180,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 30
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIADS ), CLIENT->CLIADS := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp1, , {12,12}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 5
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLICP ), CLIENT->CLICP := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp1, , {60,12}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 30
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIVILLE ), CLIENT->CLIVILLE := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp2 := XbpStatic():new( oTab1, , {372,348}, {360,96} )
oXbp2:caption := "Téléphone"
oXbp2:clipSiblings := .T.
oXbp2:type := XBPSTATIC_TYPE_GROUPBOX
oXbp2:create()
oXbp := XbpStatic():new( oXbp2, , {12,48}, {48,24} )
oXbp:caption := "Bureau:"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( oXbp2, , {72,48}, {96,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 15
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIPHONE ), CLIENT->CLIPHONE := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpStatic():new( oXbp2, , {180,48}, {48,24} )
oXbp:caption := "Dom:"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( oXbp2, , {240,48}, {84,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 15
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIPHONED ), CLIENT->CLIPHONED := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpStatic():new( oXbp2, , {12,12}, {48,24} )
oXbp:caption := "Portable:"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( oXbp2, , {72,12}, {96,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 15
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIPHONEV ), CLIENT->CLIPHONEV := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpStatic():new( oXbp2, , {180,12}, {48,24} )
oXbp:caption := "Fax:"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( oXbp2, , {240,12}, {108,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 15
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIFAX ), CLIENT->CLIFAX := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpStatic():new( oTab1, , {384,300}, {48,24} )
oXbp:caption := "Activité:"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( oTab1, , {432,300}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 4
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIPROFESS ), CLIENT->CLIPROFESS := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpStatic():new( oTab1, , {72,264}, {84,24} )
oXbp:caption := "Dernière Visite:"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( oTab1, , {156,264}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 8
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, DtoC( CLIENT->DERNVISIT ), CLIENT->DERNVISIT := CtoD(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpStatic():new( oTab1, , {240,264}, {84,24} )
oXbp:caption := "Action avant le :"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( oTab1, , {324,264}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 8
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, DtoC( CLIENT->RELANCE ), CLIENT->RELANCE := CtoD(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpStatic():new( oTab1, , {480,300}, {36,24} )
oXbp:caption := "Taille:"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( oTab1, , {516,300}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 4
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLITAILLE ), CLIENT->CLITAILLE := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpStatic():new( oTab1, , {564,300}, {96,24} )
oXbp:caption := "Créa&tion (MMYY):"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( oTab1, , {660,300}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 4
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->DATE_CRE, '@N' ), CLIENT->DATE_CRE := Val(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpMLE():new( oTab1, , {84,168}, {648,84}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:tabStop := .T.
oXbp:create()
//
//----------------------------------------------------------------------
//
// FINANCE PAGE
oXbp := XbpSLE():new( oTab2, , {72,456}, {72,24},;
{ { XBP_PP_BGCLR, GRA_CLR_CYAN },;
{ XBP_PP_DISABLED_BGCLR, GRA_CLR_CYAN } ,;
{ XBP_PP_FGCLR, GRA_CLR_BLACK } } )
oXbp:bufferLength := 10
oXbp:editable := .F.
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIREF ), CLIENT->CLIREF := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oTab2, , {156,456}, {192,24}, { { XBP_PP_BGCLR, GRA_CLR_CYAN }, { XBP_PP_FGCLR, GRA_CLR_BLACK } } )
oXbp:bufferLength := 30
oXbp:editable := .T.
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLINOM ), CLIENT->CLINOM := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpStatic():new( oTab2, , {432,456}, {36,24} )
oXbp:caption := "Siret :"
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( oTab2, , {480,456}, {84,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 14
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLISIRET ), CLIENT->CLISIRET := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp1 := XbpStatic():new( oTab2, , {72,384}, {420,60} )
oXbp1:caption := "Banque"
oXbp1:clipSiblings := .T.
oXbp1:type := XBPSTATIC_TYPE_GROUPBOX
oXbp1:create()
oXbp := XbpSLE():new( oXbp1, , {12,12}, {84,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 24
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIBANK ), CLIENT->CLIBANK := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp1, , {96,12}, {120,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 24
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIBANKADS ), CLIENT->CLIBANKADS := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp1, , {240,12}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 5
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIBCODE ), CLIENT->CLIBCODE := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp1, , {276,12}, {36,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 5
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIBCGUI ), CLIENT->CLIBCGUI := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp1, , {312,12}, {72,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 11
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIBNCPT ), CLIENT->CLIBNCPT := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp1, , {384,12}, {24,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 2
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIBRIB ), CLIENT->CLIBRIB := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp2 := XbpStatic():new( oTab2, , {288,132}, {276,228} )
oXbp2:caption := "EQUIVALENT CONCURRENT Quantité"
oXbp2:clipSiblings := .T.
oXbp2:type := XBPSTATIC_TYPE_GROUPBOX
oXbp2:create()
oXbp := XbpSLE():new( oXbp2, , {12,180}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 12
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_1 ), CLIENT->QL_1 := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp2, , {12,156}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 12
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_2 ), CLIENT->QL_2 := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp2, , {12,132}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 12
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_3 ), CLIENT->QL_3 := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp2, , {12,108}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 12
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_4 ), CLIENT->QL_4 := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp2, , {12,84}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 12
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_5 ), CLIENT->QL_5 := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp2, , {12,60}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 12
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_6 ), CLIENT->QL_6 := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp2, , {12,36}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 12
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_7 ), CLIENT->QL_7 := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp2, , {12,12}, {192,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 12
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->QL_8 ), CLIENT->QL_8 := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp2, , {216,180}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 6
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_1, '@N' ), CLIENT->QC_1 := Val(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp2, , {216,156}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 6
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_2, '@N' ), CLIENT->QC_2 := Val(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp2, , {216,132}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 6
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_3, '@N' ), CLIENT->QC_3 := Val(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp2, , {216,108}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 6
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_4, '@N' ), CLIENT->QC_4 := Val(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp2, , {216,84}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 6
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_5, '@N' ), CLIENT->QC_5 := Val(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp2, , {216,60}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 6
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_6, '@N' ), CLIENT->QC_6 := Val(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp2, , {216,36}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 6
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_7, '@N' ), CLIENT->QC_7 := Val(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp2, , {216,12}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 6
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->QC_8, '@N' ), CLIENT->QC_8 := Val(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp3 := XbpStatic():new( oTab2, , {72,132}, {168,228} )
oXbp3:caption := "MATERIEL MEFRAN Quantité"
oXbp3:clipSiblings := .T.
oXbp3:type := XBPSTATIC_TYPE_GROUPBOX
oXbp3:create()
oXbp := XbpStatic():new( oXbp3, , {12,180}, {84,24} )
oXbp:caption := "49-900"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpStatic():new( oXbp3, , {12,156}, {84,24} )
oXbp:caption := "SECURIFRAN"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpStatic():new( oXbp3, , {12,132}, {84,24} )
oXbp:caption := "42-700"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpStatic():new( oXbp3, , {12,108}, {84,24} )
oXbp:caption := "ROULANTS"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpStatic():new( oXbp3, , {12,84}, {84,24} )
oXbp:caption := "CH49/AUTO."
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpStatic():new( oXbp3, , {12,60}, {84,24} )
oXbp:caption := "PLANCHERS"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpStatic():new( oXbp3, , {12,36}, {84,24} )
oXbp:caption := "DIFFUSION"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpStatic():new( oXbp3, , {12,12}, {84,24} )
oXbp:caption := "DIVERS"
oXbp:clipSiblings := .T.
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( oXbp3, , {108,12}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 6
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_8, '@N' ), CLIENT->Q_8 := Val(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp3, , {108,36}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 6
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_7, '@N' ), CLIENT->Q_7 := Val(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp3, , {108,60}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 6
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_6, '@N' ), CLIENT->Q_6 := Val(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp3, , {108,84}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 6
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_5, '@N' ), CLIENT->Q_5 := Val(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp3, , {108,108}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 6
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_4, '@N' ), CLIENT->Q_4 := Val(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp3, , {108,132}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 6
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_3, '@N' ), CLIENT->Q_3 := Val(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp3, , {108,156}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 6
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_2, '@N' ), CLIENT->Q_2 := Val(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oXbp3, , {108,180}, {48,24}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:bufferLength := 6
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Transform( CLIENT->Q_1, '@N' ), CLIENT->Q_1 := Val(x) ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
//
//----------------------------------------------------------------------
//
// COMMENT PAGE
oXbp := XbpSLE():new( oTab3, , {72,456}, {72,24},;
{ { XBP_PP_BGCLR, GRA_CLR_CYAN },;
{ XBP_PP_DISABLED_BGCLR, GRA_CLR_CYAN } ,;
{ XBP_PP_FGCLR, GRA_CLR_BLACK } } )
oXbp:bufferLength := 10
oXbp:editable := .F.
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLIREF ), CLIENT->CLIREF := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpSLE():new( oTab3, , {156,456}, {192,24}, { { XBP_PP_BGCLR, GRA_CLR_CYAN }, { XBP_PP_FGCLR, GRA_CLR_BLACK } } )
oXbp:bufferLength := 30
oXbp:editable := .T.
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CLIENT->CLINOM ), CLIENT->CLINOM := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oXbp := XbpMle():new( oTab3, , {84,68}, {588,328}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } )
oXbp:wordWrap :=.T.
oXbp:horizScroll := .F.
oXbp:editable:=.T.
oXbp:setFontCompoundName( "10.Arial" )
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, CLIENT->COMMENTAIR, CLIENT->COMMENTAIR := x ) }
oXbp:create():setData()
AAdd ( aEditControls, oXbp )
oDlg:show()
SetAppFocus(oDlg)
nEvent := xbe_None
DO WHILE nEvent <> xbeP_Close
nEvent := AppEvent( @mp1, @mp2, @oXbp )
oXbp:handleEvent( nEvent, mp1, mp2 )
ENDDO
oDlg:hide()
oDlg:destroy()
RETURN .T.
//
//--------------------------------------------------------
//
FUNCTION MAIN_MENU ()
LOCAL LL, CHOICE, cSaveScrn, PromptList
LOCAL The_Prompts := {}, SM := {}, The_Codes := {}
The_Prompts := { ;
"MENU",;
{"Historique", {||Dispatcher ("MH")},;
"@",, ;
"Impression", {||Dispatcher ("IM")},;
"@",, ;
"Saisie Commande", {||Dispatcher ("CC")},;
"Modification Commande",{||Dispatcher ("CM")},;
"Commandes en cours", {||Dispatcher ("EC")},;
"@",, ;
"Suppression", {||Dispatcher ("S")},;
"@",, ;
"Catalogue", {||Dispatcher ("SM")},;
"@",, ;
"RETOUR", {||QUIT_IT()} },;
"?",;
{"Général", {||HELP_ME("01")},;
"Recherche", {||HELP_ME("02")},;
"Catégories", {||HELP_ME("03")} };
}
CREATE_MENU (The_Prompts)
RETURN .T.
//
//----------------------------------------------------------
//
FUNCTION QUIT_IT()
PostAppEvent (xbeP_Close)
RETURN .T.
//
//-----------------------------------------------------------------------------------------------
//
FUNCTION CREATE_MENU(The_Choices)
LOCAL i, j, oMenu, Menu_Items, oSubMenu, SM, k
FOR i = 1 TO LEN (The_Choices) STEP 2
oMenu := XbpMenu():new( The_Menu_Bar ) // New MENU object
oMenu:title := The_Choices[i] // Menu Name
oMenu:setName(i * 100) // Code for this menu
oMenu:create()
Menu_Items = The_Choices[i+1]
FOR j = 1 TO LEN (Menu_Items) -1 STEP 2
IF ValType (Menu_Items [j]) = "A"
SM = Menu_Items [j]
oSubMenu := XbpMenu():new( oMenu )
oSubMenu:title := SM[1]
oSubMenu:create()
SM = SM[2]
FOR k = 1 TO LEN(SM)-1 STEP 2
IF (SM [k]) = "@"
oSubMenu:addItem( {NIL, NIL, XBPMENUBAR_MIS_SEPARATOR, 0} )
ELSE
oSubMenu:addItem( { SM[k], SM[k+1] } )
ENDIF
NEXT k
oMenu:addItem( { oSubMenu, NIL } )
ELSEIF (Menu_Items [j]) = "@"
oMenu:addItem( {NIL, NIL, XBPMENUBAR_MIS_SEPARATOR, 0} )
ELSE
oMenu:addItem( {Menu_Items [j] , Menu_Items [j+1]}, )
ENDIF
NEXT j
The_Menu_Bar:addItem( {oMenu, NIL} ) // Create the Menu
NEXT i
RETURN .T.
//
//-----------------------------------------------------
//
FUNCTION Dispatcher (Control)
Menu_On_Off (.F.) // disable other menu choices
The_Menu_Bar:enableItem(The_Menu_Bar:numItems()) // Except HELP
DO CASE
CASE Control = "MH" // Historique
DO EV
CASE Control = "IM" // Impression
Imp_FICHE()
CASE Control = "CC" // Saisie Commande
SET CURSOR ON
DO S_COMM WITH "1"
CASE Control = "CM" // Modif. Cde
i=1
CASE Control = "EC" // Cdes en Cours
DO CC
CASE Control = "S" // Suppression
i=1
CASE Control = "SM" // Stock
DO ST WITH 4
ENDCASE
Menu_On_Off (.T.) // enable menu choices
RETURN .T.
//
//-----------------------------------------------------------------------------------------------
//
FUNCTION Menu_On_Off(CONTROL)
LOCAL oMenu ,I,J
FOR i = 1 TO The_Menu_Bar:numItems() // Number of main menu items
IF Control
The_Menu_Bar:enableItem( i )
ELSE
The_Menu_Bar:disableItem( i )
ENDIF
NEXT
RETURN .T.
//
//-----------------------------------------------------------------------------------------------
//
//
//////////////////////////////////////////////////////////////////////
//
// APPSYS.PRG
//
// Copyright:
// Alaska Software, (c) 1997-2002. All rights reserved.
//
// Contents:
// AppSys() - Creates default application window
//
// Remarks:
// This file is part of the XppRt0.lib.
//
// Syntax:
// The function AppSys() is called automatically during
// the programm startup.
//
//////////////////////////////////////////////////////////////////////
#include "xbp.ch"
****************************************************************************
* Function AppSys() to create default output devices
****************************************************************************
FUNCTION AppSys()
#define DEF_ROWS 30
#define DEF_COLS 80
LOCAL oCrt, nAppType := AppType()
LOCAL aSizeDesktop, aPos
LOCAL DEF_FONTHEIGHT:= 16
LOCAL DEF_FONTWIDTH:= 8
PUBLIC aWindow[3], The_Menu_Bar
// Compute window position (center window
// on the Desktop)
aSizeDesktop := AppDesktop():currentSize()
*IF aSizeDesktop[1] > 800
* DEF_FONTHEIGHT:= 22
* DEF_FONTWIDTH:= 12
*ENDIF
aPos := { (aSizeDesktop[1]-(DEF_COLS * DEF_FONTWIDTH)) /2, ;
(aSizeDesktop[2]-(DEF_ROWS * DEF_FONTHEIGHT)) /2 }
// Create XbpCRT object
oCrt := XbpCrt():New ( NIL, NIL, aPos, DEF_ROWS, DEF_COLS )
oCrt:FontWidth := DEF_FONTWIDTH
oCrt:FontHeight := DEF_FONTHEIGHT
oCrt:title := "ALTRAD EQUIPEMENT - CLIENTS"
IF aSizeDesktop[1] <= 800
oCrt:FontName := "Alaska Crt"
ELSE
oCrt:FontName := "Lucida Console"
ENDIF
oCrt:Create()
aWindow[1] := oCrt
*The_Menu_Bar := oCrt:menuBar() // Set up the Menu system PUBLIC variable
*MAIN_MENU ()
oCrt:setpos(apos)
// Init Presentation Space
oCrt:PresSpace()
// XbpCrt gets active window and output device
SetAppWindow ( oCrt )
SETCOLOR ("n/w")
CLEAR
//
// Help Window
//
aWindow[2] := XbpCrt():new(AppDesktop(), NIL, {50, 100}, 24, 80, "ASSISTANCE" )
aWindow[2]:FontWidth := 8
aWindow[2]:FontHeight := 16
aWindow[2]:create()
aWindow[2]:setModalState (XBP_DISP_APPMODAL)
aWindow[2]:PresSpace()
SetAppWindow( aWindow[2] )
SETCOLOR ('n/w,r/w')
CLS
aWindow[2]:hide()
//
// Mot_Clé window
//
aWindow[3] := XbpCrt():new(AppDesktop(), NIL, {50, 100}, 5, 20, "" )
aWindow[3]:FontWidth := DEF_FONTWIDTH
aWindow[3]:FontHeight := DEF_FONTHEIGHT
aWindow[3]:Border := XBPDLG_NO_BORDER
aWindow[3]:Closeable := .F.
aWindow[3]:titleBar := .F.
aWindow[3]:FontName := "Arial"
aWindow[3]:create()
aWindow[3]:PresSpace()
SetAppWindow( aWindow[3] )
SETCOLOR ('n/w,r/w')
CLS
aWindow[3]:hide()
SetAppWindow ( oCrt )
oBMP2:= XbpBitmap():new():create( oCrt ) // Logo for display
oBMP2:loadfile( "LOGO2.BMP" )
oBMP2:draw( NIL, {100 ,100} ) // Draw the logo
SetAppFocus(oCrt)
RETURN .T.
