Share add on xbrowse method save() as dbf,excel

[ShumingWang]

METHOD Save() CLASS TXBrowse
LOCAL oExcel, oHoja
LOCAL nRow := 1, nCol,i,i2,nchoice:=1,lok:=.f.
LOCAL cBuffer
local cDBF
LOCAL cValue
LOCAL cTable
LOCAL nHandle
LOCAL nFields
LOCAL nField
LOCAL nPos ,ofont14,odlg2,cvaltype
LOCAL aarray1
local Arry1:={},arry2:={},cfile1:="d:\aaa.dbf"+SPACE(15),arry3,cAlias1,utmpvar,utmpvar1
local noldrowsel:=::nrowsel

if Eval(::bKeyCount)==0; Return ""; End

nchoice:=Alert("Save as",{"Excel","DBF","XML"})

Do case

Case Nchoice==1

oExcel :=CreateObject( "Excel.Application")
oExcel:WorkBooks:Add()
oHoja := oExcel:ActiveSheet()

Eval(::bGotop)
i2:=1
for i:=1 to len(::Acols)
if !::acols[i]:lhide
oHoja:Cells( nRow, i2 ):Value := ::acols[i]:cHeader
i2++
end
NEXT
Eval(::bGotop)

DO WHILE !Eval(::bEof)
if len(::aSelected)>0.and.aScan(::aSelected,(Eval(::bKeyNo)))==0; Eval(::bSkip); loop; end
nRow++
i2:=1
FOR nCol := 1 TO len(::Acols)
if !::acols[ncol]:lhide
utmpvar1:=EVAL(::acols[nCol]:bStrdata)
if VALTYPE(utmpvar1)=="U".or.valtype(utmpvar1)==NIL.or.VALTYPE(utmpvar1)=="D".and.utmpvar1==CTOD("..")
utmpvar:=" "
elseif VALTYPE(utmpvar1)=="D"
utmpvar:=LEFT(DTOC(utmpvar1),4)+"-"+SUBSTR(DTOC(utmpvar1),6,2)+"-"+RIGHT(DTOC(utmpvar1),2)

else

utmpvar:=utmpvar1
end
if VALTYPE(utmpvar)=="C"
oHoja:Cells( nRow, i2 ):NumberFormat := "@"
end

oHoja:Cells( nRow, i2 ):Value := utmpvar

i2++
end
NEXT
Eval(::bSkip)
ENDDO

FOR nCol := 1 TO len(::aCols)
oHoja:Columns( nCol ):AutoFit()
NEXT

oExcel:Visible := .T.

//oHoja:End()
// oExcel:End()

case nchoice==2

if !MsgGet("file name first must a letter","Save to path and filename",@cFile1)

return NIL
end
cFile1:=alltrim(cFile1)

aarray1:={}

DEFINE dialog odlg2 from 4,6 to len(::acols)*2+5,50 title " Save to DBF"
// style nOR( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU ,WS_VSCROLL)
i:=1
i2:=1
for i:=1 to len(::acols)
if !::acols[i]:lhide
@i2*0.86,2 say ::acols[i]:cheader of odlg2
AADD(aarray1,"a"+padl(cvaltochar(i2),3,'0')+space(11))
TGet():New( i2, 5, GenLocalBlock( aarray1, i2), odlg2, 75,12 )
i2++
end
next

@1,22 BUTTON "&OK" OF odlg2 ACTION (lok:=.t.,odlg2:end())
@2,22 BUTTON "&Exit" OF odlg2 ACTION odlg2:end()

ACTIVATE DIALOG odlg2 CENTER

if !lok; return nil; end
i2:=1
for i:=1 to len(::aCols)

if !::acols[i]:lhide
utmpvar:=EVAL(::acols[i]:bStrdata)
cvaltype:=valtype(utmpvar)
if cvaltype<>"D".and.cvaltype<>"L".and.cvaltype<>"C".and.cvaltype<>"N"
cvaltype:="C"
end

aadd(Arry2,{aarray1[i2],cvaltype,max(len(cvaltochar(utmpvar)),int(::acols[i]:nWidth/7)),if(cvaltype=="N",len(cvaltochar(utmpvar))-at(".",cvaltochar(utmpvar)),0)})

