Inspector de Objetos

Post Reply
User avatar
jnavas
Posts: 399
Joined: Wed Nov 16, 2005 12:03 pm
Location: Caracas - Venezuela
Contact:

Inspector de Objetos

Post by jnavas »

[img]
http://adaptaproyectoserp.com.ve/imagen ... etouch.PNG
[/img]

Code: Select all

#include "FiveTouch.ch"

#include "FiveTouch.ch"

#xcommand DEFAULT <uVar1> := <uVal1> ;
[, <uVarN> := <uValN> ] => ;
<uVar1> := If( <uVar1> == nil, <uVal1>, <uVar1> ) ;;
[ <uVarN> := If( <uVarN> == nil, <uValN>, <uVarN> ); ]


function Main()
LOCAL oBtnCancelJ
LOCAL aBtnText:={"Incluir","Inspector","Modificar","Eliminar","Salir"}
LOCAL aBtn :=ARRAY(LEN(aBtnText))

PRIVATE oDlgBrw,oBrw

SET DELETE ON

FT_CREATE_TABLES()

USE ("FT_USER.DBF") 
GO TOP

IF RECCOUNT()=0
FT_EDITUSER(NIL)
ENDIF

DEFINE DIALOG oDlgBrw TITLE "Usuarios" ;
SIZE 460, 600   

@ 30, 0 BROWSE oBrw OF oDlgBrw ;
SIZE 458, 600 ;
HEADERS "Id", "Nombre","Fecha","Activo" ;
FIELDS FIELD->USR_ID, FIELD->USR_NAME, FIELD->USR_DATE,FIELD->USR_ACTIVE

@ 0, BCOL(1) BUTTON aBtn[1] PROMPT aBtnText[1] OF oDlgBrw ;
ACTION FT_EDITUSER(NIL)

@ 0, BCOL(2) BUTTON aBtn[2] PROMPT aBtnText[2] OF oDlgBrw ;
ACTION FT_INSPECT(oBrw)

@ 0, BCOL(3) BUTTON aBtn[3] PROMPT aBtnText[3] OF oDlgBrw ;
ACTION FT_EDITUSER(FIELD->USR_ID,3)

@ 0, BCOL(4) BUTTON aBtn[4] PROMPT aBtnText[4] OF oDlgBrw ;
ACTION FT_EDITUSER(FIELD->USR_ID,4)

@ 0, BCOL(5) BUTTON aBtn[5] PROMPT aBtnText[5] OF oDlgBrw ;
ACTION oDlgBrw:End()

ACTIVATE DIALOG oDlgBrw CENTERED 

//FT_EDITUSER()
CLOSE ALL

RETURN NIL

FUNCTION BCOL(nCol)
RETURN 81*(nCol-1)+10   



FUNCTION FT_EDITUSER(cId_User)
LOCAL oDlg,I,oBtnOk,oBtnCancel
LOCAL oSay:=ARRAY(3)

PRIVATE oId,oName,oDate,oActive
PRIVATE cId:=SPACE(03),cName:=SPACE(100),dDate:="00/00/0000",lActive:=.T.
PRIVATE aSay :={"ID" ,"Nombre","Fecha"}
PRIVATE aVars:={"cId","cName" ,"dDate"}

IF !Empty(cId_User)
MsgAlert(cId_User)
GO TOP
LOCATE FOR FIELD->USR_ID=cId_User
cId :=FIELD->USR_ID
cName :=FIELD->USR_NAME
dDate :=CTOD(FIELD->USR_DATE)
lActive:=FIELD->USR_ACTIVE
ENDIF

DEFINE DIALOG oDlg TITLE "Crear Usuario <AdaptaPro>" ;
SIZE 300, 200   

FOR I =1 TO LEN(aSay)
@ CROW(I),10 SAY oSay[I] PROMPT aSay[I] OF oDlg 
NEXT I

@ CROW(1),060 GET oId VAR cId OF oDlg
@ CROW(2),060 GET oName VAR cName OF oDlg 
@ CROW(3),060 GET oDate VAR dDate OF oDlg
@ CROW(1),160 CHECKBOX oChk VAR lActive OF oDlg ;
PROMPT "Active"

@ CROW(5), 110 BUTTON oBtnOk PROMPT "Ok" OF oDlg ;
ACTION FT_SAVEUSR(oDlg)

@ CROW(5),200 BUTTON oBtnCancel PROMPT "Cancel" OF oDlg ;
ACTION oDlg:End()

ACTIVATE DIALOG oDlg CENTERED

return nil 

FUNCTION CROW(nRow)
RETURN 30*(nRow-1)+20   

/*
// Guardar Registro
*/
FUNCTION FT_SAVEUSR(oDlg)
LOCAL cMsg:="",i,uValue

FOR I=1 TO LEN(aVars)
if Empty(&(aVars[I]))
cMsg:=cMsg+IF(Empty(cMsg),"",CRLF)+aSay[I]
ENDIF
NEXT I

