FiveTech Support Forums

FiveWin / Harbour / xBase community
Board index FiveWin para Harbour/xHarbour TWBrowse17 y xharbour 1.2.1 y FWH9.09
Posts: 299
Joined: Mon Oct 22, 2007 03:03 PM
Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09
Posted: Mon Sep 28, 2009 01:25 PM
Para mi compatriota Daniel.

Te envié a tu correo mi versión de twbrowse, Tiene habilitado los mensajes al editar una línea, espero que guste con el fín de unificar la clase
Code (fw): Select all Collapse
   METHOD lEditCol( nCol, uVar, cPicture, bValid, nClrFore, nClrBack,;
                    aItems, bAction, bOnInit, bOnCreate,cMessage,bButAction, lNextControl  )
.
.
.
.
//----------------------------------------------------------------------------//
METHOD lEditCol( nCol, uVar, cPicture, bValid, nClrFore, nClrBack,;
                 aItems, bAction, bOnInit, bOnCreate,cMessage,cButAction, lNextControl ) CLASS TWBrowse

   local oDlg, oGet, oFont, oBtn, oBtnAction
   local nWidth := ::aColSizes[ nCol ]
   local uTemp
   local aDim
   local lOk
   local cType
   LOCAL uJustify, lValid:= .f.
   LOCAL bInit
   local nDif

   local lButAction :=.f.,bButAction      // angel blanco

   LOCAL nColorCol, oLbx:= Self, bValid2  // CeSoTech
   LOCAL bOldValid

   DEFAULT nCol := ::nColAct,;
           bAction:= {|| .T. },;
           bOnInit:= {|| .T. },;
           cMessage  :=""        ,;
           bButaction:={|| nil}  ,;
           lNextControl:= .T.    // fjhg para brincar al siguiente control cuando es registro nuevo

   IF PCOUNT()>=12                                     // ESTO ES PARTICULAR ANGEL
     lButAction:=.t.                                   // ESTO ES PARTICULAR ANGEL
     bButAction:={|| CONSULTA(oGet, cButaction ,oDlg)} // ESTO ES PARTICULAR ANGEL
   ENDIF                                               // ESTO ES PARTICULAR ANGEL

   If nClrFore == Nil
      If "B"$Valtype( ::bTextColor ) .and. ;
         "N"$Valtype( nColorCol:= Eval( ::bTextColor, ::nRowPos, nCol ) )
         nClrFore:= nColorCol
      Else
         nClrFore := ::nClrText
      EndIf
   EndIf

   If nClrBack == Nil
      If "B"$Valtype( ::bBkColor ) .and. ;
         "N"$Valtype( nColorCol:= Eval( ::bBkColor, ::nRowPos, nCol ) )
         nClrBack:= nColorCol
      Else
         nClrBack := ::nClrPane
      EndIf
   EndIf

   // CeSoTech // -> Si son bloques de codigo habia RTError
   If "B"$ValType( nClrFore )
      nClrFore:= Eval( nClrFore )
   EndIf
   If "B"$ValType( nClrBack )
      nClrBack:= Eval( nClrBack )
   EndIf


   uTemp  := uVar

   aDim   := ::aBrwPosRect( nCol )


   lOk    := .f.
   cType  := ValType( uVar )

   IF ::lCellStyle .and. nCol != ::nColAct
        ::nColAct := nCol
         if ::oHScroll != nil
            ::oHScroll:SetPos(nCol)
         endif
        ::Refresh(.F.)
   ENDIF

   DEFINE DIALOG oDlg FROM 0,0 TO 0,0 ;
                 STYLE nOR( WS_VISIBLE, WS_POPUP, 4 ) PIXEL ;
                 COLOR nClrFore, nClrBack of ::oWnd

   if ::oFont != nil
      oFont := ::oFont   //  fjhg
*      oFont = TFont():New( ::oFont:cFaceName, ::oFont:nWidth,;
*                           ::oFont:nHeight, .f., ::oFont:lBold )
   endif


   do case
      case cType == "L"
           DEFAULT aItems := { ".T.", ".F." }
           uVar = If( uTemp, aItems[ 1 ], aItems[ 2 ] )
           @  0, 0 COMBOBOX oGet VAR uVar ITEMS aItems ;
              MESSAGE cMessage;
              SIZE ( aDim[ 4 ] - aDim[ 2 ] ) * 0.50, 50 OF oDlg ;
              ON CHANGE ( if(lNextControl,oDlg:End(),), lOk := .t. ) ;   //  fjhg
              FONT oFont COLOR nClrFore, nClrBack STYLE CBS_DROPDOWNLIST    // fjhg
