**
** Dic-2006: hernancano
**
** funciona en FPW
** no falla cuando es unidimensional
*
* Name: Array Browser
* : This is a development tool that allows to view an array in
* the Browse window
*
* Note 1 : The colum Name format : <T>_<C>_<L>
* T - Column type, V if there are diff types of values in the column
* C - Column Number
* L - Max len requered to represent value in this column.
* Added only in the columns with data types of variable size.
*
* Note 2 : The BrowseArrayCursor cursor isn't closed to allow BROWSE NOWAIT
*
* Author : Sergey Berezniker
* : Version 1.0.10 04/25/2002
* Email :
sergeyb-at-isgcom.com* : This program is placed into Public domain. Comments and suggestions
* are welcome.
*
* Changes: 19.03.2002 by Daniel Gramunt: Optional parameter < tcCaption > added
* 03/19/2002 by --SB-- : Modified the BROWSE command to display in the
* desktop.
* 04/24/2002 by --SB-- : Fixed problem with the objects in the array.
* 04/25/2002 by --SB-- : The size isn't added to the column name with
* fixed size data types in it
#if left(type([_VFP]),1)==[O]
LPARAMETER taArray, tcCaption, tlKeepOpen
#else
PARAMETER taArray, tcCaption, tlKeepOpen
#endif
* Make sure that parameter passed is an array
*if !_IsArray(@taArray)
if type("taArray[1]")=[U]
*MessageBox("Please pass array by reference!", 48, PROGRAM() + " - Array Browser")
wait window "Pase un arreglo por referencia!"+chr(13)+program() + " - Array Browser"
return .f.
endif
**
#if left(type([_VFP]),1)==[O]
Local lcTalkOld, lcOldArea
LOCAL lnRows, lnCols, lnI, lnJ, lcType, lnSize, ll1d, lnDec, lcRow, llAddSize,;
lvValue, laStru[1], lcCaption
#else
private lcTalkOld, lcOldArea
private lnRows, lnCols, lnI, lnJ, lcType, lnSize, ll1d, lnDec, lcRow,;
llAddSize, lvValue, laStru[1], lcCaption
#endif
if upper(set([TALK]))=[ON]
set talk off
lcTalkOld=[ON]
else
lcTalkOld=[OFF]
endif
lcOldArea = SELECT(0)
lcCaption = IIF(TYPE("tcCaption")="C" AND NOT EMPTY(tcCaption),;
tcCaption, "Browse_Array_Cursor" )
* Makes a cursor out of a one or two-dimensional array and browses it
* Controls if the MAX size of the value in the column is added
* to the column name
llAddSize = .T.
* Figure out the size of an array
lcCursor = "crs" + RIGHT(SYS(2015), 7) && BrowseCrs
lnRows = alen(taArray,1)
lnCols = max( alen(taArray,2), 1 )
ll1d = (lnCols = 1) && Is array 1D?
DIMENSION laStru(lnCols+1, 16)
lcRow = ""
laStru = ""
* Create an array with cursor structure definition
FOR lnI = 1 TO lnCols
lcCol = alltrim(transform(lnI,[@]))
lvValue = taArray( 1, lni )
*laStru[ lnI, 1 ] = VARTYPE(lvValue )
laStru[ lnI, 1 ] = TYPE([lvValue])
laStru[ lnI, 2 ] = "C"
lnSize = 1
FOR lnJ = 1 TO lnRows
IF ll1d
lvValue = taArray( lnJ )
ELSE
lvValue = taArray( lnJ, lnI )
ENDIF
IF laStru[ lnI, 1 ] <> TYPE( "lvValue" )
laStru[ lnI, 1 ] = "V"
ENDIF
* --sb-- 04/24/2002 -- Fixed a problem with an object in array element
lnSize = max( lnSize, len( B_R_Transform(lvValue)))
ENDFOR
laStru[ lnI, 1 ] = laStru[ lnI, 1 ] + "_" + lcCol
* --sb-- 04/25/2002 -- Don't add size if it's fixed for that data type
IF llAddSize AND NOT inlist(left(laStru[ lnI,1],1),"L","D","I","T","O","G")
laStru[ lnI, 1 ] = laStru[ lnI, 1 ] + "_" + alltrim(transform(lnSize,[@]))
ENDIF
lnSize = MIN( 254, lnSize)
laStru[ lnI, 3 ] = lnSize
laStru[ lnI, 4 ] = 0
laStru[ lnI, 5 ] = .F.
laStru[ lnI, 6 ] = .F.
* Create "insert into" values clause
* --sb-- 04/24/2002 -- Fixed problem with an object in array element
lcRow = lcRow + IIF(EMPTY( lcRow ), "", ", ") + ;
"B_R_Transform( taArray[lnI" + IIF(ll1d, "", "," +lcCol) + "] )"
ENDFOR
lAlFinal=.f.
if lAlFinal
lnI = alen(laStru,1)
lcRow = lcRow + ", 0"
else
for lnI = alen(laStru,1) TO 2 step -1
for nK=1 to alen(laStru,2)
laStru[ lnI, nK ] = laStru[ lnI-1, nK ]
endfor
endfor
lnI = 1
lcRow = "0, "+lcRow
endif
laStru[ lnI, 1 ] = "Row_______"
laStru[ lnI, 2 ] = "N"
laStru[ lnI, 3 ] = 7
laStru[ lnI, 4 ] = 0
laStru[ lnI, 5 ] = .F.
laStru[ lnI, 6 ] = .F.
* Make a cursor with fields defined by laStru
*CREATE CURSOR BrowseArrayCursor FROM ARRAY laStru
CREATE CURSOR (lcCursor) FROM ARRAY laStru
* Add rows into cursor
FOR lnI = 1 TO lnRows
*INSERT INTO BrowseArrayCursor VALUES ( &lcRow )
lcCreate = "INSERT INTO " + lcCursor + " VALUES ( "+lcRow +")"
&lcCreate
ENDFOR
**
IF USED(lcCursor)
REPLACE ALL Row_______ WITH RECNO()
LOCATE && GO TOP
KEYBOARD "{CTRL+F10}" CLEAR
IF tlKeepOpen
*BROWSE NOWAIT IN SCREEN LAST NORMAL TITLE (lcCaption)
BROWSE NOWAIT IN SCREEN NORMAL TITLE (lcCaption) noedit
ELSE
*BROWSE NORMAL noedit
BROWSE NORMAL TITLE (lcCaption) noedit
USE IN (lcCursor)
ENDIF
ENDIF
**
SELECT (lcOldArea)
SET TALK &lcTalkOld
RETURN
*-------------------------------------------------------
* Function returns "(Obj)" if the passed value is an object
* otherwise it works like Transform() w/o 2nd parameter
*FUNCTION B_R_Transform(tvVal)
FUNCTION B_R_Transform
parameter tvVal
*RETURN iif(Vartype(tvVal)="O", "(Obj)", Transform(tvVal))
*#DEFINE OBJECT_CAPTION "(Object)"
#DEFINE OBJECT_CAPTION "(Obj)"
RETURN iif(type([tvVal])="O", OBJECT_CAPTION, alltrim(transform(tvVal,[@])))
**