FiveTech Software tech support forums

www.FiveTechSoft.com
https://forums.fivetechsupport.com/

AYUDA URGENTE CON COMBOBOX

https://forums.fivetechsupport.com/viewtopic.php?f=6&t=36350

Page 2 of 2

Re: AYUDA URGENTE CON COMBOBOX

PostPosted: Fri Nov 16, 2018 7:38 pm
by karinha
Compila bién e el botón de salir funciona sin problemas, solo no puedo muestrar los bitmaps, pués no pasa en la compilación.

Mira donde hice comentários con /* */ creo el erro esté en uno de elos.

Image

Saludos.

Re: AYUDA URGENTE CON COMBOBOX

PostPosted: Fri Nov 16, 2018 7:38 pm
by karinha
Code: Select all  Expand view

#include "FiveWin.ch"
#include "xbrowse.ch"

STATIC oWnd

FUNCTION Consu_paci()

   LOCAL oFont1, oFont, oSay1, oFont2, oSay
   LOCAL oDlg1, oSay2
   PUBLIC Fecha_hoy, total_pac := 0
   PRIVATE oCod_pro1, cCod_pro1 := "", nCod_pro1
   PUBLIC aProfe := {}, aPacientes := {}, oPaci

   /*
   SELE 1
   USE Profesio Shared
   Dbgotop()
   IF Eof()
      MsgStop( " NO Existen Profesionales Medicos " )
      dbclosearea()
      RETURN
   ENDIF
   AADD( aProfe, { "", "" } )
   DO WHILE !Eof()
      IF Est_pro = "S" .AND. Tip_esp = "MEDI"
         AADD( aProfe, { a->Cod_pro, a->Nom_pro } )
      ENDIF
      a->( DbSkip() )
   ENDDO
   DbClosearea()
   ASORT( aProfe, , , { |x, y| x[2] < y[2] } )
   */

   Fecha_hoy := date()
   nCod_pro1 = 0

   Define Font oFont1 Name "Curier New" Size 0, 16  BOLD
   Define Font oFont  Name "Courier new" Size 0, 22   BOLD
   Define Font oFont2  Name "Courier new" Size 0, 20  BOLD


   DEFINE DIALOG oDlg1 RESOURCE "#1004"
   REDEFINE SAY oSay  ID 100 PROMPT "PACIENTES EN ATENCION DIA " + dtoc( Date() ) OF oDlg1 FONT oFont  COLORS RGB( 12, 135, 27 )

   REDEFINE SAY oSay1 ID 101 PROMPT "DOCTOR" OF oDlg1 FONT oFont  COLOR RGB( 38, 74, 119 )
   REDEFINE SAY oSay2 ID 120 PROMPT "TOTAL PACIENTES: " + str( total_pac, 3 ) OF oDlg1 FONT oFont2  COLOR rgb( 39, 0, 64 )

   /*
   REDEFINE COMBOBOX oCod_pro1 VAR nCod_pro1 ITEMS ArrTranspose( aProfe )[ 2 ] ID 102 OF oDlg1 COLORS nRGB( 9, 11, 10 ), nRGB( 73, 250, 202 );
      ON CHANGE ( cCod_pro1 := ArrTranspose( aProfe )[ 1 ][oCod_pro1:nAt], Carga_paci( cCod_pro1 ), oPaci:Refresh(), oSay2:Refresh() )
   */

   /*
   REDEFINE XBROWSE oPaci ID 104 OF oDlg1 ;
      COLUMNS 1, 2, 3, 4, 5, 6, 7;
      HEADERS "Nro. ", "Nombre del Paciente" , "Folio Caja", "T. Pago", "Valor ", "Digita", "Hr. Digi";
      COLSIZES 40, 350, 80, 80, 70, 80, 80 ;
      FONT oFont1;
      ARRAY aPacientes ;
      FOOTERS LINES CELL

   oPaci:bClrStd             := {|| { nRGB(  0,  0,  0 ), nRGB( 255,248,220 ) } }
   oPaci:bClrSelFocus        := {|| { nRGB(  0,  0,  0 ), nRGB( 137, 247, 33 ) } }
   oPaci:bClrHeader       := {|| { CLR_BLUE, nRGB( 245, 245, 245 ) } }
   oPaci:bClrSel := {|| { nRGB( 000,000,000 ), nRGB( 128,255,128 ) } }
   oPaci:bClrSelFocus := {|| { nRGB( 0, 0, 0 ), nRGB( 128,255,128 ) } }
   oPaci:bClrStd := {|| { nRGB( 000,000,000 ), nRGB( 255,255,200 ) } }
   oPaci:nStretchCol := STRETCHCOL_WIDEST

   oCol := oPaci:AddCol()
   oCol:AddResource( "#8006" )
   oCol:AddResource( "#8007" )
   oCol:cHeader = "Estado"
   oCol:bBmpData   :=  { || if( aPacientes[oPaci:nArrayAt,8] == "S", 1, 2 ) }
   */


   REDEFINE BTNBMP ID 103 Resource "#8005" OF oDlg1 ;  //         <--------- Boton Para actualiza Array desde la Dbf Actualizada
   ACTION ( Carga_paci( cCod_pro1 ) )


   REDEFINE BTNBMP ID 105 Resource "#8004" OF oDlg1 ;  //        <--------- Boton salir del programa y volver al menu
   ACTION ( Cierra(), oDlg1:END() )

   ACTIVATE DIALOG oDlg1 CENTERED

   RETURN  Nil