*              ON CHANGE ( oDlg:End(), lOk := .t. ) ;   /// linea original

      case aItems != nil
           @  0, 0 COMBOBOX oGet VAR uVar ITEMS aItems ;
              MESSAGE cMessage;
              SIZE ( aDim[ 4 ] - aDim[ 2 ] ) * 0.50, 50 OF oDlg ;
              ON CHANGE ( if(lNextControl,oDlg:End(),), lOk := .t. ) ;   //  fjhg
              FONT oFont COLOR nClrFore, nClrBack STYLE CBS_DROPDOWNLIST   // fjhg
*              ON CHANGE ( oDlg:End(), lOk := .t. ) ;   /// linea original

      otherwise

         If cType == "C" .and. At( CRLF, uVar ) > 0  // MULTILINE
            @  0, 0 GET oGet VAR uVar MEMO NO VSCROLL ;
              MESSAGE cMessage;
               SIZE 0,0 OF oDlg FONT oFont COLOR nClrFore, nClrBack NOBORDER
            oGet:bGotFocus := {|| PostMessage(oGet:hWnd, EM_SETSEL, 0, 0)}
         else
           IF lButAction                              // Angel Blanco
              @  0, 0 BTNGET oGet VAR uVar ;
                 MESSAGE cMessage;
                 ACTION EVAL( bButaction )  ;
                 SIZE 0,0 OF oDlg FONT oFont COLOR nClrFore, nClrBack NOBORDER
              oGet:oGet:Picture = cPicture
           ELSE
              @  0, 0 GET oGet VAR uVar ;
                MESSAGE cMessage;
                 SIZE 0,0 OF oDlg FONT oFont COLOR nClrFore, nClrBack NOBORDER
              oGet:oGet:Picture = cPicture
           ENDIF
         EndIf



         //////////// Ini //////////////
         //// Justificacion del GET ////
         ///////////////////////////////

         If ValType( ::aJustify ) $ "AB"
            If "B" $ ValType( ::aJustify )
               uJustify:= Eval( ::aJustify )
            Else
               uJustify:= AClone( ::aJustify )
            EndIf
            If nCol <= Len( uJustify )
               uJustify:= uJustify[ nCol ]

               If "L" $ ValType( uJustify )
                  uJustify:= If( uJustify, 1, 0 )
               ElseIf ! "N" $ ValType( uJustify )
                  uJustify:= 0
               EndIf

               If lAnd( uJustify, HA_RIGHT )
                  oGet:nStyle:= nOr( oGet:nStyle, ES_RIGHT )
               ElseIf lAnd( uJustify, HA_CENTER )
                  oGet:nStyle:= nOr( oGet:nStyle, ES_CENTER )
               EndIf

            EndIf
         EndIf
         //////////// Fin //////////////
         //// Justificacion del GET ////
         ///////////////////////////////

   EndCase


   DEFAULT bOnCreate:= {|oGet, oDlg| .T. }
   Eval( bOnCreate, oGet, oDlg )

   bOldValid:= oGet:bValid
   DEFAULT bOldValid:= {|| .T. },;
           bValid   := {|| .T. }

   oGet:bValid:= {|| ValidlEditCol( Self, oGet, oDlg, bOldValid, bValid, bAction, @lOk ) }


   @ 10, 0 BUTTON oBtn PROMPT "" OF oDlg


