FiveDBU for 32/64 bits

FiveDBU for 32/64 bits

Postby Otto » Sun Jan 06, 2013 8:41 pm

Hello,
I someone working in production use with fiveDBU?
Can we append a dbf file with fiveDBU.


Thanks in advance
Otto
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
User avatar
Otto
 
Posts: 6064
Joined: Fri Oct 07, 2005 7:07 pm

Re: FiveDBU for 32/64 bits

Postby BeoBeo » Mon Jan 07, 2013 6:33 am

I use this

http://dbfmanager.com/de/

include fastreport

Beo Beo
BeoBeo
 
Posts: 6
Joined: Tue Oct 09, 2012 9:59 am

Re: FiveDBU for 32/64 bits

Postby Otto » Mon Jan 07, 2013 7:20 am

Beo,
thank you.
I use WDBU but this does not work on 64 bit.
The function I use most is: Create Index and Statistics.
Yesterday I tried xaDBU from the same author but I can't find these functions there.
I will have a look at the product you suggested.
Best regards,
Otto
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
User avatar
Otto
 
Posts: 6064
Joined: Fri Oct 07, 2005 7:07 pm

Re: FiveDBU for 32/64 bits

Postby elvira » Mon Jan 07, 2013 9:14 am

Mr Otto,

WDBU does work in 64 bits as there is a new version in these forums.

Please search or ask Antonio about latest version somebody anonymous developed into 64 bits.

Best regards,
elvira
 
Posts: 516
Joined: Fri Jun 29, 2012 12:49 pm

Re: FiveDBU for 32/64 bits

Postby Otto » Mon Jan 07, 2013 2:01 pm

elvira,
thank you. I saw this version. But at that time it was not ready for real work.
Maybe there is a newer one.
Best regards,
Otto
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
User avatar
Otto
 
Posts: 6064
Joined: Fri Oct 07, 2005 7:07 pm

Re: FiveDBU for 32/64 bits

Postby Franklin Demont » Mon Jan 07, 2013 6:31 pm

Otto ,

Last month i worked on fivedbu , index creation , with a lot off enhancements

I have the intention to work also on other items.

If there is is intrest , i can mail it.

Frank Demont
test
Franklin Demont
 
Posts: 166
Joined: Wed Aug 29, 2012 8:25 am

Re: FiveDBU for 32/64 bits

Postby Antonio Linares » Mon Jan 07, 2013 6:50 pm

Frank,

Me and surely many others are interested too on your enhancements on the free FiveTech's FiveDBU utility.

I would appreciate very much if you share your enhancements here, many thanks :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 41390
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: FiveDBU for 32/64 bits

Postby Franklin Demont » Tue Jan 08, 2013 7:03 am

Antonio Linares wrote:Frank,

Me and surely many others are interested too on your enhancements on the free FiveTech's FiveDBU utility.

I would appreciate very much if you share your enhancements here, many thanks :-)


Antonio ,

To be clear , i worked on xbrdbu. This file (with rc) seems to be too big to publice here.

I will make a separate version with defines to incorporate it in xbrdbu or fivedbu

Frank
test
Franklin Demont
 
Posts: 166
Joined: Wed Aug 29, 2012 8:25 am

Re: FiveDBU for 32/64 bits , xbrdbu : index management

Postby Franklin Demont » Tue Jan 15, 2013 3:59 pm

Franklin Demont wrote:
Antonio Linares wrote:Frank,

Me and surely many others are interested too on your enhancements on the free FiveTech's FiveDBU utility.

I would appreciate very much if you share your enhancements here, many thanks :-)


Antonio ,

To be clear , i worked on xbrdbu. This file (with rc) seems to be too big to publice here.

I will make a separate version with defines to incorporate it in xbrdbu or fivedbu

Frank


Ok , i finished to make the file so litle as possible in xbrdbu . Starting from fivedbu (function indexes) , it must also be easy to incorporate it in fivedbu.

Enhancements :

1) The index browse has 5 columns (Order , tag , expression , for , bagname) . Extended with ordcount().
Very usefull as replacement for COUNT FOR .... WHILE .... SCOPE , espacially with non regular (temporary) indexes
2) Added some buttons in buttonbar :
* Edit order can be used
* Rebuild All : when a tag is edited all the indexes can be rebuild , index orders doesn't change
The data from the indexes are saved in a hash array and used to rebuild the indexes.
* Scope : Top Bottom . Shows and edit a browse from all the orders with their scopes , first and last element
* Select order : from browse with all orders
3) Indexbuilder : dialog to build the index :
* First inputfield : Checkbox REGULAR INDEX
input fields from nog regular index ( While condition , Tag to use , temporary, scope , records , startrecord) are hided for a regular index
A non regular index has as default value a unique filename , temporary is set to .T.

IMPORTANT : Program must be executed from a subdirectory from SAMPLES
i.e. DEFINE BUTTON oBut[1] OF oBar PROMPT "Add" FILE ".\..\..\bitmaps\32x32\plus.bmp"; // RESOURCE "add" ;


Frank Demont

Code: Select all  Expand view

#include 'fivewin.ch'
#include 'xbrowse.ch'
# include "dbinfo.ch"
# include "set.ch"
# ifdef __HARBOUR__
# ifndef __XHARBOUR__
# include "xhb.ch"                   // Harbour\contrib\xhb\xhb.ch
# include "hbcompat.ch"              // Harbour\contrib\xhb\hbcompat.ch
# endif
# endif
REQUEST DBFCDX
#DEFINE EXENAME "xWDBU"
#define COMPILAR(x)  &("{||"+x+"}")
#define GENBLOCK(x)  &( "{ || " + x + " }" )    // From FiveDbu

#define HLP_GOTO   1
#define HLP_SEEK   2
#define HLP_SKIP   3
#define HLP_LOCATE 4

#define SYS_COLOR_INDEX_FLAG  0x40000000

#define COLOR_BTNFACE      nOr( 15, SYS_COLOR_INDEX_FLAG )

#xtranslate MinMax( <xValue>, <nMin>, <nMax> ) => ;
   Min( Max( <xValue>, <nMin> ), <nMax> )

#xcommand DBG <vars,...> => ;
            XBrowse( ArrTranspose( \{ \{ <"vars"> \}, Eval( \{ || \{ <vars> \} \} ) \} ), ;
            ProcName(0) + " : Line : " + LTrim( Str( ProcLine(0) ) ),, ;
            { |o| o:cHeaders := { "Variable", "Value" } } )


# DEFINE CKEY         1
# DEFINE CFILENAME    2
# DEFINE CTAG         3
# DEFINE CFOR         4
# DEFINE CWHILE       5
# DEFINE LUNIQUE      6
# DEFINE LDESCEND     7
# DEFINE LTEMPORARY   8
# DEFINE LSUBINDEX    9
# DEFINE CSUBINDEX   10
# DEFINE CSCOPE      11
# DEFINE NRECORD     12
# DEFINE NSTART      13
# DEFINE NCOUNT      14

static oWndDbu, oDbfWnd, oFont, aHistory := {}, lDispMemo := .T.
STATIC hIndex    // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

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

function Main(CDBFFILE)    // CdbFile added

   local oBrw
     LOCAL oWnd

   SetBalloon( .t. )
   xbrNumformat( ,.t. )

   SET XBROWSE TO TXBrCode()

   DEFINE FONT oFont NAME 'TAHOMA' SIZE 0,-12

   DEFINE WINDOW oWndDbu MDI ;
      TITLE 'DBU for Windows' ;
      MENU MainMenu()
   
   oWndDbu:SetFont( oFont )

   SET MESSAGE OF oWndDbu TO 'Developed with Harbour and FWH (FiveWin for Harbour/xHarbour)' 2007 DATE CLOCK KEYBOARD
   hIndex := Hash() //
     hSetCaseMatch(hIndex , .F.)
     # ifdef TEST
     IF cDbfFile == nil
            cDbfFile := ".\..\Customer.dbf"
     END
     IF File("trace.log")
        DELETE FILE ("trace.log")
     END
   # endif
     ACTIVATE WINDOW oWndDbu MAXIMIZED ;
      ON DROPFILES Files2Brw( nRow, nCol, aFiles );
            ON INIT OpenMyFile(cDbfFile)
     CLOS ALL

return nil

PROC OpenMyFile(cDbfFile)
*************************
IF cDbfFile <> nil
    NewFile(cDbfFile)
END
RETURN
/*
//----------------------------------------------------------------------------//

function MainFont()     Can be replaced with wndmain():oFont

return oFont
*/

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

INIT PROCEDURE PrgInit

   SET DELETED ON
   SET EXCLUSIVE OFF

   SET DATE ITALIAN
   SET CENTURY ON

   RDDSetDefault( 'DBFCDX' )

return

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