STATIC FUNCTION  Carga_paci( cCod_pro1 )

   asize( aPacientes, 0 )

   IF Len( cCod_pro1 ) = 0
      MsgStop( "No ha Seleccionado Profesional Medico" )
      RETURN .F.
   ENDIF

   carchi := 'PACI' + trim( cCod_pro1 )
   IF !file( '&carchi..dbf' )
      MsgStop( "MEDICO SELECCIONADO NO TIENE INGRESOS DE PACIENTES" )
      RETURN .F.
   ENDIF
   SELE 2
   Use &carchi Shared
   IF !file( '&carchi..ntx' )
      INDE ON Cod_pro + dtos( ctod( fec_ate ) ) + Str( Cor_pac, 4 ) to &carchi
   ENDIF
   SET INDE to &carchi
//seek cCod_pro1+dtos(date())
   DbGotop()
   IF eof()
      MsgStop( "MEDICO SELECCIONADO NO TIENE PACIENTES EN ESPERA" )
      DbClosearea()
      RETURN .F.
   ENDIF


   STOR 0 TO total_pac
   DO WHILE !Eof()
      // If (ctod(fec_ate)=Fecha_hoy)
      AADD( aPacientes, { b->Cor_pac, b->Nom_pac, b->Fol_caj, b->Tip_pag, b->Val_bon, b->Cod_dig, b->Hor_dig, b->Con_pac } )
      total_pac = total_pac + 1
      // Endif
      DbSkip()
   ENDDO
   DbClosearea()
   oPaci:SetArray( aPacientes )
   oPaci:GoTop()
   oPaci:Refresh()

   RETURN  oPaci

STATIC FUNCTION Cierra()

   SET RELATION TO
   CLOS DATA

   sysrefresh()

   RETURN nil
 

Re: AYUDA URGENTE CON COMBOBOX

PostPosted: Fri Nov 16, 2018 7:42 pm
by Carlos Mora
Antonio,
te importaria indicar que dice la linea 1667 de la clese tget en el codigo fuente de tu copia de fivewin? \fivewin\source\classes\tget.prg Linea 1667. Si puedes copia el metodo lostfocus completo y marca cual es la linea 1667
Alogo esta fallando al cerrar la ventana, el control que tiene el foco debe tener algun problema cuando lo pierde. Puede que sea un valid o algo, ver esa linea del TGet nos puede dar una pista

Re: AYUDA URGENTE CON COMBOBOX

PostPosted: Fri Nov 16, 2018 7:54 pm
by remtec
Hola Carlos Mora.

Este el metodo que me pides.

Saludos
Code: Select all  Expand view

//---------------------------------------------------------------------------//
METHOD LostFocus( hCtlFocus ) CLASS TGet

   ::Super:LostFocus( hCtlFocus )

#ifdef UTFREVN
   if ::lWideChar
      ::Assign()
   else
      if ! ::lPassword
         if ::oGet:buffer != GetWindowText( ::hWnd )  // right click popup action       LINEA 1667
            ::oGet:buffer  = GetWindowText( ::hWnd )
            ::oGet:Assign()
         endif
      endif
   endif
#else
   if ! ::lPassword
      if ::oGet:buffer != GetWindowText( ::hWnd )  // right click popup action
         ::oGet:buffer  = GetWindowText( ::hWnd )
         ::oGet:Assign()
      endif
   endif
