AevalWhen de WINDOW.PRG

[Rossine]

Olá Antonio,

Seria possível mudar o método "Aevalwhen" de WINDOW.PRG para trabalhar com FOR EACH de xharbour ? Veja um exemplo abaixo:

Code: Select all  Expand view  RUN

#include "FiveWin.ch"

function Main()

   local oDlg, cName := Space( 10 )

   DEFINE DIALOG oDlg TITLE "Testing ForEach for speed"

   @ 1,  2 SAY "Name:"

   @ 1,  7 GET cName

   @ 2,  5 BUTTON "AEvalWhen() of FWH" ACTION FWH_EVAL( oDlg )

   @ 3,  5 BUTTON "My AEvalWhen()" ACTION MY_EVAL( oDlg )

   ACTIVATE DIALOG oDlg

return nil

function FWH_EVAL( oDlg )

   local x, nStart

   nStart := Seconds()

   for X = 1 to 100000
       oDlg:AEvalWhen()
   next

   msgstop( Seconds() - nStart )

return NIL

//----------------------------------------------------------------------------//

function MY_EVAL( oDlg )

   local n
   local aControls := oDlg:aControls, aVarray
   local x, nStart

   nStart := Seconds()

   for X = 1 to 100000
       if aControls != nil .and. ! Empty( aControls )
          for each aVarray IN oDlg:aControls
              if aVarray != nil .and. aVarray:bWhen != nil
                 if Eval( aVarray:bWhen )
                    aVarray:Enable()   // keep this as ::
                 else
                    aVarray:Disable()  // keep this as ::
                 endif
             endif
          next
       endif
   next

   msgstop( Seconds() - nStart )

return NIL

* Extract from WINDOW.PRG
*METHOD AEvalWhen() CLASS TWindow
*  local n
*  local aControls := ::aControls, aVarray
*
*  if aControls != nil .and. ! Empty( aControls )
*     for each aVarray IN ::aControls
*         if aVarray != nil .and. aVarray:bWhen != nil
*            if Eval( aVarray:bWhen )
*               aVarray:Enable()   // keep this as ::
*            else
*               aVarray:Disable()  // keep this as ::
*            endif
*        endif
*     next
**     for n = 1 to Len( aControls )
**         if aControls[ n ] != nil .and. aControls[ n ]:bWhen != nil
**            if Eval( aControls[ n ]:bWhen )
**               ::aControls[ n ]:Enable()   // keep this as ::
**            else
**               ::aControls[ n ]:Disable()  // keep this as ::
**            endif
**        endif
**     next
*  endif
*return nil


Executando o exemplo acima em meu computador o tempo fica assim:

Clicando em "AEvalWhen() of FWH" gasta o tempo de 1.203 segundos
Clicando em "My AEvalWhen()" gasta o tempo de 0.625 segundos, ou seja quase a metade do tempo

Obrigado,

Rossine.

[Frafive]

Rossine

Para cuando el twbrowse para xharbour free ?


Un saludo

[Rossine]

Olá Frafive,

Aqui eu gerei o WBROWSE.LIB para bcc 5.5 sem nenhum problema. Qual erro está aparecendo para você ?

Abraços,

Rossine.

[Frafive]

Hola Rossine

Desde Recusos no funciona el twbrowse.

Un saludo

[Rossine]

Olá Frafive,

Compilei o programa abaixo que usa recursos, e funcionou 100%.

Code: Select all  Expand view  RUN

#include "fivewin.ch"

external dbfcdx, ordkeyno, ordkeygoto, ordkeycount

// Sample by Carlos Vargas

function main()
    local oDlg

   #ifdef __CLIPPER__
      local hBorl := LoadLibrary( "BWCC.dll" )
   #else   
      local hBorl := LoadLibrary( "BWCC32.dll" )
      BWCCRegister(GetResources())
   #endif     

    private cCodigo := space(7)
    rddsetdefault( "DBFCDX" )

    use cuentas alias TEST
    index on codcta tag codigo
    index on nombre tag nombre
    ordsetfocus("codigo")

    define dialog odlg name "DLG_TEST" title "Pruba de DBSearch() com REDEFINES"

        redefine get cCodigo;
            id 101 of odlg;
            update

        redefine btnbmp;
            id 102 of odlg;
            action ( TEST->( DBSearch( "Catalogo de cuentas",; //Titulo
                {||{ TEST->codcta, TEST->nombre } },;          //Campos
                 {"Codigo"       ,"Nombre"},;                  //Headers
                {{"Codigo cuenta","Nombre Cuenta"},;           //Array Index "campos"
                 {"codigo"       ,"nombre"}} ) ),;             //            "Titulos"
                cCodigo := TEST->codcta,;
                odlg:update() )
    redefine button id 201 of odlg action odlg:end()
    redefine button id 202 of odlg action odlg:end() cancel

    activate dialog odlg center

    close all

    FreeLibrary( hBorl )

return

//============================================================================//

*DLL32 FUNCTION BWCCRegister( hInst AS LONG) AS WORD PASCAL LIB "BWCC32.DLL"

//============================================================================//

#define TRUE  .t.
#define FALSE .f.