//   fjhg casi todo ajustado
   If ::nLineStyle == 3
      If aItems != nil .or. cType == "L"
         bInit:= {|| nDif:= ((aDim[6]-GetTextHeight(oGet:hWnd))/2)+0,;
                     oDlg:Move( aDim[ 1 ], aDim[ 2 ], aDim[5], aDim[6] ),;
                     oGet:Move( nDif-3, 0, aDim[5], aDim[6] )  }
      Else
         bInit:= {|| nDif:= ((aDim[6]-GetTextHeight(oGet:hWnd))/2)+0,;
                     oDlg:Move( aDim[ 1 ], aDim[ 2 ], aDim[5], aDim[6] ),;
                     oGet:Move( 2+nDif, 0, aDim[5], aDim[6] )  }
      Endif
   Else
      If aItems != nil .or. cType == "L"
         bInit:= {|| nDif:= ((aDim[6]-GetTextHeight(oGet:hWnd))/2)+0,;
                     oDlg:Move( aDim[ 1 ], aDim[ 2 ], aDim[5], aDim[6] ),;
                     oGet:Move( nDif-4, 0, aDim[5], aDim[6] )  }
      Else
         bInit:= {|| nDif:= ((aDim[6]-GetTextHeight(oGet:hWnd))/2)+1,;
                     oDlg:Move( aDim[ 1 ], aDim[ 2 ], aDim[5], aDim[6] ),;
                     oGet:Move( nDif-1, 0, aDim[5], aDim[6] )  }
      Endif
   Endif

*-------- original de la clase
*   Else
*      bInit:= {|| nDif:= ((aDim[6]-GetTextHeight(oGet:hWnd))/2)+2,;
*                  oDlg:Move( aDim[ 1 ], aDim[ 2 ], aDim[5], aDim[6] ),;
*                  oGet:Move( 0+nDif, 1, aDim[5]-2, aDim[6] )  }
*   EndIf

*    bOpenCombo:= {|| if(cType="L" .OR. aItems!=nil,if(lAutoOpen=.t.,oGet:Open(),),)}   // fjhg
*   ACTIVATE DIALOG oDlg ON INIT ( Eval( bInit ), Eval( bOnInit, oGet, oDlg ), Eval( bOpenCombo ) )  // fjhg

   ACTIVATE DIALOG oDlg ON INIT ( Eval( bInit ), Eval( bOnInit, oGet, oDlg ) )


   if ! lOk
      uVar = uTemp
   else
      if cType == "L"
         uVar = ( uVar == aItems[ 1 ] )
      endif
   endif


return lOk


Lo único que le sobra es lo referente al uso de la clase btnget que se pudiera sustituir por la nueva clase get con acción.
Saludos



Angel, Valencia, Venezuela



xH .997 - FW 7.9 - BCC55 - WorkShop - MySql
Posts: 1279
Joined: Mon Feb 06, 2006 04:28 PM
Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09
Posted: Mon Sep 28, 2009 01:33 PM
groiss wrote:Rolando, muchas gracias, la clase ya la tengo lo que quisiera es saber si hay forma de utilizarla, para visualizar un array bidimensional, de x filas por y columnas, y en el caso de ser posible, ver algun ejemplillo donde se haga.
Muchisimas gracias y un saludo


En la carpeta de ejemplos de la twbrowse17 tienes un excelente ejemplo de manejo de arrays, es sample1.prg
Saludos/Regards,

José Murugosa

"Los errores en programación, siempre están entre la silla, el teclado y la IA!!"
Posts: 2365
Joined: Wed Nov 02, 2005 11:46 PM
Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09
Posted: Mon Sep 28, 2009 01:36 PM

Saludos Jose, Angel

A la brevedad posible examino lo que me comentan, he estado algo lleno de trabjo, pero con seguridad trendre respuestas pronto.

gracias por el feedback

Posts: 299
Joined: Mon Oct 22, 2007 03:03 PM
Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09
Posted: Mon Sep 28, 2009 02:02 PM
Groiss aquí tienes un ejemplo sencillo


Code (fw): Select all Collapse
      REDEFINE SAY oMsg VAR cMsg;
               COLOR CLR_GREEN;//, GetSysColor()
               ID 902 OF oDlg
      REDEFINE LISTBOX oLbx ;
         FIELDS strzero(aReclam[oLbx:nAt,1],3),;
                aReclam[oLbx:nAt,2],;
                transform(aReclam[oLbx:nAt,3],'99/99/9999');
         ID 401 OF oDlg ;
         HEADERS "Nro. Reclamo","Nombre del Reclamante","Fecha Aviso";
         FIELDSIZES 90,230,90;
         WHEN .F.
      oLbx:nHeaderHeight := 31  && Da la altura del header
      oLbx:Ajustify      := {2,0,1} && Justificado de Columnas 0=izq, 1=Der, 2=Cent
      oLbx:nFreeze       :=  3
      oLbx:SetArray( aReclam )
      oLbx:Set3DStyle()