i2+=1
end
next
dbcreate(cFile1,Arry2)
use (cfile1) new
cAlias1:=alias()

Eval(::bGoTop)
while !Eval(::bEof)
if len(::Aselected)>0.and.Ascan(::Aselected,(Eval(::bKeyNo)))==0; Eval(::bSkip); loop; end
select (cAlias1)
append blank
i2:=1
for i:=1 to len(::acols)
if !::acols[i]:lhide
utmpvar:=eval(::acols[i]:bStrdata)
select (cAlias1)
fieldput(i2,if(valtype(utmpvar)=="U".or.valtype(utmpvar)==NIL,cvaltochar(utmpvar),utmpvar))
i2++
end
next
Eval(::bSkip)
end
select (cAlias1)
close
msginfo(trans2("saved as ")+cfile1)

case Nchoice==3
if !MsgGet("Save as","Path and file name",@cFile1)
return NIL
end

aarray1:={}

DEFINE dialog odlg2 from 4,6 to len(::acols)*4+5,50 title "Save as XML"
i:=1
i2:=1

for i:=1 to len(::acols)
if !::acols[i]:lhide
@i2*0.9,2 say ::acols[i]:cheader of odlg2
AADD(aarray1,padr(::acols[i]:cheader,15," "))
TGet():New( i2, 5, GenLocalBlock( aarray1, i2), odlg2, 75,12 )

i2++
end
next

@i2,6 BUTTON "&OK" ACTION (lok:=.t.,odlg2:end())
@i2,12 BUTTON "&Exit" ACTION odlg2:end()

ACTIVATE DIALOG odlg2 CENTER

if !lok; return nil; end

cfile1:=alltrim(cfile1)
cDBF := lower(cfile1)
cFile1 := StrTran( cfile1, ".dbf", ".xml" )
if !".xml"$cfile1
cfile1+=".xml"
end
cTable := Left( cDbf, At( ".", cfile1 ) - 1 )

nHandle := fCreate( cFile1 )

// Writes XML header
fWrite( nHandle, [<?xml version="1.0" encoding="latin1" ?>] + CRLF )
fWrite( nHandle, Space( 0 ) + "<" + cDbf + ">" + CRLF )

Eval(::bGoTop)
while !Eval(::bEof)

if len(::Aselected)>0.and.Ascan(::Aselected,(Eval(::bKeyNo)))==0; Eval(::bSkip); loop; end

cBuffer := Space( 2 ) + "<" + cTable + ">" + CRLF
fWrite( nHandle, cBuffer )
i2:=1
for i:=1 to len(::acols)
if !::acols[i]:lhide
cBuffer:= Space( 4 ) + "<" + aarray1[i2] + ">"
utmpvar:=eval(::acols[i]:bStrdata)
DO CASE
CASE valtype(utmpvar) == "D"
cValue := Dtos(utmpvar)

CASE valtype(utmpvar) == "N"
cValue := Str( utmpvar)

CASE valtype(utmpvar) == "L"
cValue := If( utmpvar, "True", "False" )

OTHERWISE
cValue := cvaltochar(utmpvar)
ENDCASE

cValue:= strTran(cValue,"&","&amp;")
cValue:= strTran(cValue,"<","&lt;")
cValue:= strTran(cValue,">","&gt;")
cValue:= strTran(cValue,"'","&apos;")
cValue:= strTran(cValue,["],[&quot;])

cBuffer := cBuffer + ;
Alltrim( cValue ) + ;
"</" + ;
aarray1[i2]+ ;
">" + ;
CRLF

fWrite( nHandle, cBuffer )
i2++
endif
next
fWrite( nHandle, Space( 2 ) + "</" + cTable + ">" + CRLF )
Eval(::bSkip)
end
fWrite( nHandle, Space(0) + "</" + cDbf + ">" + CRLF )
fClose( nHandle )
msginfo(trans2("Saved as ")+cfile1)
endcase

// Eval(::bGoTo)
::setfocus()
::refresh()
return cfile1

[Otto]

Thanks for sharing the code.
Would you be so kind to post a working example.
Thanks in advance
Otto

[ShumingWang]

function myfun()
define dialog odlg resource "aaa"

xbrowse define ...
...

redefine button id 202 of odlg action obrow:save()

activate dialog odlg

return