static function MainMenu()

   local oMenu, URLNAME := "http://www.fivetechsoft.com"

   MENU oMenu 2007
     
          MENUITEM "File"
 
          MENU
               MENUITEM "&Open"+chr(9)+"Ctrl+A" ;
                    RESOURCE "OPEN" ;
                    ACTION NewFile() ;
                    MESSAGE "Open file" ;
                    ACCELERATOR ACC_CONTROL, asc("A") ;
                    ENABLED
                   
               MENUITEM "C&lose"+chr(9)+"Ctrl+E" ;
                    RESOURCE "SAVE" ;
                    ACTION oWndDbu:oWndActive:end(); //oWndDbu:oWnd:End() ;
                    MESSAGE "Close file" ;
                    ACCELERATOR ACC_CONTROL, asc("E") ;
                    ENABLED
                    ENDMENU
         
                    MENUITEM "&Indexes"
          MENU
               MENUITEM OemtoAnsi("&Open Index"+chr(9)+"Ctrl+X") ;
                    RESOURCE "OPEN" ;
                    ACTION OpenMyIndex();
                                        MESSAGE "Select an index file" ;
                    ACCELERATOR ACC_CONTROL, asc("X") ;
                    ENABLED
               MENUITEM OemtoAnsi("&Close Index"+chr(9)+"Ctrl+L") ;
                    RESOURCE "SAVE" ;
                    ACTION CloseMyIndex() ;
                    MESSAGE "Close current index file" ;
                    ACCELERATOR ACC_CONTROL, asc("L") ;
                    ENABLED
               
               MENUITEM "&Index order"+chr(9)+"Ctrl+P" ;
                    RESOURCE "PREV" ;
                    ACTION MySetOrder();
                    MESSAGE "Select index order from list" ;
                    ACCELERATOR ACC_CONTROL, asc("P") ;
                    ENABLED
               MENUITEM OemtoAnsi("&Filter by scope"+chr(9)+"Ctrl+F") ;
                    RESOURCE "FILTER" ;
                    ACTION MyScopes();  
                    MESSAGE "Set a scope to filter records, based on the active index" ;
                    ACCELERATOR ACC_CONTROL, asc("F") ;
                    ENABLED
               
               MENUITEM OemtoAnsi("&Change/add index"+chr(9)+"Ctrl+W") ;
                    RESOURCE "INDEX" ;
                    ACTION ChangeAddIndex();
                    MESSAGE "Change or add new index file or Tag" ;
                    ACCELERATOR ACC_CONTROL, asc("W") ;
                    ENABLED
          ENDMENU
                   
         
ENDMENU

return oMenu

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

static function files2brw( nRow, nCol, aFiles )

   local cFile

   for each cFile in aFiles
      if Upper( cFileExt( cFile ) ) == 'DBF'
         File2Brw( cFile )
      else
         CheckBrwDrop( ClientToScreen( oWndDbu:hWnd, { nRow, nCol } ), cFile)
      endif
   next

return nil

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

static function file2brw( cFile )

   local oWndChild, oBrw
   local cAlias, cFileNoExt

   if ! OpenFile( cFile, @cAlias, @cFileNoExt )
      return nil
   endif

   DEFINE WINDOW oWndChild MDICHILD OF oWndDbu ;
      TITLE cFileNoExt

   @ 0,0 XBROWSE oBrw OF oWndChild ;
      ALIAS cAlias ;
      AUTOCOLS AUTOSORT FOOTERS LINES CELL NOBORDER

   AEval( oBrw:aCols, { |oCol| oCol:cCol := oCol:cHeader } )
   AEval( oBrw:aCols, { |oCol| oCol:cHeader := Upper( Left( oCol:cHeader, 1 ) ) + Lower( Substr( oCol:cHeader, 2 ) ) } )
   //oBrw:bPopUp       := { |o| ColMenu( o ) }

   oBrw:CreateFromCode()
   oWndChild:oClient := oBrw

   //BrwBtnBar( oBrw )
   SET MESSAGE OF oWndChild TO cFile 2007
   
   ACTIVATE WINDOW oWndChild;
     VALID (testIndexWnd(cFile) ,(cAlias)->(DbCloseArea()) , hDel(hIndex,cAlias) , .T.)
   
   TDbfWnd():New( oWndChild, oBrw )

return nil
    func testIndexWnd(cFile)
    local oWnd := SearchWnd("Indexes of " + cFile,"TMDICHILD")
    IF oWnd<>nil
        oWnd:end()
    END
    return nil

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

static function CheckBrwDrop( aPoint, cFile )

   local ownd, oBrw, nRow, nCol
   local nColPos, nRowPos

   if ( oDbfWnd := oWndDbu:oWndActive ) != nil
      oBrw  := oWnd:oClient
      if oBrw != nil .and. oBrw:IsKindOf( TXBrowse() )
         aPoint   := ScreenToClient( oBrw:hWnd, aPoint )
         nRow     := aPoint[ 1 ]
         nCol     := aPoint[ 2 ]
         if oBrw:DropFile( nRow, nCol, cFile )
//            MsgInfo( 'handled' )
         else
            msginfo( 'Not Valid File' )
         endif
      endif
   endif

return nil

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

static function OpenFile( cFile, cAlias, cFileNoExt )

   local lOpen    := .f.
   local cDriver  := 'DBFCDX'

   if Upper( cFileExt( cFile ) ) == 'DBF'
      cFileNoExt  := cFileNoExt( cFile )
      cAlias   := cGetNewAlias( Left( cFileNoExt, 4 ) )
      TRY
         dbUseArea( .t., cDriver, cFile, cAlias, .t., .f. )
      CATCH
         MsgInfo( cFile + CRLF + 'can not be opened' )
         return .f.
      END
      lOpen := .t.
   else
      MsgInfo( 'Not a DBF File' )
   endif
(cAlias)->(LoadhIndex(cAlias))   // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

return lOpen

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

static PROC NewFile(CFILE)             // CFILE added

   //local cFile
    if cFile <> nil .AND. ! Empty( cFile ) .AND. file(cFile)
        File2Brw( cFile )
        Return
    endif

   if ! Empty( cFile := cGetFile(   "DataFile (*.DBF)|*.dbf|",          ;
                                    "Select Data File to Browse",1,     ;
                                    "\fwh\samples" ) )
      File2Brw( cFile )
   endif


return

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

CLASS TDbfWnd

   DATA  oBrowse, oWnd, oFont
   DATA  cAlias, cIndex, cSeekExpr
   DATA  lExclusive INIT .F.
   DATA  cLocate
   DATA  aColumns INIT {}
   DATA  aStruc INIT {}
   DATA  lAnsiTrans INIT .F.
   DATA  lExpress INIT .F.
   
   METHOD New( oWndChild, oBrw )
//   METHOD DelRec()
//   METHOD EditRec()
//   METHOD AppRec()
//   METHOD Refresh() INLINE ::oBrowse:Refresh()
//   METHOD GoTo( nRow, nCol )
//   METHOD Seek()
//   METHOD Skip()
//   METHOD Locate(lReady)

ENDCLASS

METHOD New( oWndChild, oBrw ) CLASS TDbfWnd

   local n

   ::oWnd    = oWndChild
   ::oBrowse = oBrw
   ::oWnd:Cargo = Self
   ::oWnd:bGotFocus = { || oDbfWnd := ::oWnd:Cargo }
   ::cAlias = Alias()
   ::oFont = oWndChild:oFont
   
   for n = 1 to FCount()
      AAdd( ::aStruc, { FieldName( n ), FieldType( n ), FieldSize( n ), FieldDec( n ) } )
   next    
   
   for n = 1 to Len( ::oBrowse:aCols )
      AAdd( ::aColumns, TDbfCol():New( Self, n ) )
   next  
   
   oDbfWnd = Self

return Self

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

CLASS TDbfCol

     CLASSDATA nColumns                                      AS NUMERIC

     DATA oDbfWnd                                            AS OBJECT
     DATA bData, bExpress                                    AS BLOCK
     DATA cAlias, cType, cHeader, cPicture, cField           AS CHARACTER
     DATA nField, nSize, nDec, nWidth                        AS NUMERIC
     DATA lJustify, lExpress, lError                         AS LOGICAL

     METHOD New(oDbfWnd, nField) CONSTRUCTOR

//     METHOD FromExp(oDbfWnd, cExpression) CONSTRUCTOR

     METHOD SetText(cPicture)
//     METHOD Check()

ENDCLASS

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

METHOD New(oDbfWnd,nField) CLASS TDbfCol

     LOCAL aStruc
     LOCAL uVal

     ::nColumns := ::nColumns + 1

     aStruc := oDbfWnd:aStruc
     uVal   := (oDbfWnd:cAlias)->(FieldGet(nField))

     ::oDbfWnd  := oDbfWnd
     ::nField   := nField
     ::cAlias   := oDbfWnd:cAlias
     ::cHeader  := aStruc[nField][1]
     ::cField   := aStruc[nField][1]
     ::cType    := aStruc[nField][2]
     ::nSize    := aStruc[nField][3]
     ::nDec     := aStruc[nField][4]
     ::cPicture := ""
     ::nWidth   := GetTextWidth(0,Replicate("B",Max(::nSize,len(::cHeader))+1),;
                               oDbfWnd:oFont:hFont)
     ::lJustify := (::cType == "N")
     ::bExpress := {|| FieldGet(::nField)}
     ::SetText()