Saludos



Angel, Valencia, Venezuela



xH .997 - FW 7.9 - BCC55 - WorkShop - MySql
Posts: 234
Joined: Tue Sep 01, 2009 07:55 AM
Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09
Posted: Mon Sep 28, 2009 02:06 PM

Muchas gracias, José.
El ejemplo es perfecto, miré todos los samples menos ese.
Un saludo y mil gracias.

Posts: 1380
Joined: Fri Oct 14, 2005 01:28 PM
Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09
Posted: Mon Sep 28, 2009 03:08 PM
ejemplo:
Un array con la sgte estrucutra: aPrcPrv:= { {iFePrec,iPrecio1,iPrcUnit,iRazSoc}, ...}

Code (fw): Select all Collapse
   // Crear browse
   TWbrowse():lHScroll := .f.
   @0,0.5 LISTBOX  oLst ;
          FIELDS   DtoC ( aPrcPrv[oLst:nAt, iFePrec] ), ;
                   Trans( aPrcPrv[oLst:nAt, iPrecio1], P_OCHOCIF), ;
                   Trans( aPrcPrv[oLst:nAt, iPrcUnit ], P_DIEZ3D), ;
                   aPrcPrv[oLst:nAt,iRazSoc] ;
          HEADERS  "Fecha", "Precio", "Prc.Unit", "Proveedor" ;
          SIZE     225,55               ;
          COLSIZES 60, 65, 65, 50       ;
          COLOR    CLR_BLACK, cClrFondo ;
          OF oDlg

   oLst:SetArray( aPrcPrv )
Resistencia - "Ciudad de las Esculturas"

Chaco - Argentina
Posts: 593
Joined: Sat May 12, 2007 11:47 AM
Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09
Posted: Mon Sep 28, 2009 05:04 PM
Hola Groiss,

Aunque ya los amigos del foro te han informado, igualmente coloco una función que uso con la TWbrowse de HC, la "reduje" un poco pero está funcional.

