TWBrowse17 y xharbour 1.2.1 y FWH9.09

Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09

Postby ADBLANCO » Mon Sep 28, 2009 1: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: Select all  Expand view  RUN
  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
User avatar
ADBLANCO
 
Posts: 299
Joined: Mon Oct 22, 2007 3:03 pm
Location: Valencia - Venezuela

Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09

Postby jose_murugosa » Mon Sep 28, 2009 1: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 y el teclado y la IA!!"
User avatar
jose_murugosa
 
Posts: 1180
Joined: Mon Feb 06, 2006 4:28 pm
Location: Uruguay

Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09

Postby Daniel Garcia-Gil » Mon Sep 28, 2009 1: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
User avatar
Daniel Garcia-Gil
 
Posts: 2365
Joined: Wed Nov 02, 2005 11:46 pm
Location: Isla de Margarita

Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09

Postby ADBLANCO » Mon Sep 28, 2009 2:02 pm

Groiss aquí tienes un ejemplo sencillo


Code: Select all  Expand view  RUN
     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()
 
Last edited by ADBLANCO on Mon Sep 28, 2009 2:12 pm, edited 1 time in total.
Saludos

Angel, Valencia, Venezuela

xH .997 - FW 7.9 - BCC55 - WorkShop - MySql
User avatar
ADBLANCO
 
Posts: 299
Joined: Mon Oct 22, 2007 3:03 pm
Location: Valencia - Venezuela

Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09

Postby groiss » Mon Sep 28, 2009 2:06 pm

Muchas gracias, José.
El ejemplo es perfecto, miré todos los samples menos ese.
Un saludo y mil gracias.
groiss
 
Posts: 225
Joined: Tue Sep 01, 2009 7:55 am
Location: Plasencia - ESPAÑA

Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09

Postby MarioG » Mon Sep 28, 2009 3:08 pm

ejemplo:
Un array con la sgte estrucutra: aPrcPrv:= { {iFePrec,iPrecio1,iPrcUnit,iRazSoc}, ...}

Code: Select all  Expand view  RUN

   // 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
User avatar
MarioG
 
Posts: 1380
Joined: Fri Oct 14, 2005 1:28 pm
Location: Resistencia - Chaco - AR

Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09

Postby rolando » Mon Sep 28, 2009 5: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: Select all  Expand view  RUN
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 :D
User avatar
rolando
 
Posts: 593
Joined: Sat May 12, 2007 11:47 am
Location: San Nicolás - BA - ARGENTINA

Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09

Postby jose_murugosa » Mon Sep 28, 2009 5: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 :D , la tarea de modificación de wbrwline.c por lo que pude ver tenía sus bemoles :roll: , y quedó perfecto, quedo a la espera de las novedades :wink: .
Saludos/Regards,
José Murugosa
"Los errores en programación, siempre están entre la silla y el teclado y la IA!!"
User avatar
jose_murugosa
 
Posts: 1180
Joined: Mon Feb 06, 2006 4:28 pm
Location: Uruguay

Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09

Postby Francisco Horta » Tue Sep 29, 2009 4:07 am

Daniel,
Enterado, muchas gracias nuevamente por los apoyos
saludos
Francisco
____________________
Paco
Francisco Horta
 
Posts: 845
Joined: Sun Oct 09, 2005 5:36 pm
Location: la laguna, mexico.

Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09

Postby groiss » Thu Oct 01, 2009 6: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: Select all  Expand view  RUN
browse:bline:={|| {vararr[browse:nat,1],vararr[browse:nat,2],vararr[browse:nat,3],vararr[browse:nat,4],}}
 


que sería simialar a
Code: Select all  Expand view  RUN
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: Select all  Expand view  RUN
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
groiss
 
Posts: 225
Joined: Tue Sep 01, 2009 7:55 am
Location: Plasencia - ESPAÑA

Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09

Postby Daniel Garcia-Gil » Thu Oct 01, 2009 2: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. :D

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
User avatar
Daniel Garcia-Gil
 
Posts: 2365
Joined: Wed Nov 02, 2005 11:46 pm
Location: Isla de Margarita

Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09

Postby jose_murugosa » Thu Oct 01, 2009 2: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. :D

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 y el teclado y la IA!!"
User avatar
jose_murugosa
 
Posts: 1180
Joined: Mon Feb 06, 2006 4:28 pm
Location: Uruguay

Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09

Postby Daniel Garcia-Gil » Thu Oct 01, 2009 2: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
User avatar
Daniel Garcia-Gil
 
Posts: 2365
Joined: Wed Nov 02, 2005 11:46 pm
Location: Isla de Margarita

Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09

Postby ADBLANCO » Thu Oct 01, 2009 4:13 pm

Puntualmente, las modificaciones se situan en el método lEditcol


Sustituye en tu código las siguientes líneas


Code: Select all  Expand view  RUN


   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 :oops:
Saludos

Angel, Valencia, Venezuela

xH .997 - FW 7.9 - BCC55 - WorkShop - MySql
User avatar
ADBLANCO
 
Posts: 299
Joined: Mon Oct 22, 2007 3:03 pm
Location: Valencia - Venezuela

Re: TWBrowse17 y xharbour 1.2.1 y FWH9.09

Postby Daniel Garcia-Gil » Thu Oct 01, 2009 4:17 pm

Angel...

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

Gracias...
User avatar
Daniel Garcia-Gil
 
Posts: 2365
Joined: Wed Nov 02, 2005 11:46 pm
Location: Isla de Margarita

PreviousNext

Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: No registered users and 47 guests