RETURN Self

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

METHOD SetText(cPicture) CLASS TDbfCol

     DEFAULT cPicture := ::cPicture

     ::cPicture := trim(cPicture)

     DO CASE
     CASE ::cType == "N"
          IF !empty(cPicture)
               ::bData := {|| Transform(Eval(::bExpress),::cPicture)}
          ELSE
               ::bData := {|| str(Eval(::bExpress),::nSize,::nDec)}
          ENDIF

     CASE ::cType == "C"
          IF !empty(::cPicture)
               IF ::oDbfWnd:lAnsiTrans
                    ::bData := {|| Transform(OemtoAnsi(Eval(::bExpress)),::cPicture)}
               ELSE
                    ::bData := {|| Transform(Eval(::bExpress),::cPicture)}
               ENDIF
          ELSE
               IF ::oDbfWnd:lAnsiTrans
                    ::bData := {|| OemtoAnsi(Eval(::bExpress))}
               ELSE
                    ::bData := {|| Eval(::bExpress)}
               ENDIF
          ENDIF

     CASE ::cType == "D"
          ::bData := {|| dtoc(Eval(::bExpress))}

     CASE ::cType == "M"
          IF lDispMemo
               ::bData := {|| Memo2Txt(::bExpress)}
          ELSE
               ::bData := {|| "  <Memo>  "}
          ENDIF

     CASE ::cType == "L"
          ::bData := {|| iif(Eval(::bExpress),"True", "False") }
          //::bData := {|| iif(Eval(::bExpress),cYesLogic, cNoLogic) }
     ENDCASE

RETURN NIL

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

FUNCTION Memo2Txt(bExpr)

     LOCAL xExpr
     LOCAL cValtype

     xExpr := Eval(bExpr)
     cValtype := Valtype(xExpr)

     DO CASE
     CASE cValType == "A"
           RETU "< Array: ["+ltrim(str(len(xExpr)))+"] >"

     CASE cValType == "N"
          RETU "< Number: "+lTrim(Str(xExpr))+" >"

     CASE cValType == "C"
          IF empty(xExpr)
               RETU "< Empty string >"
          ELSE
               RETU StrTran(HardCR(Left(xExpr, 255)),CRLF,"$")
          ENDIF

     CASE cValType == "D"
          RETU  "< Date: "+dtoc(xExpr)+" >"

     CASE cValType == "L"
          RETU "< Logical: "+iif(xExpr,"True", "False")+" >"
          //RETU "< Logical: "+iif(xExpr,cYesLogic, cNoLogic)+" >"

     ENDCASE

RETURN ""
*************************
PROC OpenMyIndex()
******************
LOCAL cFile
LOCAL cPath,cFileName,cExtension
LOCAL oBrw   := oDbfWnd:oBrowse
LOCAL cAlias := oBrw:cAlias , aFile
LOCAL aStruct , nFor , n

IF EMPTY(cAlias)
    RETURN
END
Hb_fNameSplit((cAlias)->(DbInfo(DBI_FULLPATH)),@cPath,@cFileName,@cExtension)
IF EMPTY(cPath)
    cPath := CurDrive()+":\"+CurDir()
ELSE
    IF Right(cPath,1) == "
\"
        cPath := LEFT(cPath,LEN(cPath)-1)
    END