Code (fw): Select all Collapse
 Function ComboArray(aArray,cRetorno,nMuestro,nRetorno,oWnd,aCabeceras,aTamanos,aJustifys) //

                                // cRetorno trae la variable y la reotrna al elegir (si ESC, retorna lo mismo que trajo)
                                                                 // nMuestro indica el la posicion del array que quiere se muestre en el listbox
                                                                 // nRetorno indica el la posicion del array que quiere se retorne en cRetorno


    Local nEle, nId, xVar, hBrush, cDateFormat, oRect, oLbx , lMulti:=.f. , nCols , oSay1, oSay2 , ;
          cVAr1:="123" , cVar2:="456" , oBtnSalir , oBtnAgrega , oCur1 ,;
        lOk := .F. , nLineas:=0 , nLineasAnt  , roro , nRetor

    local oHoy ,  Hoy := .f. , aCoordenadas:={} , aCopia:={}

    private nAtAntes:=5



    define cursor oCur1 resource 222


    define dialog oDlg resource "ComboArray" //of oDlgAnt

    oDlg:lHelpIcon := .f.    // saca el "?" de ayuda del dialog   *** ATENCION, SOLO FUNCIONA, SI EN EL DLL >>> "AYUDA CONTEXTUAL = NO "


  if ValType( aArray[1] ) == 'A'         // si es array multidimensional
         lMulti:=.t.
         nCols:=len(aArray[1])                              // nro de columnas del array
         if nArray = 3  //
                aArray:=asort(aArray,,, { |x, y| x[2] < y[2] })                       //ordeno el array
            else
              aArray:=asort(aArray,,, { |x, y| x[1] < y[1] })                       //ordeno el array
         endif
    else
         lMulti:=.f.
         nCols:=1
        asort(aArray,,, { |x, y| upper(x) < upper(y) })
 endif


    redefine listbox oLbx fields ;                //
                             if(lMulti , aArray[oLbx:nAt,nMuestro] , aArray[oLbx:nAt]) ;//  
                                 id 4001 ;                                                       //
                                 of oDlg  ;
                                 on dblclick (if(lMulti , (cRetorno:=aArray[oLbx:nAt,nRetorno] , oDlg:end()) , ;
                                              (cRetorno:=aArray[oLbx:nAt] , oDlg:end()) ) )

         oLbx:bChange:= {|| roro:=oLbx:nAt }

         oLbx:setarray(aArray)
       oLbx:bLogicLen := { || len( aArray ) }
         oLbx:CubroFondo(nRGB(255,255,224))
         oLbx:oCursor:=oCur1

         oLbx:lDrawHeaders:=.f.


         oLbx:brClicked:={|| nAtAntes:=oLbx:nAt , aArray:=EditarArray(aArray,nArray,lMulti,oDlg,nRow,nCol,nAtAntes,oLbx,;
                             aCabeceras,aTamanos,aJustifys) ,;
                                oLbx:refresh() } // , ;


         oLbx:bSeek := {|| if(lMulti , nLineas:=ascan(aArray,{|aVal| ;
                        if(nArray=3 , aVal[2]=upper(oLbx:cBuffer) , aVal[1]=upper(oLbx:cBuffer) ) } ) , ;
                      nLineas:=ascan(aArray,upper(oLbx:cBuffer)) ) , if(nLineas>0,(oLbx:GoToLine(nLineas-1)) , )  , oLbx:cBuffer:="" }


         oDlg:bKeyDown := {|nK| if(nK=13, (if(lMulti , (cRetorno:=aArray[oLbx:nAt,nRetorno] , oDlg:end()) , ;
                                              (cRetorno:=aArray[oLbx:nAt] , oDlg:end()) ) ) , ) }
                                                                                                                                                    *nRetor:=ascan(aArray[nRetorno],alltrim(upper(cRetorno)))


 ACTIVATE DIALOG oDlg ;
   ON INIT ( if(lMulti, (nRetor:=ascan(aArray,{|aVal|aVal[nRetorno]=alltrim(cRetorno) }) , ;
            if(nRetor>0,(oLbx:GoToLine(nRetor-1),oLbx:refresh()) , )) , ;
                 (nRetor:=ascan(aArray,alltrim(cRetorno)) , if(nRetor>0,(oLbx:GoToLine(nRetor-1),oLbx:refresh()) , ;
                  ))  ) )
Return cRetorno


Espero te sirva de guí. Yo la uso como un "Combo" para listar un array de varias columnas y al elegir, que sólo devuelva el contenido de una de sus celdas.

Saludos.

Rolando :-)
Posts: 1279
Joined: Mon Feb 06, 2006 04:28 PM
Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09
Posted: Mon Sep 28, 2009 05:23 PM
Daniel Garcia-Gil wrote:Saludos Jose, Angel

A la brevedad posible examino lo que me comentan, he estado algo lleno de trabjo, pero con seguridad trendre respuestas pronto.

gracias por el feedback



Daniel,

Muchas gracias por tus esfuerzos :-) , la tarea de modificación de wbrwline.c por lo que pude ver tenía sus bemoles :-) , y quedó perfecto, quedo a la espera de las novedades :-) .
Saludos/Regards,

José Murugosa

"Los errores en programación, siempre están entre la silla, el teclado y la IA!!"
Posts: 845
Joined: Sun Oct 09, 2005 05:36 PM
Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09
Posted: Tue Sep 29, 2009 04:07 AM

Daniel,
Enterado, muchas gracias nuevamente por los apoyos
saludos
Francisco

____________________

Paco
Posts: 234
Joined: Tue Sep 01, 2009 07:55 AM
Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09
Posted: Thu Oct 01, 2009 06:54 AM
Una consulta más sobre esta clase, aunque más bien es sobre el macro operador, el bloque Bline de la clase, espera encontrar un array con los campos a mostrar en el Browse, yo necesito crear ese array en tiempo de ejecución, ya que no siempre es el mismo, supongamos un array de 20 x 4, tendríamos 20 filas de 4 columnas su bline sería
Code (fw): Select all Collapse
browse:bline:={|| {vararr[browse:nat,1],vararr[browse:nat,2],vararr[browse:nat,3],vararr[browse:nat,4],}}


