Hola buenos dias Ing. Jose Luis le paso el codigo de un modulo de alta de cuentas contables de 1 a 4 niveles de cuentas, espero que te ayude .
Code: Select all
#include "FiveWin.ch"
*#Include "BtnGet.Ch"
STATIC S06, S08, S15
STATIC oDlg
STATIC cCuenta,cDescribe,nTCuenta,cCtaProv,nTProveedor,nTOperacion,lAp_SN,lIVA,lSNMov,cDesOpera
STATIC cNombFM,cCurp,cDireccion,cCiudad,cRfc,cCp,nTelefono,nFax
STATIC nNivel
STATIC oGet,oSay, oBtn,lNuevo,lOk, oRad1, oRad2
Memvar S04, oMOpc, cNombUsua, cNombre
//------------------------------------------------------------------------------
FUNCTION CATALOGO()
AltCat(.F.,"cCta")
RETURN NIL
//------------------------------------------------------------------------------
FUNCTION AltCat(lPol,AltaCta)
LOCAL oItem:=oMOpc
PUBLIC nNUMEMP, nMES, nANO
oGet := Array(15)
oSay := Array(1)
oBtn := Array(2)
nNivel := 0
IF lPol
cCuenta := AltaCta
ELSE
cCuenta := Space(19)
ENDIF
lAp_SN := (S04)->AP_SEGNG
cDescribe := SPACE(65)
nTCuenta := 2
nTProveedor := 2
cCtaProv := SPACE(12)
nTOperacion := 0
cDesOpera := ""
lIVA := .F.
lSNMov := .F.
cNombFM := SPACE(65)
cCurp := SPACE(18)
cDireccion := SPACE(80)
cCiudad := SPACE(36)
cRfc := SPACE(14)
cCp := SPACE(14)
nTelefono := 0
nFax := 0
lNuevo := .F.
S06 := Abre_Dbf(6,6) // ABRE TIPOPERA.DBF
S08 := Abre_Dbf(8,8) // ABRE CATCTAxA.DBF
S15 := Abre_Dbf(15,15) // ABRE CATPROVD.DBF
DEFINE DIALOG oDlg RESOURCE "CATALOGO" TITLE "Altas catálogo de cuentas"
REDEFINE GET oGet[01] VAR cCuenta ID 101 OF oDlg ;
PICTURE "@K ###################";
ACTION (ListCat(@cCuenta,S08,"cCuenta",oGet[01]));
UPDATE VALID VALCTA()
REDEFINE GET oGet[02] VAR cDescribe ID 102 OF oDlg PICTURE "@K" UPDATE VALID V_DESCRIP(cDescribe)
REDEFINE RADIO oGet[03] VAR nTCuenta ID 103,104 OF oDlg UPDATE
REDEFINE RADIO oGet[04] VAR nTProveedor ID 105,106 OF oDlg UPDATE
*oRad1:aItems[1]:SetText("QUE ONDA")
REDEFINE CHECKBOX oGet[05] VAR lIVA ID 107 OF oDlg //UPDATE
REDEFINE CHECKBOX oGet[06] VAR lSNMov ID 108 OF oDlg WHEN lAp_SN
REDEFINE GET oGet[07] VAR nTOperacion ID 109 OF oDlg PICTURE "9" WHEN IF(nTCuenta = 2 .OR. nTProveedor = 1, .F., .T.);
ACTION (A_TOPERA(@nTOperacion,S06)) VALID VTOPERA()
REDEFINE SAY oSay[01] PROMPT cDesOpera ID 150 OF oDlg PICTURE "@!" UPDATE
REDEFINE GET oGet[08] VAR cNombFM ID 110 OF oDlg PICTURE "@!" UPDATE;
WHEN IF(nTCuenta = 2 .OR. nTProveedor = 1, .F., .T.)
REDEFINE GET oGet[09] VAR cCurp ID 111 OF oDlg PICTURE "@!" UPDATE;
WHEN IF(nTCuenta = 2 .OR. nTProveedor = 1, .F., .T.) VALID invStr(cCurp)
REDEFINE GET oGet[10] VAR cDireccion ID 112 OF oDlg PICTURE "@!" UPDATE;
WHEN IF(nTCuenta = 2 .OR. nTProveedor = 1, .F., .T.)
REDEFINE GET oGet[11] VAR cCiudad ID 113 OF oDlg PICTURE "@!" UPDATE;
WHEN IF(nTCuenta = 2 .OR. nTProveedor = 1, .F., .T.)
REDEFINE GET oGet[12] VAR cRfc ID 114 OF oDlg PICTURE "@!" UPDATE;
WHEN IF(nTCuenta = 2 .OR. nTProveedor = 1, .F., .T.);
VALID V_RFC(cRFC)
REDEFINE GET oGet[13] VAR cCp ID 115 OF oDlg PICTURE "@K #######" UPDATE;
WHEN IF(nTCuenta = 2 .OR. nTProveedor = 1, .F., .T.)
REDEFINE GET oGet[14] VAR nTelefono ID 116 OF oDlg PICTURE "@9" UPDATE;
WHEN IF(nTCuenta = 2 .OR. nTProveedor = 1, .F., .T.)
REDEFINE GET oGet[15] VAR nFax ID 117 OF oDlg PICTURE "@9" UPDATE;
WHEN IF(nTCuenta = 2 .OR. nTProveedor = 1, .F., .T.)
oGet[01]:bKeyDown := { |nKey| IIF( nKey == VK_F2,(oGet[01]:Assign(),Eval( oGet[01]:bAction )),"" ) }
oGet[01]:cToolTip := "Presiona F2"
oGet[05]:bKeyDown := { |nKey| IIF( nKey == VK_F2,(oGet[05]:Assign(),Eval( oGet[05]:bAction )),"" ) }
oGet[05]:cToolTip := "Presiona F2"
REDEFINE BUTTON oBtn[1] ID 201 OF oDlg ACTION REG_DATO(lPol)
REDEFINE BUTTON oBtn[2] ID 202 OF oDlg ACTION oDlg:END()
ACTIVATE DIALOG oDlg CENTERED VALID (oItem:Enable(),.T.)
Close_Dbf(6,S06)
IF !lPol
Close_Dbf(8,S08)
ELSE
Close_Dbf(8,S08)
ENDIF
Close_Dbf(15,S15)
RETURN NIL
//------------------------------------------------------------------------------
STATIC FUNCTION VALCTA()
LOCAL I, cCta:=SPACE(16),xDig1,xDig2,xDig3,xDig4,xCtaDig,nPos1,nPos2,lProv :=.F.
cCuenta := FORMATO1("cCuenta", cCuenta,.T.) // Despliega formato con guion en el get
cCta := FORMATO1("cCuenta", cCuenta,.F.) // Despliega formato sin guion a buscar
// INICIA PROCESOS EN CAMPOS DE DIGITOS
* VALIDA SI SOBREPASA MAS DE X DIGITOS POR NIVEL DE CUENTAS SI MARCA ERROR DE "*"
FOR I = 1 TO LEN(cCuenta)
IF SUBS(cCuenta, I, 1) == "*" .OR. I > LEN(cCuenta)
MsgInfo("Cuenta inválida "+TRIM(cCuenta),"Confirme")
cCuenta := SPACE(19)
oGet[01]:Refresh()
RETURN .F.
ENDIF
END FOR
* XXXX-XXXX-XXXX-XXXX
xDig1 := Val(SubStr(cCuenta,1,4))
xDig2 := Val(SubStr(cCuenta,6,4))
xDig3 := Val(SubStr(cCuenta,11,4))
xDig4 := Val(SubStr(cCuenta,16,4))
DO CASE
CASE xDig1 > 0 .AND. xDig2 = 0 .AND. xDig3 = 0 // NIVEL 1
nNivel := 1
CASE xDig1 > 0 .AND. xDig2 > 0 .AND. xDig3 = 0 // NIVEL 2
nNivel := 2
xCtaDig := STRZERO(xDig1,4) + "0000" + "0000" + "0000"
(S08)->(DBSeek(xCtaDig))
IF !EMPTY(xDig2)
IF (S08)->TIPONAT = 'D'
MsgInfo('La cuenta tiene subcuentas, no puede ser de detalle',"Confirme")
RETURN .F.
ENDIF
ENDIF
IF (S08)->(!FOUND())
MsgInfo('La cuenta '+Ext_xNiv(xCtaDig)+' nivel '+STR(nNivel)+' no tiene antecedentes ', "Confirme")
oGet[01]:Refresh()
RETURN .F.
ENDIF
CASE xDig1 > 0 .AND. xDig2 > 0 .AND. xDig3 > 0 .AND. xDig4 = 0 // NIVEL 3
nNivel := 3
xCtaDig := STRZERO(xDig1,4) + STRZERO(xDig2,4) + "0000" + "0000"
(S08)->(DBSeek(xCtaDig))
IF !EMPTY(xDig2)
IF (S08)->TIPONAT = 'D'
MsgInfo('La cuenta tiene subcuentas, no puede ser de detalle',"Confirme")
RETURN .F.
ENDIF
ENDIF
IF (S08)->(!FOUND())
MsgInfo('La cuenta '+Ext_xNiv(xCtaDig)+' nivel '+STR(nNivel)+' no tiene antecedentes ', "Confirme")
oGet[01]:Refresh()
RETURN .F.
ENDIF
CASE xDig1 > 0 .AND. xDig2 > 0 .AND. xDig3 > 0 .AND. xDig4 > 0 // NIVEL 4
nNivel := 4
xCtaDig := STRZERO(xDig1,4) + STRZERO(xDig2,4) + STRZERO(xDig3,4) + "0000"
(S08)->(DBSeek(xCtaDig))
IF !EMPTY(xDig3)
IF (S08)->TIPONAT = 'D'
MsgInfo('La cuenta tiene subcuentas, no puede ser de detalle',"Confirme")
RETURN .F.
ENDIF
ENDIF
IF (S08)->(!FOUND())
MsgInfo('La cuenta '+Ext_xNiv(xCtaDig)+' nivel '+STR(nNivel)+' no tiene antecedentes ', "Confirme")
oGet[01]:Refresh()
RETURN .F.
ENDIF
OTHERWISE
RETURN .F.
ENDCASE
(S08)->(DBSeek(cCta))
IF (S08)->(Found())
cDescribe := (S08)->DESCRIP
nTCuenta := IF(AllTrim((S08)->TIPONAT) == "D" ,1,2)
nTProveedor := IF(AllTrim((S08)->TIPOPRV) == "C" ,1,2)
nTOperacion := (S08)->TIPOPERA
lIVA := (S08)->AP_IVA
lSNMov := (S08)->MOVSN
*MsgInfo(nTProveedor)
DO CASE
CASE (S08)->NIVSUM = 1 .AND. (S08)->TIPONAT == "D" //.AND. (S08)->TIPOPRV == "P"
nPos1 := 0
nPos2 := 1
lProv := .T.
CASE (S08)->NIVSUM = 2 .AND. (S08)->TIPONAT == "D" //.AND. (S08)->TIPOPRV == "P"
nPos1 := 3
nPos2 := 5
lProv := .T.
CASE (S08)->NIVSUM = 3 .AND. (S08)->TIPONAT == "D" //.AND. (S08)->TIPOPRV == "P"
nPos1 := 7
nPos2 := 9
lProv := .T.
CASE (S08)->NIVSUM = 4 .AND. (S08)->TIPONAT == "D" //.AND. (S08)->TIPOPRV == "P"
nPos1 := 11
nPos2 := 13
lProv := .T.
ENDCASE
IF lProv
(S15)->(DBSeek(IF(lProv, SUBS(cCta,nPos1,2),"")+IF(lProv, SUBS(cCta,nPos2,4),"")))
cNombFM := IF(nTProveedor=1,(S08)->DESCRIP ,(S15)->NOMPROV)
cCurp := IF(nTProveedor=1,(S08)->C_U_R_P ,(S15)->C_U_R_P)
cDireccion := IF(nTProveedor=1,(S08)->DIRECCIO,(S15)->DIRECCIO)
cCiudad := IF(nTProveedor=1,(S08)->CIUDAD ,(S15)->CIUDAD)
cRfc := IF(nTProveedor=1,(S08)->R_F_C ,(S15)->R_F_C)
cCp := IF(nTProveedor=1,(S08)->CODPOST ,(S15)->CODPOST)
nTelefono := IF(nTProveedor=1,(S08)->TELEFONO,(S15)->TELEFONO)
nFax := IF(nTProveedor=1,(S08)->TELEFFAX,(S15)->TELEFFAX)
ENDIF
(S06)->(DBSeek(STR(nTOperacion,1)))
cDesOpera := (S06)->DESCRIP
lNuevo := .F.
ELSE
lNuevo := .T.
ENDIF
AEval( oGet,{|o| o:Refresh()} )
AEval( oSay,{|o| o:Refresh()} )
Release I, cCta, xDig1, xDig2, xDig3, xCtaDig
RETURN (.T.)
//------------------------------------------------------------------------------
STATIC FUNCTION V_DESCRIP(cDescribe)
cNombFM := cDescribe
oGet[07]:REFRESH()
RETURN (.T.)
//------------------------------------------------------------------------------
STATIC FUNCTION VTOPERA()
LOCAL lRet := .T., cCta:=SPACE(16),nPos1,nPos2,lProv
cCta := FORMATO1("cCuenta", cCuenta,.F.) // Despliega formato sin guion a buscar
DO CASE
CASE nNivel = 1 .AND. nTCuenta = 1 .AND. nTProveedor = 2
nPos1 := 0
nPos2 := 1
lProv := .T.
CASE nNivel = 2 .AND. nTCuenta = 1 .AND. nTProveedor = 2
nPos1 := 3
nPos2 := 5
lProv := .T.
CASE nNivel = 3 .AND. nTCuenta = 1 .AND. nTProveedor = 2
nPos1 := 7
nPos2 := 9
lProv := .T.
CASE nNivel = 4 .AND. nTCuenta = 1 .AND. nTProveedor = 2
nPos1 := 11
nPos2 := 13
lProv := .T.
ENDCASE
IF lProv .AND. nTCuenta = 1 .AND. nTProveedor = 2
(S15)->(DBSeek(IF(lProv, SUBS(cCta,nPos1,2),"")+IF(lProv, SUBS(cCta,nPos2,4),"")))
** cNombFM := (S15)->NOMPROV // porque aquí lo borra...tengo que checar ese detalle...!
cCurp := (S15)->C_U_R_P
cDireccion := (S15)->DIRECCIO
cCiudad := (S15)->CIUDAD
cRfc := (S15)->R_F_C
cCp := (S15)->CODPOST
nTelefono := (S15)->TELEFONO
nFax := (S15)->TELEFFAX
AEval( oGet,{|o| o:Refresh()} )
ENDIF
DbSelectArea(S06)
(S06)->(DbSeek(STR(nTOperacion,1)))
IF FOUND()
nTOperacion := (S06)->CVETIPO
cDesOpera := (S06)->DESCRIP
ELSE
MsgAlert("No existe tipo de operación","Confirme")
lRet := .F.
ENDIF
oGet[05]:Refresh()
oGet[06]:Refresh()
RETURN (lRet)
//------------------------------------------------------------------------------
STATIC FUNCTION V_RFC(RFCf)
LOCAL I := 0, lRet:=.T.
IF RFCf = " "
MsgInfo("El primer digito del RFC deber ser una letra")
lRet := .F.
ELSE
FOR I = 1 TO LEN(RFCf)
IF SUBS(RFCf,I,1) == "-" .OR. SUBS(RFCf,I-1,1) == " "
MsgInfo("Favor de no teclear guion o dejar espacios en blanco")
lRet := .T.
ENDIF
NEXT
ENDIF
oGet[11]:Refresh()
Release I
RETURN (.T.)
//------------------------------------------------------------------------------
STATIC FUNCTION invStr( __cTexto )
LOCAL aText1, cNew, n, cTemp, g, x
aText1 = ARRAY (LEN ( __cTexto ) )
cNew = ""
FOR n = 1 TO LEN( __cTexto )
cTemp = LEFT( __cTexto, n )
aText1[ n ] = RIGHT( cTemp, 1 )
MsgInfo(aText1[ n ])
NEXT n
x = 1
FOR g = LEN( __cTexto ) TO 1 STEP -1
cNew = aText1[ x ] + cNew
x = x + 1
MsgInfo(cNew)
NEXT g
MsgInfo(cNew)
RETURN (.t.)
//------------------------------------------------------------------------------
STATIC FUNCTION REG_DATO(lPol)
LOCAL cCta, nRecno1,nRecno2, lProv:=.F., nPos1,nPos2
nRecno1:= (S08)->(RecNo())
nRecno2:= (S15)->(RecNo())
cCta := FORMATO1("cCuenta", cCuenta,.F.) // Despliega formato sin guion a buscar
(S08)->(DBSeek(cCta))
* XXXX-XXXX-XXXX-XXXX
* 1 5 9 13
DO CASE
CASE nNivel = 1 .AND. nTCuenta = 1 .AND. nTProveedor = 2
nPos1 := 0
nPos2 := 1
lProv := .T.
CASE nNivel = 2 .AND. nTCuenta = 1 .AND. nTProveedor = 2
nPos1 := 3
nPos2 := 5
lProv := .T.
CASE nNivel = 3 .AND. nTCuenta = 1 .AND. nTProveedor = 2
nPos1 := 7
nPos2 := 9
lProv := .T.
CASE nNivel = 4 .AND. nTCuenta = 1 .AND. nTProveedor = 2
nPos1 := 11
nPos2 := 13
lProv := .T.
ENDCASE
IF lNuevo // Si agrega nuevo registro
(S08)->(DBAppend())
(S08)->FECALTA := DATE()
(S08)->REGHORA := AMPM(TIME())
(S08)->NICKUSUA:= cNombUsua
(S08)->NOMBUSUA:= cNombre
ELSE
(S08)->(DBGoTo(nRecno1))
ENDIF
IF !OCUPADO(S08) // Bloquea registro
(S08)->CUENTAS := cCta
(S08)->NIVSUM := nNivel
(S08)->DESCRIP := cDescribe
(S08)->TIPONAT := IF(nTCuenta == 1, "D", "A")
(S08)->GRUPOCTA := 0
(S08)->TIPOPRV := IF(nTProveedor == 1, "C", "P")
(S08)->TIPOPERA := nTOperacion
(S08)->AP_SN := (S04)->AP_SEGNG // Temporal, mientras se termine de programar... \\
(S08)->AP_IVA := lIVA
(S08)->MOVSN := lSNMov //IF((S04)->AP_SEGNG, .T., .F.) // Temporal, mientras se termine de programar... \\
(S08)->NOMBRE := cNombFM
(S08)->C_U_R_P := cCurp
(S08)->DIRECCIO := cDireccion
(S08)->CIUDAD := cCiudad
(S08)->R_F_C := cRfc
(S08)->CODPOST := cCp
(S08)->TELEFONO := nTelefono
(S08)->TELEFFAX := nFax
(S08)->(DbCommit())
(S08)->(DbUnlock())
ENDIF
(S15)->(DBSeek(IF(lProv, SUBS(cCta,nPos1,2),"")+IF(lProv, SUBS(cCta,nPos2,4),"")))
IF lNuevo .AND. nTCuenta = 1 .AND. nTProveedor = 2 // Si agrega nuevo registro
(S15)->(DBAppend())
ELSE
(S15)->(DBGoTo(nRecno2))
ENDIF
IF !OCUPADO(S15) .AND. nTCuenta = 1 .AND. nTProveedor = 2 .AND. lProv // Bloquea
(S15)->SUBCTA := IF(lProv, SUBS(cCta,nPos1,2),"")
(S15)->CTAPROV := IF(lProv, SUBS(cCta,nPos2,4),"")
(S15)->NOMPROV := cNombFM
(S15)->C_U_R_P := cCurp
(S15)->DIRECCIO := cDireccion
(S15)->CIUDAD := cCiudad
(S15)->R_F_C := cRfc
(S15)->CODPOST := cCp
(S15)->TELEFONO := nTelefono
(S15)->TELEFFAX := nFax
(S15)->(DbCommit())
(S15)->(DbUnlock())
ENDIF
cCuenta := Space(19)
cDescribe := SPACE(65)
nTCuenta := 2
nTProveedor := 2
cCtaProv := SPACE(12)
nTOperacion := 0
lIVA := .F.
lSNMov := .F.
cDesOpera := ""
cNombFM := SPACE(65)
cCurp := SPACE(18)
cDireccion := SPACE(80)
cCiudad := SPACE(36)
cRfc := SPACE(14)
cCp := SPACE(14)
nTelefono := 0
nFax := 0
AEval( oGet,{|o| o:Refresh()} )
IF lPol
oDlg:End()
ELSE
oGet[1]:SetFocus()
oBtn[1]:oJump := oGet[01]
* oDlg:SetFocus()
ENDIF
Release cCta, nRecno1, nRecno2
RETURN NIL
//------------------------------------------------------------------------------
STATIC FUNCTION ListCat(Ctaf,S08,VarCta,oGetCpo)
LOCAL lRet:= .T.
Default oGetCpo := NIL
IF SelCta(Ctaf,S08)
DO CASE
CASE VarCta = "cCuenta"
cCuenta := Ext_xNiv((S08)->CUENTAS)
ENDCASE
ENDIF
oGetCpo:Refresh()
Release oDLbx1, oLbx1, cCta2
RETURN NIL
//------------------------------------------------------------------------------
STATIC FUNCTION A_TOPERA(nTOpera,S06)
LOCAL oDLbx1, oLbx1, lSel := .F.
DbSelectArea(S06)
(S06)->(DbGoTop())
DEFINE DIALOG oDLbx1 RESOURCE "VCATALAG" TITLE "Catálogo tipo de operación"
REDEFINE LISTBOX oLbx1 FIELDS STR((S06)->CVETIPO), SUBS((S06)->DESCRIP,1,36) ;
HEADER "Tipo", "Descripción" ;
SIZES 85,200 ;
ALIAS (S06)->(ALIAS()) ID 101 OF oDLbx1
oLbx1:lCellStyle := .T.
oLbx1:bLogicLen := {||(S06)->(OrdKeyCount())}
* oLbx1:lAdjLastCol:= .F.
oLbx1:nClrForeHead:= CLR_RED
oLbx1:bLDblClick := {||oDLbx1:END()}
oLbx1:bKeyDown := {| nKey| IF(nKey = VK_RETURN, (lSel:=.T.,oDLbx1:End()),)}
ACTIVATE DIALOG oDLbx1
IF lSel
nTOperacion := (S06)->CVETIPO
cDesOpera := (S06)->DESCRIP
ENDIF
oGet[05]:Refresh()
oGet[06]:Refresh()
Release oDLbx1, oLbx1
RETURN (lSel)
Saludos ing. Jose Luis y buen dia a todos.
Atte: Adriano C. C.