#endif

   if ! Empty( ::cPicture ) .and. ::oGet:Type == "N"
      ::oGet:Assign()
      ::oGet:Picture := ::cPicture
      ::oGet:UpdateBuffer()
      ::oGet:KillFocus()
   endif

   ::oGet:SetFocus()   // to avoid oGet:buffer be nil

   if ! ::oGet:BadDate .and. ! ::lReadOnly .and. ;
      ( ::oGet:changed .or. ::oGet:unTransform() <> ::oGet:original )
      ::oGet:Assign()     // for adjust numbers
      // ::oGet:UpdateBuffer()
   endif

   if ::bColor == nil
      if ::lClrFocus
         if ::nOldClrPane != nil
            ::SetColor( ::nClrText, ::nOldClrPane )
         endif
      endif
   else
      tmp      := Eval( ::bColor, Self )
      ::SetColor( tmp[ 1 ], tmp[ 2 ] )
   endif

   if ::oGet:Type == "D"
      ::oGet:KillFocus()
      ::oGet:SetFocus()
   endif
   ::DispText()

   if ! ::oGet:BadDate
      ::oGet:KillFocus()
   else
      ::oGet:Pos = 1
      ::nPos = 1
   endif

   if ! Empty( ::oBtn )
      ::oBtn:lCancel := .F.
   endif

return nil



 

Re: AYUDA URGENTE CON COMBOBOX

PostPosted: Fri Nov 16, 2018 8:03 pm
by remtec
Hola Karinha

Mira te dejo este codigo para llenar el array del COMBOBOX, al seleccionar un profesional ira a Carga_paci(cCod_pro1), donde no existira el archivo del profesional y volvera al Combobox, despues das el boton Salir.

En mi caso, anule los botones con recursos y lo hice con boton normal y arroja el mismo error al no encontrar datos o la dbf para el profesional seleccionado.


Codigo:
Code: Select all  Expand view

     AADD( aProfe,{ "",""})
 */
  //   Do While !Eof()
   //         If Est_pro="S".and.Tip_esp="MEDI"
   //          AADD( aProfe,{ a->Cod_pro,a->Nom_pro})
   //         Endif
   //     a->(DbSkip())
   //  Enddo
  //   DbClosearea()
*/

        aProfe:= {{"BUST","ARTURO BUSTIOS"},{"AREL","ARNALDO ARELLANO"},{"OLMO","JORGE OLMO"}}

     // Ordenar Arreglo por Nombre
     ASORT( aProfe,,, { |x,y| x[2] < y[2] } )


 
]

Re: AYUDA URGENTE CON COMBOBOX

PostPosted: Sat Nov 17, 2018 11:33 pm
by remtec
Amigos

La tengo dificil, le he dado muchas vueltas y no logro solucionar el problema.

En la Function Carga_paci(cCod_pro1), tengo varias validaciones al no cumplirlas, emito un mensaje de aviso como el siguiente:

Code: Select all  Expand view

             If eof()
                MsgStop("MEDICO SELECCIONADO NO TIENE PACIENTES EN ESPERA")
                   
                Return .f.
             Endif
 


En cada caso, se produce el error al dar boton Salir.

Pero si no emito el mensaje de aviso, no se produce el Error, por lo que solo se produce al usar cualquier forma de aviso.

Saludos
Antonio

Re: AYUDA URGENTE CON COMBOBOX

PostPosted: Mon Nov 19, 2018 3:55 pm
by remtec
Amigos.

Estoy complicado, algun Amigo que se le ocurra alguna idea por donde corregir el error.

Saludos.
Antonio

Re: AYUDA URGENTE CON COMBOBOX

PostPosted: Wed Nov 21, 2018 11:19 am
by cmsoft
Code: Select all  Expand view

#include "FiveWin.ch"
#include "xbrowse.ch"

static oWnd