END 
IF File(cPath+"
\"+cFileName+".cdx")
    cFile :=    cGetFile(   "
IndexFile (*.CDX)|*.cdx|",          ;
                                    "
Select Index file",1,     ;
                                     cPath , , , , cFileName)
ELSE
    cFile :=    cGetFile(   "
IndexFile (*.CDX)|*.cdx|",          ;
                                    "
Select Index file",1,     ;
                                     cPath)
END    
IF ! Empty(cFile)
    (cAlias)->(DbSetIndex(cFile))
    (cAlias)->(LoadhIndex(cAlias))
    SetTagColumns(oBrw)
END

RETURN
************************************************************************************
PROC SetTagColumns(oBrw)
******************************
LOCAL aStruct
LOCAL nFor , n
LOCAL cAlias := oBrw:cAlias
aStruct := (cAlias)->(DbStruct())
(cAlias)->( OrderTagInfo( aStruct, 8 ) )
WITH OBJECT oBrw
    for nFor := 1 to Len( :aCols )
    if ( n := AScan( aStruct, { |a| a[ 1 ] == Upper( :aCols[ nFor ]:cHeader ) } ) ) > 0
        :aCols[ nFor ]:cSortOrder    := aStruct[ n ][ 8 ]
        :aCols[ nFor ]:cOrdBag       := ( cAlias )->( OrdBagName( :aCols[ nFor ]:cSortOrder ) )
        else
        :aCols[ nFor ]:cSortOrder    := nil
        :aCols[ nFor ]:cOrdBag       := nil
    endif
  next nFor
END
RETURN
************************************************************************************
STATIC FUNC SearchWnd(cTitle,ClassName)
**************************************
LOCAL aWin := GetAllWin()
LOCAL i , oWnd
i := ASCAN(aWin,{|o|Valtype(o)=="
O" .AND. IIF(PCOUNT()==2,o:ClassName=ClassName,.T.) .AND. UPPER(o:cTitle)=UPPER(cTitle)})
IF i > 0
    oWnd := aWin[i]
END
RETURN oWnd
**************************************************************************************
FUNC DlgDisEnable(lMOde)
************************
LOCAL el
LOCAL aWin , aDlg[0]
DEFAULT lMode := .F. // Disable
IF ! lMode
    WndMain():oMenu:Disable()
ELSE
    WndMain():oMenu:Enable()
END
RETURN .T.
************************************************************************************
PROC CloseMyIndex()
*******************
LOCAL oBrw   := oDbfWnd:oBrowse
LOCAL cAlias := oBrw:cAlias
LOCAL oCol
(cAlias)->(OrdListClear())
FOR EACH oCol IN oBrw:aCols
    oCol:cSortOrder := nil
    oCol:cOrder     := nil
    oCol:cOrdBag    := nil
NEXT
hIndex[cAlias] := {}
RETURN        
************************************************************************************
PROC MySetOrder()
**********************
LOCAL oDlg , oBut , oBrow
LOCAL oBrw   := oDbfWnd:oBrowse
LOCAL cAlias := oBrw:cAlias
LOCAL oCol , i , j
LOCAL aIndex[0] , ColName , nCol
LOCAL GehOrd := (cAlias)->(UPPER(OrdSetFocus())) , aRow
IF (cAlias)->(OrdCount()) == 0
    RETURN
END
FOR i := 1 TO (cAlias)->(OrdCount())
    ColName := Space(8)
    j := 0
    FOR EACH oCol IN oBrw:aCols
        IF oCol:cSortOrder <> nil .AND. UPPER(TRIM(oCol:cSortOrder)) == UPPER(TRIM((cAlias)->(OrdName(i))))
            ColName := UPPER(oCol:cHeader)
            j := oCol:nCreationOrder
            IF UPPER((cAlias)->(OrdName(i))) = GehOrd//oCol:cOrder$"
AD"
                nCol := Hb_EnumIndex()
            END
            EXIT
        END
    NEXT
    (cAlias)->(AADD(aIndex,{i,OrdName(i),OrdKey(i),j,ColName}))
NEXT
XBROWSER aIndex TITLE "
Select index" ;
                SETUP (cAlias)->(fSetup(oBrw));
              SELECT (aRow := oBrw:aRow)    
IF aRow <> nil
    i := aRow[4]
    IF i > 0
        oBrw:nColsel := i
        oBrw:aCols[i]:SetOrder()
        oBrw:Refresh()
        SysRefresh()
    ELSE
        OrdSetFocus(aRow[2])
        oBrw:Refresh()
    END
END
oBrw:Setfocus()
RETURN
***********************************************************************************
PROC fSetup(oBrw)
*********************   
    oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW
    oBrw:nArrayAt := IndexOrd()
    oBrw:aCols[1]:cHeader := "
Nr"
    oBrw:aCols[2]:cHeader := "
Order Name"
  oBrw:aCols[3]:cHeader := "
Expression"
    oBrw:aCols[4]:cHeader := "
Nr"
  oBrw:aCols[5]:cHeader := "
Name"
    oBrw:SetGroupHeader( "
Column",4,5)
    oBrw:oWnd:bInit := {||oBrw:oWnd:aControls[ BUTTON_PRINT ]:Hide() , oBrw:oWnd:aControls[ BUTTON_SHEET ]:Hide(),HideWildSeek(oBrw:oWnd)}
RETURN
PROC HideWildSeek(oDlg)
***********************
LOCAL Obj
FOR EACH Obj IN oDlg:aControls
    IF Obj:ClassName == "
TCHECKBOX"
        Obj:Hide()
        EXIT
    END
NEXT
RETURN
***************************************************************************************
PROC MyScopes(oBrw)
*******************
LOCAL oDlg , oDdlg , oBrow
LOCAL aHeaders , aWidth
LOCAL cTitle
LOCAL aIndex[0] , i
LOCAL nOrder , nRecord  
LOCAL bIndKey
LOCAL cAlias
LOCAL bShow
LOCAL   nCol := GetSysMetrics(0)/2 - 300
LOCAL   nRow := GetSysMetrics(1)/2 - 170
IF PCOUNT() == 0
    cAlias := oDbfWnd:oBrowse:cAlias
    SELECT (cAlias)
END
cAlias := Alias()
IF OrdCount() == 0
    RETURN
END
IF IndexOrd()==0
    DbSetOrder(1)
END
nOrder  := IndexOrd()
nRecord := RecNo()
aSize(aIndex,OrdCount())
FOR i := 1 TO LEN(aIndex)
    aIndex[i] := {OrdName(i) , , , , , }
    AddScopes(aIndex[i],i)  // Top , Bottom , nCount
NEXT
DEFINE DIALOG oDlg FONT WndMain():oFont();
     FROM nRow , nCol TO nRow + 340 , nCol + 600 PIXEL
oDlg:cTitle := cTitle
aHeaders := {"
Nr","TagName","Top Scope","Bottom Scope","Count"}
aWidth   := {20,70,185,185,50}
@ 5,5 XBROWSE oBrow OF oDlg ;
    SIZE 290,150;
    ARRAY aIndex;
    COLUMNS {{||oBrow:nArrayAt},1,2,3,4};
    HEADERS aHeaders;
    COLSIZES aWidth;
    PIXEL AUTOCOLS LINES
WITH OBJECT oBrow  
    :lhScroll := .F.
    :lFastEdit                    := .T.
    :nMoveType     := MOVE_FAST_RIGHT
    :lColChangeNotify := .T.
    :nMarqueeStyle := MARQSTYLE_HIGHLCELL
    bShow          := {||(cAlias)->(EditTest(@oDDlg , GetSysMetrics(1)/2 - 65 , nCol + 600  , oBrow)) ,;
                                                                            SetActiveWindow(oDlg:hWnd) , .T. }
    :bChange       := {|oBrw,lRow|oBrw:nColsel := MinMax(oBrw:nColsel,3,4) , IIF(lRow , EVAL(bShow) , oBrw:Refresh())  }
    :oCol("
Top Scope"):nEditType(1)
    :oCol("
Bottom Scope"):nEditType(1)
    :bClrSel                 := { || { CLR_WHITE, CLR_BLUE } }
  :oCol("
Nr"):bClrSel      := { || IIF(oBrow:nArrayAt==IndexOrd() , { CLR_BLACK, CLR_YELLOW } , { CLR_WHITE, CLR_BLUE }) }
    :bClrSelFocus            := {||{ CLR_WHITE, CLR_HBLUE } }
  :oCol("
Nr"):bClrSelFocus := { || IIF(oBrow:nArrayAt==IndexOrd() , { CLR_BLACK, CLR_YELLOW } , { CLR_WHITE, CLR_HBLUE }) }
   
    :bClrStd                 := { || { CLR_BLACK, CLR_WHITE }}
  :oCol("
Nr"):bClrStd      := { || IIF(oBrow:nArrayAt==IndexOrd() , { CLR_BLACK, CLR_YELLOW } , { CLR_BLACK, CLR_WHITE }) }
END
oBrow:CreateFromCode()
ACTIVATE DIALOG oDlg ;
         ON INIT ( oBrow:nRowSel := oBrow:nArrayAt := MAX(1,nOrder)  , EVAL(oBrow:bChange,oBrow,.T.) );
                 VALID ( IIF(oDdlg<>nil,oDdlg:end(),) , .T.)
IF oBrw <> nil .AND. ! Empty(cAlias)
    FOR i := 1 TO oBrw:nLen
        DbSetOrder(i)  
        bIndKey := &("
{||"+IndexKey()+"}")
        IF i == nOrder
            DbGoto(nRecord)
            IF EVAL(bIndKey) < OrdScope(0)
                DbGotop()
            ELSEIF EVAL(bIndKey) > OrdScope(1)
                DbGoBottom()
            END
        END
        oBrw:aArrayData[i,NCOUNT] := OrdKeyCount()
    NEXT
    oBrw:Refresh()
    DbSetOrder(nOrder)
END
RETURN
***************************************************************************************
PROC AddScopes(Arr,i)
*********************
LOCAL nOrder := IndexOrd()
LOCAL xTop , xBot , xFirst , xLast , nCount
LOCAL bIndKey
DbSetOrder(i)
bIndKey := &("
{||"+IndexKey()+"}")
xTop := OrdScope(0)
xBot := OrdScope(1)
OrdScope(0,nil)
DbGoTop()
xFirst := EVAL(bIndKey)
IF EMPTY(xTop)
    xTop := xFirst
END
OrdScope(1,nil)
DbGoBottom()
xLast := EVAL(bIndKey)
IF EMPTY(xBot)
    xBot := xLast
END
nCount := OrdKeyCount()
Arr[2] := xTop
Arr[3] := xBot
Arr[4] := nCount
Arr[5] := xFirst
Arr[6] := xLast
OrdScope(0,xTop)
OrdScope(1,xBot)
DbSetOrder(nOrder)
RETURN
***************************************************************************************
STATIC PROC Reindex(oBrw)
*************************
LOCAL aRow
REINDEX
FOR EACH aRow IN oBrw:aArrayData
    aRow[NCOUNT] := OrdKeyCount()
NEXT
oBrw:Refresh()
RETURN
***************************************************************************************
STATIC PROC EditTest( oDdlg , nRow, nCol, oBrw )
************************************************
local oDlg := oBrw:oWnd , aPoint , x
local nAt := oBrw:nArrayAt
local aRow := oBrw:aRow
local calias := Alias()
local Txt
local hRow := hIndex[cAlias,nAt]
IF oDdlg<>nil .AND. oDdlg:ClassName == "
TDIALOG"
    oDdlg:end()
END
DEFINE DIALOG oDDlg OF oBrw:oWnd FROM nRow +2, nCol TO nRow + 130, nCol + 370 PIXEL FONT WndMain():oFont();
    TITLE "
Index Tag :  " + aRow[1]
@ 2,5   SAY "
First record" OF oDdlg PIXEL
@ 2,56  SAY "
:  " + cValToChar(oBrw:aRow[5])   OF oDdlg PIXEL
@ 12,5  SAY "
Last  record"         OF oDdlg PIXEL
@ 12,56 SAY "
:  " + cValToChar(oBrw:aRow[6])   OF oDdlg PIXEL
@ 22,5  SAY  "
Index expression"    OF oDdlg PIXEL
@ 22,56 SAY  "
:  " + OrdKey(nAt)   OF oDdlg PIXEL
@ 32,5  SAY  "
For expression"      OF oDdlg PIXEL
@ 32,56 SAY  "
:  " + OrdFOr(nAt)   OF oDdlg PIXEL
@ 42,5  SAY  "
While expression"      OF oDdlg PIXEL
@ 42,56 SAY  "
:  " + hRow[CWHILE]   OF oDdlg PIXEL
@ 52,5  SAY  "
Scope"      OF oDdlg PIXEL
Txt := hRow[CSCOPE]
IF hRow[CSCOPE] $ "
NextRecord"
    Txt += "
" + LTRIM(STR(hRow[NRECORD]))
END
@ 52,56 SAY  "
:  " + Txt OF oDdlg PIXEL
IF hRow[LDESCEND]
    @ 52,100 SAY  "
  " + IIF(hRow[LDESCEND],"Descending","") OF oDdlg PIXEL
END
ACTIVATE DIALOG oDDlg NOWAIT ON INIT Move_Dlg(oDdlg,oDlg,nRow,nCol)
RETURN
PROC Move_Dlg(oDdlg,oDlg,nRow,nCol)
local x := MIN( GetSysmetrics(0) - (nCol + oDdlg:nWidth) , 0 )
oDDlg:Move(nRow  , nCol + x ,   ,  , .T.)
RETURN
***************************************************************************************
PROC ChangeAddIndex()
**********************
local oWnd, oBar, oBrw, oMsgBar , oBut[7]
LOCAL oBrwAct      := oDbfWnd:oBrowse
LOCAL cAlias       := oBrwAct:cAlias
local nOrder
local cPath, cFileName, cExtension , cTitle
local bClrStd
IF (cAlias)->(IndexOrd())==0 .AND. (cAlias)->(OrdCount()) > 0
    (cAlias)->(DbSetOrder(1))
END
nOrder := (cAlias)->(IndexOrd())
Hb_fNameSplit((cAlias)->(DbInfo(DBI_FULLPATH)),@cPath,@cFileName,@cExtension)
cTitle := cPath+cFileName+cExtension
DEFINE WINDOW oWnd TITLE "
Indexes of " + cTitle MDICHILD  ;
     FROM 1 , 1 TO 35 , 95

   DEFINE BUTTONBAR oBar OF oWnd 2010 SIZE 70, 70

   DEFINE BUTTON oBut[1] OF oBar PROMPT "
Add" FILE ".\..\..\bitmaps\32x32\plus.bmp"; // RESOURCE "add" ;
            ACTION ( (cAlias)->(NewIndex(oBrw)),           ;
                     (cAlias)->(IndexBuilder(oBrw,oBrwAct,.T.)) ,;
                             oBrw:Refresh(),;
                             SetButText(oBut,oBrw),;
                             oBrw:SetFocus(),;
                             oWnd:AevalWhen(),oBut[1]:Refresh(),oBut[4]:Refresh())
                                                                       
   DEFINE BUTTON oBut[2] OF oBar PROMPT "
Edit" FILE ".\..\..\bitmaps\32x32\edit.bmp"; //RESOURCE "edit32" ;
      ACTION ( (cAlias)->(IndexBuilder(oBrw,oBrwAct)),;
                      oBrw:Refresh(),;
                                oBrw:SetFocus(),;
                                oWnd:AevalWhen() )    

   DEFINE BUTTON oBut[3] OF oBar PROMPT "
Del" FILE ".\..\..\bitmaps\32x32\minus.bmp"; //RESOURCE "del32" ;
      ACTION If( MsgYesNo( "
Want to delete this tag ?" ),;
                ( ( cAlias )->( DelTag(oBrw,oBrwAct) ), oBrw:Refresh() ),)

     DEFINE BUTTON oBut[4] OF oBar PROMPT "
Rebuild All" FILE ".\..\..\bitmaps\16x16\build.bmp" ;
     ACTION ( (cAlias)->(BuildAllIndex(oBrw,oBrwAct)) ) //, oBrw:Refresh(), oBrw:SetFocus() )    
   
     DEFINE BUTTON oBut[5] OF oBar PROMPT "
Select Order" FILE ".\..\..\bitmaps\32x32\goto.bmp"; // RESOURCE "SelOrder" ;
     ACTION ( (cAlias)->(MySetOrder()) , nOrder := (cAlias)->(IndexOrd()) );
         GROUP             

   DEFINE BUTTON oBut[6] OF oBar PROMPT "
Scope:Top Bottom" FILE  ".\..\..\bitmaps\32x32\tiled.bmp" ; //RESOURCE "Scopes" ;
     ACTION ( (cAlias)->(MyScopes(oBrw))  )
               
   DEFINE BUTTON oBut[7] OF oBar PROMPT "
Reindex" FILE ".\..\..\bitmaps\32x32\setup.bmp";//RESOURCE "Setup" ;
     ACTION ( (cAlias)->(Reindex(oBrw))  )
     
     DEFINE BUTTON OF oBar PROMPT "
Report" FILE ".\..\..\bitmaps\32x32\print.bmp";//RESOURCE "report" ;
      ACTION oBrw:Report() GROUP

   DEFINE BUTTON OF oBar PROMPT "
Exit" FILE ".\..\..\bitmaps\16x16\exit2.bmp";//RESOURCE "exit" ;
      ACTION oWnd:End() GROUP
   
     @ 0, 0 XBROWSE oBrw OF oWnd ARRAY hIndex[cAlias] AUTOCOLS LINES ;
   HEADERS "
Order", "TagName", "Expression", "For", "BagName", "Count" ;
     COLUMNS {||oBrw:nArrayAt},CTAG,CKEY,CFOR,{||Hb_fNameSplit(hIndex[cAlias,oBrw:nArrayAt,CFILENAME],@cPath,@cFileName,@cExtension),cFileName+cExtension},NCOUNT;
   COLSIZES 40, 90, 200, 200 , 100, 50
     WITH OBJECT oBrw
        :nMarqueeStyle = MARQSTYLE_HIGHLROW
            :bChange    := {||SetButText(oBut,oBrw)}    
          :bkeyDown   := { | nkey | IIF(nkey==13 , EVAL(oBut[2]:bAction)  , IIF(nkey==VK_DELETE .AND. EVAL(oBut[3]:bWhen) , EVAL(oBut[3]:bAction)  ,  )  )}
        :bPastEof   := {||IIF(EVAL(oBut[1]:bWhen) , EVAL(oBut[1]:bAction) , )}                      
            :bLDblClick := {||EVAL(oBut[2]:bAction) }
           
            bClrStd := :bClrStd := { || If( oBrw:KeyNo() % 2 == 0, ;
                                { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                                { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
        :oCol("
Order"):bClrStd      := { || IIF(oBrw:nArrayAt==(cAlias)->(IndexOrd()) , { CLR_BLACK, CLR_YELLOW } , EVAL(bClrStd) ) }
        :bClrSel = :bClrSelFocus := { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }
        :oCol("
Order"):bClrSel      := { || IIF(oBrw:nArrayAt==(cAlias)->(IndexOrd()) , { CLR_BLACK, CLR_YELLOW } , { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) }) }
            :oCol("
Order"):bClrSelFocus := { || IIF(oBrw:nArrayAt==(cAlias)->(IndexOrd()) , { CLR_BLACK, CLR_YELLOW } , { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) }) }
            :SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
        :nDatalines := 2
            :CreateFromCode()
        :SetFocus()
        END
   oWnd:oClient = oBrw
   oBut[1]:bWhen := {||(cAlias)->(OrdCount())== LEN(oBrw:aArrayData)}
   //oBut[3]:bWhen := {||(cAlias)->(OrdCount())== oBrw:nLen}
   oBut[4]:bWhen := {||(cAlias)->(OrdCount())== LEN(oBrw:aArrayData)}
   DlgDisEnable(.F.)
     DEFINE MSGBAR oMsgBar 2010
   ACTIVATE WINDOW oWnd ON INIT (DlgMove(oWnd),EVAL(oBrw:bChange));
     VALID DlgDisEnable(.T.)
return nil
//----------------------------------------------------------------------------//
PROC DlgMove(oDlg)
LOCAL   nWd    
nWd := WndMain():nRight - oDlg:nWidth
oDlg:Move(  , nWd ,   ,  , .T.)
RETURN
*******************************************************************************************************
PROC SetButText(oBut,oBrw)
***************************
LOCAL Nr := STR(oBrw:nArrayAt,2)
oBut[2]:SetText("
Edit"+CRLF + "Order " + Nr)
oBut[2]:Refresh()
oBut[3]:SetText("
Del"+CRLF + "Order " + Nr)
oBut[3]:Refresh()
RETURN
*******************************************************************************************************
function IndexBuilder(oBrw , oBrwAct , lCreate)
*********************** 
   local oDlg
     local cAlias := oBrwAct:cAlias
     local aSubIndex[0] , i
     local o[NSTART] , Inp[NSTART]  // NSTART , 12 , last inputfield
     local oBut[1] , oSay[4]    
   local oPgr, nMeter := 0 , nStep := 10
     local nAt := oBrw:nArrayAt
     local nRow := oBrw:nRowSel * oBrw:nRowHeight  + oBrw:HeaderHeight() - 3
     local nCol := oBrw:oCol("
Order"):nDisplayCol
     local aPoint   := ClientToScreen( oBrw:hWnd, { nRow, nCol } )
     LOCAL nHt := GetSysMetrics(1) , nTo
     local cTmpFile , nHandle , bTmp := {|Inp|! Empty(Inp[CWHILE]) .OR. Inp[LTEMPORARY] .OR. Inp[LSUBINDEX] .OR. Inp[CSCOPE]<>"
All"}
     local cMem
     local nRw := 4 , nSt := 16
     local lRegular := .T.
     local aReg := {CKEY,CFILENAME,CTAG,CFOR,LUNIQUE,LDESCEND}
     local aTmp := {CWHILE,LTEMPORARY,LSUBINDEX,CSUBINDEX,CSCOPE,NRECORD,NSTART}
     local bRegular := {||AEVAL(aTmp,{|x|IIF(lRegular,o[x]:Hide(),o[x]:Show())}) , ShowHide(o,oSay,lRegular) , .T.}
     DEFAULT lCreate := .F.
     IF nAt > (cAlias)->(OrdCount())
            lCreate := .T.
     END     
     lRegular := ! EVAL(bTmp , oBrw:aRow)
     i := 1
     AEVAL(oBrw:aArrayData,{|a|IIF(i++<>nAt,AADD(aSubIndex , a[CTAG]),)})
     nRow    := aPoint[ 1 ]
     nCol    := aPoint[ 2 ]
     nTo := nRow+400
     DEFINE DIALOG oDlg OF oBrw:oWnd FROM nRow +2, nCol TO nTo , nCol + oBrw:nWidth*3/4;
                           PIXEL TITLE "
Index builder order " + LTRIM(STR(nAt))  //SIZE 530, 380
   
     @ nRw , 100 CHECKBOX lRegular PROMPT "
Regular index" OF oDlg SIZE 50 , 10 PIXEL;
                             WHEN lCreate;
                 ON CHANGE ( EVAL(bRegular) , (cAlias)->(TestProd(o,lRegular,oBrw)) )
                 //ON CHANGE AEVAL(aTmp,{|a|IIF(lRegular,o[a]:Hide(),o[a]:Show())})

     nRw += nSt
     @ nRw +2 , 7 SAY "
Expression:" OF oDlg SIZE 40, 8 PIXEL RIGHT
     Inp[CKEY] := SPACE(80)
   @ nRw , 50  GET o[CKEY] VAR Inp[CKEY] OF oDlg SIZE 200, 12 PIXEL ACTION ExpBuilder( o[CKEY] ) ;
      VALID If( ! Empty( Inp[CKEY] ), CheckExpression( Inp[CKEY] ), .F. )
   
     nRw += nSt
     @ nRw + 2 , 7 SAY "
To:" OF oDlg SIZE 40, 8 PIXEL RIGHT
     Inp[CFILENAME] := SPACE(80)
   @ nRw , 50 GET o[CFILENAME] VAR Inp[CFILENAME] OF oDlg SIZE 200, 12 PIXEL;
              PICTURE "
@K!"

     nRw += nSt
   @ nRw + 2 , 7 SAY "
Tag:" OF oDlg SIZE 40, 8 PIXEL RIGHT

   Inp[CTAG] := SPACE(20)
     @  nRw , 50 GET o[CTAG] VAR Inp[CTAG] OF oDlg SIZE 100, 11 PIXEL;
        PICTURE "
@K!";
        VALID ! EMPTY(Inp[CTAG])    // To avoid problems with CSUBINDEX

     nRw += nSt
   @ nRw + 2 , 7  SAY "
For:" OF oDlg SIZE 40, 8 PIXEL RIGHT

   @ nRw , 50 GET o[CFOR] VAR Inp[CFOR] OF oDlg SIZE 200, 11 PIXEL ACTION ExpBuilder(o[CFOR]) ;
      VALID If( ! Empty( Inp[CFOR] ), CheckExpression( Inp[CFOR] ) , .T. )

     nRw += nSt
   @ nRw + 2 , 7 SAY oSay[3] VAR "
While:" OF oDlg SIZE 40, 8 PIXEl RIGHT

   @ nRw , 50  GET o[CWHILE] VAR Inp[CWHILE] OF oDlg SIZE 200, 11 PIXEL ACTION ExpBuilder(o[CWHILE]) ;
      VALID If( ! Empty( Inp[CWHILE] ), CheckExpression( Inp[CWHILE] ), .T. ) //.AND. (cAlias)->(TestProd(o,bTmp,Inp,oBrw))

   nRw += nSt + 2
     @ nRw , 50 CHECKBOX o[LUNIQUE] VAR Inp[LUNIQUE] PROMPT "
&Unique" OF oDlg SIZE 50, 8 PIXEL

   @ nRw , 100 CHECKBOX o[LDESCEND] VAR Inp[LDESCEND] PROMPT "
&Descending" OF oDlg SIZE 50, 8 PIXEL

   @ nRw , 150 CHECKBOX o[LTEMPORARY] VAR Inp[LTEMPORARY] PROMPT "
&Memory" OF oDlg SIZE 50, 8 PIXEL

   @ nRw , 200 CHECKBOX o[LSUBINDEX] VAR Inp[LSUBINDEX] PROMPT "
&SubIndex" OF oDlg SIZE 58, 8 PIXEL;
                 ON CHANGE ShowHide(o,oSay)
     
     @ nRw+10 , 200 COMBOBOX o[CSUBINDEX] VAR Inp[CSUBINDEX] ITEMS aSubIndex OF oDlg PIXEL VALID ! EMPTY(Inp[CSUBINDEX])
     
     nRw += nSt
     @ nRw , 50  SAY oSay[4] VAR "
Scope:" OF oDlg SIZE 40, 8 PIXEL
   @ nRw , 100 SAY oSay[1] VAR "
Record:" OF oDlg SIZE 40, 8 PIXEL
   @ nRw , 150 SAY oSay[2] VAR "
StartRecord:" OF oDlg SIZE 40, 8 PIXEL

     nRw += nSt - 6
   @ nRw , 50  COMBOBOX o[CSCOPE] VAR Inp[CSCOPE] ITEMS { "
All", "Next", "Record", "Rest" } OF oDlg PIXEL;
                        ON CHANGE ShowHide(o,oSay)


   @ nRw , 100 GET o[NRECORD] VAR Inp[NRECORD] OF oDlg SIZE 30, 10 PIXEL


   @ nRw , 150 GET o[NSTART] VAR Inp[NSTART] OF oDlg SIZE 30, 10 PIXEL

     nRw += nSt
   @ nRw , 50  SAY "
Progress:" OF oDlg SIZE 40, 8 PIXEL

     nRw += nSt - 6
   @ nRw , 50 PROGRESS oPgr OF oDlg SIZE 200, 10 PIXEL

     nRw += nSt
     IF lCreate
          oBrw:aRow[NSTART] := (cAlias)->(Recno())
        @ nRw , 75 BUTTON oBut[1] PROMPT "
Create" OF oDlg SIZE 45, 13 PIXEL;
                WHEN ! EMPTY(Inp[CKEY]) .AND. ! EMPTY(Inp[CTAG])           ;
        ACTION ( SetBrwValues(o,oBrw,Inp) ,                        ;
                      (cAlias)->(CreateIndex(oBrwAct,oBrw,oBrw:nArrayAt,;
                                          { || nMeter += nStep, oPgr:SetPos( nMeter ), SysRefresh() })),;
                                oDlg:end())
     ELSE
        @ nRw , 75 BUTTON oBut[1] PROMPT "
Save" OF oDlg SIZE 45, 13 PIXEL;
                WHEN ! EMPTY(Inp[CKEY]) .AND. ! EMPTY(Inp[CTAG])          ;
        ACTION ( SetBrwValues(o,oBrw,Inp) , oDlg:end() )
     END
   
     @ nRw , 175 BUTTON "
&Cancel" OF oDlg SIZE 45, 13 ACTION oDlg:End() CANCEL PIXEL
   

   ACTIVATE DIALOG oDlg ON INIT (SetDlgValues(o,oBrw,oSay) , EVAL(bRegular) , MoveDlg(oDlg,oBrw) ) //,oCommand)

return nil
************************************************************************************
************************************************************************************
PROC SetDlgValues(o,oBrow,oSay)
*******************************
LOCAL i
LOCAL aIndex := oBrow:aRow
FOR i := 1 TO LEN(o)
    o[i]:Varput(aIndex[i])
    o[i]:Refresh()
    IF i == LSUBINDEX .AND. ! aIndex[i]
        o[CSUBINDEX]:Hide()
    END
NEXT
ShowHide(o,oSay)
RETURN
************************************************************************************
STATIC FUNC ShowHide(o,oSay,lRegular)
*************************************
LOCAL cScope    := o[CSCOPE]:Varget()
LOCAL lSubIndex := o[LSUBINDEX]:Varget()
IF lRegular <> nil .AND. lRegular
    oSay[1]:Hide()
    oSay[2]:Hide()
    oSay[3]:Hide()
    oSay[4]:Hide()
    o[CSUBINDEX]:Hide()
    o[NRECORD]:Hide()
    o[NSTART]:Hide()
    RETURN .T.
END
oSay[3]:Show()
oSay[4]:Show()
IF lSubIndex
    o[CSUBINDEX]:Show()
ELSE
    o[CSUBINDEX]:Hide()
END
IF (cScope IN {"
All"})
    oSay[1]:Hide()
    oSay[2]:Hide()
    o[NRECORD]:Hide()
    o[NSTART]:Hide()
ELSE
    IF (cScope IN {"
Next","Record"})
        oSay[1]:Show()
        o[NRECORD]:Show()
    END
    oSay[2]:Show()
    o[NSTART]:Show()
END
RETURN .T.
************************************************************************************
PROC SetBrwValues(o,oBrow,Inp) //,oCommand)
*******************************
LOCAL i
FOR i := 1 TO LEN(o)
    oBrow:aRow[i] := o[i]:Varget()
NEXT
oBrow:Refresh()
RETURN
********************************************************************************************************
PROC NewIndex(oBrow)
********************
local nOrder := IndexOrd()
local cAlias := Alias()
IF (cAlias)->(OrdCount()) > 0
    (cAlias)->(LoadhIndex(cAlias,.T.))
END
IF nOrder > 0
    Atail(hIndex[cAlias])[CSUBINDEX] := hIndex[cAlias,nOrder,CTAG]
END
oBrow:nArrayAt:=LEN(oBrow:aArrayData)
oBrow:Refresh()
RETURN
***************************************************************************************
PROC BuildAllIndex(oBrw,oBrwAct)
********************************
LOCAL oDlg , i , aBag[0] , cOrderBagName
LOCAL aIndex := oBrw:aArrayData
local nLen := oBrw:nLen
local nRow
local aScopes := Array(OrdCount())
local lCOunt := .F.
local nOrder := Indexord()
FOR i := 1 TO LEN(aScopes)
    aScopes[i] := {OrdName(i) , , , , , }
    AddScopes(aScopes[i],i)  //  , Top , Bottom , nCount , xFirst , xLast
NEXT
FOR i := OrdCount() TO 1 STEP -1
    OrdDestroy(i)
NEXT
OrdListClear()
FOR i := 1 TO nLen
      //IF i == 3
        //  DbSetOrder(1)
        //END
        MsgMeter( { | oMeter, oText, oDlg, lEnd | ;
             BCdxIndex( oMeter, oText, oDlg, @lEnd , oBrw , oBrwAct , i ) } , "
IndexKey : " + aIndex[i,CKEY] , "Order : " + STR(i,2) + " " + aIndex[i,CTAG] )//,;
        lCount := .F.
        DbSetOrder(i)
        IF aScopes[i,2]<>nil .AND. aScopes[i,2] > aScopes[i,5]
            OrdScope(0,aScopes[i,2])
            lCOunt := .T.
        END
        IF aScopes[i,3]<>nil .AND. aScopes[i,3] < aScopes[i,6]
            OrdScope(1,aScopes[i,3])
            lCount := .T.
        END
        IF lCount
            oBrw:aArrayData[i,NCOUNT] := OrdKeyCount()
        END
NEXT
DbSetOrder(nOrder)
oBrw:Refresh()
RETURN
**********************************************************************************
PROC BCdxIndex( oMeter, oText, oDlg , lEnd , oBrow, oBrwAct , i )
****************************************************************************
oMeter:nTotal = RecCount()
CreateIndex(oBrwAct,oBrow,i,{||(oMeter:Set(RecNo() ),SysRefresh(),! lEnd )})
RETU
***************************************************************************************
PROC CreateIndex(oBrwAct,oBrow,i,bEval)
***************************************
local cAlias       := oBrwAct:cAlias
local nOrder := (cAlias)->(IndexOrd())
LOCAL cFor , bFor , cWhile , cSubIndex
LOCAL lAll , bWhile , nInterval := 10 , nStart , nNext  , nRecord , lRest , lDescend , lReserved , lAdditive , lCurrent , lCustom , lNoOptimize , lTemporary := .F.
LOCAL cOrderBagName , cOrderName , ckey , bkey , lUnique
LOCAL a
LOCAL j
LOCAL aIndex := oBrow:aArrayData
LOCAL cText
CursorWait()
    a := aIndex[i]
    IF EMPTY(a[CFILENAME]+a[CTAG]) .OR. EMPTY(a[CKEY])
        RETURN
    END
    IF ! EMPTY(a[CFILENAME])
        cOrderBagName := a[CFILENAME]
    END
    lCurrent  := a[LSUBINDEX]
    cSubIndex := a[CSUBINDEX]
    IF ! EMPTY(a[CFOR])
        cFor := ALLTRIM(a[CFOR])
        bFor := COMPILAR(cFor)
    END
    lAll := (a[CSCOPE] == "
All")
    IF ! EMPTY(a[CWHILE])
        cWhile := ALLTRIM(a[CWHILE])
        bWhile := COMPILAR(cWhile)
    END
    IF lCurrent .AND. ! EMPTY(cSubIndex)
        (cAlias)->(OrdSetFocus(cSubIndex))
        IF ! EMPTY(cWhile) .AND. ! a[CSCOPE]$"
NextRest"
            (cAlias)->(DbGotop())
            DO WHIL ! (cAlias)->(EVAL(bWhile)) .AND. ! (cAlias)->(Eof())
                (cAlias)->(DbSkip())
            END
        END
    END
    lDescend  := a[LDESCEND]
    nStart    := (cAlias)->(RECNO())
    IF ! lAll
        IF (a[CSCOPE] IN "
RestNext")
            DEFAULT a[NSTART] := (cAlias)->(RECNO())
            nStart := a[NSTART]
            IF a[CSCOPE] = "
Rest"
                lRest := .T.
            ELSE
                nNext   := a[NRECORD]
            ENDIF
        ELSEIF a[CSCOPE] == "
Record"
            nRecord := a[NRECORD]
        END
    END
    lTemporary    := a[LTEMPORARY]
    cOrderName    := a[CTAG]
    ckey          := TRIM(a[CKEY])
    bkey          := COMPILAR(cKey)
    lUnique       := a[LUNIQUE]
    lAdditive     := .T.
    //                       1     2      3       4       5         6          7       8         9        10       11     12     13          14         15        16          17        18
    (cAlias)->(ordCondSet( cFor , bFor , lAll , bWhile , bEval , nInterval , nStart , nNext  , nRecord , lRest , lDescend , , lAdditive , lCurrent , lCustom , lNoOptimize , cWhile , lTemporary , , .F.))
    (cAlias)->(ordCreate(cOrderBagName , cOrderName , ckey , bkey , lUnique))
    aIndex[i,NCOUNT] := (cAlias)->(OrdKeyCount(i))
CursorArrow()
IF (cAlias)->(OrdKeyCount(i)) > 0
    (cAlias)->(SetTagColumns(oBrwAct))
    SetIndOrd(oBrow,oBrwAct,@nOrder)
ELSE
    IF (cAlias)->(Indexord()) == i
        (cAlias)->(DbSetOrder(nOrder))
        (cAlias)->(DbGotop())
        oBrwAct:Refresh(.T.)     
    END
END
oBrow:Refresh()
oBrow:oWnd:AevalWhen()
sysrefresh()
RETURN
*************************************************************************************
PROC DelTag(oBrow,oBrwAct)
*************************
LOCAL oCol
LOCAL nOrder := (oBrwAct:cAlias)->(IndexOrd())
LOCAL nAt := oBrow:nArrayAt
LOCAL i
IF ! (nAt == LEN(oBrow:aArraydata) .AND. EMPTY(oBrow:aRow[CTAG]))
    (oBrwAct:cAlias)->(OrdDestroy(nAt))
    IF ! EMPTY(oBrow:aRow[CTAG])
        FOR EACH oCol IN oBrwAct:aCols
            i := Hb_EnumIndex()
            IF oCol:cSortOrder <> nil .AND. oCol:cSortOrder == oBrow:aRow[CTAG]
                oCol:cSortOrder := nil
            END
        NEXT
    END
END
aDel(oBrow:aArrayData,nAt,.T.)
oBrow:nLen := LEN(oBrow:aArrayData)
oBrow:Keycount()
oBrow:nArrayAt := MIN(oBrow:nArrayAt , LEN(oBrow:aArrayData))
SetIndOrd(oBrow,oBrwAct,@nOrder)
oBrow:Refresh(.T.)                                                
RETURN
*******************************************************************************************************
PROC MoveDlg(oDlg,oBrow)
************************
LOCAL x := oDlg:nBottom - WndMain():nBottom
LOCAL nHt := oDlg:nTop , nWd := oDlg:nLeft
IF x > 0
    oDlg:Move(nHt - x  , nWd ,  , , .T.)   
END
RETURN
********************************************************************************************************
PROC SetIndOrd(oBrow,oBrw,nOrder)
**********************************
LOCAL oCol
(oBrw:cAlias)->(OrdSetFocus(oBrow:aRow[CTAG]))
oBrow:Refresh()
FOR EACH oCol IN oBrw:aCols
    IF oCol:cSortOrder <> nil .AND. oCol:cSortOrder = UPPER(oBrow:aRow[CTAG])
        AEVAL(oBrw:aCols,{|o|o:cOrder := nil})
        oCol:cOrder := "
A"
        oBrw:Refresh()
    END
NEXT
SysRefresh()
RETURN
*********************************************************************************************************
FUNC TestProd(o,lRegular,oBrw)
******************************
local cTmpFile
local   nHandle
local el
IF ! lRegular
    cTmpFile := GetEnv("
TEMP") + "\" + DTOS(DATE()) + "." + CharOnly("0123456789",Time()) + ".cdx"
    o[LTEMPORARY]:Varput(.T.)
    o[LTEMPORARY]:Refresh()
ELSE
    cTmpFile := ATAIL(oBrw:aArrayData)[CFILENAME]
END
o[CFILENAME]:Varput(cTmpFile)
o[CFILENAME]:Refresh()
RETURN .T.
********************************************************************************************************
PROC LoadhIndex(cAlias,lNewLine)
********************************
LOCAL i
LOCAL cPath , cFileName , cExtension
LOCAL lTemporary := .F. , lSubIndex  := .F.
LOCAL cSubIndex  := Space(10)
LOCAL cScope := "
All" , nRec := 0
LOCAL nStart
LOCAL cWhile := Space(80)
DEFAULT cAlias := Alias() , lNewLine := .F.
IF ! hHasKey(hIndex,cAlias)
    hIndex[cAlias] := {}
END
IF (cAlias)->(IndexOrd()) > 0
    cSubIndex := (cAlias)->(OrdName(IndexOrd()))
END
IF (cAlias)->(OrdCount()) > 0 .AND. ! lNewLine
    FOR i := 1 TO (cAlias)->(OrdCount())
        Hb_fNameSplit((cAlias)->(DbOrderInfo(DBOI_FULLPATH ,, i)),@cPath,@cFileName,@cExtension)
        IF EMPTY(cPath)
            cPath := CurDrive()+"
:\"+CurDir()
        END
        IF Right(cPath,1) <> "
\"
            cPath += "
\"
        END
        cFileName := UPPER(cPath+cFileName+cExtension)
        IF ASCAN(hIndex[cAlias],{|a|a[2]=cFilename .AND. a[3]=(cAlias)->(OrdName(i))})==0
        //                     nOrder,Path,Indexfile,lMulti-tag,TagName, Keyexpression,    For expression,     lIsUnique ,   lDescend    , ... )
            (cAlias)->(AADD(hIndex[cAlias],{PAD((cAlias)->(OrdKey(i)),80),PAD(cFileName,80),PAD((cAlias)->(OrdName(i)),20),PAD((cAlias)->(OrdFor(i)),80),cWhile,(cAlias)->(OrdIsUnique(i)),(cAlias)->(OrdDescend(i)),lTemporary,lSubIndex,cSubIndex,cScope,nRec,nStart,(cAlias)->(OrdkeyCount(i))}))
        END
    NEXT
ELSE
    IF LEN(hIndex[cAlias]) == 0
        Hb_fNameSplit((cAlias)->(DbInfo(DBI_FULLPATH)),@cPath,@cFileName,@cExtension)
        cExtension := (cAlias)->(OrdBagExt())
        IF EMPTY(cPath)
            cPath := CurDrive()+"
:\"+CurDir()
        END
        IF Right(cPath,1) <> "
\"
            cPath += "
\"
        END
        cFileName := UPPER(cPath+cFileName+cExtension)
    ELSE
        cFileName := Atail(hIndex[cAlias])[CFILENAME]
    END
    AADD(hIndex[cAlias] , {Space(80),PAD(cFileName,80),Space(20),Space(80),Space(80),.F.,.F.,lTemporary,lSubIndex,cSubIndex,cScope,nRec,nStart,0})
END
RETURN
*************************************************************************************
FUNCTION NM_ALFA(tekst)
***********************
// Used in indexexpressions
DEFAULT tekst := "
"
RETU PADR(CharOnly("
AZERTYUIOPQSDFGHJKLMWXCVBN1234567890",upper(TRIM(tekst))),20)
*************************************************************************************
//----------------------------------------------------------------------------//

function ExpBuilder( cExp )

   local oDlg, oBrw, aFields := DBStruct()
   local oExp, cFunction, nLen := Len( cExp )
   local Obj
     IF VALTYPE(cExp) == "
O"
        Obj  := cExp
        cExp := Obj:Varget()
     END
     cExp = RTrim( cExp )

   DEFINE DIALOG oDlg TITLE "
Expression builder" SIZE 480, 450

   @ 0.2, 1.5 SAY "
Expression:" SIZE 80, 11 OF oDlg

   @ 1.1, 1 GET oExp VAR cExp MEMO SIZE 221, 27

   @ 3, 1.5 SAY "
Fields" OF oDlg SIZE 40, 10

   @ 4, 1 XBROWSE oBrw OF oDlg ARRAY aFields AUTOCOLS LINES SIZE 120, 120;
      HEADERS "
Name", "Type", "Len", "Dec" ;
      COLSIZES 95, 30, 30, 30
     
   oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                         { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
     
   oBrw:CreateFromCode()
   oBrw:bLDblClick = { || cExp += oBrw:aRow[ 1 ], oExp:Refresh() }
   @ 3, 23.1 SAY "
Operators" OF oDlg SIZE 40, 10

   @ 3.1, 23 BUTTON "
=" OF oDlg SIZE 15, 15 ACTION ( cExp += " = ", oExp:Refresh() )

   @ 3.1, 26.2 BUTTON "
<>" OF oDlg SIZE 15, 15 ACTION ( cExp += " <> ", oExp:Refresh() )

   @ 3.1, 29.4 BUTTON "
+" OF oDlg SIZE 15, 15 ACTION ( cExp += " + ", oExp:Refresh() )

   @ 3.1, 32.6 BUTTON "
(" OF oDlg SIZE 15, 15 ACTION ( cExp += " ( ", oExp:Refresh() )

   @ 3.1, 35.8 BUTTON "
.T." OF oDlg SIZE 15, 15 ACTION ( cExp += " .T. ", oExp:Refresh() )

   @ 4.1, 23 BUTTON "
<" OF oDlg SIZE 15, 15 ACTION ( cExp += " < ", oExp:Refresh() )

   @ 4.1, 26.2 BUTTON "
>" OF oDlg SIZE 15, 15 ACTION ( cExp += " > ", oExp:Refresh() )

   @ 4.1, 29.4 BUTTON "
-" OF oDlg SIZE 15, 15 ACTION ( cExp += " - ", oExp:Refresh() )

   @ 4.1, 32.6 BUTTON "
)" OF oDlg SIZE 15, 15 ACTION ( cExp += " )", oExp:Refresh() )

   @ 4.1, 35.8 BUTTON "
.F." OF oDlg SIZE 15, 15 ACTION ( cExp += " .F. ", oExp:Refresh() )

   @ 5.1, 23 BUTTON "
<=" OF oDlg SIZE 15, 15 ACTION ( cExp += " <= ", oExp:Refresh() )

   @ 5.1, 26.2 BUTTON "
>=" OF oDlg SIZE 15, 15 ACTION ( cExp += " >= ", oExp:Refresh() )

   @ 5.1, 29.4 BUTTON "
*" OF oDlg SIZE 15, 15 ACTION ( cExp += " * ", oExp:Refresh() )

   @ 5.1, 32.6 BUTTON "
/" OF oDlg SIZE 15, 15 ACTION ( cExp += " / ", oExp:Refresh() )

   @ 5.1, 35.8 BUTTON "
$" OF oDlg SIZE 15, 15 ACTION ( cExp += " $ ", oExp:Refresh() )

   @ 6.1, 23 BUTTON '"
' OF oDlg SIZE 15, 15 ACTION ( cExp += '"', oExp:Refresh() )

   @ 6.1, 26.2 BUTTON "
!" OF oDlg SIZE 15, 15 ACTION ( cExp += " ! ", oExp:Refresh() )

   @ 6.1, 29.4 BUTTON "
SP" OF oDlg SIZE 15, 15 ACTION ( cExp += " ", oExp:Refresh() )

   @ 6.1, 32.6 BUTTON "
," OF oDlg SIZE 15, 15 ACTION ( cExp += ", ", oExp:Refresh() )

   @ 6.1, 35.8 BUTTON "
:" OF oDlg SIZE 15, 15 ACTION ( cExp += " : ", oExp:Refresh() )

   @ 7.1, 23 BUTTON "
AND" OF oDlg SIZE 27, 15 ACTION ( cExp += " .and. ", oExp:Refresh() )

   @ 7.1, 28.4 BUTTON "
OR" OF oDlg SIZE 27, 15 ACTION ( cExp += " .or. ", oExp:Refresh() )

   @ 7.1, 33.7 BUTTON "
NOT" OF oDlg SIZE 27, 15 ACTION ( cExp += " ! ", oExp:Refresh() )

   @ 10.3, 23.2 SAY "
Functions" OF oDlg SIZE 84, 11

   @ 11.9, 17.3 COMBOBOX cFunction ITEMS { "
AllTrim()", "Left()", "Right()", "SubStr()" } ;
      OF oDlg SIZE 92, 80 ON CHANGE ( cExp += Left( cFunction, Len( cFunction ) - 1 ) + "
",;
                                      oExp:Refresh() )

   @ 11, 13 BUTTON "
&Ok" OF oDlg SIZE 45, 13 ;
      ACTION If( ! Empty( cExp ), If( CheckExpression( cExp ), oDlg:End(),), oDlg:End() )

   @ 11, 24 BUTTON "
&Cancel" OF oDlg SIZE 45, 13 ACTION oDlg:End() CANCEL

   ACTIVATE DIALOG oDlg CENTERED

   if Empty( cExp )
      cExp = Space( nLen )
   endif

     IF !(Obj==nil)
        Obj:Varput(cExp)
        Obj:Refresh()
     END

return cExp
//----------------------------------------------------------------------------//

function CheckExpression( cExpression )

   local bCode := GENBLOCK( cExpression ), lResult := .F., oError

   TRY
      Eval( bCode )
      lResult = .T.
   CATCH oError
      MsgAlert( oError:Description + If( ! Empty( oError:Operation ),;
                CRLF + oError:Operation, "
" ) + CRLF + ArgsList( oError ),;
                "
Expression error" )
   END

return lResult

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

static function ArgsList( oError )

   local cArgs := "
", n

   if ValType( oError:Args ) == "
A"
      cArgs += "
Args:" + CRLF
      for n = 1 to Len( oError:Args )
         cArgs += "
  [" + Str( n, 4 ) + "] = " + ValType( oError:Args[ n ] ) + ;
                  "
  " + cValToChar( oError:Args[ n ] ) + CRLF
      next
   elseif ValType( oError:Args ) == "
C"
      cArgs += "
Args:" + oError:Args + CRLF
   endif

return cArgs

test
Franklin Demont
 
Posts: 166
Joined: Wed Aug 29, 2012 8:25 am


Return to FiveWin for Harbour/xHarbour

Who is online

Users browsing this forum: No registered users and 60 guests