IF !Empty(cMsg)
MsgInfo(cMsg,"Falta campo(s)")
RETURN .F.
ENDIF

// USE ("FT_USER.DBF") 
GO TOP

LOCATE FOR FIELD->USR_ID=cId

IF !FOUND()
APPEND BLANK
ENDIF

REPLACE FIELD->USR_ID WITH cId,;
FIELD->USR_NAME WITH cName,;
FIELD->USR_DATE WITH CTOD(dDate),;
FIELD->USR_ACTIVE WITH lActive

COMMIT
// USE

IF !MsgYesNo("Desea Agregar Otro Usuario")
oDlg:End()
ENDIF

FOR I=1 TO LEN(aVars)
if Empty(&(aVars[I]))
cMsg:=cMsg+IF(Empty(cMsg),"",CRLF)+aSay[I]
ENDIF
NEXT I

// Las variables debe ser vaciadas
FOR I=1 TO LEN(aVars)
uValue:=CTOEMPTY(&(aVars[I]))
STORE uValue TO &(aVars[I])
NEXT I

// oId:Refresh(.T.) No refresca

RETURN NIL  


FUNCTION FT_CREATE_TABLES()
LOCAL I
LOCAL aTables:={}
LOCAL aStruct:={}
LOCAL aIndex :={}

AADD(aStruct,{"USR_ID", "C",003,0})
AADD(aStruct,{"USR_NAME", "C",120,0})
AADD(aStruct,{"USR_DATE" , "D",008,0})
AADD(aStruct,{"USR_ACTIVE","L",001,0})

AADD(aTables,{"FT_USER.DBF",aStruct,aIndex})

FOR I=1 TO LEN(aTables)

IF !FILE(aTables[I,1])
dbcreate(aTables[I,1],aTables[I,2])
ENDIF
NEXT I

RETURN NIL

/*
// Devuelve Vacio
*/
FUNCTION CTOEMPTY(uValue,cType,nLen)

DEFAULT cType:=ValType(uValue)

IF cType="C" .AND. EMPTY(nLen) .AND. ValType(uValue)="C"
nLen:=LEN(uValue)
ENDIF

DO CASE
CASE ValType(uValue)="U".AND.cType$"CM"
uValue:=SPACE(nLen)
CASE ValType(uValue)="U".AND.cType="N"
uValue:=0.00
CASE ValType(uValue)="U".AND.cType="D"
uValue:=CTOD("")
CASE ValType(uValue)="U".AND.cType="L"
uValue:=.F.
CASE ValType(uValue)="C"
uValue:=SPACE(nLen) 
CASE ValType(uValue)="N"
uValue:=0
CASE ValType(uValue)="D"
uValue:=CTOD("")
CASE ValType(uValue)="L"
uValue:=.F.
ENDCASE
RETURN uValue

FUNCTION MsgAlert(cMsg1,cMsg2)
return MsgInfo(cMsg1,cMsg2) 

FUNCTION FT_INSPECT(oObj)

LOCAL aMetodos:=__objGetMethodList( oObj ) // Lectura de Metodos

ViewArray(aMetodos,2,oObj)

RETURN NIL

function VIEWARRAY(aData,nCol,oObj)

local oDlg := QDialog()
local oLayout := QVBoxLayout()
local oBrw := QTableView( oDlg )
local oModel := QStandardItemModel( LEN(aData), nCol, oDlg )

oModel:SetHorizontalHeaderItem( 0, QStandardItem( "Header1" ) )
oModel:SetHorizontalHeaderItem( 1, QStandardItem( "Header2" ) )

FOR I=1 TO LEN(aData)
oModel:SetItem( I-1, 0, QStandardItem( aData[I] ) )
oModel:SetItem( I-1, 1, QStandardItem( STR(I) ) )
NEXT I

oDlg:SetLayout( oLayout )
oBrw:SetModel( oModel )
oLayout:AddWidget( oBrw )

oDlg:SetWindowTitle( "Inspector, Clase "+oObj:ClassName() )
oDlg:Resize( 500, 400 ) 
oDlg:Center()
oDlg:Exec()

return nil

 
User avatar
jnavas
Posts: 399
Joined: Wed Nov 16, 2005 12:03 pm
Location: Caracas - Venezuela
Contact:

Re: Inspector de Objetos

Post by jnavas »

Antonio,
Buen día.
Es posible agregar en el binario las funciones OSEND, AODATA, asi lograr leer la classdata del objeto y conocer sus propiedades, en el caso del Browse, necesito saber la posicion focalizada y el valor de cada casilla, asi poder avanzar con mi aplicación.
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: Inspector de Objetos

Post by Antonio Linares »

Juan,

Voy a revisar lo que has publicado y te comento, gracias! :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
jnavas
Posts: 399
Joined: Wed Nov 16, 2005 12:03 pm
Location: Caracas - Venezuela
Contact:

Re: Inspector de Objetos

Post by jnavas »

Antonio
Excelente, esperaré, en harbour e utilizado una similar a OSEND()
Post Reply