jeu. 01 juin 2017, 15h30
Felix
Togo
atoutfox.public.association
migrer une application développée en foxpro2.6 à VFP8
Bonsoir
L'application est développée dans FPW26 avec foxprow.exe.
J'ai mis en place l'icone suivante pour lancer l'application dans le VFP98\vfp6.exe.
La conversion a été automatique mais avec certains problèmes:
Par exemple, le bouton de recherche ne fonctionne pas, en sélectionnant un critère de recherche il sort l'instruction =jkeyinit("A"
Exemple d'un formulaire de saisie des données du ciment
Le fichier .spr généré automatiquement est le suivant:
*- [CONVERTER] New INCLUDE file, with #DEFINEs
#INCLUDE ciment4.h
*- [CONVERTER] Declare variables for record pointers
PUBLIC _iconvChargeGoToPlaceHolder
PUBLIC _iconvContratGoToPlaceHolder
PUBLIC _iconvProduitGoToPlaceHolder
PUBLIC _iconvVehiculeGoToPlaceHolder
PUBLIC _iconvTransporGoToPlaceHolder
PUBLIC _iconvClientGoToPlaceHolder
PUBLIC _iconvDestinaGoToPlaceHolder
PUBLIC _iconvPaysGoToPlaceHolder
PUBLIC _iconvTable1GoToPlaceHolder
PUBLIC _iconvTable2GoToPlaceHolder
PUBLIC _iconvCompteurGoToPlaceHolder
PUBLIC _iconvDollarGoToPlaceHolder
PUBLIC _iconvPeriodeGoToPlaceHolder
PUBLIC _iconvElfGoToPlaceHolder
PUBLIC _iconvPrixGoToPlaceHolder
PUBLIC _iconvPayeGoToPlaceHolder
PUBLIC _iconvRepresGoToPlaceHolder
PUBLIC _iconvFchargeGoToPlaceHolder
PUBLIC _iconvDepartGoToPlaceHolder
EXTERNAL PROC ciment4.scx
DO FORM "ciment4.scx" NAME _4XJ0H331R LINKED
*- [CONVERTER] Begin CLEANUP and other procedures from 2.x Form
PROCEDURE readdeac
IF isediting
ACTIVATE WINDOW 'wz_win'
WAIT WINDOW c_edits NOWAIT
ENDIF
IF !WVISIBLE(WOUTPUT())
CLEAR READ
RETURN .T.
ENDIF
RETURN .F.
PROCEDURE readact
IF !isediting
SELECT (m.wzalias)
SHOW GETS
ENDIF
DO REFRESH
RETURN
PROCEDURE printrec
PRIVATE solderror,wizfname,saverec,savearea,tmpcurs,tmpstr
PRIVATE prnt_btn,p_recs,p_output,pr_out,pr_record
STORE 1 TO p_recs,p_output
STORE 0 TO prnt_btn
STORE RECNO() TO saverec
m.solderror=ON('error')
DO pdialog
IF m.prnt_btn = 2
RETURN
ENDIF
m.pr_out=IIF(m.p_output=1,'TO PRINT PROMPT NOCONSOLE','PREVIEW')
**** m.pr_record=IIF(m.p_recs=1,'NEXT 1','ALL')
m.pr_record='ALL'
** DO PrinTrav.spr
SELECT Fcharge
DELE ALL
SELECT Charge
DO CASE
CASE charge.cod_pro = "CIMENT"
IF Charge.cod_cli = "FORWAR"
DO borbli
ELSE
DO interne
ENDIF
CASE charge.cod_pro = "CIMENTE"
IF Charge.cod_cli = "FORWAR"
DO borbli
ELSE
DO EXTERNE
ENDIF
ENDCASE
SELECT CHARGE
REPLACE cod_imp WITH "O"
SELECT CHARGE
GO m.saverec
RETURN
PROCEDURE btn_val
PARAMETER m.btnfunction
DO CASE
CASE m.btnfunction='TOP'
GO TOP
WAIT WINDOW c_topfile NOWAIT
CASE m.btnfunction='PREV'
IF !BOF()
SKIP -1
ENDIF
IF BOF()
WAIT WINDOW c_topfile NOWAIT
GO TOP
ENDIF
CASE m.btnfunction='NEXT'
IF !EOF()
SKIP 1
ENDIF
IF EOF()
WAIT WINDOW c_endfile NOWAIT
GO BOTTOM
ENDIF
CASE m.btnfunction='END'
GO BOTTOM
WAIT WINDOW c_endfile NOWAIT
CASE m.btnfunction='LOCATE'
IF EOF() OR BOF()
WAIT WINDOW c_endfile NOWAIT
RETURN
ENDIF
DO loc_dlog
CASE m.btnfunction='ADD' AND !isediting &&add record
SELECT charge
isediting=.T.
isadding=.T.
=edithand('ADD')
mton_cha = 0
m.ref_fac = m.sav_ref_fac
m.dat_cha = m.sav_dat_cha
m.ref_cli = m.sav_ref_cli
m.con_pai = m.sav_con_pai
m.heu_ent = time()
m.num_pro = "1"
STOR date() TO m.dat_cha, m.dat_sre, m.dat_fac
SELECT charge
*---- modif SEMA
sprevget=""
_CUROBJ=OBJNUM(m.scnobj1) && avant= 1
*---
DO REFRESH
SHOW GETS
RETURN
CASE m.btnfunction='EDIT' AND !isediting &&edit record
SELECT charge
IF EOF() OR BOF()
WAIT WINDOW c_endfile NOWAIT
RETURN
ENDIF
IF RLOCK()
isediting=.T.
SELECT CHARGE
mton_cha = CHARGE.ton_cha
mcod_cli = CHARGE.cod_cli
*---- modif SEMA
sprevget=""
*=========----- avant, _curobj était 1.
* permet de rester dans l'écran d'où on a demandé la modif.
_CUROBJ=OBJNUM(m.scnobj1)
*=========------
DO REFRESH
RETURN
ELSE
WAIT WINDOW c_nolock
UNLOCK ALL
RETURN
ENDIF
CASE m.btnfunction='SAVE' AND isediting &&save record
SELECT charge
*---- modif SEMA
exe_browse = .F. && sera mis à .T. si un all_srch a été activé
=vld() && refait la validation COMPLETE
IF exe_browse OR !was_fld_valid
RETURN
ENDIF
*-------------
*** Faire appel à la procédure de mise à jour des fichiers
m.sav_ref_fac = m.ref_fac
m.sav_dat_cha = m.dat_cha
m.sav_ref_cli = m.ref_cli
m.sav_con_pai = m.con_pai
DO Majfile
SELECT CHARGE
*** Valeurs à proposer par défaut
m.existe=.F.
=edithand('SAVE')
IF m.existe=.T. AND isadding
RETURN
ENDIF
UNLOCK ALL
isediting=.F.
isadding=.F.
SELECT charge
SCATTER MEMVAR MEMO
SHOW GETS
DO REFRESH
_CUROBJ=OBJNUM(m.add_btn)
CASE m.btnfunction='CANCEL' AND isediting &&cancel record
IF isadding
=edithand('CANCEL')
ENDIF
UNLOCK ALL
isediting=.F.
isadding=.F.
WAIT WINDOW c_ecancel NOWAIT
DO REFRESH
CASE m.btnfunction='DELETE'
IF EOF() OR BOF()
WAIT WINDOW C_ENDFILE NOWAIT
RETURN
ENDIF
IF RLOCK() then
IF fox_alert(c_delrec)
SELECT CLIENT
IF SEEK(m.cod_cli)
REPLACE ton_cde WITH (ton_cde + m.ton_cha)
ENDIF
SELECT CHARGE
DELETE
UNLOCK ALL
SKIP
IF EOF()
WAIT WINDOW c_endfile NOWAIT
GO BOTTOM
ENDIF
ELSE
RETURN
ENDIF
ELSE
??CHR(7)
WAIT WIND "CHARGEMENT EN COURS D'UTILISATION !!! OPERATION IMPOSSIBLE" TIMEOUT 3
RETURN
ENDIF
CASE m.btnfunction='PRINT'
IF EOF() OR BOF()
WAIT WINDOW c_endfile NOWAIT
RETURN
ENDIF
DO printrec
RETURN
CASE m.btnfunction='EXIT'
m.bailout=.T. &&this is needed if used with FoxApp
CLEAR READ
RETURN
OTHERWISE
RETURN
ENDCASE
* place le record en mémoire, et réaffiche le tout
SELECT charge
SCATTER MEMVAR MEMO
SHOW GETS
RETURN
PROCEDURE edithand
PARAMETER m.paction
* procedure de manip des modifs,add,...
DO CASE
CASE m.paction = 'ADD'
SCATTER MEMVAR MEMO BLANK && crée des var. mémoire vides
*==== si nécessaire, créer un 'deleted()' à blanc
*---- ceci pour 'réinitialiser' tous les liens vers les tables
m.actualposi=RECNO() && pour repositionement si abandon
SET DELETED OFF
GOTO TOP
IF DELETED()
BLANK && s'assurer que tout est réinitialisé!
DELETE
ELSE
APPEND BLANK
DELETE
ENDIF
SET DELETED ON && le re-rend 'invisible'
CASE m.paction = 'SAVE'
m.cdernuser=GTuser
m.ddernmodif=date()
IF NOT RLOCK()
RETURN
ENDIF
SELECT charge
IF isadding
INSERT INTO (ALIAS()) FROM MEMVAR && insert SQL!
ELSE
GATHER MEMVAR MEMO && sauver modifs.
ENDIF
CASE m.paction = 'CANCEL'
* return to last record displayed
GOTO m.actualposi
ENDCASE
RETURN
*====== insertion de la gestion de l'affichage des boutons
#INSERT refresh.txt
*======
PROCEDURE fox_alert
PARAMETER wzalrtmess
PRIVATE alrtbtn
m.alrtbtn=2
DEFINE WINDOW _qec1ij2t7 AT 0,0 SIZE 8,50 ;
FONT "MS Sans Serif",10 STYLE 'B' ;
FLOAT NOCLOSE NOMINIMIZE DOUBLE TITLE WTITLE()
MOVE WINDOW _qec1ij2t7 CENTER
ACTIVATE WINDOW _qec1ij2t7 NOSHOW
@ 2,(50-TXTWIDTH(wzalrtmess))/2 SAY wzalrtmess;
FONT "MS Sans Serif", 10 STYLE "B"
@ 6,18 GET m.alrtbtn ;
PICTURE "@*HT \<OK;\?\!A\<nnuler" ;
SIZE 1.769,8.667,1.333 ;
FONT "MS Sans Serif", 8 STYLE "B"
ACTIVATE WINDOW _qec1ij2t7
READ CYCLE MODAL
RELEASE WINDOW _qec1ij2t7
RETURN m.alrtbtn=1
PROCEDURE pdialog
DEFINE WINDOW _qjn12zbvh ;
AT 0.000, 0.000 ;
SIZE 13.231,55.000 ;
TITLE "Microsoft FoxPro" ;
FONT "MS Sans Serif", 8 ;
FLOAT NOCLOSE MINIMIZE SYSTEM
MOVE WINDOW _qjn12zbvh CENTER
ACTIVATE WINDOW _qjn12zbvh NOSHOW
@ 2.846,20.000 SAY "Sortie:" ;
FONT "MS Sans Serif", 8 ;
STYLE "BT"
@ 4.692,20.000 GET m.p_output ;
PICTURE "@*RVN \<Imprimante;Ap\<erçu" ;
SIZE 1.308,12.000,0.308 ;
DEFAULT 1 ;
FONT "MS Sans Serif", 8 ;
STYLE "BT"
@ 10.154,16.600 GET m.prnt_btn ;
PICTURE "@*HT Imp\<rimer;A\<nnuler" ;
SIZE 1.769,8.667,0.667 ;
DEFAULT 1 ;
FONT "MS Sans Serif", 8 ;
STYLE "B"
ACTIVATE WINDOW _qjn12zbvh
READ CYCLE MODAL
RELEASE WINDOW _qjn12zbvh
RETURN
PROCEDURE loc_dlog
actual_rec=RECNO()
mchoix=wmsgbox("Veuillez choisir le type de recherche désiré:", ;
"Choix du type de recherche","?","N° Entrée;N° Véhicule;N° Facture;N° Reçu;Abandon", ;
'','','','','','','',1)
IF mchoix > 0 && pas d'abandon dans le pop-up
IF mchoix=1
DO all_srch WITH "charge","num_ent","num_ent",'','',"","Chargement, (classés par N° Entrée)", "","","", ;
"num_ent","N° ENTREE", ;
"num_REC:w=GLfaux","N° Reçu", ;
"num_imm:w=GLfaux","N° Camion", ;
"num_fac:w=GLfaux","N° FACTURE", ;
"CLIENT.nom_cli:w=GLfaux","CLIENT"
ELSE
IF mchoix=2
DO all_srch WITH "charge","num_imm","num_imm",'','',"","Chargement, (classés par N° Camion)", "","","", ;
"num_imm","N° Camion", ;
"num_REC:w=GLfaux","N° Reçu", ;
"num_ent:w=GLfaux","N° ENTREE", ;
"num_fac:w=GLfaux","N° FACTURE", ;
"CLIENT.nom_cli:w=GLfaux","CLIENT"
ELSE
IF mchoix=3
DO all_srch WITH "charge","num_fac","num_fac",'','',"","Chargement, (classés par N° FACTURE)", "","","", ;
"num_REC:w=GLfaux","N° Reçu", ;
"num_imm:w=GLfaux","N° Camion", ;
"num_ent:w=GLfaux","N° ENTREE", ;
"num_fac","N° FACTURE", ;
"CLIENT.nom_cli:w=GLfaux","CLIENT"
ELSE
IF mchoix=4
DO all_srch WITH "charge","num_rec","num_rec",'','',"","Chargement, (classés par N° RECU)", "","","", ;
"num_REC","N° Reçu", ;
"num_imm:w=GLfaux","N° Camion", ;
"num_ent:w=GLfaux","N° ENTREE", ;
"num_fac:w=GLfaux","N° FACTURE", ;
"CLIENT.nom_cli:w=GLfaux","CLIENT"
ENDIF
ENDIF
ENDIF
ENDIF
IF LASTKEY() = ik_esc && abandon dans le browse
GOTO (actual_rec)
ENDIF
ENDIF
* déclenchée par F5 sur le champ N° CLIENT:
PROCEDURE pr_val_cli
IF valid_cli()
KEYBOARD '{TAB}'
ENDIF
FUNCTION valid_cli
DO all_srch WITH "CLIENT","nom_cli","nom_cli", "","","", ;
"Choisir le Code Client","","","", ;
"cod_cli:w=GLfaux","CODE", ;
"nom_cli","NOM CLIENT"
IF LASTKEY() = ik_enter
m.cod_cli=Client.cod_cli
m.non_bic=Client.non_bic
SHOW GET m.cod_cli
ELSE
IF !SEEK(m.cod_cli,'CLIENT')
RETURN .F.
ENDIF
ENDIF
SHOW GET CLIENT.nom_cli
SHOW GET CLIENT.tel_cli
SHOW GET CLIENT.ton_cde
mton_cde = Client.ton_cde
mcod_ind = Client.cod_ind
m.non_bic=Client.non_bic
m.non_per = Client.non_per
m.ref_bve=Client.ref_bve
m.fra_div=ClienT.fra_div
RETURN .T.
* déclenchée par F5 sur le champ code transport:
PROCEDURE pr_val_tra
IF valid_tra()
KEYBOARD '{TAB}'
ENDIF
FUNCTION valid_tra
DO all_srch WITH "transpor","nom_tra","nom_tra", "","","", ;
"Choisir le Code Transport","","","", ;
"cod_tra:w=GLfaux","CODE", ;
"nom_tra","NOM TRANSPORTEUR"
IF LASTKEY() = ik_enter
m.cod_tra=transpor.cod_tra
SHOW GET m.cod_tra
ELSE
IF !SEEK(m.cod_tra,'transpor')
RETURN .F.
ENDIF
ENDIF
SHOW GET transpor.nom_tra
RETURN .T.
* déclenchée par F5 sur le champ CODE PRODUIT:
PROCEDURE pr_val_pro
IF valid_pro()
KEYBOARD '{TAB}'
ENDIF
FUNCTION valid_pro
DO all_srch WITH "PRODUIT","cod_pro","cod_pro", "","","", ;
"Choisir le Code Produit","","","", ;
"cod_pro","CODE", ;
"nom_pro:w=GLfaux","NOM PRODUIT"
IF LASTKEY() = ik_enter
m.cod_pro=Produit.cod_pro
SHOW GET m.cod_pro
ELSE
IF !SEEK(m.cod_pro,'produit')
RETURN .F.
ENDIF
ENDIF
SHOW GET Produit.nom_pro
RETURN .T.
* déclenchée par F5 sur le champ CODE REPRESENTANT:
PROCEDURE pr_val_rep
IF valid_rep()
KEYBOARD '{TAB}'
ENDIF
FUNCTION valid_rep
DO all_srch WITH "REPRES","nom_rep","nom_rep", "","","", ;
"Choisir le Code Representant","","","", ;
"cod_rep:w=GLfaux","CODE REPR.", ;
"cod_cli:w=GLfaux","CODE CLIENT", ;
"nom_rep","REPRESENTANT", ;
"nom_cli:w=GLfaux","NOM CLIENT"
IF LASTKEY() = ik_enter
m.cod_rep=repres.cod_rep
SHOW GET m.cod_rep
ELSE
IF !SEEK(m.cod_rep,'repres')
RETURN .F.
ENDIF
ENDIF
SHOW GET repres.nom_rep
RETURN .T.
* déclenchée par F5 sur le champ Code Destination:
PROCEDURE pr_val_des
IF valid_des()
KEYBOARD '{TAB}'
ENDIF
FUNCTION valid_des
DO all_srch WITH "DESTINA","nom_des","nom_des", "","","", ;
"Choisir le Code Destination","","","", ;
"cod_des:w=GLfaux","CODE", ;
"nom_des","NOM DESTINATION", ;
"PAYS.nom_pay","NOM PAYS"
IF LASTKEY() = ik_enter
m.cod_des=Destina.cod_des
SHOW GET m.cod_des
ELSE
IF !SEEK(m.cod_des,'DESTINA')
RETURN .F.
ENDIF
ENDIF
RETURN .T.
* déclenchée par F5 sur le champ N° Camion:
PROCEDURE pr_val_imm
IF valid_imm()
KEYBOARD '{TAB}'
ENDIF
FUNCTION valid_imm
DO all_srch WITH "vehicule","num_imm","num_imm", "","","", ;
"Choisir le N° Camion","","","", ;
"num_imm","N° Camion", ;
"num_rem:w=GLfaux","N° Remorque", ;
"cod_tra:w=GLfaux","Code Transporteur"
IF LASTKEY() = ik_enter
m.num_imm=Vehicule.num_imm
SHOW GET m.num_imm
ELSE
IF !SEEK(m.num_imm,'Vehicule')
RETURN .F.
ENDIF
ENDIF
RETURN .T.
* déclenchée par F5 sur le champ N° Camion:
PROCEDURE pr_val_dep
IF valid_dep()
KEYBOARD '{TAB}'
ENDIF
FUNCTION valid_dep
DO all_srch WITH "depart","cod_dep","cod_dep", "","","", ;
"Choisir le code depart","","","", ;
"cod_dep","CODE", ;
"lib_dep:w=GLfaux","LIBELLE"
IF LASTKEY() = ik_enter
m.cod_dep=depart.cod_dep
SHOW GET m.cod_dep
ELSE
IF !SEEK(m.cod_dep,'depart')
RETURN .F.
ENDIF
ENDIF
RETURN .T.
* déclenchée par F5 sur le champ N° Camion:
PROCEDURE pr_val_elf
IF valid_elf()
KEYBOARD '{TAB}'
ENDIF
FUNCTION valid_elf
DO all_srch WITH "elf","cod_elf","cod_elf", "","","", ;
"Choisir local, export ou Fowarehouse","","","", ;
"cod_elf","CODE", ;
"lib_elf:w=GLfaux","LIBELLE"
IF LASTKEY() = ik_enter
m.cod_elf=elf.cod_elf
SHOW GET m.cod_elf
ELSE
IF !SEEK(m.cod_elf,'elf')
RETURN .F.
ENDIF
ENDIF
SHOW GET elf.lib_elf
RETURN .T.
*------
* fonction contenant TOUTES les validations CRITIQUES de l'écran!!!
FUNCTION vld
was_fld_valid = .T. && défaut
ON KEY LABEL F5 && réinit F5
DO CASE
CASE VARREAD()=sprevget
*--- error trap. ne fait rien, mais DOIT exister, sous peine de LOOP infinie...
CASE "CAN_BTN" $ VARREAD()
*--- ne rien faire
OTHERWISE
PRIVATE n_vld_loops, ncurloop
IF "SAVE_BTN" $ VARREAD() AND Save_Btn_Click
Save_Btn_Click=.F.
n_vld_loops = 2
ELSE
n_vld_loops = 1
ENDIF
*---si n_vld_loops = 2, on refait TOUS les contrôles
*---Ci-après, la boucle contenant les contrôles:
FOR ncurloop = 1 TO n_vld_loops
*========= ELF OBLIGATOIRE
IF sprevget="cod_elf" ;
OR (ncurloop=2 AND "SAVE_BTN" $ VARREAD() AND was_fld_valid)
IF !SEEK((m.cod_elf),"elf") then
??CHR(7)
WAIT WIND NOWAIT "LOCAL, EXPORT OU FORWARE OBLIGATOIRE"
was_fld_valid = valid_elf()
exe_browse=.T.
ENDIF
SHOW GET elf.lib_elf
IF !was_fld_valid
was_fld_valid=.F.
??CHR(7)
WAIT WIND NOWAIT "LOCAL, EXPORT OU FORWARE OBLIGATOIRE"
_CUROBJ=OBJNUM(m.cod_elf) && retour au champ en erreur
ENDIF
ENDIF
*========= TRANSPORTEUR OBLIGATOIRE
IF sprevget="cod_tra" ;
OR (ncurloop=2 AND "SAVE_BTN" $ VARREAD() AND was_fld_valid)
IF !SEEK((m.cod_tra),"transpor") then
??CHR(7)
WAIT WIND NOWAIT "CODE TRANSPORTEUR OBLIGATOIRE"
was_fld_valid = valid_tra()
exe_browse=.T.
ENDIF
SHOW GET transpor.nom_tra
IF !was_fld_valid
was_fld_valid=.F.
??CHR(7)
WAIT WIND NOWAIT "CODE TRANSPORTEUR OBLIGATOIRE"
_CUROBJ=OBJNUM(m.cod_tra) && retour au champ en erreur
ENDIF
ENDIF
*========= N° ENTREE obligatoire
IF sprevget="num_ent" ;
OR (ncurloop=2 AND "SAVE_BTN" $ VARREAD() AND was_fld_valid)
m.clemand=m.num_ent
was_fld_valid = chkcode(m.clemand)
IF !was_fld_valid
was_fld_valid=.F.
WAIT WIND NOWAIT "LE N° D'ENTREE EXISTE DEJA !!! AJOUT IMPOSSIBLE"
sprevget="" && Cas spécial retour en arrière
_CUROBJ=OBJNUM(m.num_ent) && retour au champ en erreur
RETURN
ENDIF
IF was_fld_valid AND EMPTY(m.num_ent)
was_fld_valid=.F.
??CHR(7)
WAIT WIND NOWAIT "LE N° D'ENTREE EST OBLIGATOIRE"
_CUROBJ=OBJNUM(m.num_ent) && retour au champ en erreur
ENDIF
IF was_fld_valid AND (SUBSTR(m.num_ent,1,1)<>"L" AND ;
SUBSTR(m.num_ent,1,1)<>"E") AND ;
SUBSTR(m.num_ent,1,1)<>"S") AND ;
Permalink : http://www.atoutfox.org/nntp.asp?ID=0000018283