ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Forum AtoutFox : migrer une application développée en foxpro2.6 à VFP8   

Sujet

rss Flux RSS des derniers messages

Vous devez vous identifier pour pouvoir poser une question ou répondre.

jeu. 01 juin 2017, 15h30
Felix
Togo 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
18 288 messages dans le forum • Liste complète des messages

Publicité

Les pubs en cours :

www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2017.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0