FUNCTION DBSearch( cTitle, aFields, aHeaders, aOrders, oWnd )

    PRIVATE oDlgS ,;
            oBrw  ,;
            oCombo,;
            oSayRec,;
            oSaySeek,;
            cOldOrder := ordsetfocus(),;
            lOk       := FALSE,;           
            nOrden := 1
   
    DEFAULT oWnd := GetWndDefault()

    //salta al inicio de la tabla   
    dbgotop()

    //define dialogo
    DEFINE DIALOG oDlgS NAME "DLG_LISTA";
         TITLE cTitle;
         OF oWnd
   
    REDEFINE LISTBOX oBrw ;
        FIELDS;
        ID 102;
        OF oDlgS;
        UPDATE;
        ON DBLCLICK ( lOk:=TRUE, oDlgS:end() );
        ON CHANGE ShowPos( recno(), ordkeycount(), oSayRec)

        oBrw:Set3DStyle()
        oBrw:nHeaderHeight := 18
        oBrw:nLineHeight   := 15
        oBrw:cAlias        := alias()
        oBrw:bLine         := aFields
        oBrw:aHeaders      := aHeaders
        oBrw:aJustify      := {2,0}
        oBrw:bSeek         := {|lRet| oBrw:DbfSeek( .F. ,{|| Tone(500,3) }) }
        oBrw:bUpdateBuffer := {|| UpdateBuffer( oSaySeek, oBrw:cBuffer ) }

      oBrw:lRecSel       := .t.
      oBrw:lTheader      := .t.
      oBrw:lDrawTitle    := .t.
      oBrw:cHeaderTitle  := "Tabela do Cadastro de Clientes"
      oBrw:nTitleHeight  := 30
      oBrw:aHeaderSort   := { 1, "BOTTOM", "TOP.BMP", "BOTTOM.BMP" }
      oBrw:HeaderTImg    := { "\fwh\icons\chart.ico" }
      oBrw:HeaderHImg    := { "\fwh\bitmaps\16x16\explorer.bmp", ;
                              "\fwh\icons\dialog2.ico" , ;
                              "\fwh\icons\msdos.ico"   , ;
                              "\fwh\icons\summer.ico"  , ;
                              "\fwh\icons\contar.ico"  }
*     oBrw:HeaderFImg     := oBrw:HeaderHImg

    REDEFINE SAY oSayRec ;
        ID 103 OF oDlgS COLOR CLR_BLUE

    REDEFINE SAY oSaySeek PROMPT "" ;
        ID 104 OF oDlgS COLOR CLR_BLUE

    REDEFINE BUTTON ;
        ID 201      ;
        OF oDlgS     ;
        ACTION ( lOk := TRUE, oDlgS:end() )

    REDEFINE BUTTON ;
        ID 202      ;
        OF oDlgS    ;
        ACTION ( lOk := FALSE, oDlgS:end() )   
   
    ACTIVATE DIALOG oDlgS ;
        CENTER ;
        ON INIT ( ToolBar(aOrders)  ,;
                  oBrw:nHeight -= 85 )

    ordsetfocus( cOldOrder )

RETURN ( lOk )

STATIC PROCEDURE ToolBar(aOrders)
    LOCAL oToolBar

    //define la barra de herramientas con el combobox de tag's
    DEFINE BUTTONBAR oToolBar OF oDlgS SIZE 30,30 3D

        @ 5, oToolBar:GetBtnLeft() + 3;
             COMBOBOX oCombo VAR nOrden ;
             ITEMS aOrders[1];
             SIZE oDlgs:nWidth - 25, 200;
             OF oToolBar PIXEL FONT oDlgS:oFont;
             ON CHANGE ( ordsetfocus( aOrders[2, nOrden ] ),;
                         oBrw:refresh(TRUE),;
                         oBrw:setfocus(), Tone(650,3) )

    oDlgS:SetControl(oBrw)

RETURN

STATIC PROCEDURE ShowPos(nActual, nTotal, oSay)
    oSay:SetText( alltrim( str(nActual) )+"/"+alltrim(str(nTotal)) )
    oSay:refresh()
RETURN


STATIC FUNCTION UpdateBuffer( oSay, cBuffer )
    LOCAL cMsg

    IF len( cBuffer ) > 0
        cMsg := cBuffer
    ELSE
        cMsg := ""
    ENDIF
    oSay:SetText(cMsg)

RETURN Nil


//----------------------------------------------------------------------------//

DLL32 FUNCTION BWCCRegister( hInst AS LONG  ) AS WORD PASCAL LIB "BWCC32.DLL"

//----------------------------------------------------------------------------//



Veja se você consegue gerar e executar este exemplo, ok ? Ele se chama SAMPLE04.PRG que se encontra junto com os fontes de wbrowse que eu modifiquei.

Abraços,

Rossine.

[Frafive]

Hoa Rossine

Desde recursos no funciona el twbrowse, si creas el twbrowse en unas coordenadas en archivo de RC, despues no te lo pinta bien, lo pinta siempre en TOP.

un saludo y gracias

[Antonio Linares]

Rossine,

No podemos usar FOR EACH ya que no lo soporta ni Clipper, ni Xbase++ ni C3.

[Rossine]

OK Antonio

un saludo y gracias

Rossine.