que sería simialar a
Code (fw): Select all Collapse
browse:bline:={|| {vararr[browse:nat]}


sin embargo al tener que crearlo en tiempo de ejecución debo hacerlo con una variable de texto así
Code (fw): Select all Collapse
vartexto:="{|| {vararr[browse:nat,1],vararr[browse:nat,2],vararr[browse:nat,3],vararr[browse:nat,4],}}"
browse:bline:=&vartexto

Pues esto no me funciona, y con clipper si me funcionaba algo similar
Un saludo y muchas gracias
Posts: 2365
Joined: Wed Nov 02, 2005 11:46 PM
Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09
Posted: Thu Oct 01, 2009 02:20 PM
Hola Jose...

jose_murugosa wrote:Daniel,

He probado la TWBrowse que me enviaste y anda de maravillas en todos mis programas!!!!!, nuevamente muchísimas gracias por el tiempo dedicado para ayudarme. :-)

Me ha surgido un problema al utilizar TCBrowse con TWBrowse de Hernan, que antes no lo tenía.

No me aparecen las filas del browse y aparecen a la izquierda unos cuadritos.....

Agradezco si puedes darle un vistazo, ruego disculpes las molestias.


He revisado lo que me comentas, pienso que la solucion esta en colocar la LIB TWBrowse primero que las de FWH...

prueba y me comentas...

Gracias
Posts: 1279
Joined: Mon Feb 06, 2006 04:28 PM
Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09
Posted: Thu Oct 01, 2009 02:24 PM
Gracias por tu interés, pruebo y te comento.


Daniel Garcia-Gil wrote:Hola Jose...

jose_murugosa wrote:Daniel,

He probado la TWBrowse que me enviaste y anda de maravillas en todos mis programas!!!!!, nuevamente muchísimas gracias por el tiempo dedicado para ayudarme. :-)

Me ha surgido un problema al utilizar TCBrowse con TWBrowse de Hernan, que antes no lo tenía.

No me aparecen las filas del browse y aparecen a la izquierda unos cuadritos.....

Agradezco si puedes darle un vistazo, ruego disculpes las molestias.


He revisado lo que me comentas, pienso que la solucion esta en colocar la LIB TWBrowse primero que las de FWH...

prueba y me comentas...

Gracias
Saludos/Regards,

José Murugosa

"Los errores en programación, siempre están entre la silla, el teclado y la IA!!"
Posts: 2365
Joined: Wed Nov 02, 2005 11:46 PM
Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09
Posted: Thu Oct 01, 2009 02:31 PM
Saludos compatriota Angel...

ADBLANCO wrote:Para mi compatriota Daniel.

Te envié a tu correo mi versión de twbrowse, Tiene habilitado los mensajes al editar una línea, espero que guste con el fín de unificar la clase
Lo único que le sobra es lo referente al uso de la clase btnget que se pudiera sustituir por la nueva clase get con acción.


Angel por favor enviame un ejemplo funcional de las modificaciones sugeridas
Posts: 299
Joined: Mon Oct 22, 2007 03:03 PM
Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09
Posted: Thu Oct 01, 2009 04:13 PM
Puntualmente, las modificaciones se situan en el método lEditcol


Sustituye en tu código las siguientes líneas


Code (fw): Select all Collapse
   METHOD lEditCol( nCol, uVar, cPicture, bValid, nClrFore, nClrBack,;
                    aItems, bAction, bOnInit, bOnCreate,cMessage, lNextControl  )