Function Consu_paci()
     Local oFont1,oFont,oSay1,oFont2,oSay
     Local oDlg1,oSay2
     Public Fecha_hoy,total_pac:=0
     Private oCod_pro1,cCod_pro1:="",nCod_pro1
     Public aProfe:= {},aPacientes:={},oPaci
     Sele 1
     Use Profesio Shared
     Dbgotop()
     If Eof()
          MsgStop(" NO Existen Profesionales Medicos ")
            dbclosearea()
            Return
     Endif
     AADD( aProfe,{ "",""})
     Do While !Eof()
            If Est_pro="S".and.Tip_esp="MEDI"
             AADD( aProfe,{ a->Cod_pro,a->Nom_pro})
            Endif
        a->(DbSkip())
     Enddo
     DbClosearea()
     ASORT( aProfe,,, { |x,y| x[2] < y[2] } )

     Fecha_hoy:=date()
     nCod_pro1=0

     Define Font oFont1 Name "Curier New" Size 0,16  BOLD
     Define Font oFont  Name "Courier new" Size 0,22   BOLD
     Define Font oFont2  Name "Courier new" Size 0,20  BOLD


   DEFINE DIALOG oDlg1 RESOURCE "#1004"
     REDEFINE SAY oSay  ID 100 PROMPT "PACIENTES EN ATENCION DIA "+dtoc(Date()) OF oDlg1 FONT oFont  COLORS RGB(12, 135, 27)

     REDEFINE SAY oSay1 ID 101 PROMPT "DOCTOR" OF oDlg1 FONT oFont  COLOR RGB(38, 74, 119)
     REDEFINE SAY oSay2 ID 120 PROMPT "TOTAL PACIENTES: "+str(total_pac,3) OF oDlg1 FONT oFont2  COLOR rgb(39, 0, 64)

     REDEFINE COMBOBOX oCod_pro1 VAR nCod_pro1 ITEMS ArrTranspose( aProfe )[ 2 ] ID 102 OF oDlg1 COLORS nRGB(9, 11, 10), nRGB(73, 250, 202);
                    ON CHANGE (Carga_paci(oCod_pro1,aProfe),oPaci:Refresh(),oSay2:Refresh())   //<--- Cambiar aca

     REDEFINE XBROWSE oPaci ID 104 OF oDlg1 ;
          COLUMNS 1,2,3,4,5,6,7;
            HEADERS "Nro. ","Nombre del Paciente" ,"Folio Caja","T. Pago","Valor ","Digita","Hr. Digi";
            COLSIZES 40, 350, 80, 80,70,80,80 ;
                FONT oFont1;
                ARRAY aPacientes ;
                FOOTERS LINES CELL

                oPaci:bClrStd             := {|| { nRGB(  0,  0,  0), nRGB(255,248,220) } }
                oPaci:bClrSelFocus        := {|| { nRGB(  0,  0,  0), nRGB(137, 247, 33) } }
                oPaci:bClrHeader       := {|| { CLR_BLUE, nRGB( 245, 245, 245 ) } }
                oPaci:bClrSel := {|| { nRGB(000,000,000), nRGB(128,255,128) } }
                oPaci:bClrSelFocus := {|| { nRGB( 0, 0, 0), nRGB(128,255,128) } }
                oPaci:bClrStd := {|| { nRGB(000,000,000), nRGB(255,255,200) } }
                oPaci:nStretchCol := STRETCHCOL_WIDEST

            oCol := oPaci:AddCol()
            oCol:AddResource("#8006")
            oCol:AddResource("#8007")
                oCol:cHeader = "Estado"
                oCol:bBmpData   :=  { || if(aPacientes[oPaci:nArrayAt,8]=="S",1,2)}




     REDEFINE BTNBMP ID 103 Resource "#8005" OF oDlg1 ;             <--------- Boton Para actualiza Array desde la Dbf Actualizada
            ACTION (Carga_paci(cCod_pro1))


     REDEFINE BTNBMP ID 105 Resource "#8004" OF oDlg1 ;            <--------- Boton salir del programa y volver al menu
            ACTION (Cierra(),oDlg1:END())

   ACTIVATE DIALOG oDlg1 CENTERED

Return  Nil


Static Function  Carga_paci(oCod_pro1,aProfe)  // <--- Cambiar aca
LOCAL cCod_Pro1 := aProfe [1,oCod_pro1:nAt]  // <--- Cambiar aca
             asize( aPacientes, 0 )

             If Len(cCod_pro1)=0
                MsgStop("No ha Seleccionado Profesional Medico")
                    Return .f.
             Endif

             carchi:='PACI'+trim(cCod_pro1)
             If !file('&carchi..dbf')
                MsgStop("MEDICO SELECCIONADO NO TIENE INGRESOS DE PACIENTES")
                    Return .f.
             Endif
             Sele 2
             Use &carchi Shared
             If !file('&carchi..ntx')
                    Inde on Cod_pro+dtos(ctod(fec_ate))+Str(Cor_pac,4) to &carchi
             Endif
             Set Inde to &carchi
             //seek cCod_pro1+dtos(date())
             DbGotop()
             If eof()
                MsgStop("MEDICO SELECCIONADO NO TIENE PACIENTES EN ESPERA")
                    DbClosearea()
                Return .f.
             Endif


             Stor 0 to total_pac
             Do While !Eof()
                 // If (ctod(fec_ate)=Fecha_hoy)
                         AADD( aPacientes,{ b->Cor_pac,b->Nom_pac,b->Fol_caj,b->Tip_pag,b->Val_bon,b->Cod_dig,b->Hor_dig,b->Con_pac})
                         total_pac=total_pac+1
                 // Endif
                    DbSkip()
             Enddo
             DbClosearea()
             oPaci:SetArray( aPacientes )
         oPaci:GoTop()
         oPaci:Refresh()
             Return  oPaci

