#include "FiveWin.ch"
#include "xbrowse.ch"
*#include "InKey.ch"
*#include "Directry.ch"
#define EMPRESA "FRANCISCO J. ALEGRIA P."
#define MEMBRE "FAPSOFTWARE"
#define PAD_LEFT 0
#define PAD_RIGHT 1
#define PAD_CENTER 2
#define SM_CXSCREEN 0
#define SM_CYSCREEN 1
Static oServer
Static oWnd
//----------------
Function Main()
local oMenu, oMainFont,oBar
local cHost, cUser, cPass, nPort, cNomBDD
//CONECCION CON SERVIDOR
cHost := "localhost" // en modo local
cUser := "root" // usuario
cPass := "fap" // password
nPort := "3306" // puerto
cNomBDD := "mibasedatos" //Nombre base de datos
//Coneccion con el servidor
if !Coneccion(cHost, cUser, cPass, nPort, cNomBDD)
return nil
endif
//FIN CONECCION CON SERVIDOR
SET DATE BRITISH
SET EPOCH TO 1995
SET CENTURY ON
SET DELETED ON
DEFINE FONT oMainFont NAME "Tahoma" SIZE 0, -11 //"MS SANS SERIF" SIZE 0,-10
DEFINE WINDOW oWnd MDI TITLE "WINCONT "+EMPRESA +" (MYSQL-TMYSQL)"
DEFINE BUTTONBAR oBar OF oWnd SIZE 60, 64 2007
oWnd:oFont:=oMainFont
oWnd:SetMenu( oMenu:=BuildMenu(oBar) ) //MENUINFO 2
ACTIVATE WINDOW oWnd MAXIMIZED
oMainFont:End()
SET RESOURCES TO
oServer:End()
return nil
//----------------------------------------------------------------------------//
Function BuildMenu(oBar)
local cFecha
local oMenu, oItem1,oItem2,oItem3,oItem4,oItem5,oItem6,oItem7,oItem8
MENU oMenu 2007
MENUITEM oItem1 PROMPT "&Fichero"
MENU
MENUITEM "Formato de &Resultados" ACTION GOPMULT() MESSAGE "Personalizar Formato Estado de Resultados"
MENUITEM "&Salir..." ACTION oWnd:End() MESSAGE "Finalizar esta sesion"
ENDMENU
ENDMENU
return oMenu
//CONECTAR CON SERVIDOR MYSQL Y CREAR BASE DE DATOS Y TABLAS
//----------------------------------
Function Coneccion(cHost, cUser, cPass, nPort, cNomBDD)
local cCmdSql
MsgRun( "Conectando con servidor. Aguarde...", "FAPSOFTWARE", ;
{|| oServer := TMYsqlServer():new( cHost, cUser, cPass, nPort) } )
if oServer:lError
MsgStop( "Error: No se estableció conección, reintente...","Alto" )
Return .f.
endif
oServer:Query( "CREATE DATABASE IF NOT EXISTS " + cNomBDD )
oServer:SelectDB( cNomBDD )
if oServer:lError
oServer:End()
MsgStop(oServer:Error()) //Descrip en MySql.prg
MsgStop( "No se pudo seleccionar la Base de Datos (o no existe)."+CRLF+;
"Base de Datos: "+cNomBDD,"Alto" )
return .f.
endif
//CREAR TABLAS SI NO EXISTEN
cCmdSql:= "CREATE TABLE IF NOT EXISTS catalogo(" +;
"CODICONT VARCHAR(20) NOT NULL DEFAULT '' COMMENT 'Codigo Contable'," +;
"NOMBRE VARCHAR(50) DEFAULT '' COMMENT 'Nombre de la Cuenta'," +;
"PRIMARY KEY (CODICONT) )" +;
"ENGINE = InnoDB COMMENT 'catalogo';"
oServer:Query(cCmdSql)
//Agregamos registros
oServer:Query( "INSERT INTO CATALOGO (CODICONT,NOMBRE) VALUES('1','ACTIVO');" )
oServer:Query( "INSERT INTO CATALOGO (CODICONT,NOMBRE) VALUES('11','ACTIVO CIRCULANTE');" )
oServer:Query( "INSERT INTO CATALOGO (CODICONT,NOMBRE) VALUES('110','DISPONIBILIDAD');" )
oServer:Query( "INSERT INTO CATALOGO (CODICONT,NOMBRE) VALUES('1101','EFECTIVO EN CAJA');" )
oServer:Query( "INSERT INTO CATALOGO (CODICONT,NOMBRE) VALUES('1101001','CAJA GENERAL');" )
oServer:Query( "INSERT INTO CATALOGO (CODICONT,NOMBRE) VALUES('1101002','CAJA CHICA');" )
oServer:Query( "INSERT INTO CATALOGO (CODICONT,NOMBRE) VALUES('1101002001','CAJA CHICA GERENCIA');" )
oServer:Query( "INSERT INTO CATALOGO (CODICONT,NOMBRE) VALUES('1101002002','CAJA CHICA ADMINISTRACION');" )
oServer:Query( "INSERT INTO CATALOGO (CODICONT,NOMBRE) VALUES('1102','BANCOS');" )
oServer:Query( "INSERT INTO CATALOGO (CODICONT,NOMBRE) VALUES('1102001','BANCOS MONEDA NACIONAL');" )
oServer:Query( "INSERT INTO CATALOGO (CODICONT,NOMBRE) VALUES('1102001001','BANPRO CTA CTE NO.');" )
oServer:Query( "INSERT INTO CATALOGO (CODICONT,NOMBRE) VALUES('1102001002','BAC CTA CTE NO.');" )
oServer:Query( "INSERT INTO CATALOGO (CODICONT,NOMBRE) VALUES('1102002','BANCOS MONEDA EXTRANJERA');" )
oServer:Query( "INSERT INTO CATALOGO (CODICONT,NOMBRE) VALUES('1102002001','BANPRO US$ CTA CTE NO.);" )
oServer:Query( "INSERT INTO CATALOGO (CODICONT,NOMBRE) VALUES('1102002002','BAC US$ CTA CTE NO.');" )
//TABLA PARA EST/RESULTADO DEFINIDO POR EL USUARIO
oServer:Query("CREATE TABLE IF NOT EXISTS gopmult(" +;
"idgopmult INTEGER UNSIGNED NOT NULL AUTO_INCREMENT," +;
"CTRL FLOAT DEFAULT '0.0' COMMENT 'control lineas'," +;
"LIN INT NOT NULL DEFAULT 0 COMMENT 'control lineas'," +;
"TP1 VARCHAR(4) NULL DEFAULT '' COMMENT 'tp'," +;
"CTA1 VARCHAR(120) NULL DEFAULT '' COMMENT 'cuenta'," +;
"NOMBRE1 VARCHAR(50) NULL DEFAULT '' COMMENT 'cuenta'," +;
"PORC1 NUMERIC(10,2) NULL DEFAULT 0.00 COMMENT 'porcentaje'," +;
"PRIMARY KEY (idgopmult) )"+;
"ENGINE = InnoDB ;")
return .t.
//-----------------------------------------------------
//Estado de resultados definido por el usuario
//-----------------------------------------------------
FUNCTION GopMult()
LOCAL oDlg, oLbx, cOldSele:=Select()
local obt1,obt2,obt3,obt4,obt5,obt6,obt7,oBt8
local oSayTit,cSayTit:="ESTADO DE RESULTADOS DEFINIDO POR EL USUARIO", oFont1
local aColCtrls, aLinCtrls, aObjetos, aLinColCtrls:={}
local nAltoIniDlg:=0
local aGradBarSel:= { { 1, RGB(252,232,171) , RGB(248,195, 34) } }
local aGradRowSel:= {{1, RGB(108,125, 184), RGB(241,222,088)}}
local cAlias,n, oCol
local nId
local oQuery:=oServer:Query("SELECT * FROM gopmult ORDER BY ctrl")
local bPorc:={|nId,nPorc| nId:=oQuery:idgopmult,nPorc:=100,;
oServer:Query("UPDATE gopmult SET porc1 = '0' ORDER BY ctrl"),; //limpiamos porque solo queremos un item con valor
oServer:Query("UPDATE gopmult SET porc1 = '"+cValToChar(nPorc)+"' WHERE idgopmult = '"+cValToChar(nId)+"' ORDER BY ctrl") }
DEFINE FONT oFont1 NAME "Ms sans Serif" SIZE 4,24 BOLD
DEFINE DIALOG oDlg RESOURCE "BROWUTILIT" TITLE "FORMATO DE RESULTADOS"
REDEFINE SAY oSayTit VAR cSayTit ID 400 OF oDlg FONT oFont1
REDEFINE BUTTONBMP obt1 PROMPT "&Ins Linea " ID 101 OF oDlg BITMAP "NUEVO" TEXTRIGHT ACTION InsGopMult(oLbx,oQuery)
oBt1:cToolTip := "Inserta nueva linea debajo de posicion actual"
REDEFINE BUTTONBMP obt2 PROMPT "&Bor Linea " ID 102 OF oDlg BITMAP "BORRAR" TEXTRIGHT ACTION DelGopMult( oLbx,oQuery )
oBt2:cToolTip := "Elimina linea en posicion actual"
REDEFINE BUTTONBMP obt3 PROMPT "&Agreg Cta " ID 103 OF oDlg BITMAP "BUSCAR" TEXTRIGHT ACTION AgregCta(oLbx,oQuery)
oBt3:cToolTip := "Agregar cuenta desde el Catalogo, al registro actual"
REDEFINE BUTTONBMP obt4 PROMPT "&Salir "ID 104 OF oDlg BITMAP "SALIR" TEXTRIGHT ACTION ( oDlg:End() )
XbrNumFormat( 'A', .t. )
oLbx := TXBrowse():New( oDlg )
oLbx:SetMySql(oQuery,.f.)
oLbx:lFastEdit := .t.
oLbx:nMarqueeStyle := MARQSTYLE_HIGHLCELL //ilumina solo la celda actual
oLbx:bClrHeader := {|| { nRGB(140, 0, 0), nRGB( 231, 242, 255 ), } }
oLbx:bClrFooter := oLbx:bClrHeader // Colores texto de footers
oLbx:bClrSel := {|| { nRGB( 0, 0, 0), aGradRowSel } } // para barra de linea selecc cuando el control no tiene el foco
oLbx:bClrSelFocus := { || { CLR_BLACK, aGradBarSel } } // para barra de linea selecc cuando el control tiene el foco
oLbx:lKinetic := .f.
oLbx:lContrastClr := .f. //para que no cambie color de texto automaticamente segun intensidad del fondo
oLbx:nRowHeight := 20 //altura entre lineas
oLbx:nColDividerStyle:=LINESTYLE_LIGHTGRAY
oLbx:nRowDividerStyle:=LINESTYLE_LIGHTGRAY
oLbx:lColChangeNotify := .t. // bChange evalua cambio de columna y permite tomar una accion
oLbx:lCanPaste := .t. //copiar/pegar datos entre columnas
oCol = oLbx:AddCol()
oCol:bEditValue = { || oQuery:idgopmult }
oCol:nDataStrAlign := 1
oCol:nEditType = 0
oCol:cHeader = "Incremental"
oCol:nWidth = 100
oCol = oLbx:AddCol()
oCol:bEditValue = { || oQuery:ctrl }
oCol:cEditPicture = "@ 999"
oCol:nDataStrAlign := 1
oCol:nEditType = 0
oCol:cHeader = "ctrl"
oCol:nWidth = 30
oCol = oLbx:AddCol()
oCol:bEditValue = { || oQuery:lin }
oCol:cEditPicture = "@ 999"
oCol:nDataStrAlign := 1
oCol:nEditType = 0
oCol:cHeader = "Lin"
oCol:nWidth = 30
oCol = oLbx:AddCol()
oCol:bEditValue = { || oQuery:tp1 }
oCol:nDataStrAlign := 3
oCol:nEditType = EDIT_GET
oCol:cHeader = "Tp1"
oCol:nWidth = 35
oCol:bOnPostEdit = { | oCol, xVal, nKey | nId:=oQuery:idgopmult,;
If( nKey == VK_RETURN, oServer:Query("UPDATE gopmult SET tp1 = '"+xVal+"' WHERE idgopmult = '"+cValToChar(nId)+"'") ,) ,oQuery:Refresh() }
oCol = oLbx:AddCol()
oCol:bEditValue = { || oQuery:cta1 }
oCol:nDataStrAlign := 3
oCol:cHeader = "Cta1"
oCol:nEditType = EDIT_GET
oCol:nWidth = 100
oCol:cToolTip:= "Si entra manualmente las cuentas, debe separarlas con comas, y coma al final, sin espacios."
oCol:bOnPostEdit = { | oCol, xVal, nKey | nId:=oQuery:idgopmult,;
If( nKey == VK_RETURN,;
if(!empty(xVal) .and. Right(alltrim(xVal),1) != ",", (MsgStop("Debe introducir la coma al final","Alto"),oLbx:nColSel:=5,oLbx:Refresh()) ,;
oServer:Query("UPDATE gopmult SET cta1 = '"+xVal+"' WHERE idgopmult = '"+cValToChar(nId)+"'") ) ,) ,oQuery:Refresh() }
oCol = oLbx:AddCol()
oCol:bEditValue = { || oQuery:nombre1 }
oCol:nDataStrAlign := 3
oCol:nEditType = EDIT_GET
oCol:cHeader = "nombre1"
oCol:nWidth = 256
oCol:cToolTip:= "Introduzca aqui, la Descripcion de las cuentas."
oCol:bOnPostEdit = { | oCol, xVal, nKey | nId:=oQuery:idgopmult,;
If( nKey == VK_RETURN, oServer:Query("UPDATE gopmult SET nombre1 = '"+xVal+"' WHERE idgopmult = '"+cValToChar(nId)+"'") ,) ,oQuery:Refresh() }
oCol = oLbx:AddCol()
oCol:bEditValue = { || oQuery:Porc1 }
oCol:cEditPicture = "@ZK ###,###.## %"
oCol:nDataStrAlign := 1
oCol:nEditType = EDIT_GET
oCol:cHeader = "Porc1"
oCol:nWidth = 70
oCol:cTooltip:= "Click Derecho o digite en la linea sobre cuyo valor"+CRLF+"se evaluarán los porcentajes"
oCol:bOnPostEdit = { | oCol, xVal, nKey | If( nKey == VK_RETURN, (Eval(bPorc),oLbx:nColSel:=10 , oQuery:Refresh(),oLbx:refresh()) ,) }
oLbx:SetBackGround( ".\stone.bmp")
FOR n := 1 to len(oLbx:aCols)
oLbx:aCols[n]:nHeadStrAlign := AL_CENTER
NEXT
oLbx:CreateFromResource(181)
oLbx:bRClicked:={|nRow,nCol| if(upper(oLbx:SelectedCol:cHeader) <> "PORC1", MenuPopOpc(oLbx,nRow,nCol,oQuery), Eval(bPorc)), oQuery:Refresh(),oLbx:refresh() }
oLbx:bLClicked:={|nRow,nCol| if( UPPER( SUBSTR(oLbx:SelectedCol:cHeader, 1,3) ) = "CTA", oBt3:Enable(), oBt3:Disable() ) }
oLbx:bChange:={|| iif( UPPER( SUBSTR(oLbx:SelectedCol:cHeader, 1,3) ) = "CTA", oBt3:Enable(), oBt3:Disable() ) }
ACTIVATE DIALOG oDlg ;
ON INIT ( nAltoIniDlg:=oDlg:nHeight,;
oDlg:SetSize(oWnd:nWidth(), oWnd:nHeight()), oDlg:Move(0,0),;
oLbx:SetSize(oDlg:nWidth()-22,oDlg:nHeight()-120),;
oLbx:SetFocus() )
oQuery:End()
oFont1:End()
RETURN NIL
//-----------------------------//Extraido de codigo proporcionado por Willi Quintana
Function InsGopMult(oLbx,oQuery)
local cCtrl, cCad, nVal, cNombre
cNombre := ""
cCtrl := ALLTRIM(STR(oQuery:ctrl))
nVal := oQuery:ctrl
oQuery:Skip()
If oQuery:EOF()
nVal := nVal + 1
EndIf
nVal := nVal + oQuery:ctrl
nVal := ( nVal / 2 )
cCtrl := STR(nVal,10, 5)
oServer:Query("INSERT INTO gopmult (ctrl, nombre1) VALUES ('" + cCtrl + "', '" + cNombre + "')")
ReconstLin(oLbx,oQuery) //reconstruye las lineas (LIN)
Return nil
//-----------------------------//Extraido de codigo proporcionado por Willi Quintana
Function ReconstLin(oLbx,oQuery)
oServer:Query("SET @r := 0")
oServer:Query("UPDATE gopmult SET lin := (@r := @r + 1) ORDER BY ctrl")
oQuery:Refresh()
oLbx:Refresh()
Return nil
//-------------------------//Elimina linea
Function DelGopMult( oLbx, oQuery )
local nLin:=oQuery:lin
if MsgNoYes("Esta seguro de borrar este registro?","Elija su opcion" )
oServer:Query("DELETE FROM gopmult WHERE lin = '"+cValtochar(nLin)+"'")
if oServer:lError
MsgInfo(oServer:error + " No se pudo borrar el registro")
endif
ReconstLin(oLbx,oQuery) //reconstruye las lineas (LIN)
endif
return nil
//--------------------------
Function AgregCta(oLbx,oQuery)
local cCodigo:=alltrim(oQuery:cta1), cCodi:="", cNombre:=""
local nLin:=oQuery:lin
local oCata
cCodi:=alltrim(Catalogo(.t.,.t.))
oCata:=oServer:Query("SELECT * FROM catalogo WHERE codicont = '"+cCodi+"' ORDER BY CODICONT")
cNombre:=oCata:Nombre
oCata:End()
if!empty(cCodi)
cCodigo+=cCodi+","
oServer:Query("UPDATE gopmult SET cta1 = '"+cCodigo+"',nombre1 ='"+cNombre+"' WHERE lin = '"+cValToChar(nLin)+"' ORDER BY ctrl LIMIT 1")
if oServer:lError
MsgInfo(oServer:Error)
endif
oQuery:Refresh()
oLbx:Refresh()
endif
Return nil
//--------------------------------
Function MenuPopOpc(oLbx,nRow,nCol,oQuery)
local oMenu
MENU oMenu POPUP 2007
if UPPER( SUBSTR(oLbx:SelectedCol:cHeader, 1,3) ) = "CTA"
MENUITEM "&Agregar Codigo de cuenta desde el catalogo" ;
ACTION AgregCta(oLbx,oQuery)
else
MENUITEM "&Insertar una nueva linea" ACTION ( InsGopMult(oLbx,oQuery) )
MENUITEM "&Eliminar la linea actual" ACTION ( DelGopMult(oLbx,oQuery) )
endif
ENDMENU
ACTIVATE POPUP oMenu OF oLbx AT nRow, nCol
RETURN oMenu
//-----------------------------------
Function Catalogo(lGrabacion,lConfCks,lConfBcoAnex)
local oDlg, oLbx, cCodiC:="",oFont, cOldSele:=Select(), oCatalogo
local nRecno:=0,oCol,n,oBt7
DEFAULT lGrabacion:=.f., lConfCks:=.f.,lConfBcoAnex:=.f.
oCatalogo:= oServer:Query( "SELECT * FROM catalogo ORDER BY codicont" )
DEFINE FONT oFont NAME "ARIAL" SIZE 0,-12 BOLD
DEFINE DIALOG oDlg RESOURCE "CATALOGO" TITLE "Catalogo General de Cuentas"
oLbx := TXBrowse():New( oDlg )
oLbx:SetMySql(oCatalogo,.f.)
//ESTILOS DE LINEAS
oLbx:nMarqueeStyle := MARQSTYLE_HIGHLROW //normal
oLbx:nColDividerStyle := LINESTYLE_DARKGRAY //LINESTYLE_INSET
oLbx:nRowDividerStyle := LINESTYLE_DARKGRAY //LINESTYLE_INSET
oLbx:lColDividerComplete := .t. //completa pintado hasta el footer cuando lineas no llenan todo el browse
oLbx:nStretchCol := STRETCHCOL_LAST //llenar espacio con ultima columna
oLbx:lTransparent := .t.
//COLUMNAS DEL BROWSE
oCol = oLbx:AddCol()
oCol:bEditValue = { || oCatalogo:codicont }
oCol:cHeader = "Codigo Contable"
oCol:nWidth = 164
oCol = oLbx:AddCol()
oCol:bEditValue = { || oCatalogo:Nombre }
oCol:nDataStrAlign := 3
oCol:cHeader = "Nombre de la Cuenta"
oCol:nWidth = 350
FOR N:=1 TO LEN(oLbx:aCols)
oLbx:aCols[n]:nHeadStrAlign := 2 //texto centrado
NEXT
oLbx:CreateFromResource(181)
oLbx:lKinetic := .f.
//este goleft es p/que bar horiz no avance cada vez que oprime enter
oLbx:bKeyDown := {|nTecla| iif( nTecla=13, if( lGrabacion, (cCodic:=oCatalogo:Codicont,oDlg:End()),),) }
oLbx:bLDblClick:={|| if(lGrabacion, (cCodic:=oCatalogo:Codicont,oDlg:End()),) }
REDEFINE BUTTONBMP oBt7 PROMPT "&Salir " ID 107 OF oDlg BITMAP "SALIR16X16" TEXTRIGHT ACTION (cCodic:="",oDlg:End()) CANCEL
ACTIVATE DIALOG oDlg CENTERED
oFont:End()
oCatalogo:End()
return cCodiC