.
.
.
.
.
//----------------------------------------------------------------------------//
METHOD lEditCol( nCol      ,;
                 uVar      ,;
                 cPicture  ,;
                 bValid    ,;
                 nClrFore  ,;
                 nClrBack  ,;
                 aItems    ,;
                 bAction   ,;
                 bOnInit   ,;
                 bOnCreate ,;
                 cMessage  ,;
                 lNextControl ) CLASS TWBrowse

   local oDlg, oGet, oFont, oBtn, oBtnAction
   local nWidth := ::aColSizes[ nCol ]
   local uTemp
   local aDim
   local lOk
   local cType
   LOCAL uJustify, lValid:= .f.
   LOCAL bInit
   local nDif

   LOCAL nColorCol, oLbx:= Self, bValid2  // CeSoTech
   LOCAL bOldValid

   DEFAULT nCol        := ::nColAct,;
           bAction     := {|| .T. },;
           bOnInit     := {|| .T. },;
           cMessage    :=""        ,;
           lNextControl:= .T.    // fjhg para brincar al siguiente control cuando es registro nuevo

   If nClrFore == Nil
      If "B"$Valtype( ::bTextColor ) .and. ;
         "N"$Valtype( nColorCol:= Eval( ::bTextColor, ::nRowPos, nCol ) )
         nClrFore:= nColorCol
      Else
         nClrFore := ::nClrText
      EndIf
   EndIf

   If nClrBack == Nil
      If "B"$Valtype( ::bBkColor ) .and. ;
         "N"$Valtype( nColorCol:= Eval( ::bBkColor, ::nRowPos, nCol ) )
         nClrBack:= nColorCol
      Else
         nClrBack := ::nClrPane
      EndIf
   EndIf

   // CeSoTech // -> Si son bloques de codigo habia RTError
   If "B"$ValType( nClrFore )
      nClrFore:= Eval( nClrFore )
   EndIf
   If "B"$ValType( nClrBack )
      nClrBack:= Eval( nClrBack )
   EndIf


   uTemp  := uVar

   aDim   := ::aBrwPosRect( nCol )


   lOk    := .f.
   cType  := ValType( uVar )

   IF ::lCellStyle .and. nCol != ::nColAct
        ::nColAct := nCol
         if ::oHScroll != nil
            ::oHScroll:SetPos(nCol)
         endif
        ::Refresh(.F.)
   ENDIF

   DEFINE DIALOG oDlg FROM 0,0 TO 0,0 ;
                 STYLE nOR( WS_VISIBLE, WS_POPUP, 4 ) PIXEL ;
                 COLOR nClrFore, nClrBack of ::oWnd

   if ::oFont != nil
      oFont := ::oFont   //  fjhg
*      oFont = TFont():New( ::oFont:cFaceName, ::oFont:nWidth,;
*                           ::oFont:nHeight, .f., ::oFont:lBold )
   endif


   do case
      case cType == "L"
           DEFAULT aItems := { ".T.", ".F." }
           uVar = If( uTemp, aItems[ 1 ], aItems[ 2 ] )
           @  0, 0 COMBOBOX oGet VAR uVar ITEMS aItems ;
              MESSAGE cMessage;
              SIZE ( aDim[ 4 ] - aDim[ 2 ] ) * 0.50, 50 OF oDlg ;
              ON CHANGE ( if(lNextControl,oDlg:End(),), lOk := .t. ) ;   //  fjhg
              FONT oFont COLOR nClrFore, nClrBack STYLE CBS_DROPDOWNLIST    // fjhg
*              ON CHANGE ( oDlg:End(), lOk := .t. ) ;   /// linea original

      case aItems != nil
           @  0, 0 COMBOBOX oGet VAR uVar ITEMS aItems ;
              MESSAGE cMessage;
              SIZE ( aDim[ 4 ] - aDim[ 2 ] ) * 0.50, 50 OF oDlg ;
              ON CHANGE ( if(lNextControl,oDlg:End(),), lOk := .t. ) ;   //  fjhg
              FONT oFont COLOR nClrFore, nClrBack STYLE CBS_DROPDOWNLIST   // fjhg
