i've said it before and i'll say it again. arrays in vfp are not good. the cursor can do far more and sensibly too. simply modify structure. insert a new field between any two existing fields and the result is what you expect. not so with ains and two-dimensional (2d) arrays. this code demonstrates:

clear

?"using ains"

local array laarray[1]

prepareinitialarray(@laarray)

dimension laarray[3,3]

displayarray(@laarray)

ains(laarray,2,2)

displayarray(@laarray)

release all like laarray

*by this point the array does not look like it should.

wait window "now try ainsertcolumn"

clear

?"using ainsertcolumn"

local array laarray[1]

prepareinitialarray(@laarray)

ainsertcolumn(@laarray,2)

displayarray(@laarray)

return

procedure prepareinitialarray

lparameters raarray

?"initial array"

dimension raarray[3,2]

local m.lnx

for lnx = 1 to alen(raarray)

   raarray[m.lnx]=" "+alltrim(str(m.lnx))+" "

endfor m.lnx

displayarray(@raarray)

return

procedure displayarray

lparameters raarray

*!* display memory like raarray

local m.lnx, m.lny

?

for m.lny = 1 to alen(raarray,1)

   for m.lnx = 1 to alen(raarray,2)

      ??raarray[m.lny,m.lnx],

   endfor m.lnx

   ?

endfor m.lny

return

here is ainsertcolumn.prg, a little udf that does this job as expected.

*

* ainsertcolumn.prg

* returns a logical value indicating whether the

* specified column was inserted into the specified

* array.

*

* copyright (c) 2008-2012 fox ridge software all rights reserved

* 120 parsell square

* toronto, on canada m1b 2a6

* 416-282-3942

* http://www.foxridgesoftware.com

* author: mike yearwood

*

* usage

* =====================================

* *insert a column before the specified column.

* *no data will be lost.

* if ainsertcolumn(@m.somearray,3)

*    ...

* endif

*

* lparameters

* tasource (r) array to process passed here by reference

* tntargetcolumn (r) insert column before specified. must be numeric and

* within the array column boundaries (+1).

*

lparameters tasource, m.tntargetcolumn

if not x2isarray(@tasource)

   *it has to be an array.

   error 232,"tasource" && name is not an array.

endif

local m.lnsourcecolumncount

m.lnsourcecolumncount = alen(tasource,2)

do case

case vartype(m.tntargetcolumn) # "n"

   *you have to specify a numeric column.

   error 11,"tntargetcolumn" && function argument, value, type or count is invalid.

case m.tntargetcolumn <= 0 ;

or m.tntargetcolumn > (m.lnsourcecolumncount + 1)

   *you can't attempt to insert column 0,

   *nor a column more than 1 wider than the

   *existing array.

error 31 && invalid subscript reference.

endcase

*determine the number of rows and columns in the final result.

local m.lntargetcolumncount, m.lnrow, m.lntargetrowcount

lntargetcolumncount = alen(tasource,2) + 1

lntargetrowcount = alen(tasource,1)

*turn the array into a single column array because ains() won't

*move the data in a 2 dimensional array.

dimension tasource[m.lntargetrowcount * m.lntargetcolumncount]

for m.lnrow = 1 to m.lntargetrowcount

   *insert each cell into the target column, and

   *vfp will move the data toward the end.

   ains(tasource,((m.lnrow-1) *
m.lntargetcolumncount) + m.tntargetcolumn
)

endfor

*redimension the source array so it fits the new data

dimension tasource[m.lntargetrowcount,m.lntargetcolumncount]

return .t.

ainsertcolumn uses x2isarray a utility to determine if a passed variable or object is an array. thanks to russ swall at visionpace - who donated it to the vfp community - in memory of drew speedie.

*

* x2isarray.prg

* returns a logical value indicating whether the

* variable passed by reference or the passed object.property

* is an array.

*

* copyright (c) 2004-2005 visionpace all rights reserved

* 17501 east 40 hwy., suite 218

* independence, mo 64055

* 816-350-7900

* http://www.visionpace.com

* http://vmpdiscussion.visionpace.com

* author: drew speedie

* special thanks to mike yearwood and chris bohling

*

* usage

* =====================================

* if x2isarray(@somevariable)

*    ...

* endif

* if x2isarray(someobject,"someproperty")

*    ...

* endif

*

*

* lparameters

* tuvariable (r) memory variable to be checked,

* passed here by reference

* -or-

* object whose tcproperty is to be

* checked

* tcproperty (o) if tuvariable is passed as an object

* reference, this parameter is required,

* and indicates the property of the

* tuvariable object that is checked for

* being an array

* if tuvariable is passed as a memory

* variable, do not pass this parameter,

* or this routine will return .f.

*

lparameters tuvariable, tcproperty

local llretval

do case

******************************************************

case pcount() = 1 and not vartype(m.tuvariable) = "o"

******************************************************

   llretval = type("alen(m.tuvariable)") = "n"

******************************************************

case pcount() = 1 and type("alen(m.tuvariable)") = "n"

******************************************************

   llretval = .t.

******************************************************

case vartype(m.tuvariable) = "o" ;

   and vartype(m.tcproperty) = "c" ;

   and not empty(m.tcproperty)

******************************************************

   llretval = type("alen(m.tuvariable." + m.tcproperty + ")") = "n"

******************************************************

otherwise

******************************************************

   *

   * you apparently haven't passed the parameters

   * properly -- we could have returned .null. here,

   * but then every time you call x2isarray(), you

   * would have to check for .null, .t., and .f.

   * rather than just .t. or .f., so it's up to you

   * to pass the parameters correctly

   * roses are red

   * violets are blue

   * to pass parms correctly

   * is all up to you

   *

   llretval = .f.

endcase

return m.llretval

 

Leave a Reply

Your email address will not be published. Required fields are marked *