Static FUNCTION Cierra()
    Set relation to
    Clos data
  sysrefresh()
return nil

 

Fijate si persiste el error

Re: AYUDA URGENTE CON COMBOBOX

PostPosted: Wed Nov 21, 2018 2:58 pm
by remtec
Hola Cesar.

Hice la prueba, pero tengo el problema que los datos no llegan a la Function "CARGA_PACI():

REDEFINE COMBOBOX oCod_pro1 VAR nCod_pro1 ITEMS ArrTranspose( aProfe )[ 2 ] ID 102 OF oDlg COLORS nRGB(9, 11, 10), nRGB(73, 250, 202);
ON CHANGE (Carga_paci(oCod_pro1,aProfe),oPaci:Refresh(),oSay2:Refresh()) //<--- Cambiar aca



Static Function Carga_paci(oCod_pro1,aProfe) // <--- Cambiar aca
LOCAL cCod_Pro1 := aProfe [1,oCod_pro1:nAt] // <--- Cambiar aca <------ Linea 89

?cCod_pro1 <------- cCod_pro1 no tiene dato.

Saludos.

Antonio

Detallle de Error:
Code: Select all  Expand view

  Time from start: 0 hours 0 mins 8 secs
   Error occurred at: 21/11/2018, 11:48:05
   Error description: Error BASE/1132  Bound error: array access
   Args:
     [   1] = A   { ... } length: 2
     [   2] = N   3

Stack Calls
===========
   Called from: .\Consulta.PRG => CARGA_PACI( 89 )
   Called from: .\Consulta.PRG => (b)CONSU_PACI( 47 )
   Called from: .\source\classes\COMBOBOX.PRG => TCOMBOBOX:CHANGE( 482 )
   Called from: .\source\classes\CONTROL.PRG => TCONTROL:HANDLEEVENT( 1702 )
   Called from: .\source\classes\COMBOBOX.PRG => TCOMBOBOX:HANDLEEVENT( 820 )
   Called from: .\source\classes\WINDOW.PRG => _FWH( 3544 )
   Called from:  => SENDMESSAGE( 0 )
   Called from: .\source\classes\DIALOG.PRG => TDIALOG:COMMAND( 427 )
   Called from:  => TWINDOW:HANDLEEVENT( 0 )
   Called from: .\source\classes\DIALOG.PRG => TDIALOG:HANDLEEVENT( 916 )
   Called from:  => DIALOGBOX( 0 )
   Called from: .\source\classes\DIALOG.PRG => TDIALOG:ACTIVATE( 289 )
   Called from: .\Consulta.PRG => CONSU_PACI( 83 )
   Called from: .\MenuCon.PRG => (b)MAIN( 46 )
   Called from: .\source\classes\BTNBMP.PRG => TBTNBMP:CLICK( 638 )
   Called from: .\source\classes\BTNBMP.PRG => TBTNBMP:LBUTTONUP( 872 )
   Called from: .\source\classes\CONTROL.PRG => TCONTROL:HANDLEEVENT( 1723 )
   Called from: .\source\classes\BTNBMP.PRG => TBTNBMP:HANDLEEVENT( 1705 )
   Called from: .\source\classes\WINDOW.PRG => _FWH( 3544 )
   Called from:  => WINRUN( 0 )
   Called from: .\source\classes\WINDOW.PRG => TWINDOW:ACTIVATE( 1062 )
   Called from: .\MenuCon.PRG => MAIN( 58 )


 

Re: AYUDA URGENTE CON COMBOBOX

PostPosted: Wed Nov 21, 2018 3:55 pm
by remtec
Hola Cesar

Extraño por decir lo menos.

Agregue Arrtranspose y obtengo el cCod_pro1, pero al emitir el MsgStop se cae.

Creo que si esto tiene esta limitacion a estas alturas, nada que hacer.

Simplemente no entiendo nada.

Saludos
Antonio.


Code: Select all  Expand view

Static Function  Carga_paci(oCod_pro1,aProfe)  // <--- Cambiar aca
LOCAL cCod_Pro1 := ArrTranspose( aProfe )[ 1 ][oCod_pro1:nAt]  // <--- Cambiar aca
             ?cCod_pro1
             aPacentes := {}
             asize( aPacientes, 0 )


             carchi:='PACI'+trim(cCod_pro1)
             If !file('&carchi..dbf')
                MsgStop("MEDICO SELECCIONADO NO TIENE INGRESOS DE PACIENTES")   <====  Aqui se cae el prog.
                Return  nil
             Endif

 
All times are UTC
Page 2 of 2
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/