FiveTech Software tech support forums

Code: Select all

#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

Code: Select all

#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"

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