*              ON CHANGE ( oDlg:End(), lOk := .t. ) ;   /// linea original

      otherwise

         If cType == "C" .and. At( CRLF, uVar ) > 0  // MULTILINE
            @  0, 0 GET oGet VAR uVar MEMO NO VSCROLL ;
              MESSAGE cMessage;
              SIZE 0,0 OF oDlg FONT oFont COLOR nClrFore, nClrBack NOBORDER
            oGet:bGotFocus := {|| PostMessage(oGet:hWnd, EM_SETSEL, 0, 0)}
         else
              @  0, 0 GET oGet VAR uVar ;
                MESSAGE cMessage;
                 SIZE 0,0 OF oDlg FONT oFont COLOR nClrFore, nClrBack NOBORDER
              oGet:oGet:Picture = cPicture
         EndIf



         //////////// Ini //////////////
         //// Justificacion del GET ////
         ///////////////////////////////

         If ValType( ::aJustify ) $ "AB"
            If "B" $ ValType( ::aJustify )
               uJustify:= Eval( ::aJustify )
            Else
               uJustify:= AClone( ::aJustify )
            EndIf
            If nCol <= Len( uJustify )
               uJustify:= uJustify[ nCol ]

               If "L" $ ValType( uJustify )
                  uJustify:= If( uJustify, 1, 0 )
               ElseIf ! "N" $ ValType( uJustify )
                  uJustify:= 0
               EndIf

               If lAnd( uJustify, HA_RIGHT )
                  oGet:nStyle:= nOr( oGet:nStyle, ES_RIGHT )
               ElseIf lAnd( uJustify, HA_CENTER )
                  oGet:nStyle:= nOr( oGet:nStyle, ES_CENTER )
               EndIf

            EndIf
         EndIf
         //////////// Fin //////////////
         //// Justificacion del GET ////
         ///////////////////////////////

   EndCase


   DEFAULT bOnCreate:= {|oGet, oDlg| .T. }
   Eval( bOnCreate, oGet, oDlg )

   bOldValid:= oGet:bValid
   DEFAULT bOldValid:= {|| .T. },;
           bValid   := {|| .T. }

   oGet:bValid:= {|| ValidlEditCol( Self, oGet, oDlg, bOldValid, bValid, bAction, @lOk ) }


   @ 10, 0 BUTTON oBtn PROMPT "" OF oDlg


//   fjhg casi todo ajustado
   If ::nLineStyle == 3
      If aItems != nil .or. cType == "L"
         bInit:= {|| nDif:= ((aDim[6]-GetTextHeight(oGet:hWnd))/2)+0,;
                     oDlg:Move( aDim[ 1 ], aDim[ 2 ], aDim[5], aDim[6] ),;
                     oGet:Move( nDif-3, 0, aDim[5], aDim[6] )  }
      Else
         bInit:= {|| nDif:= ((aDim[6]-GetTextHeight(oGet:hWnd))/2)+0,;
                     oDlg:Move( aDim[ 1 ], aDim[ 2 ], aDim[5], aDim[6] ),;
                     oGet:Move( 2+nDif, 0, aDim[5], aDim[6] )  }
      Endif
   Else
      If aItems != nil .or. cType == "L"
         bInit:= {|| nDif:= ((aDim[6]-GetTextHeight(oGet:hWnd))/2)+0,;
                     oDlg:Move( aDim[ 1 ], aDim[ 2 ], aDim[5], aDim[6] ),;
                     oGet:Move( nDif-4, 0, aDim[5], aDim[6] )  }
      Else
         bInit:= {|| nDif:= ((aDim[6]-GetTextHeight(oGet:hWnd))/2)+1,;
                     oDlg:Move( aDim[ 1 ], aDim[ 2 ], aDim[5], aDim[6] ),;
                     oGet:Move( nDif-1, 0, aDim[5], aDim[6] )  }
      Endif
   Endif

*-------- original de la clase
*   Else
*      bInit:= {|| nDif:= ((aDim[6]-GetTextHeight(oGet:hWnd))/2)+2,;
*                  oDlg:Move( aDim[ 1 ], aDim[ 2 ], aDim[5], aDim[6] ),;
*                  oGet:Move( 0+nDif, 1, aDim[5]-2, aDim[6] )  }
*   EndIf

*    bOpenCombo:= {|| if(cType="L" .OR. aItems!=nil,if(lAutoOpen=.t.,oGet:Open(),),)}   // fjhg
*   ACTIVATE DIALOG oDlg ON INIT ( Eval( bInit ), Eval( bOnInit, oGet, oDlg ), Eval( bOpenCombo ) )  // fjhg

   ACTIVATE DIALOG oDlg ON INIT ( Eval( bInit ), Eval( bOnInit, oGet, oDlg ) )


   if ! lOk
      uVar = uTemp
   else
      if cType == "L"
         uVar = ( uVar == aItems[ 1 ] )
      endif
   endif


return lOk


y mas na!


No se si eso es lo que me pides :-)
Saludos



Angel, Valencia, Venezuela



xH .997 - FW 7.9 - BCC55 - WorkShop - MySql
Posts: 2365
Joined: Wed Nov 02, 2005 11:46 PM
Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09
Posted: Thu Oct 01, 2009 04:17 PM

Angel...

Gracias me ahorras trabajo, pero necesito un ejemplo para probar tus cambios, si tienes alguno funcional seria mejor

Gracias...