www.FiveTechSoft.com
https://fivetechsoft.com/forums/
Antonio ,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
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.Franklin Demont wrote:Antonio ,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
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
Code: Select all
#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("AZERTYUIOPQSDFGHJKLMWXCVBN1234567890",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