by fespinoza » Tue Jan 08, 2008 4:12 pm
La primera parte de Ingresar.prg es la siguiente:
FUNCTION Ingresar(NPar)
#INCLUDE "FiveWin.CH"
#INCLUDE "RichEdit.CH"
LOCAL oSay, oGrp[3], oGet[12], NOM:=SPACE(20)
PRIVATE oDlgING, NREG:="Nuevo", oBut[20], Btmp[2], oBtmp[2], oCom[9]
PRIVATE CIU:={}, EST:={}, ARB:={}, DTS:={}, EDC[22], RES[22], NDT:=REA:=REF:=LM:=0
PRIVATE JUGADL[14,4], JUGADV[14,4], GOLL[30,3], GOLV[30,3], PF[5,4]
PRIVATE aTorn:={}, LOC:={}, VIS:={}, LIN1:=SPACE(56), PAIS:={{},{},{}}, ETP[14]
PRIVATE NOMD[30,13], DEBOJ[30,2], NDJU:=DDT:=DOJU:=DAR:=NPA:=0
PRIVATE CIUHIS:={}, ESTHIS:={}, NOMARD[8], NOMDTD[2,8], NCH:=NESH:=0
PRIVATE NED:=NCD:=0, ESD[6], CID[2], IDEN:=1, NOAR:=NODT:=0, nPerr:=0
PRIVATE DEBOTAR[2], DEBOTDT[2,2], PLE:=PVE:=0, NMJU:=14, aRec[4]
Btmp[1]:=Btmp[2]:="VACIO"
IF TAA=1
AADD(aTorn,"")
AADD(aTorn,"APERTURA SERIE A")
AADD(aTorn,"CAMPEONATO NACIONAL")
AADD(aTorn,"CLAUSURA SERIE A")
AADD(aTorn,"SERIE A")
ELSEIF TAA=2
AADD(aTorn,"")
AADD(aTorn,"APERTURA SERIE B")
AADD(aTorn,"CLAUSURA SERIE B")
AADD(aTorn,"SERIE B")
ELSEIF TAA=3
AADD(aTorn,"")
AADD(aTorn,"TORNEO DE ASO GUAYAS")
ELSEIF TAA=4
AADD(aTorn,"")
AADD(aTorn,"TORNEO DE AFNA")
AADD(aTorn,"TORNEO INTERANDINO")
ENDIF
ETP[1]=""
ETP[2]="1ra. ETAPA"
ETP[3]="2da. ETAPA"
ETP[4]="3ra. ETAPA"
ETP[5]="4tos. FINAL"
ETP[6]="APERTURA"
ETP[7]="CAMPEONATO"
ETP[8]="CLAUSURA"
ETP[9]="DEFINICION"
ETP[10]="FINAL"
ETP[11]="LIGUILLA"
ETP[12]="NO DESCENSO"
ETP[13]="PRE CONMEBOL"
ETP[14]="SEMIFINAL"
Llenar(IDEN)
USE &RUTDIR.NACION
DO WHILE .NOT. EOF()
NPA++
AADD(PAIS[1],NACION); AADD(PAIS[2],SIMB); AADD(PAIS[3],CONFEDERAC)
SKIP
ENDDO
USE &RUTDIR.CIUDADES
DO WHILE .NOT. EOF()
NCH++
AADD(CIUHIS,CIUDAD)
SKIP
ENDDO
ASORT(CIUHIS)
USE &RUTDIR.ESTADIOS
DO WHILE .NOT. EOF()
NESH++
AADD(ESTHIS,ESTADIO)
SKIP
ENDDO
ASORT(ESTHIS)
USE &RUTRES.&NOMARC
IF LastRec()>0
Llemat(,CIU)
Llemat(6,EST)
Llemat(8,ARB)
NDT=Llemat(19,DTS)
NDT=Llemat(20,DTS,NDT)
ENDIF
AADD(CIU,"")
AADD(EST,"")
AADD(ARB,"")
AADD(DTS,"")
ASORT(CIU)
ASORT(EST)
ASORT(ARB)
ASORT(DTS)
IF EMPTY(NPar)
REF=LASTREC()
REA=REF+1
ELSE
REF=NPar
REA=REF+1
LeerReg(REF,IDEN)
ENDIF
DEFINE DIALOG oDlgING OF oVENT RESOURCE "INGRESO_CE" TITLE "Ingreso de datos al archivo: "+NOMARC
REDEFINE GROUP oGrp[1] ID 1400 OF oDlgING COLOR GetTextColor()
REDEFINE GET oGet[1] VAR EDC[1] ID 1402 OF oDlgING VALID EDC[1]>=0 SPINNER MIN 0 MAX 99 PICTURE "##" UPDATE
REDEFINE GET oGet[2] VAR EDC[2] ID 1403 OF oDlgING UPDATE
REDEFINE BTNBMP oBut[20] ID 1416 OF oDlgING RESOURCE "CALENDAR" ACTION MsgDate(DATE(),"Seleccione fecha",oGet[2]) MESSAGE "Selecciona fecha" UPDATE
REDEFINE COMBOBOX oCom[9] VAR EDC[22] ITEMS aTorn ID 1404 OF oDlgING MESSAGE "Seleccionar Nombre del Torneo" STYLE CBS_DROPDOWN UPDATE
REDEFINE COMBOBOX oCom[1] VAR EDC[20] ITEMS ETP ID 1405 OF oDlgING MESSAGE "Seleccionar Etapa" STYLE CBS_DROPDOWN UPDATE
REDEFINE COMBOBOX oCom[2] VAR EDC[3] ITEMS CIU ID 1406 OF oDlgING MESSAGE "Seleccionar Ciudad" STYLE CBS_DROPDOWN UPDATE
REDEFINE BTNBMP oBut[10] ID 1407 OF oDlgING FILENAME RUTBMP+"INSPECT.BMP" ACTION OtraCiudad(oDlgIng) MESSAGE "Seleccione otra Ciudad"
REDEFINE BTNBMP oBut[11] ID 1408 OF oDlgING FILENAME RUTBMP+"ADDREC.BMP" ACTION CiudadDeb(oDlgING) MESSAGE "Seleccione nueva Ciudad"
REDEFINE COMBOBOX oCom[3] VAR EDC[4] ITEMS EST ID 1409 OF oDlgING MESSAGE "Seleccionar Estadio" STYLE CBS_DROPDOWN UPDATE
REDEFINE BTNBMP oBut[12] ID 1410 OF oDlgING FILENAME RUTBMP+"INSPECT.BMP" ACTION OtroEstadio(oDlgIng) MESSAGE "Seleccione otro Estadio"
REDEFINE BTNBMP oBut[13] ID 1411 OF oDlgING FILENAME RUTBMP+"ADDREC.BMP" ACTION EstadioDeb(oDlgING) MESSAGE "Seleccione nuevo Estadio"
REDEFINE GET oGet[3] VAR EDC[21] ID 1412 OF oDlgING VALID EDC[21]>=0 SPINNER MIN 0 MAX 999999 PICTURE "###,###" UPDATE
REDEFINE COMBOBOX oCom[4] VAR EDC[5] ITEMS ARB ID 1413 OF oDlgING MESSAGE "Seleccionar Arbitro" STYLE CBS_DROPDOWN UPDATE
REDEFINE BTNBMP oBut[14] ID 1414 OF oDlgING FILENAME RUTBMP+"INSPECT.BMP" ACTION OtroArbitro(oDlgING,1,,1) MESSAGE "Seleccione otro Arbitro"
REDEFINE BTNBMP oBut[15] ID 1415 OF oDlgING FILENAME RUTBMP+"ADDREC.BMP" ACTION NombreArDeb(oDlgING,1) MESSAGE "Seleccione nuevo Arbitro"
REDEFINE SAY oSay ID 1422 OF oDlgING COLOR RGB(255,0,0),RGB(nRGBRed(oDlgING:nClrPane),nRGBGreen(oDlgING:nClrPane),nRGBBlue(oDlgING:nClrPane))
REDEFINE COMBOBOX oCom[5] VAR EDC[6] ITEMS EQUIPO ID 1421 OF oDlgING ON CHANGE CambiaBMP(EDC[6]) MESSAGE "Seleccionar Equipo" VALID EDC[6]<>EDC[8] STYLE CBS_DROPDOWN UPDATE
REDEFINE GET oGET[4] VAR EDC[7] ID 1423 OF oDlgING VALID EDC[7]>=0 SPINNER MIN 0 MAX 14 PICTURE "##" UPDATE
REDEFINE COMBOBOX oCom[6] VAR EDC[8] ITEMS EQUIPO ID 1425 OF oDlgING ON CHANGE CambiaBMP(EDC[8]) MESSAGE "Seleccionar Equipo" VALID EDC[8]<>EDC[6] STYLE CBS_DROPDOWN UPDATE
REDEFINE GET oGET[5] VAR EDC[9] ID 1427 OF oDlgING VALID EDC[9]>=0 SPINNER MIN 0 MAX 14 PICTURE "##" UPDATE
REDEFINE BITMAP oBtmp[1] ID 1490 OF oDlgING FILE RUTBMP+Btmp[1]+".BMP" UPDATE ADJUST
REDEFINE BITMAP oBtmp[2] ID 1491 OF oDlgING FILE RUTBMP+Btmp[2]+".BMP" UPDATE ADJUST
REDEFINE GROUP oGrp[2] ID 1480 OF oDlgING COLOR GetTextColor()
REDEFINE GET oGet[6] VAR EDC[10] ID 1431 OF oDlgING VALID EDC[10]>=0 SPINNER MIN 0 MAX 14 PICTURE "##" UPDATE
REDEFINE GET oGet[7] VAR EDC[11] ID 1433 OF oDlgING VALID EDC[11]>=0 SPINNER MIN 0 MAX 14 PICTURE "##" UPDATE
REDEFINE GET oGet[8] VAR EDC[12] ID 1441 OF oDlgING VALID EDC[12]>=0 SPINNER MIN 0 MAX 10 PICTURE "##" UPDATE
REDEFINE GET oGet[9] VAR EDC[13] ID 1445 OF oDlgING VALID (EDC[13]<=EDC[12] .AND. EDC[12]>=0) SPINNER MIN 0 MAX EDC[12] PICTURE "##" UPDATE
REDEFINE GET oGet[10] VAR EDC[14] ID 1443 OF oDlgING VALID EDC[14]>=0 SPINNER MIN 0 MAX 10 PICTURE "##" UPDATE
REDEFINE GET oGet[11] VAR EDC[15] ID 1447 OF oDlgING VALID (EDC[15]<=EDC[14] .AND. EDC[14]>=0) SPINNER MIN 0 MAX EDC[14] PICTURE "##" UPDATE
REDEFINE COMBOBOX oCom[7] VAR EDC[16] ITEMS DTS ID 1451 OF oDlgING MESSAGE "Seleccionar T‚cnico" STYLE CBS_DROPDOWN UPDATE
REDEFINE BTNBMP oBut[16] ID 1454 OF oDlgING FILENAME RUTBMP+"INSPECT.BMP" ACTION OtroArbitro(oDlgING,2,1,1) MESSAGE OemToANSI("Seleccione otro T‚cnico")
REDEFINE BTNBMP oBut[17] ID 1455 OF oDlgING FILENAME RUTBMP+"ADDREC.BMP" ACTION NombreDTDeb(1,oDlgING,1) MESSAGE OemToANSI("Seleccione nuevo T‚cnico")
REDEFINE COMBOBOX oCom[8] VAR EDC[17] ITEMS DTS ID 1453 OF oDlgING MESSAGE "Seleccionar T‚cnico" STYLE CBS_DROPDOWN UPDATE
REDEFINE BTNBMP oBut[18] ID 1456 OF oDlgING FILENAME RUTBMP+"INSPECT.BMP" ACTION OtroArbitro(oDlgING,2,2,1) MESSAGE OemToANSI("Seleccione otro T‚cnico")
REDEFINE BTNBMP oBut[19] ID 1457 OF oDlgING FILENAME RUTBMP+"ADDREC.BMP" ACTION NombreDTDeb(2,oDlgING,1) MESSAGE OemToANSI("Seleccione nuevo T‚cnico")
REDEFINE BUTTON oBut[2] ID 1460 OF oDlgING MESSAGE "Ingreso de las alineaciones de ambos equipos";
ACTION IF(EDC[6]=SPACE(12) .OR. EDC[8]=SPACE(12),MsgInfo("Falta ingresar dato(s)","Confirme datos"),;
Alineac(EDC[6],EDC[8],EDC[7],EDC[9],EDC[10],EDC[11],REA,1,oDlgING))
REDEFINE GET oGet[12] VAR NREG ID 1462 OF oDlgING READONLY UPDATE
REDEFINE GROUP oGrp[3] ID 1475 OF oDlgING COLOR GetTextColor()
REDEFINE BUTTON oBut[1] ID 1474 OF oDlgING MESSAGE "Va a un registro determinado" ACTION IrARegistro(1)
REDEFINE BUTTON oBut[3] ID 1470 OF oDlgING MESSAGE "Va al inicio del archivo" ACTION InicioArch(1)
REDEFINE BUTTON oBut[4] ID 1471 OF oDlgING MESSAGE "Va al fin del archivo" ACTION FinArch(1)
REDEFINE BUTTON oBut[5] ID 1472 OF oDlgING MESSAGE "Retrocede un registro" ACTION Atras(1)
REDEFINE BUTTON oBut[6] ID 1473 OF oDlgING MESSAGE "Adelanta un registro" ACTION Adelante(1)
REDEFINE BUTTON oBut[7] ID 1 OF oDlgING MESSAGE "Graba datos" ACTION GrabaUlt(1)
REDEFINE BUTTON oBut[8] ID 2 OF oDlgING MESSAGE "Sale de esta pantalla" ACTION oDlgING:END()
* REDEFINE BUTTON oBut[9] ID 3 OF oDlgING MESSAGE "Imprimir" ACTION ImprimeDato(REA,IDEN,EDC[7],EDC[9])
REDEFINE BUTTON oBut[9] ID 3 OF oDlgING MESSAGE "Imprimir" ACTION ""
IF REA=1
oBut[3]:DISABLE()
oBut[4]:DISABLE()
oBut[5]:DISABLE()
oBut[6]:DISABLE()
ELSE
oBut[3]:ENABLE()
oBut[4]:DISABLE()
oBut[5]:ENABLE()
oBut[6]:DISABLE()
ENDIF
ACTIVATE DIALOG oDlgING CENTERED VALID SalirArch() RESIZE16
DBCloseAll()
RETU .T.
*FDF Ingresar