romfast/comun
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
16c56282f55950bb3117ab0df9de217d37c5126e
comun/utile/excel/exportxlsx.vc2

3198 lines
108 KiB
Plaintext
Raw Blame History

*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
*--------------------------------------------------------------------------------------------------------------------------------------------------------
*< FOXBIN2PRG: Version="1.21" SourceFile="exportxlsx.vcx" CPID="1250" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
*
*
DEFINE CLASS exportxlsx AS commandbutton
*< CLASSDATA: Baseclass="commandbutton" Timestamp="" Scale="Pixels" Uniqueid="" />
*<DefinedPropArrayMethod>
*m: cleanup
*m: cleanup2
*m: copytoxlsx
*m: gen_app
*m: gen_content_types
*m: gen_core
*m: gen_dirs
*m: gen_rels
*m: gen_styles
*m: gen_workbook
*m: gen_workbook2
*m: gen_workbook3 && For comments
*m: getcurr
*m: htmspec
*m: langset
*m: testprop
*m: thefirsttime
*p: autocolw
*p: cfields
*p: cfieldstotal
*p: cheaders
*p: grid
*p: headbackcolor
*p: headfill
*p: headfontbold
*p: headfontitalic
*p: headfontname
*p: headfontsize
*p: headforecolor
*p: label
*p: langid
*p: lastcol
*p: lastrow
*p: lerror
*p: lfirst
*p: lhead
*p: lmemoascomment && When .T. memo fields are converted into comments while the cell contains the word "Memo"
*p: lopen
*p: ncodepage
*p: nmaxindexlen
*p: rowbackcolor
*p: rowfill
*p: rowfontbold
*p: rowfontitalic
*p: rowfontname
*p: rowfontsize
*p: rowforecolor
*p: sheetfirstcol
*p: sheetfirstrow
*p: sheetname
*a: aerrmess[7,0]
*a: astyles[6,0]
*</DefinedPropArrayMethod>
PROTECTED lerror
*<PropValue>
autocolw = .F.
Caption = ""
cfields = ("")
cfieldstotal = ("")
cheaders = ("")
grid = ("")
headbackcolor = -1
headfill = .F.
headfontbold = .T.
headfontitalic = .F.
headfontname = ("")
headfontsize = 0
headforecolor = -1
Height = 15
label = ('')
langid = EN
lastcol = XFD
lastrow = (1048576)
lerror = .F.
lfirst = .T.
lhead = .T.
lmemoascomment = .F.
lopen = .T.
Name = "exportxlsx"
ncodepage = 0
nmaxindexlen = 60
rowbackcolor = -1
rowfill = .F.
rowfontbold = .F.
rowfontitalic = .F.
rowfontname = ('')
rowfontsize = 0
rowforecolor = -1
sheetfirstcol = A
sheetfirstrow = 0
sheetname = sheet1
ToolTipText = "Export xlsx (Excel 2007+)"
Width = 15
*</PropValue>
PROCEDURE cleanup
**********************
* For OS below Win 7 *
**********************
LPARAMETERS lcDir,llMemoAsComment,llToClose,cCur,cTotal,cMax,cStrings,lcCurrAlias,lnFHSh,lnFHStr,lnFHCo,lnFHDr,lcOldPath
LOCAL lSetSafety
lSetSafety = SET("Safety")
SET SAFETY OFF
This.cleanup2(m.llToClose,m.cCur,m.cTotal,m.cMax,m.cStrings,m.lcCurrAlias,m.lnFHSh,m.lnFHStr,m.lnFHCo,m.lnFHDr,m.lcOldPath)
ERASE (ADDBS(ADDBS(m.lcDir+[xl])+[_rels]) + "*.*")
RD (ADDBS(ADDBS(m.lcDir+[xl])+[_rels]))
IF m.llMemoAsComment
ERASE (ADDBS(ADDBS(m.lcDir+[xl])+[drawings]) + "*.*")
RD (ADDBS(ADDBS(m.lcDir+[xl])+[drawings]))
ERASE (ADDBS(ADDBS(ADDBS(m.lcDir+[xl])+[worksheets])+[_rels]) + "*.*")
RD (ADDBS(ADDBS(ADDBS(m.lcDir+[xl])+[worksheets])+[_rels]))
ENDIF
ERASE (ADDBS(ADDBS(m.lcDir+[xl])+[worksheets]) + "*.*")
RD (ADDBS(ADDBS(m.lcDir+[xl])+[worksheets]))
ERASE (ADDBS(m.lcDir+[xl]) + "*.*")
RD (ADDBS(m.lcDir+[xl]))
ERASE (ADDBS(m.lcDir+[docProps]) + "*.*")
RD (ADDBS(m.lcDir+[docProps]))
ERASE (ADDBS(m.lcDir+[_rels]) + "*.*")
RD (ADDBS(m.lcDir+[_rels]))
ERASE (m.lcDir + "*.*")
RD (m.lcDir)
SET SAFETY &lSetSafety
ENDPROC
PROCEDURE cleanup2
LPARAMETERS llToClose,cCur,cTotal,cMax,cStrings,lcCurrAlias,lnFHSh,lnFHStr,lnFHCo,lnFHDr,lcOldPath
IF m.llToClose
USE IN (m.cCur)
ENDIF
IF USED(m.cTotal)
USE IN (m.cTotal)
ENDIF
IF USED(m.cMax)
USE IN (m.cMax)
ENDIF
IF USED(m.cStrings)
USE IN (m.cStrings)
ENDIF
IF !EMPTY(m.lcCurrAlias)
SELECT (m.lcCurrAlias)
ENDIF
IF VARTYPE(m.lnFHSh) == "N"
FCLOSE(m.lnFHSh)
ENDIF
IF VARTYPE(m.lnFHStr) == "N"
FCLOSE(m.lnFHStr)
ENDIF
IF VARTYPE(m.lnFHCo) == "N"
FCLOSE(m.lnFHCo)
ENDIF
IF VARTYPE(m.lnFHDr) == "N"
FCLOSE(m.lnFHDr)
ENDIF
IF !EMPTY(m.lcOldPath)
SET DEFAULT TO (m.lcOldPath)
ENDIF
ENDPROC
PROCEDURE Click
LOCAL lcFile,cCursor,llDo
llDo = .F.
* Courtesy of Tobias B
LOCAL lc_FileName
DO CASE
CASE TYPE("THIS.Label") == "C"
m.lc_FileName = THIS.Label + "_"
CASE TYPE("THIS.Label.Caption") == "C"
m.lc_FileName = THIS.Label.Caption + "_"
OTHERWISE
m.lc_FileName = ""
ENDCASE
lc_FileName = m.lc_FileName + TTOC(DATETIME(),1) + ".xlsx"
IF VARTYPE(This.grid)="O" AND !ISNULL(This.grid)
IF LOWER(This.grid.baseclass)!="grid"
RETURN
ENDIF
lcFile=PUTFILE("File name",m.lc_FileName,"XLSX")
cCursor=This.grid.RecordSource
llDo = !EMPTY(m.lcFile) AND USED(m.cCursor)
ENDIF
IF VARTYPE(This.grid)="C" AND !EMPTY(This.grid)
lcFile=PUTFILE("File name",m.lc_FileName,"XLSX")
cCursor=This.grid
llDo = !EMPTY(m.lcFile) AND USED(m.cCursor)
ENDIF
IF m.llDo
This.TestProp
This.Thefirsttime
This.langSet
This.copytoxlsx(m.cCursor,m.lcFile)
ENDIF
ENDPROC
PROCEDURE copytoxlsx
LPARAMETERS cCur,lcFileName
# DEFINE MAXIMUMCOMMENTHEIGHT 20 && maximum height of a comment (expressed in sheet rows)
# DEFINE MAXIMUMCOMMENTWIDTH 10 && maximum width of a comment (expressed in sheet columns)
DECLARE INTEGER ShellExecute IN SHELL32.DLL INTEGER nWinHandle,STRING cOperation,STRING cFileName,STRING cParameters,STRING cDirectory,INTEGER nShowWindow
IF OS(3) < '6' && XP
Declare INTEGER GetLocaleInfo in Win32API LONG Locale, LONG LCType, STRING @LpLCData, INTEGER cchData
ELSE
Declare INTEGER GetLocaleInfoEx in Win32API String Locale, LONG LCType, STRING @LpLCData, INTEGER cchData
ENDIF
DECLARE Sleep IN kernel32 INTEGER
LOCAL lcMyPath,lcDir,loerr as Exception
LOCAL lnRowsNo,lnColsNo,laFields[1,6],lnCurRow,lnCurCol,lnTime,ltTime,lcSetDec,lnColsNoAll,laFieldsAll[1],lnLenStr,lnLenIdx,llMemos,lnII,lSetTalk,lnFFields,laFFields[1]
LOCAL cStrings,lnColChars,llCR,lcValue,lnDec,cMax,ldValue
LOCAL lcCurr,lcFFields
LOCAL ldDat01,ldDat11,ldDat02,ldDat12,ldDat03,ltDat02
LOCAL lnFHStr,lnFHSh,lcLenStr,lcLenIdx,lnCountbefore,lcUnion,lcField,lnTotal,cTotal,lcCurRow,ofile,lcSource,lcZipFileName,oShell,oFolder
LOCAL lcStH,lcStN,lcStD,lcStT,lcStM,lcStC,llBelow7
LOCAL lnHead,laHead[1],llHead,lnsheetfirstcol,lni,lcRowHeight,lcFontName,lnFontSize,lnColWidth,lnNoRows,lcProcName,lcProcCode
LOCAL laFields[1,7],lnType,lala[1],lcSetPoint,llMemoAsComment,lnFHCo,lnFHDr,lnCurComm,lnNoRow,laNoRow[1],lniNoRow,lnMaxLenRow,lnCommW,lnCommH
LOCAL lcCurrAlias,llToClose,lcOldPath,lnCodePage,lcCodePage,lcStrBad,lcTmp,lnj
lcStrBad = ''
FOR lni = 0 TO 31
IF !INLIST(m.lni,9,10,13)
lcStrBad = m.lcStrBad + CHR(m.lni)
ENDIF
NEXT
lcCurrAlias = ALIAS()
llToClose = .F.
llMemoAsComment = This.lMemoAsComment
IF PCOUNT() < 1
MESSAGEBOX(This.aErrMess[4],48,This.aErrMess[3])
RETURN
ELSE
IF VARTYPE(m.cCur) $ "CV"
IF !USED(m.cCur)
USE (m.cCur) IN 0
llToClose = .T.
ENDIF
ELSE
MESSAGEBOX(This.aErrMess[5],48,This.aErrMess[3])
RETURN
ENDIF
ENDIF
IF PCOUNT() < 2
lcFileName = FORCEEXT(SYS(2015),"xlsx")
ELSE
IF VARTYPE(m.lcFileName) $ "CV"
lcFileName = FORCEEXT(m.lcFileName,"xlsx")
ELSE
lcFileName = FORCEEXT(SYS(2015),"xlsx")
ENDIF
ENDIF
* Thanks to Gregory Green
IF VARTYPE(This.nCodePage) <> "N"
lcCodePage = ''
ELSE
IF !INLIST(This.nCodePage,437,620,737,850,852,857,861,865,866,874,895,932,936,949,950,1250,1251,1252,1253,1254,1255,1256)
lcCodePage = ''
ELSE
lcCodePage = 'CODEPAGE = ' + TRANSFORM(This.nCodePage)
ENDIF
ENDIF
********
llHead = This.lHead
lcFFields = This.cFields
IF m.llHead AND !EMPTY(This.cHeaders)
lnHead = ALINES(laHead,This.cHeaders,4,",")
ELSE
lnHead = 0
ENDIF
IF FILE(FORCEEXT(m.lcFileName,"xlsx"))
IF MESSAGEBOX(FORCEEXT(m.lcFileName,"xlsx")+" "+This.aErrMess[6]+CHR(13)+This.aErrMess[7],4+48,This.aErrMess[3]) = 7
RETURN
ELSE
ERASE (FORCEEXT(m.lcFileName,"xlsx")) RECYCLE
ENDIF
ENDIF
lnFFields = 0
IF VARTYPE(m.lcFFields) <> "C"
lcFFields = ""
ELSE
lnFFields = ALINES(laFFields,UPPER(m.lcFFields),1+4,",")
ENDIF
lSetTalk = SET("Talk")
SET TALK OFF
lcSetPoint = SET("Point")
SET POINT TO "."
lnColsNoAll=AFIELDS(m.laFieldsAll,m.cCur)
lnColsNo = 0
lnLenStr = 19 && for datetime
llMemos = .F.
lcUnion = ""
cTotal = SYS(2015)
lnTotal = 0
ldDat01 = DATE(1900,3,1)
ldDat02 = DATE(1900,1,1)
ldDat03 = DATE(1900,2,28)
ldDat11 = m.ldDat01 - 61
ldDat12 = m.ldDat02 - 1
ltDat02 = DATETIME(1900,1,1,0,0,0)
lnColChars = 0
lnsheetfirstcol = 0
FOR lni = 1 TO LEN(This.sheetfirstcol)
lnsheetfirstcol = m.lnsheetfirstcol * 26 + ASC(SUBSTR(This.sheetfirstcol,m.lni,1)) - 64
NEXT
LOCAL lnActualCol,lnActualField,lnActualField2
lnActualCol = 0
FOR lnCurCol = 1 TO m.lnColsNoAll
lnActualCol = m.lnActualCol + 1
IF m.laFieldsAll[m.lnCurCol,2] $ "G"
lnActualCol = m.lnActualCol - 1
FOR lnActualField = 1 TO m.lnFFields
IF m.laFieldsAll[m.lnCurCol,1] == laFFields[m.lnActualField]
FOR lnActualField2 = m.lnActualField TO m.lnFFields - 1
laFFields[m.lnActualField2] = m.laFFields[m.lnActualField2 + 1]
NEXT
lnFFields = m.lnFFields - 1
EXIT
ENDIF
NEXT
ENDIF
IF m.laFieldsAll[m.lnCurCol,2] $ "NFYBIDTLCVM"
IF !EMPTY(m.lcFFields)
IF ASCAN(m.laFFields,laFieldsAll[m.lnCurCol,1],1,-1,-1,1+2+4)=0
LOOP
ENDIF
ENDIF
lnColsNo = m.lnColsNo + 1
DIMENSION laFields[m.lnColsNo,7]
laFields[m.lnColsNo,1] = laFieldsAll[m.lnCurCol,1]
laFields[m.lnColsNo,2] = IIF(laFieldsAll[m.lnCurCol,2] $ "CV",1,;
IIF(laFieldsAll[m.lnCurCol,2] $ "NF",2,;
IIF(laFieldsAll[m.lnCurCol,2] == "I",3,;
IIF(laFieldsAll[m.lnCurCol,2] == "D",4,;
IIF(laFieldsAll[m.lnCurCol,2] == "T",5,;
IIF(laFieldsAll[m.lnCurCol,2] == "L",6,;
IIF(laFieldsAll[m.lnCurCol,2] == "Y",7,;
IIF(laFieldsAll[m.lnCurCol,2] == "B",8,;
IIF(laFieldsAll[m.lnCurCol,2] == "M",9,10)))))))))
laFields[m.lnColsNo,3] = laFieldsAll[m.lnCurCol,3]
laFields[m.lnColsNo,4] = laFieldsAll[m.lnCurCol,4]
laFields[m.lnColsNo,5] = IIF(m.lnColsNo + m.lnsheetfirstcol - 1 <=26,[],;
IIF(m.lnColsNo + m.lnsheetfirstcol - 1 <=702,CHR(64 + FLOOR((m.lnColsNo + m.lnsheetfirstcol - 2) / 26)),;
CHR(64 + FLOOR((m.lnColsNo + m.lnsheetfirstcol - 2 - 26) / 676))+CHR(65 + FLOOR(MOD(m.lnColsNo + m.lnsheetfirstcol - 2 - 26,676) / 26))))+;
CHR(65 + MOD(m.lnColsNo + m.lnsheetfirstcol - 2,26))
laFields[m.lnColsNo,6] = laFieldsAll[m.lnCurCol,3]
laFields[m.lnColsNo,7] = m.lnActualCol &&lnCurCol
IF LEN(laFields[m.lnColsNo,5]) = 3 AND laFields[m.lnColsNo,5] = This.LastCol
EXIT
ENDIF
ELSE
LOOP
ENDIF
lcField = laFieldsAll[m.lnCurCol,1]
IF m.laFieldsAll[m.lnCurCol,2] $ "CV"
lnLenStr = MAX(m.lnLenStr, laFieldsAll[m.lnCurCol,3])
IF !EMPTY(m.lcUnion)
lcUnion = m.lcUnion + " UNION"
ENDIF
lcUnion = m.lcUnion + " SELECT DISTINCT CAST(RTRIM(" + m.lcField + ") AS V("+TRANSFORM(m.laFieldsAll[m.lnCurCol,3])+")) FROM " + m.cCur + " WHERE !ISNULL(" + m.lcField + ")"
SELECT COUNT(*) as no FROM (m.cCur) WHERE ISNULL(&lcField) INTO CURSOR (m.cTotal)
lnTotal = m.lnTotal + RECCOUNT(m.cCur) - &cTotal..no
IF This.autocolw
SELECT CAST(MAX(LEN(RTRIM(&lcField))) as I) as maxw FROM (m.cCur) WHERE !ISNULL(&lcField) INTO CURSOR (m.cTotal)
laFields[m.lnColsNo,6] = &cTotal..maxw
ENDIF
ENDIF
IF This.autocolw
IF m.laFieldsAll[m.lnCurCol,2] $ "NF"
SELECT MAX(ABS(&lcField)) as maxw FROM (m.cCur) WHERE !ISNULL(&lcField) INTO CURSOR (m.cTotal)
laFields[m.lnColsNo,6] = LEN(ALLTRIM(STR(&cTotal..maxw,laFieldsAll[m.lnCurCol,3],laFieldsAll[m.lnCurCol,4])))+1
ENDIF
IF m.laFieldsAll[m.lnCurCol,2] == "L"
laFields[m.lnColsNo,6] = 5
ENDIF
IF m.laFieldsAll[m.lnCurCol,2] == "I"
SELECT MAX(ABS(&lcField)) as maxw FROM (m.cCur) WHERE !ISNULL(&lcField) INTO CURSOR (m.cTotal)
laFields[m.lnColsNo,6] = LEN(ALLTRIM(STR(&cTotal..maxw,12)))+1
ENDIF
IF m.laFieldsAll[m.lnCurCol,2] == "Y"
SELECT MAX(ABS(&lcField)) as maxw FROM (m.cCur) WHERE !ISNULL(&lcField) INTO CURSOR (m.cTotal)
laFields[m.lnColsNo,6] = LEN(ALLTRIM(STR(&cTotal..maxw,22,4)))+1
ENDIF
IF m.laFieldsAll[m.lnCurCol,2] == "B"
SELECT MAX(ABS(&lcField)) as maxw FROM (m.cCur) WHERE !ISNULL(&lcField) INTO CURSOR (m.cTotal)
laFields[m.lnColsNo,6] = LEN(ALLTRIM(STR(&cTotal..maxw,22,laFieldsAll[m.lnCurCol,4])))+1
ENDIF
ENDIF
IF m.laFieldsAll[m.lnCurCol,2] == "D"
IF !EMPTY(m.lcUnion)
lcUnion = m.lcUnion + " UNION"
ENDIF
lcUnion = m.lcUnion + " SELECT DISTINCT DTOC(" + m.lcField + ") FROM " + m.cCur + " WHERE " + m.lcField + " < m.ldDat02 "
SELECT COUNT(*) as no FROM (m.cCur) WHERE &lcField < m.ldDat02 INTO CURSOR (m.cTotal)
lnTotal = m.lnTotal + &cTotal..no
laFields[m.lnColsNo,6] = 10
ENDIF
IF m.laFieldsAll[m.lnCurCol,2] == "T"
IF !EMPTY(m.lcUnion)
lcUnion = m.lcUnion + " UNION"
ENDIF
lcUnion = m.lcUnion + " SELECT DISTINCT TTOC(" + m.lcField + ") FROM " + m.cCur + " WHERE " + m.lcField + " < m.ltDat02 "
SELECT COUNT(*) as no FROM (m.cCur) WHERE &lcField < m.ltDat02 INTO CURSOR (m.cTotal)
lnTotal = m.lnTotal + &cTotal..no
laFields[m.lnColsNo,6] = 19
ENDIF
IF m.laFieldsAll[m.lnCurCol,2] == "M"
lnColChars = m.lnColChars +1
llMemos = .T.
IF This.autocolw
IF m.llMemoAsComment
laFields[m.lnColsNo,6] = 5
ELSE
lcProcName = SYS(2015)
TEXT TO m.lcProcCode TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
SELECT MAX(<<m.lcProcName>>(<<m.lcField>>)) as maxw FROM <<m.cCur>> WHERE !ISNULL(<<m.lcField>>) INTO CURSOR <<m.cTotal>>
RETURN <<m.cTotal>>.maxw
FUNCTION <<m.lcProcName>>
LPARAMETERS tcValue
LOCAL lnRow,laRow[1],lnMax,lni
IF EMPTY(m.tcValue)
RETURN 0
ELSE
lnRow = ALINES(laRow,m.tcValue,2)
lnMax = LEN(m.laRow[1])
FOR lni = 2 TO m.lnRow
lnMax = MAX(m.lnMax,LEN(m.laRow[m.lni]))
NEXT
RETURN m.lnMax
ENDIF
ENDFUNC
ENDTEXT
laFields[m.lnColsNo,6] = EXECSCRIPT(m.lcProcCode)
ENDIF
ENDIF
ENDIF
NEXT
lnLenIdx = MIN(This.nMaxIndexLen, m.lnLenStr)
lnTotal = m.lnTotal + m.lnColsNo
SELECT (m.cCur)
COUNT TO m.lnRowsNo
lnTotal = m.lnTotal + m.lnRowsNo * m.lnColChars
lnRowsNo=m.lnRowsNo+IIF(m.llHead,1,0)
FOR lni = 1 TO m.lnFFields
FOR lnCurCol = 1 TO m.lnColsNo
IF m.laFields[m.lnCurCol,1] == m.laFFields[m.lni]
FOR lnj = 1 TO ALEN(laFields,2)
lcTmp = m.laFields[m.lnCurCol,m.lnj]
laFields[m.lnCurCol,m.lnj] = m.laFields[m.lni,m.lnj]
laFields[m.lni,m.lnj] = m.lcTmp
NEXT
EXIT
ENDIF
NEXT
NEXT
FOR lnCurCol = 1 TO m.lnColsNo
laFields[m.lnCurCol,5] = IIF(m.lnCurCol + m.lnsheetfirstcol - 1 <=26,[],;
IIF(m.lnCurCol + m.lnsheetfirstcol - 1 <=702,CHR(64 + FLOOR((m.lnCurCol + m.lnsheetfirstcol - 2) / 26)),;
CHR(64 + FLOOR((m.lnCurCol + m.lnsheetfirstcol - 2 - 26) / 676))+CHR(65 + FLOOR(MOD(m.lnCurCol + m.lnsheetfirstcol - 2 - 26,676) / 26))))+;
CHR(65 + MOD(m.lnCurCol + m.lnsheetfirstcol - 2,26))
NEXT
cStrings = SYS(2015)
cMax = SYS(2015)
CREATE CURSOR (m.cStrings) &lcCodePage (ii I AUTOINC NEXTVALUE 0,cStr V(m.lnLenStr),cM M)
IF m.llMemoAsComment and m.llMemos
INSERT INTO (m.cStrings) (cStr) VALUES ("Memo")
ENDIF
IF !EMPTY(m.lcUnion)
EXECSCRIPT("LPARAMETERS ldDat02,ltDat02"+CHR(13)+"INSERT INTO " + m.cStrings + " (cStr)" + m.lcUnion,m.ldDat02,m.ltDat02)
ENDIF
IF m.lnLenStr > 0
IF m.lnLenIdx >= m.lnLenStr
INDEX on cStr TAG cStr
ELSE
lcLenIdx = LTRIM(STR(m.lnLenIdx))
INDEX on LEFT(cStr,&lcLenIdx) TAG cStr
ENDIF
ENDIF
IF m.llMemos
lcLenStr = LTRIM(STR(m.lnLenIdx)) && courtesy of Tobias B
INDEX on LEFT(cM,&lcLenStr) TAG cM
ENDIF
SET ORDER TO cStr
lcCurr = This.Getcurr(m.lcStrBad) && courtesy of Martina Jindrov<6F>
lcOldPath = SYS(5)+SYS(2003)
lcMyPath=''
IF !EMPTY(JUSTPATH(m.lcFileName))
lcMyPath=ADDBS(JUSTPATH(m.lcFileName))
SET DEFAULT TO (m.lcMyPath)
ELSE
lcMyPath = ADDBS(JUSTPATH(FULLPATH(m.lcFileName)))
ENDIF
lcDir=This.gen_dirs(m.llMemoAsComment and m.llMemos)
This.gen_Content_Types(m.lcDir,m.llMemoAsComment and m.llMemos)
IF This.lError
RETURN
ENDIF
This.gen_rels(ADDBS(m.lcDir+[_rels]))
IF This.lError
RETURN
ENDIF
This.gen_app(ADDBS(m.lcDir+[docProps]))
IF This.lError
RETURN
ENDIF
This.gen_core(ADDBS(m.lcDir+[docProps]))
IF This.lError
RETURN
ENDIF
This.gen_workbook(ADDBS(ADDBS(m.lcDir+[xl])+[_rels]),m.llMemoAsComment and m.llMemos)
IF This.lError
RETURN
ENDIF
This.gen_styles(ADDBS(m.lcDir+[xl]),m.lcCurr,m.llMemoAsComment and m.llMemos)
IF This.lError
RETURN
ENDIF
This.gen_workbook2(ADDBS(m.lcDir+[xl]))
IF This.lError
RETURN
ENDIF
IF m.llMemoAsComment and m.llMemos
This.gen_workbook3(ADDBS(ADDBS(ADDBS(m.lcDir+[xl])+[worksheets])+[_rels]))
ENDIF
lcStH = [ s="]+LTRIM(STR(This.aStyles[6]))+["]
lcStN = [ s="]+LTRIM(STR(This.aStyles[1]))+["]
lcStD = [ s="]+LTRIM(STR(This.aStyles[2]))+["]
lcStT = [ s="]+LTRIM(STR(This.aStyles[3]))+["]
lcStM = [ s="]+LTRIM(STR(This.aStyles[4]))+["]
lcStC = [ s="]+LTRIM(STR(This.aStyles[5]))+["]
* Begin sheet1
lnFHSh = FCREATE(ADDBS(ADDBS(m.lcDir+[xl])+[worksheets]) + [sheet1.xml])
IF m.lnFHSh < 0
MESSAGEBOX(This.aErrMess[2] + ' sheet1.xml',16,This.aErrMess[1])
This.cleanup(m.lcDir,m.llMemoAsComment AND m.llMemos,m.llToClose,m.cCur,m.cTotal,m.cMax,m.cStrings,m.lcCurrAlias,m.lnFHSh,m.lnFHStr,m.lnFHCo,m.lnFHDr,m.lcOldPath)
RETURN
ENDIF
FWRITE(m.lnFHSh,[<?xml version="1.0" encoding="UTF-8" standalone="yes"?>]+CHR(10))
FWRITE(m.lnFHSh,[<worksheet xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships" ])
IF m.llMemoAsComment AND m.llMemos
FWRITE(m.lnFHSh,[xmlns:xdr="http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing" ])
ENDIF
FWRITE(m.lnFHSh,[xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="x14ac" xmlns:x14ac="http://schemas.microsoft.com/office/spreadsheetml/2009/9/ac"> ])
FWRITE(m.lnFHSh,[<dimension ref="] + This.sheetfirstcol + TRANSFORM(This.sheetfirstrow) + ;
[:] + IIF(m.lnColsNo + m.lnsheetfirstcol - 1>702,CHR(64 + FLOOR((m.lnColsNo + m.lnsheetfirstcol - 2 - 26) / 676))+CHR(65 + FLOOR(MOD(m.lnColsNo + m.lnsheetfirstcol - 2 - 26,676) / 26)),;
IIF(m.lnColsNo + m.lnsheetfirstcol - 1>26,CHR(64+FLOOR((m.lnColsNo + m.lnsheetfirstcol - 2)/26)),[]))+;
CHR(65+MOD(m.lnColsNo + m.lnsheetfirstcol - 2,26)) + TRANSFORM(MIN(m.lnRowsNo + This.sheetfirstrow - 1,This.LastRow))+["/>])
FWRITE(m.lnFHSh,[<sheetViews><sheetView workbookViewId="0"/></sheetViews>])
FWRITE(m.lnFHSh,[<sheetFormatPr defaultRowHeight="15"/>])
IF This.autocolw
FWRITE(m.lnFHSh,[<cols>])
FOR lnCurCol = 1 TO m.lnColsNo
lcFontName = _screen.FontName
lnFontSize = _screen.FontSize
_screen.FontName = IIF(!EMPTY(This.rowFontName), This.rowFontName, "Calibri")
_screen.FontSize = IIF(This.RowFontSize>0, This.RowFontSize, 11)
lnColWidth = _screen.TextWidth(REPLICATE("A",m.laFields[m.lnCurCol,6])) / 75 * 10 + 0.7
_screen.FontName = m.lcFontName
_screen.FontSize = m.lnFontSize
FWRITE(m.lnFHSh,[<col customWidth="1" width="] + TRANSFORM(ROUND(m.lnColWidth,1)) + [" max="] + LTRIM(STR(m.lnCurCol)) + [" min="] + LTRIM(STR(m.lnCurCol)) + ["/>])
NEXT
FWRITE(m.lnFHSh,[</cols>])
ENDIF
FWRITE(m.lnFHSh,[<sheetData>])
IF m.llMemoAsComment AND m.llMemos
* Begin comments1
lnFHCo = FCREATE(ADDBS(m.lcDir+[xl])+"comments1.xml")
IF m.lnFHCo < 0
MESSAGEBOX(This.aErrMess[2] + ' comments1.xml',16,This.aErrMess[1])
This.cleanup(m.lcDir,m.llMemoAsComment AND m.llMemos,m.llToClose,m.cCur,m.cTotal,m.cMax,m.cStrings,m.lcCurrAlias,m.lnFHSh,m.lnFHStr,m.lnFHCo,m.lnFHDr,m.lcOldPath)
RETURN
ENDIF
FWRITE(m.lnFHCo,[<?xml version="1.0" encoding="UTF-8" standalone="yes"?>]+CHR(10))
FWRITE(m.lnFHCo,[<comments xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main">])
FWRITE(m.lnFHCo,[<authors>])
FWRITE(m.lnFHCo,[<author>CopyToXlsx</author>])
FWRITE(m.lnFHCo,[</authors>])
FWRITE(m.lnFHCo,[<commentList>])
* Begin vmlDrawing1.vml
lnFHDr = FCREATE(ADDBS(ADDBS(m.lcDir+[xl])+[drawings])+"vmlDrawing1.vml")
IF m.lnFHDr < 0
MESSAGEBOX(This.aErrMess[2] + ' vmlDrawing1.vml',16,This.aErrMess[1])
This.cleanup(m.lcDir,m.llMemoAsComment AND m.llMemos,m.llToClose,m.cCur,m.cTotal,m.cMax,m.cStrings,m.lcCurrAlias,m.lnFHSh,m.lnFHStr,m.lnFHCo,m.lnFHDr,m.lcOldPath)
RETURN
ENDIF
FWRITE(m.lnFHDr,[<?xml version="1.0"?>]+CHR(10))
FWRITE(m.lnFHDr,[<xml xmlns:x="urn:schemas-microsoft-com:office:excel" xmlns:o="urn:schemas-microsoft-com:office:office" xmlns:v="urn:schemas-microsoft-com:vml">])
FWRITE(m.lnFHDr,[<o:shapelayout v:ext="edit">])
FWRITE(m.lnFHDr,[<o:idmap v:ext="edit" data="1"/>])
FWRITE(m.lnFHDr,[</o:shapelayout>])
FWRITE(m.lnFHDr,[<v:shapetype path="m,l,21600r21600,l21600,xe" o:spt="202" coordsize="21600,21600" id="_x0000_t202">])
FWRITE(m.lnFHDr,[<v:stroke joinstyle="miter"/>])
FWRITE(m.lnFHDr,[<v:path o:connecttype="rect" gradientshapeok="t"/>])
FWRITE(m.lnFHDr,[</v:shapetype>])
ENDIF
* Begin sharedStrings
lnFHStr = FCREATE(ADDBS(m.lcDir+[xl])+"sharedStrings.xml")
IF m.lnFHStr < 0
MESSAGEBOX(This.aErrMess[2] + ' sharedStrings.xml',16,This.aErrMess[1])
This.cleanup(m.lcDir,m.llMemoAsComment AND m.llMemos,m.llToClose,m.cCur,m.cTotal,m.cMax,m.cStrings,m.lcCurrAlias,m.lnFHSh,m.lnFHStr,m.lnFHCo,m.lnFHDr,m.lcOldPath)
RETURN
ENDIF
FWRITE(m.lnFHStr,[<?xml version="1.0" encoding="UTF-8" standalone="yes"?>]+CHR(10))
FWRITE(m.lnFHStr,[<sst xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" count="]+SPACE(40))
SELECT (m.cStrings)
SET ORDER TO
SCAN NOOPTIMIZE
FWRITE(m.lnFHStr,[<si><t>]+This.htmspec(cStr,m.lcStrBad)+[</t></si>])
ENDSCAN
SET ORDER TO cStr
lnCurRow = This.sheetfirstrow - 1
IF m.llHead
lnCurRow = m.lnCurRow + 1
lcCurRow = LTRIM(STR(m.lnCurRow))
FWRITE(m.lnFHSh,[<row r="]+m.lcCurRow+["] + IIF(This.HeadFontSize>0,[ customHeight="1" ht="] + LTRIM(STR(This.HeadFontSize * 1.275,10,2)) + ["],[])+ [>]) && spans="1:1" x14ac:dyDescent="0.25"
FOR lnCurCol = 1 TO m.lnColsNo
FWRITE(m.lnFHSh,[<c r="]+m.laFields[m.lnCurCol,5]+m.lcCurRow)
IF m.lnHead <> 0
lcValue = m.laHead[m.lnCurCol]
ELSE
lcValue = m.laFields[m.lnCurCol,1]
ENDIF
SELECT (m.cStrings)
IF m.lnLenIdx >= m.lnLenStr
SET KEY TO m.lcValue
ELSE
SET KEY TO LEFT(m.lcValue,m.lnLenIdx)
ENDIF
lnII = 0
SCAN
IF cStr == m.lcValue
lnII = ii
EXIT
ENDIF
ENDSCAN
SET KEY TO
IF m.lnII > 0
FWRITE(m.lnFHSh,[" t="s"] + m.lcStH +[><v>]+LTRIM(STR(m.lnII))+[</v></c>])
ELSE
FWRITE(m.lnFHStr,[<si><t>]+This.htmspec(m.lcValue,m.lcStrBad)+[</t></si>])
INSERT INTO (m.cStrings) (cStr) VALUES (m.lcValue)
SELECT MAX(ii) as ii FROM (m.cStrings) INTO CURSOR (m.cMax)
SELECT (m.cMax)
lnII = ii
FWRITE(m.lnFHSh,[" t="s"] + m.lcStH +[><v>]+LTRIM(STR(m.lnII))+[</v></c>])
ENDIF
NEXT
FWRITE(m.lnFHSh,[</row>]+CHR(10))
ENDIF
lcRowHeight = IIF(This.RowFontSize>0,[ customHeight="1" ht="] + LTRIM(STR(This.RowFontSize * 1.275,10,2)) + ["],[])
lcSetDec = SET("Decimals")
SET DECIMALS TO 13
IF m.llMemoAsComment AND m.llMemos
lnCurComm = 0
ENDIF
SELECT (m.cCur)
DO CASE
CASE m.llMemos AND m.lnLenIdx < m.lnLenStr
SCAN
lnCurRow = m.lnCurRow + 1
IF m.lnCurRow > This.LastRow
EXIT
ENDIF
lcCurRow = LTRIM(STR(m.lnCurRow))
SCATTER MEMO TO lala
lnNoRows = 1
FOR lnCurCol = 1 TO m.lnColsNo
IF m.laFields[m.lnCurCol,2] = 9
lnNoRows = MAX(m.lnNoRows , 1 + OCCURS(CHR(13),RTRIM(lala[m.laFields[m.lnCurCol,7]])))
ENDIF
NEXT
lcRowHeight = [ customHeight="1" ht="] + LTRIM(STR(IIF(This.RowFontSize>0,This.RowFontSize,11) * m.lnNoRows * 1.275,10,2)) + ["]
FWRITE(m.lnFHSh,[<row r="]+m.lcCurRow+["] + m.lcRowHeight + [>])
FOR lnCurCol = 1 TO m.lnColsNo
SET ORDER TO cStr IN (m.cStrings)
lcValue = lala[m.laFields[m.lnCurCol,7]]
IF ISNULL(m.lcValue)
LOOP
ENDIF
lnType = m.laFields[m.lnCurCol,2]
lnDec = m.laFields[m.lnCurCol,4]
FWRITE(m.lnFHSh,[<c r="]+m.laFields[m.lnCurCol,5]+m.lcCurRow)
IF m.lnType == 1
lcValue = RTRIM(m.lcValue)
IF EMPTY(m.lcValue)
FWRITE(m.lnFHSh,[" t="s"] + m.lcStN +[></c>]) && Empty cell
ELSE
SELECT (m.cStrings)
SET KEY TO LEFT(m.lcValue,m.lnLenIdx)
SCAN
IF cStr == m.lcValue
EXIT
ENDIF
ENDSCAN
SET KEY TO
FWRITE(m.lnFHSh,[" t="s"] + m.lcStN +[><v>]+LTRIM(STR(II))+[</v></c>])
ENDIF
SELECT (m.cCur)
ELSE
IF m.lnType == 2
FWRITE(m.lnFHSh,["] + m.lcStN +[><v>]+LTRIM(STR(m.lcValue,m.laFields[m.lnCurCol,3],m.lnDec))+[</v></c>])
ELSE
IF m.lnType == 3
FWRITE(m.lnFHSh,["] + m.lcStN +[><v>]+LTRIM(STR(m.lcValue))+[</v></c>])
ELSE
IF m.lnType == 4
IF EMPTY(m.lcValue)
FWRITE(m.lnFHSh,["></c>]) && Empty cell
ELSE
IF m.lcValue >= m.ldDat01
FWRITE(m.lnFHSh,["] + m.lcStD +[><v>]+LTRIM(STR(m.lcValue - m.ldDat11))+[</v></c>])
ELSE
IF BETWEEN(m.lcValue,m.ldDat02,m.ldDat03)
FWRITE(m.lnFHSh,["] + m.lcStD +[><v>]+LTRIM(STR(m.lcValue - m.ldDat12))+[</v></c>])
ELSE
lcValue = DTOC(m.lcValue)
SELECT (m.cStrings)
SET KEY TO LEFT(m.lcValue,m.lnLenIdx)
SCAN
IF cStr == m.lcValue
EXIT
ENDIF
ENDSCAN
SET KEY TO
FWRITE(m.lnFHSh,[" t="s"] + m.lcStN +[><v>]+LTRIM(STR(II))+[</v></c>])
SELECT (m.cCur)
ENDIF
ENDIF
ENDIF
ELSE
IF m.lnType == 5
IF EMPTY(m.lcValue)
FWRITE(m.lnFHSh,["></c>]) && Empty cell
ELSE
ltTime = m.lcValue
ldValue = TTOD(m.lcValue)
lnTime = (m.ltTime-DATETIME(YEAR(m.ltTime),MONTH(m.ltTime),DAY(m.ltTime),0,0,0))/(86400.0)
IF m.ldValue >= m.ldDat01
FWRITE(m.lnFHSh,["] + m.lcStT +[><v>]+LTRIM(STR(m.ldValue - m.ldDat11))+SUBSTR(TRANSFORM(m.lnTime),2,14)+[</v></c>])
ELSE
IF BETWEEN(m.ldValue,m.ldDat02,m.ldDat03)
FWRITE(m.lnFHSh,["] + m.lcStT +[><v>]+LTRIM(STR(m.ldValue - m.ldDat12))+SUBSTR(TRANSFORM(m.lnTime),2,14)+[</v></c>])
ELSE
lcValue = TTOC(m.lcValue)
SELECT (m.cStrings)
SET KEY TO LEFT(m.lcValue,m.lnLenIdx)
SCAN
IF cStr == m.lcValue
EXIT
ENDIF
ENDSCAN
SET KEY TO
FWRITE(m.lnFHSh,[" t="s"] + m.lcStN +[><v>]+LTRIM(STR(II))+[</v></c>])
SELECT (m.cCur)
ENDIF
ENDIF
ENDIF
ELSE
IF m.lnType == 6
FWRITE(m.lnFHSh,[" t="b"] + m.lcStN +[><v>]+IIF(m.lcValue ,[1],[0])+[</v></c>])
ELSE
IF m.lnType == 7
FWRITE(m.lnFHSh,["] + m.lcStC +[><v>]+LTRIM(STR(m.lcValue,21,4))+[</v></c>])
ELSE
IF m.lnType == 8
FWRITE(m.lnFHSh,["] + m.lcStN +[><v>]+LTRIM(STR(m.lcValue,21,m.lnDec))+[</v></c>])
ELSE
IF m.lnType == 9
lcValue = RTRIM(m.lcValue)
IF m.llMemoAsComment
lnCurComm = m.lnCurComm + 1
IF EMPTY(m.lcValue)
FWRITE(m.lnFHSh,["] + m.lcStN + [ t="s"></c>]) && Empty cell
ELSE
FWRITE(m.lnFHSh,["] + m.lcStN + [ t="s"><v>0</v></c>]) && Type "Memo" in sheet1
FWRITE(m.lnFHCo,[<comment authorId="0" ref="] + m.laFields[m.lnCurCol,5]+m.lcCurRow + [">]) && comments1
FWRITE(m.lnFHCo,[<text>])
FWRITE(m.lnFHCo,[<r>])
FWRITE(m.lnFHCo,[<rPr>])
FWRITE(m.lnFHCo,[<sz val="9"/>])
FWRITE(m.lnFHCo,[<color indexed="81"/>])
FWRITE(m.lnFHCo,[<rFont val="Tahoma"/>])
FWRITE(m.lnFHCo,[<family val="2"/>])
FWRITE(m.lnFHCo,[<charset val="238"/>])
FWRITE(m.lnFHCo,[</rPr>])
FWRITE(m.lnFHCo,[<t>] + m.lcValue + [</t>])
FWRITE(m.lnFHCo,[</r>])
FWRITE(m.lnFHCo,[</text>])
FWRITE(m.lnFHCo,[</comment>])
FWRITE(m.lnFHDr,[<v:shape id="_x] + PADL(LTRIM(STR(m.lnCurComm)),10,"0") + [" o:insetmode="auto" fillcolor="#ffffe1" style="position:absolute; margin-left:] + ;
LTRIM(STR(59.25 + 48 * (m.lnCurCol - 1))) + [pt;margin-top:] + LTRIM(STR(1.5 + 15 * (m.lnCurRow - 1))) + [pt;width:108pt;height:59.25pt;z-index:] + ;
LTRIM(STR(m.lnCurComm)) + [; visibility:hidden" type="#_x0000_t202">])
FWRITE(m.lnFHDr,[<v:fill color2="#ffffe1"/>])
FWRITE(m.lnFHDr,[<v:shadow obscured="t" color="black" on="t"/>])
FWRITE(m.lnFHDr,[<v:path o:connecttype="none"/>])
FWRITE(m.lnFHDr,[<v:textbox style="mso-direction-alt:auto">])
FWRITE(m.lnFHDr,[<div style="text-align:left"/>])
FWRITE(m.lnFHDr,[</v:textbox>])
FWRITE(m.lnFHDr,[<x:ClientData ObjectType="Note">])
FWRITE(m.lnFHDr,[<x:MoveWithCells/>])
FWRITE(m.lnFHDr,[<x:SizeWithCells/>])
lnNoRow = ALINES(laNoRow,m.lcValue)
lnMaxLenRow = LEN(m.laNoRow[1])
FOR lniNoRow = 2 TO m.lnNoRow
IF m.lnMaxLenRow < LEN(m.laNoRow[m.lniNoRow])
m.lnMaxLenRow = LEN(m.laNoRow[m.lniNoRow])
ENDIF
NEXT
lnCommH = MAX(3,MIN(m.lnNoRow - 2, MAXIMUMCOMMENTHEIGHT))
lnCommW = MAX(2, MIN(CEILING(m.lnMaxLenRow / 5), MAXIMUMCOMMENTWIDTH))
FWRITE(m.lnFHDr,[<x:Anchor> ] + LTRIM(STR(m.lnCurCol)) + [, 15, ] + LTRIM(STR(m.lnCurRow - 1)) + [, 2, ] + LTRIM(STR(m.lnCurCol + m.lnCommW)) + [, 31, ] + LTRIM(STR(m.lnCurRow + m.lnCommH)) + [, 1</x:Anchor>])
FWRITE(m.lnFHDr,[<x:AutoFill>False</x:AutoFill>])
FWRITE(m.lnFHDr,[<x:Row>] + LTRIM(STR(m.lnCurRow - 1)) + [</x:Row>])
FWRITE(m.lnFHDr,[<x:Column>] + LTRIM(STR(m.lnCurCol - 1)) + [</x:Column>])
FWRITE(m.lnFHDr,[</x:ClientData>])
FWRITE(m.lnFHDr,[</v:shape>])
ENDIF
ELSE
IF EMPTY(m.lcValue)
FWRITE(m.lnFHSh,["] + m.lcStN + [ t="s"></c>]) && Empty cell
ELSE
llCR=AT(CHR(13),m.lcValue)>0 or AT(CHR(10),m.lcValue)>0
SELECT (m.cStrings)
SET ORDER TO cM
SET KEY TO LEFT(m.lcValue,m.lnLenIdx)
lnII = 0
SCAN
IF cM == m.lcValue
lnII = ii
EXIT
ENDIF
ENDSCAN
SET KEY TO
IF lnII > 0
FWRITE(m.lnFHSh,["] + IIF(m.llCR,m.lcStM, m.lcStN)+[ t="s"><v>]+LTRIM(STR(m.lnII))+[</v></c>])
ELSE
FWRITE(m.lnFHStr,[<si><t>]+This.htmspec(m.lcValue,m.lcStrBad)+[</t></si>])
INSERT INTO (m.cStrings) (cM) VALUES (m.lcValue)
SELECT MAX(ii) as ii FROM (m.cStrings) INTO CURSOR (m.cMax)
SELECT (m.cMax)
lnII = ii
FWRITE(m.lnFHSh,["] + IIF(m.llCR,m.lcStM, m.lcStN)+[ t="s"><v>]+LTRIM(STR(m.lnII))+[</v></c>])
ENDIF
ENDIF
ENDIF
SELECT (m.cCur)
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
NEXT
FWRITE(m.lnFHSh,[</row>]+CHR(10))
ENDSCAN
CASE m.llMemos AND m.lnLenIdx >= m.lnLenStr
SCAN
lnCurRow = m.lnCurRow + 1
IF m.lnCurRow > This.LastRow
EXIT
ENDIF
lcCurRow = LTRIM(STR(m.lnCurRow))
SCATTER MEMO TO lala
lnNoRows = 1
FOR lnCurCol = 1 TO m.lnColsNo
IF m.laFields[m.lnCurCol,2] = 9
lnNoRows = MAX(m.lnNoRows , 1 + OCCURS(CHR(13),RTRIM(lala[m.laFields[m.lnCurCol,7]])))
ENDIF
NEXT
lcRowHeight = [ customHeight="1" ht="] + LTRIM(STR(IIF(This.RowFontSize>0,This.RowFontSize,11) * m.lnNoRows * 1.275,10,2)) + ["]
FWRITE(m.lnFHSh,[<row r="]+m.lcCurRow+["] + m.lcRowHeight + [>])
FOR lnCurCol = 1 TO m.lnColsNo
SET ORDER TO cStr IN (m.cStrings)
lcValue = lala[m.laFields[m.lnCurCol,7]]
IF ISNULL(m.lcValue)
LOOP
ENDIF
lnType = m.laFields[m.lnCurCol,2]
lnDec = m.laFields[m.lnCurCol,4]
FWRITE(m.lnFHSh,[<c r="]+m.laFields[m.lnCurCol,5]+m.lcCurRow)
IF m.lnType = 1
lcValue = RTRIM(m.lcValue)
IF EMPTY(m.lcValue)
FWRITE(m.lnFHSh,[" t="s"] + m.lcStN +[></c>]) && Empty cell
ELSE
SELECT (m.cStrings)
SEEK m.lcValue
FWRITE(m.lnFHSh,[" t="s"] + m.lcStN +[><v>]+LTRIM(STR(II))+[</v></c>])
ENDIF
SELECT (m.cCur)
ELSE
IF m.lnType = 2
FWRITE(m.lnFHSh,["] + m.lcStN +[><v>]+LTRIM(STR(m.lcValue,m.laFields[m.lnCurCol,3],m.lnDec))+[</v></c>])
ELSE
IF m.lnType = 3
FWRITE(m.lnFHSh,["] + m.lcStN +[><v>]+LTRIM(STR(m.lcValue))+[</v></c>])
ELSE
IF m.lnType = 4
IF EMPTY(m.lcValue)
FWRITE(m.lnFHSh,["></c>]) && Empty cell
ELSE
IF m.lcValue >= m.ldDat01
FWRITE(m.lnFHSh,["] + m.lcStD +[><v>]+LTRIM(STR(m.lcValue - m.ldDat11))+[</v></c>])
ELSE
IF BETWEEN(m.lcValue,m.ldDat02,m.ldDat03)
FWRITE(m.lnFHSh,["] + m.lcStD +[><v>]+LTRIM(STR(m.lcValue - m.ldDat12))+[</v></c>])
ELSE
lcValue = DTOC(m.lcValue)
SELECT (m.cStrings)
SEEK m.lcValue
FWRITE(m.lnFHSh,[" t="s"] + m.lcStN +[><v>]+LTRIM(STR(II))+[</v></c>])
SELECT (m.cCur)
ENDIF
ENDIF
ENDIF
ELSE
IF m.lnType = 5
IF EMPTY(m.lcValue)
FWRITE(m.lnFHSh,["></c>]) && Empty cell
ELSE
ltTime = m.lcValue
ldValue = TTOD(m.lcValue)
lnTime = (m.ltTime-DATETIME(YEAR(m.ltTime),MONTH(m.ltTime),DAY(m.ltTime),0,0,0))/(86400.0)
IF m.ldValue >= m.ldDat01
FWRITE(m.lnFHSh,["] + m.lcStT +[><v>]+LTRIM(STR(m.ldValue - m.ldDat11))+SUBSTR(TRANSFORM(m.lnTime),2,14)+[</v></c>])
ELSE
IF BETWEEN(m.ldValue,m.ldDat02,m.ldDat03)
FWRITE(m.lnFHSh,["] + m.lcStT +[><v>]+LTRIM(STR(m.ldValue - m.ldDat12))+SUBSTR(TRANSFORM(m.lnTime),2,14)+[</v></c>])
ELSE
lcValue = TTOC(m.lcValue)
SELECT (m.cStrings)
SEEK m.lcValue
FWRITE(m.lnFHSh,[" t="s"] + m.lcStN +[><v>]+LTRIM(STR(II))+[</v></c>])
SELECT (m.cCur)
ENDIF
ENDIF
ENDIF
ELSE
IF m.lnType = 6
FWRITE(m.lnFHSh,[" t="b"] + m.lcStN +[><v>]+IIF(m.lcValue ,[1],[0])+[</v></c>])
ELSE
IF m.lnType = 7
FWRITE(m.lnFHSh,["] + m.lcStC +[><v>]+LTRIM(STR(m.lcValue,21,4))+[</v></c>])
ELSE
IF m.lnType = 8
FWRITE(m.lnFHSh,["] + m.lcStN +[><v>]+LTRIM(STR(m.lcValue,21,m.lnDec))+[</v></c>])
ELSE
IF m.lnType = 9
lcValue = RTRIM(m.lcValue)
IF m.llMemoAsComment
lnCurComm = m.lnCurComm + 1
IF EMPTY(m.lcValue)
FWRITE(m.lnFHSh,["] + m.lcStN + [ t="s"></c>]) && Empty cell
ELSE
FWRITE(m.lnFHSh,["] + m.lcStN + [ t="s"><v>0</v></c>]) && Tyoe "Memo" in sheet1
FWRITE(m.lnFHCo,[<comment authorId="0" ref="] + m.laFields[m.lnCurCol,5]+m.lcCurRow + [">]) && comments1
FWRITE(m.lnFHCo,[<text>])
FWRITE(m.lnFHCo,[<r>])
FWRITE(m.lnFHCo,[<rPr>])
FWRITE(m.lnFHCo,[<sz val="9"/>])
FWRITE(m.lnFHCo,[<color indexed="81"/>])
FWRITE(m.lnFHCo,[<rFont val="Tahoma"/>])
FWRITE(m.lnFHCo,[<family val="2"/>])
FWRITE(m.lnFHCo,[<charset val="238"/>])
FWRITE(m.lnFHCo,[</rPr>])
FWRITE(m.lnFHCo,[<t>] + m.lcValue + [</t>])
FWRITE(m.lnFHCo,[</r>])
FWRITE(m.lnFHCo,[</text>])
FWRITE(m.lnFHCo,[</comment>])
FWRITE(m.lnFHDr,[<v:shape id="_x] + PADL(LTRIM(STR(m.lnCurComm)),10,"0") + [" o:insetmode="auto" fillcolor="#ffffe1" style="position:absolute; margin-left:] + ;
LTRIM(STR(59.25 + 48 * (m.lnCurCol - 1))) + [pt;margin-top:] + LTRIM(STR(1.5 + 15 * (m.lnCurRow - 1))) + [pt;width:108pt;height:59.25pt;z-index:] + ;
LTRIM(STR(m.lnCurComm)) + [; visibility:hidden" type="#_x0000_t202">])
FWRITE(m.lnFHDr,[<v:fill color2="#ffffe1"/>])
FWRITE(m.lnFHDr,[<v:shadow obscured="t" color="black" on="t"/>])
FWRITE(m.lnFHDr,[<v:path o:connecttype="none"/>])
FWRITE(m.lnFHDr,[<v:textbox style="mso-direction-alt:auto">])
FWRITE(m.lnFHDr,[<div style="text-align:left"/>])
FWRITE(m.lnFHDr,[</v:textbox>])
FWRITE(m.lnFHDr,[<x:ClientData ObjectType="Note">])
FWRITE(m.lnFHDr,[<x:MoveWithCells/>])
FWRITE(m.lnFHDr,[<x:SizeWithCells/>])
lnNoRow = ALINES(laNoRow,m.lcValue)
lnMaxLenRow = LEN(m.laNoRow[1])
FOR lniNoRow = 2 TO m.lnNoRow
IF m.lnMaxLenRow < LEN(m.laNoRow[m.lniNoRow])
m.lnMaxLenRow = LEN(m.laNoRow[m.lniNoRow])
ENDIF
NEXT
lnCommH = MAX(3,MIN(m.lnNoRow - 2, MAXIMUMCOMMENTHEIGHT))
lnCommW = MAX(2, MIN(CEILING(m.lnMaxLenRow / 5), MAXIMUMCOMMENTWIDTH))
FWRITE(m.lnFHDr,[<x:Anchor> ] + LTRIM(STR(m.lnCurCol)) + [, 15, ] + LTRIM(STR(m.lnCurRow - 1)) + [, 2, ] + LTRIM(STR(m.lnCurCol + m.lnCommW)) + [, 31, ] + LTRIM(STR(m.lnCurRow + m.lnCommH)) + [, 1</x:Anchor>])
FWRITE(m.lnFHDr,[<x:AutoFill>False</x:AutoFill>])
FWRITE(m.lnFHDr,[<x:Row>] + LTRIM(STR(m.lnCurRow - 1)) + [</x:Row>])
FWRITE(m.lnFHDr,[<x:Column>] + LTRIM(STR(m.lnCurCol - 1)) + [</x:Column>])
FWRITE(m.lnFHDr,[</x:ClientData>])
FWRITE(m.lnFHDr,[</v:shape>])
ENDIF
ELSE
IF EMPTY(m.lcValue)
FWRITE(m.lnFHSh,["] + m.lcStN + [ t="s"></c>]) && Empty cell
ELSE
llCR=AT(CHR(13),m.lcValue)>0 or AT(CHR(10),m.lcValue)>0
SELECT (m.cStrings)
SET ORDER TO cM
SET KEY TO LEFT(m.lcValue,m.lnLenIdx)
lnII = 0
SCAN
IF cM == m.lcValue
lnII = ii
EXIT
ENDIF
ENDSCAN
SET KEY TO
IF lnII > 0
FWRITE(m.lnFHSh,["] + IIF(m.llCR,m.lcStM, m.lcStN)+[ t="s"><v>]+LTRIM(STR(m.lnII))+[</v></c>])
ELSE
FWRITE(m.lnFHStr,[<si><t>]+This.htmspec(m.lcValue,m.lcStrBad)+[</t></si>])
INSERT INTO (m.cStrings) (cM) VALUES (m.lcValue)
SELECT MAX(ii) as ii FROM (m.cStrings) INTO CURSOR (m.cMax)
SELECT (m.cMax)
lnII = ii
FWRITE(m.lnFHSh,["] + IIF(m.llCR,m.lcStM, m.lcStN)+[ t="s"><v>]+LTRIM(STR(m.lnII))+[</v></c>])
ENDIF
ENDIF
ENDIF
SELECT (m.cCur)
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
NEXT
FWRITE(m.lnFHSh,[</row>]+CHR(10))
ENDSCAN
CASE !m.llMemos AND m.lnLenIdx < m.lnLenStr
SET ORDER TO cStr IN (m.cStrings)
SCAN
lnCurRow = m.lnCurRow + 1
IF m.lnCurRow > This.LastRow
EXIT
ENDIF
lcCurRow = LTRIM(STR(m.lnCurRow))
FWRITE(m.lnFHSh,[<row r="]+m.lcCurRow+["] + m.lcRowHeight + [>]) &&spans="1:1" x14ac:dyDescent="0.25"
SCATTER TO lala
FOR lnCurCol = 1 TO m.lnColsNo
lcValue = lala[m.laFields[m.lnCurCol,7]]
IF ISNULL(m.lcValue)
LOOP
ENDIF
lnType = m.laFields[m.lnCurCol,2]
lnDec = m.laFields[m.lnCurCol,4]
FWRITE(m.lnFHSh,[<c r="]+m.laFields[m.lnCurCol,5]+m.lcCurRow)
IF m.lnType = 1
lcValue = RTRIM(m.lcValue)
IF EMPTY(m.lcValue)
FWRITE(m.lnFHSh,[" t="s"] + m.lcStN +[></c>]) && Empty cell
ELSE
SELECT (m.cStrings)
SET KEY TO LEFT(m.lcValue,m.lnLenIdx)
SCAN
IF cStr == m.lcValue
EXIT
ENDIF
ENDSCAN
SET KEY TO
FWRITE(m.lnFHSh,[" t="s"] + m.lcStN +[><v>]+LTRIM(STR(II))+[</v></c>])
ENDIF
SELECT (m.cCur)
ELSE
IF m.lnType = 2
FWRITE(m.lnFHSh,["] + m.lcStN +[><v>]+LTRIM(STR(m.lcValue,m.laFields[m.lnCurCol,3],m.lnDec))+[</v></c>])
ELSE
IF m.lnType = 3
FWRITE(m.lnFHSh,["] + m.lcStN +[><v>]+LTRIM(STR(m.lcValue))+[</v></c>])
ELSE
IF m.lnType = 4
IF EMPTY(m.lcValue)
FWRITE(m.lnFHSh,["></c>]) && Empty cell
ELSE
IF m.lcValue >= m.ldDat01
FWRITE(m.lnFHSh,["] + m.lcStD +[><v>]+LTRIM(STR(m.lcValue - m.ldDat11))+[</v></c>])
ELSE
IF BETWEEN(m.lcValue,m.ldDat02,m.ldDat03)
FWRITE(m.lnFHSh,["] + m.lcStD +[><v>]+LTRIM(STR(m.lcValue - m.ldDat12))+[</v></c>])
ELSE
lcValue = DTOC(m.lcValue)
SELECT (m.cStrings)
SET KEY TO LEFT(m.lcValue,m.lnLenIdx)
SCAN
IF cStr == m.lcValue
EXIT
ENDIF
ENDSCAN
SET KEY TO
FWRITE(m.lnFHSh,[" t="s"] + m.lcStN +[><v>]+LTRIM(STR(II))+[</v></c>])
SELECT (m.cCur)
ENDIF
ENDIF
ENDIF
ELSE
IF m.lnType = 5
IF EMPTY(m.lcValue)
FWRITE(m.lnFHSh,["></c>]) && Empty cell
ELSE
ltTime = m.lcValue
ldValue = TTOD(m.lcValue)
lnTime = (m.ltTime-DATETIME(YEAR(m.ltTime),MONTH(m.ltTime),DAY(m.ltTime),0,0,0))/(86400.0)
IF m.ldValue >= m.ldDat01
FWRITE(m.lnFHSh,["] + m.lcStT +[><v>]+LTRIM(STR(m.ldValue - m.ldDat11))+SUBSTR(TRANSFORM(m.lnTime),2,14)+[</v></c>])
ELSE
IF BETWEEN(m.ldValue,m.ldDat02,m.ldDat03)
FWRITE(m.lnFHSh,["] + m.lcStT +[><v>]+LTRIM(STR(m.ldValue - m.ldDat12))+SUBSTR(TRANSFORM(m.lnTime),2,14)+[</v></c>])
ELSE
lcValue = TTOC(m.lcValue)
SELECT (m.cStrings)
SET KEY TO LEFT(m.lcValue,m.lnLenIdx)
SCAN
IF cStr == m.lcValue
EXIT
ENDIF
ENDSCAN
SET KEY TO
FWRITE(m.lnFHSh,[" t="s"] + m.lcStN +[><v>]+LTRIM(STR(II))+[</v></c>])
SELECT (m.cCur)
ENDIF
ENDIF
ENDIF
ELSE
IF m.lnType = 6
FWRITE(m.lnFHSh,[" t="b"] + m.lcStN +[><v>]+IIF(m.lcValue ,[1],[0])+[</v></c>])
ELSE
IF m.lnType = 7
FWRITE(m.lnFHSh,["] + m.lcStC +[><v>]+LTRIM(STR(m.lcValue,21,4))+[</v></c>])
ELSE
IF m.lnType = 8
FWRITE(m.lnFHSh,["] + m.lcStN +[><v>]+LTRIM(STR(m.lcValue,21,m.lnDec))+[</v></c>])
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
NEXT
FWRITE(m.lnFHSh,[</row>]+CHR(10))
ENDSCAN
CASE !m.llMemos AND m.lnLenIdx >= m.lnLenStr
SET ORDER TO cStr IN (m.cStrings)
SCAN
lnCurRow = m.lnCurRow + 1
IF m.lnCurRow > This.LastRow
EXIT
ENDIF
lcCurRow = LTRIM(STR(m.lnCurRow))
FWRITE(m.lnFHSh,[<row r="]+m.lcCurRow+["] + m.lcRowHeight + [>]) &&spans="1:1" x14ac:dyDescent="0.25"
SCATTER TO lala
FOR lnCurCol = 1 TO m.lnColsNo
lcValue = lala[m.laFields[m.lnCurCol,7]]
IF ISNULL(m.lcValue)
LOOP
ENDIF
lnType = m.laFields[m.lnCurCol,2]
lnDec = m.laFields[m.lnCurCol,4]
FWRITE(m.lnFHSh,[<c r="]+m.laFields[m.lnCurCol,5]+m.lcCurRow)
IF m.lnType = 1
lcValue = RTRIM(m.lcValue)
IF EMPTY(m.lcValue)
FWRITE(m.lnFHSh,[" t="s"] + m.lcStN +[></c>]) && Empty cell
ELSE
SELECT (m.cStrings)
SEEK m.lcValue
FWRITE(m.lnFHSh,[" t="s"] + m.lcStN +[><v>]+LTRIM(STR(II))+[</v></c>])
ENDIF
SELECT (m.cCur)
ELSE
IF m.lnType = 2
FWRITE(m.lnFHSh,["] + m.lcStN +[><v>]+LTRIM(STR(m.lcValue,m.laFields[m.lnCurCol,3],m.lnDec))+[</v></c>])
ELSE
IF m.lnType = 3
FWRITE(m.lnFHSh,["] + m.lcStN +[><v>]+LTRIM(STR(m.lcValue))+[</v></c>])
ELSE
IF m.lnType = 4
IF EMPTY(m.lcValue)
FWRITE(m.lnFHSh,["></c>]) && Empty cell
ELSE
IF m.lcValue >= m.ldDat01
FWRITE(m.lnFHSh,["] + m.lcStD +[><v>]+LTRIM(STR(m.lcValue - m.ldDat11))+[</v></c>])
ELSE
IF BETWEEN(m.lcValue,m.ldDat02,m.ldDat03)
FWRITE(m.lnFHSh,["] + m.lcStD +[><v>]+LTRIM(STR(m.lcValue - m.ldDat12))+[</v></c>])
ELSE
lcValue = DTOC(m.lcValue)
SELECT (m.cStrings)
SEEK m.lcValue
FWRITE(m.lnFHSh,[" t="s"] + m.lcStN +[><v>]+LTRIM(STR(II))+[</v></c>])
SELECT (m.cCur)
ENDIF
ENDIF
ENDIF
ELSE
IF m.lnType = 5
IF EMPTY(m.lcValue)
FWRITE(m.lnFHSh,["></c>]) && Empty cell
ELSE
ltTime = m.lcValue
ldValue = TTOD(m.lcValue)
lnTime = (m.ltTime-DATETIME(YEAR(m.ltTime),MONTH(m.ltTime),DAY(m.ltTime),0,0,0))/(86400.0)
IF m.ldValue >= m.ldDat01
FWRITE(m.lnFHSh,["] + m.lcStT +[><v>]+LTRIM(STR(m.ldValue - m.ldDat11))+SUBSTR(TRANSFORM(m.lnTime),2,14)+[</v></c>])
ELSE
IF BETWEEN(m.ldValue,m.ldDat02,m.ldDat03)
FWRITE(m.lnFHSh,["] + m.lcStT +[><v>]+LTRIM(STR(m.ldValue - m.ldDat12))+SUBSTR(TRANSFORM(m.lnTime),2,14)+[</v></c>])
ELSE
lcValue = TTOC(m.lcValue)
SELECT (m.cStrings)
SEEK m.lcValue
FWRITE(m.lnFHSh,[" t="s"] + m.lcStN +[><v>]+LTRIM(STR(II))+[</v></c>])
SELECT (m.cCur)
ENDIF
ENDIF
ENDIF
ELSE
IF m.lnType = 6
FWRITE(m.lnFHSh,[" t="b"] + m.lcStN +[><v>]+IIF(m.lcValue ,[1],[0])+[</v></c>])
ELSE
IF m.lnType = 7
FWRITE(m.lnFHSh,["] + m.lcStC +[><v>]+LTRIM(STR(m.lcValue,21,4))+[</v></c>])
ELSE
IF m.lnType = 8
FWRITE(m.lnFHSh,["] + m.lcStN +[><v>]+LTRIM(STR(m.lcValue,21,m.lnDec))+[</v></c>])
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
NEXT
FWRITE(m.lnFHSh,[</row>]+CHR(10))
ENDSCAN
ENDCASE
SET DECIMALS TO &lcSetDec
* End sheet1
FWRITE(m.lnFHSh,[</sheetData>])
FWRITE(m.lnFHSh,[<pageMargins left="0.7" right="0.7" top="0.75" bottom="0.75" header="0.3" footer="0.3"/>])
IF m.llMemoAsComment AND m.llMemos
FWRITE(m.lnFHSh,[<legacyDrawing r:id="rId6"/>])
ENDIF
FWRITE(m.lnFHSh,[</worksheet>])
FCLOSE(m.lnFHSh)
* End sharedStrings
FWRITE(m.lnFHStr,[</sst>])
FSEEK(m.lnFHStr,55+1+LEN([<sst xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" count="]))
FWRITE(m.lnFHStr,LTRIM(STR(m.lnTotal))+[" uniqueCount="]+LTRIM(STR(RECCOUNT(m.cStrings)))+[">])
FCLOSE(m.lnFHStr)
IF m.llMemoAsComment AND m.llMemos
* End comment1
FWRITE(m.lnFHCo,[</commentList>])
FWRITE(m.lnFHCo,[</comments>])
FCLOSE(m.lnFHCo)
* End comment1
FWRITE(m.lnFHDr,[</xml>])
FCLOSE(m.lnFHDr)
ENDIF
*****
lcSource = m.lcMyPath + m.lcDir &&"<< fully qualified path name to some folder >>"
*lcZipFileName = m.lcMyPath + FORCEEXT(m.lcFileName,'zip') &&"<< fully qualified path name to some zip file >>"
lcZipFileName = FORCEEXT(m.lcFileName,'zip') &&"<< fully qualified path name to some zip file >>"
TRY
IF FILE(m.lcZipFileName)
ERASE (m.lcZipFileName)
ENDIF
CATCH TO m.loerr
ENDTRY
TRY
IF FILE(m.lcFileName)
ERASE (m.lcFileName)
ENDIF
CATCH TO m.loerr
ENDTRY
STRTOFILE(CHR( 80 )+CHR( 75 )+CHR( 5 )+CHR( 6 )+REPLICATE( CHR(0), 18 ), m.lcZipFileName)
oShell = CREATEOBJECT("shell.application")
oFolder = m.oShell.NameSpace( m.lcSource ).items
llBelow7 = OS(3)<'6' OR OS(3)='6' AND OS(4)<'1'
IF m.llBelow7 && Win XP
TRY
FOR EACH ofile IN m.oFolder
lnCountbefore = m.oShell.NameSpace( m.lcSource ).items.count
oShell.NameSpace( m.lcZipFileName ).copyhere( m.ofile )
sleep(100)
ENDFOR
CATCH TO loErr
ENDTRY
llErr = .T.
DO WHILE llErr
TRY
llErr = .F.
RENAME (m.lcZipFileName) TO (FORCEEXT(m.lcZipFileName,"xlsx"))
CATCH
llErr = .T.
sleep(100)
ENDTRY
ENDDO
This.cleanup(m.lcDir,m.llMemoAsComment AND m.llMemos,m.llToClose,m.cCur,m.cTotal,m.cMax,m.cStrings,m.lcCurrAlias,m.lnFHSh,m.lnFHStr,m.lnFHCo,m.lnFHDr,m.lcOldPath)
ELSE && WIN 7
TRY
FOR EACH ofile IN m.oFolder
lnCountbefore = m.oShell.NameSpace( m.lcSource ).items.count
oShell.NameSpace( m.lcZipFileName ).movehere( m.ofile )
sleep(100)
DO WHILE m.lnCountbefore = m.oShell.NameSpace( m.lcSource ).items.count
sleep(100)
ENDDO
ENDFOR
CATCH TO loErr
ENDTRY
TRY
RD (m.lcDir)
CATCH TO m.loErr
ENDTRY
This.cleanup2(m.llToClose,m.cCur,m.cTotal,m.cMax,m.cStrings,m.lcCurrAlias,m.lnFHSh,m.lnFHStr,m.lnFHCo,m.lnFHDr,m.lcOldPath)
RENAME (m.lcZipFileName) TO (FORCEEXT(m.lcZipFileName,"xlsx"))
ENDIF
IF This.lOpen
ShellExecute(0,"Open",FORCEEXT(m.lcZipFileName,"xlsx"),"","",1)
ENDIF
SET TALK &lSetTalk
SET POINT TO lcSetPoint
ENDPROC
PROCEDURE gen_app
*****************************
* Generate docProps\app.xml *
*****************************
LPARAMETERS lcDir
LOCAL lnF
lnF = FCREATE(m.lcDir+"app.xml")
IF m.lnF < 0
MESSAGEBOX(This.aErrMess[2] + ' app.xml',16,This.aErrMess[1])
This.lError=.T.
RETURN
ENDIF
FWRITE(m.lnF,[<?xml version="1.0" encoding="UTF-8" standalone="yes"?>]+CHR(10))
FWRITE(m.lnF,[<Properties xmlns="http://schemas.openxmlformats.org/officeDocument/2006/extended-properties" xmlns:vt="http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes">])
FWRITE(m.lnF,[<Application>exportxlsx</Application>])
FWRITE(m.lnF,[<AppVersion>5.1000</AppVersion>])
FWRITE(m.lnF,[</Properties>])
FCLOSE(m.lnF)
ENDPROC
PROCEDURE gen_content_types
********************************
* Generate [Content_Types].xml *
********************************
LPARAMETERS lcDir,llMemoAsComment
LOCAL lnF
lnF = FCREATE(m.lcDir+"[Content_Types].xml")
IF m.lnF < 0
MESSAGEBOX(This.aErrMess[2] + ' [Content_Types].xml',16,This.aErrMess[1])
This.lError=.T.
RETURN
ENDIF
FWRITE(m.lnF,[<?xml version="1.0" encoding="UTF-8" standalone="yes"?>])
FWRITE(m.lnF,[<Types xmlns="http://schemas.openxmlformats.org/package/2006/content-types">])
FWRITE(m.lnF,[<Default Extension="rels" ContentType="application/vnd.openxmlformats-package.relationships+xml"/>])
FWRITE(m.lnF,[<Default Extension="xml" ContentType="application/xml"/>])
IF m.llMemoAsComment
FWRITE(m.lnF,[<Default ContentType="application/vnd.openxmlformats-officedocument.vmlDrawing" Extension="vml"/>])
FWRITE(m.lnF,[<Override ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.comments+xml" PartName="/xl/comments1.xml"/>])
ENDIF
FWRITE(m.lnF,[<Override PartName="/xl/workbook.xml" ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.sheet.main+xml"/>])
FWRITE(m.lnF,[<Override PartName="/xl/worksheets/sheet1.xml" ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.worksheet+xml"/>])
FWRITE(m.lnF,[<Override PartName="/xl/styles.xml" ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.styles+xml"/>])
FWRITE(m.lnF,[<Override PartName="/xl/sharedStrings.xml" ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.sharedStrings+xml"/>])
FWRITE(m.lnF,[<Override PartName="/docProps/core.xml" ContentType="application/vnd.openxmlformats-package.core-properties+xml"/>])
FWRITE(m.lnF,[<Override PartName="/docProps/app.xml" ContentType="application/vnd.openxmlformats-officedocument.extended-properties+xml"/>]+CHR(10))
FWRITE(m.lnF,[</Types>])
FCLOSE(m.lnF)
ENDPROC
PROCEDURE gen_core
******************************
* Generate docProps\core.xml *
******************************
LPARAMETERS lcDir
LOCAL lnF
lnF = FCREATE(m.lcDir+"core.xml")
IF m.lnF < 0
MESSAGEBOX(This.aErrMess[2] + ' core.xml',16,This.aErrMess[1])
This.lError=.T.
RETURN
ENDIF
FWRITE(m.lnF,[<?xml version="1.0" encoding="UTF-8" standalone="yes"?>]+CHR(10))
FWRITE(m.lnF,[<cp:coreProperties xmlns:cp="http://schemas.openxmlformats.org/package/2006/metadata/core-properties" xmlns:dc="http://purl.org/dc/elements/1.1/" ])
FWRITE(m.lnF,[xmlns:dcterms="http://purl.org/dc/terms/" xmlns:dcmitype="http://purl.org/dc/dcmitype/" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">])
FWRITE(m.lnF,[<dc:creator>Vilhelm-Ion Praisach</dc:creator>])
FWRITE(m.lnF,[<dcterms:created xsi:type="dcterms:W3CDTF">]+TTOC(DATETIME(),3)+[</dcterms:created>])
FWRITE(m.lnF,[</cp:coreProperties>])
FCLOSE(m.lnF)
ENDPROC
PROCEDURE gen_dirs
**********************
* Generate temp dirs *
**********************
LPARAMETERS llMemoAsComment
LOCAL lcDir
lcDir=ADDBS(SYS(2015))
MD (m.lcDir)
MD (ADDBS(m.lcDir+[_rels]))
MD (ADDBS(m.lcDir+[docProps]))
MD (ADDBS(m.lcDir+[xl]))
MD (ADDBS(ADDBS(m.lcDir+[xl])+[_rels]))
MD (ADDBS(ADDBS(m.lcDir+[xl])+[worksheets]))
IF m.llMemoAsComment
MD (ADDBS(ADDBS(m.lcDir+[xl])+[drawings]))
MD (ADDBS(ADDBS(ADDBS(m.lcDir+[xl])+[worksheets])+[_rels]))
ENDIF
RETURN m.lcDir
ENDPROC
PROCEDURE gen_rels
***************************
* Generate _rels\rels.xml *
***************************
LPARAMETERS lcDir
LOCAL lnF
lnF = FCREATE(m.lcDir+".rels")
IF m.lnF < 0
MESSAGEBOX(This.aErrMess[2] + ' .rels',16,This.aErrMess[1])
This.lError=.T.
RETURN
ENDIF
FWRITE(m.lnF,[<?xml version="1.0" encoding="UTF-8" standalone="yes"?>]+CHR(10))
FWRITE(m.lnF,[<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships">])
FWRITE(m.lnF,[<Relationship Id="rId3" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties" Target="docProps/app.xml"/>])
FWRITE(m.lnF,[<Relationship Id="rId2" Type="http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties" Target="docProps/core.xml"/>])
FWRITE(m.lnF,[<Relationship Id="rId1" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument" Target="xl/workbook.xml"/>]+CHR(10))
FWRITE(m.lnF,[</Relationships>])
FCLOSE(m.lnF)
ENDPROC
PROCEDURE gen_styles
**************************
* Generate xl\styles.xml *
**************************
LPARAMETERS lcDir,lcCurr,llMemoAsComment
LOCAL lnF,lnFonts,laFo[1],llHead,llRow,lcColor,lnFills,lnCellF,lnFontIdHead,lnFontIdRow,lnFillIdHead,lnFillIdRow,lcFont,lni
*
lnFonts = 1
STORE .F. TO llHead,llRow
IF BETWEEN(this.headforecolor,0,RGB(255,255,255)) OR ;
this.headFontBold OR ;
this.headFontItalic OR ;
(!EMPTY(This.headFontName) AND AFONT(laFont,This.headFontName)) OR ;
This.headFontSize > 0
lnFonts = m.lnFonts +1
llHead = .T.
ENDIF
IF BETWEEN(this.rowforecolor,0,RGB(255,255,255)) OR ;
this.rowFontBold OR ;
this.rowFontItalic OR ;
(!EMPTY(This.rowFontName) AND AFONT(laFont,This.rowFontName)) OR ;
This.rowFontSize > 0
lnFonts = m.lnFonts +1
llRow = .T.
ENDIF
*
lnFills = 2
IF BETWEEN(this.headbackcolor,0,RGB(255,255,255)) AND This.HeadFill
lnFills = m.lnFills + 1
ENDIF
IF BETWEEN(this.rowbackcolor,0,RGB(255,255,255)) AND This.RowFill
lnFills = m.lnFills + 1
ENDIF
lnF = FCREATE(m.lcDir+"styles.xml")
IF m.lnF < 0
MESSAGEBOX(This.aErrMess[2] + ' styles.xml',16,This.aErrMess[1])
This.lError=.T.
RETURN
ENDIF
*
lnCellF = 5
IF m.llHead OR (BETWEEN(this.headbackcolor,0,RGB(255,255,255)) AND This.HeadFill)
lnCellF = m.lnCellF + 1
ENDIF
IF m.llRow OR (BETWEEN(this.rowbackcolor,0,RGB(255,255,255)) AND This.RowFill)
lnCellF = m.lnCellF + 5
ENDIF
*
FWRITE(m.lnF,[<?xml version="1.0" encoding="UTF-8" standalone="yes"?>]+CHR(10))
FWRITE(m.lnF,[<styleSheet xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" ])
FWRITE(m.lnF,[mc:Ignorable="x14ac" xmlns:x14ac="http://schemas.microsoft.com/office/spreadsheetml/2009/9/ac">])
FWRITE(m.lnF,[<numFmts count="2">]) && currency
FWRITE(m.lnF,[<numFmt numFmtId="164" formatCode="]+m.lcCurr+["/>])
FWRITE(m.lnF,[<numFmt formatCode="dd/mm/yyyy\ hh:mm:ss" numFmtId="22"/>])
FWRITE(m.lnF,[</numFmts>])
STORE 0 TO m.lnFontIdHead,m.lnFontIdRow
IF m.llMemoAsComment
FWRITE(m.lnF,[<fonts count="] + LTRIM(STR(m.lnFonts + 1)) + [" x14ac:knownFonts="1">])
ELSE
FWRITE(m.lnF,[<fonts count="] + LTRIM(STR(m.lnFonts)) + [" x14ac:knownFonts="1">])
ENDIF
FWRITE(m.lnF,[<font><sz val="11"/>])
FWRITE(m.lnF,[<color theme="1"/>])
FWRITE(m.lnF,[<name val="Calibri"/>])
FWRITE(m.lnF,[<family val="2"/>])
FWRITE(m.lnF,[<charset val="238"/>])
FWRITE(m.lnF,[<scheme val="minor"/>])
FWRITE(m.lnF,[</font>])
IF m.llHead
lnFontIdHead = 1
FWRITE(m.lnF,[<font>])
IF this.headFontBold
FWRITE(m.lnF,[<b/>])
ENDIF
IF this.headFontItalic
FWRITE(m.lnF,[<i/>])
ENDIF
IF This.headFontSize > 0
FWRITE(m.lnF,[<sz val="]+LTRIM(STR(INT(This.headFontSize)))+["/>])
ELSE
FWRITE(m.lnF,[<sz val="11"/>])
ENDIF
IF BETWEEN(this.headforecolor,0,RGB(255,255,255))
lcColor = TRANSFORM(this.headforecolor,"@0")
FWRITE(m.lnF,[<color rgb="FF] + SUBSTR(m.lcColor,9,2) + SUBSTR(m.lcColor,7,2) + SUBSTR(m.lcColor,5,2) +["/>])
ENDIF
IF (!EMPTY(This.headFontName) AND AFONT(laFont,This.headFontName))
FWRITE(m.lnF,[<name val="]+This.headFontName+["/>])
ELSE
FWRITE(m.lnF,[<name val="Calibri"/>])
ENDIF
FWRITE(m.lnF,[</font>])
ENDIF
IF m.llRow
lnFontIdRow = 1 + m.lnFontIdHead
FWRITE(m.lnF,[<font>])
IF this.RowFontBold
FWRITE(m.lnF,[<b/>])
ENDIF
IF this.RowFontItalic
FWRITE(m.lnF,[<i/>])
ENDIF
IF This.RowFontSize > 0
FWRITE(m.lnF,[<sz val="]+LTRIM(STR(INT(This.RowFontSize)))+["/>])
ELSE
FWRITE(m.lnF,[<sz val="11"/>])
ENDIF
IF BETWEEN(this.Rowforecolor,0,RGB(255,255,255))
lcColor = TRANSFORM(this.Rowforecolor,"@0")
FWRITE(m.lnF,[<color rgb="FF] + SUBSTR(m.lcColor,9,2) + SUBSTR(m.lcColor,7,2) + SUBSTR(m.lcColor,5,2) +["/>])
ENDIF
IF (!EMPTY(This.RowFontName) AND AFONT(laFont,This.RowFontName))
FWRITE(m.lnF,[<name val="]+This.RowFontName+["/>])
ELSE
FWRITE(m.lnF,[<name val="Calibri"/>])
ENDIF
FWRITE(m.lnF,[</font>])
ENDIF
IF m.llMemoAsComment
FWRITE(m.lnF,[<font>])
FWRITE(m.lnF,[<sz val="9"/>])
FWRITE(m.lnF,[<color indexed="81"/>])
FWRITE(m.lnF,[<name val="Tahoma"/>])
FWRITE(m.lnF,[<family val="2"/>])
FWRITE(m.lnF,[<charset val="238"/>])
FWRITE(m.lnF,[</font>])
ENDIF
FWRITE(m.lnF,[</fonts>])
STORE 0 TO m.lnFillIdHead,m.lnFillIdRow
FWRITE(m.lnF,[<fills count="] + LTRIM(STR(m.lnFills)) + [">])
FWRITE(m.lnF,[<fill>])
FWRITE(m.lnF,[<patternFill patternType="none"/>])
FWRITE(m.lnF,[</fill>])
FWRITE(m.lnF,[<fill>])
FWRITE(m.lnF,[<patternFill patternType="gray125"/>])
FWRITE(m.lnF,[</fill>])
IF BETWEEN(this.headbackcolor,0,RGB(255,255,255)) AND This.HeadFill
lnFillIdHead = 2
FWRITE(m.lnF,[<fill>])
FWRITE(m.lnF,[<patternFill patternType="solid">])
lcColor = TRANSFORM(this.headbackcolor,"@0")
FWRITE(m.lnF,[<fgColor rgb="FF] + SUBSTR(m.lcColor,9,2) + SUBSTR(m.lcColor,7,2) + SUBSTR(m.lcColor,5,2) +["/>])
FWRITE(m.lnF,[<bgColor indexed="64"/>])
FWRITE(m.lnF,[</patternFill>])
FWRITE(m.lnF,[</fill>])
ENDIF
IF BETWEEN(this.rowbackcolor,0,RGB(255,255,255)) AND This.rowFill
lnFillIdRow = 2 + IIF(m.lnFillIdHead > 0, 1, 0)
FWRITE(m.lnF,[<fill>])
FWRITE(m.lnF,[<patternFill patternType="solid">])
lcColor = TRANSFORM(this.rowbackcolor,"@0")
FWRITE(m.lnF,[<fgColor rgb="FF] + SUBSTR(m.lcColor,9,2) + SUBSTR(m.lcColor,7,2) + SUBSTR(m.lcColor,5,2) +["/>])
FWRITE(m.lnF,[<bgColor indexed="64"/>])
FWRITE(m.lnF,[</patternFill>])
FWRITE(m.lnF,[</fill>])
ENDIF
FWRITE(m.lnF,[</fills>])
FWRITE(m.lnF,[<borders count="1">])
FWRITE(m.lnF,[<border>])
FWRITE(m.lnF,[<left/><right/><top/><bottom/><diagonal/>])
FWRITE(m.lnF,[</border>])
FWRITE(m.lnF,[</borders>])
FWRITE(m.lnF,[<cellXfs count="] + LTRIM(STR(m.lnCellF)) + [">])
lcFont = [fontId="0" fillId="0" ]
This.aStyles[6] = 0
FOR lni = 1 TO 5
This.aStyles[m.lni] = m.lni - 1
NEXT
FWRITE(m.lnF,[<xf numFmtId="0" ] + m.lcFont + [/>]) && Number
FWRITE(m.lnF,[<xf numFmtId="14" ] + m.lcFont + [applyNumberFormat="1"/>]) && date
FWRITE(m.lnF,[<xf numFmtId="22" ] + m.lcFont + [applyNumberFormat="1"/>]) && time
FWRITE(m.lnF,[<xf numFmtId="0" ] + m.lcFont + [applyAlignment="1"><alignment wrapText="1"/></xf>]) && enter in memo
FWRITE(m.lnF,[<xf numFmtId="164" ] + m.lcFont + [applyNumberFormat="1"/>]) && currency
IF m.llHead OR (BETWEEN(this.headbackcolor,0,RGB(255,255,255)) AND This.headFill)
FWRITE(m.lnF,[<xf numFmtId="0" fontId="] + LTRIM(STR(m.lnFontIdHead)) + [" fillId="] + LTRIM(STR(m.lnFillIdHead)) + [" ] + IIF(m.lnFontIdHead>0,[applyFont="1" ],[]) + IIF(m.lnFillIdHead>0,[applyFill="1" ],[]) + [/>]) && Number
This.aStyles[6] = 5
ENDIF
IF m.llRow OR (BETWEEN(this.rowbackcolor,0,RGB(255,255,255)) AND This.rowFill)
FOR lni = 1 TO 5
This.aStyles[m.lni] = m.lni + 4 + IIF(This.aStyles[6] >0,1,0)
NEXT
lcFont = [fontId="] + LTRIM(STR(m.lnFontIdrow)) + [" fillId="] + LTRIM(STR(m.lnFillIdrow)) + [" ] + IIF(m.lnFontIdrow>0,[applyFont="1" ],[]) + IIF(m.lnFillIdrow>0,[applyFill="1" ],[])
FWRITE(m.lnF,[<xf numFmtId="0" ] + m.lcFont + [/>]) && Number
FWRITE(m.lnF,[<xf numFmtId="14" ] + m.lcFont + [applyNumberFormat="1"/>]) && date
FWRITE(m.lnF,[<xf numFmtId="22" ] + m.lcFont + [applyNumberFormat="1"/>]) && time
FWRITE(m.lnF,[<xf numFmtId="0" ] + m.lcFont + [applyAlignment="1"><alignment wrapText="1"/></xf>]) && enter in memo
FWRITE(m.lnF,[<xf numFmtId="164" ] + m.lcFont + [applyNumberFormat="1"/>]) && currency
ENDIF
FWRITE(m.lnF,[</cellXfs>])
FWRITE(m.lnF,[</styleSheet>])
FCLOSE(m.lnF)
ENDPROC
PROCEDURE gen_workbook
***************************************
* Generate xl\_rels\workbook.xml.rels *
***************************************
LPARAMETERS lcDir,llMemoAsComment
LOCAL lnF
lnF = FCREATE(m.lcDir+"workbook.xml.rels")
IF m.lnF < 0
MESSAGEBOX(This.aErrMess[2] + ' workbook.xml.rels',16,This.aErrMess[1])
This.lError=.T.
RETURN
ENDIF
FWRITE(m.lnF,[<?xml version="1.0" encoding="UTF-8" standalone="yes"?>]+CHR(10))
FWRITE(m.lnF,[<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships">])
FWRITE(m.lnF,[<Relationship Id="rId3" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/styles" Target="styles.xml"/>])
FWRITE(m.lnF,[<Relationship Id="rId1" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/worksheet" Target="worksheets/sheet1.xml"/>])
IF m.llMemoAsComment
FWRITE(m.lnF,[<Relationship Id="rId5" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments" Target="../comments1.xml"/>])
FWRITE(m.lnF,[<Relationship Id="rId6" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/vmlDrawing" Target="../drawings/vmlDrawing1.vml"/>])
ENDIF
FWRITE(m.lnF,[<Relationship Id="rId4" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/sharedStrings" Target="sharedStrings.xml"/>]+CHR(10))
FWRITE(m.lnF,[</Relationships>])
FCLOSE(m.lnF)
ENDPROC
PROCEDURE gen_workbook2
****************************
* Generate xl\workbook.xml *
****************************
LPARAMETERS lcDir
LOCAL lnF
lnF = FCREATE(m.lcDir+"workbook.xml")
IF m.lnF < 0
MESSAGEBOX(This.aErrMess[2] + ' workbook.xml',16,This.aErrMess[1])
This.lError=.T.
RETURN
ENDIF
FWRITE(m.lnF,[<?xml version="1.0" encoding="UTF-8" standalone="yes"?>]+CHR(10))
FWRITE(m.lnF,[<workbook xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships">])
FWRITE(m.lnF,[<sheets>])
FWRITE(m.lnF,[<sheet name="] + This.sheetname + [" sheetId="1" r:id="rId1"/>])
FWRITE(m.lnF,[</sheets>])
FWRITE(m.lnF,[</workbook>])
FCLOSE(m.lnF)
ENDPROC
PROCEDURE gen_workbook3 && For comments
************************************************
* Generate xl\worksheets\_rels\sheet1.xml.rels *
************************************************
LPARAMETERS lcDir
LOCAL lnF
lnF = FCREATE(m.lcDir+"sheet1.xml.rels")
IF m.lnF < 0
MESSAGEBOX(This.aErrMess[2] + ' sheet1.xml.rels',16,This.aErrMess[1])
RETURN TO MASTER
ENDIF
FWRITE(m.lnF,[<?xml version="1.0" encoding="UTF-8" standalone="yes"?>]+CHR(10))
FWRITE(m.lnF,[<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships">])
FWRITE(m.lnF,[<Relationship Id="rId5" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments" Target="../comments1.xml"/>])
FWRITE(m.lnF,[<Relationship Id="rId6" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/vmlDrawing" Target="../drawings/vmlDrawing1.vml"/>])
FWRITE(m.lnF,[</Relationships>])
FCLOSE(m.lnF)
ENDPROC
PROCEDURE getcurr
LOCAL nretval,LpLCData,cchData,llLeftCurr,lcCurr,lni
LPARAMETERS lcStrBad
llLeftCurr = SET("Currency")=="LEFT"
LpLCData = space(255)
cchData = LEN(LpLCData)
IF OS(3)<'6' && Win XP
nretval = GetLocaleInfo(1024, 0x14, @LpLCData, cchData) && get symbol
lcCurr = LEFT(ALLTRIM(m.LpLCData) , m.nretval - 1)
nretval = GetLocaleInfo(1024, 0x1B, @LpLCData, cchData) && get position
LpLCData = LEFT(ALLTRIM(m.LpLCData) , m.nretval - 1)
IF m.lcCurr == CHR(128)
lcCurr = [&quot;&#8364;&quot;]
ELSE
lcCurr = [&quot;]+This.htmspec(m.lcCurr,m.lcStrBad)+[&quot;] && courtesy of Martina Jindrov<6F>
ENDIF
ELSE && Win Vista +
nretval = GetLocaleInfoEx(Null, 0x14, @LpLCData, cchData) && get symbol
lcCurr = [&quot;]
FOR lni = 1 TO m.nretval - 1
lcCurr = m.lcCurr + [&#x] + RIGHT(TRANSFORM(ASC(SUBSTR(m.LpLCData,2*m.lni)),"@0"),2) + RIGHT(TRANSFORM(ASC(SUBSTR(m.LpLCData,2*m.lni - 1)),"@0"),2) + [;]
NEXT
lcCurr = m.lcCurr + [&quot;]
nretval = GetLocaleInfoEx(Null, 0x1B, @LpLCData, cchData) && get position
LpLCData = LEFT(m.LpLCData,1)
ENDIF
DO CASE
CASE LpLCData = "0"
lcCurr = m.lcCurr + [#,##0.00]
CASE LpLCData = "1"
lcCurr = [#,##0.00] + m.lcCurr
CASE LpLCData = "2"
lcCurr = m.lcCurr + [\ #,##0.00]
CASE LpLCData = "3"
lcCurr = [#,##0.00\ ] + m.lcCurr
ENDCASE
RETURN m.lcCurr
ENDPROC
PROCEDURE htmspec
**********************
* Special characters *
**********************
LPARAMETERS cStr,lcStrBad
LOCAL lni,lcStrF,lcChar,lnChar,lcStrF2
lcStrF = m.cStr
IF AT(CHR(38),m.lcStrF)>0
lcStrF = STRTRAN(m.lcStrF,CHR(38),'&amp;')
ENDIF
IF AT('>',m.lcStrF)>0
lcStrF = STRTRAN(m.lcStrF,'>','&gt;')
ENDIF
IF AT('<',m.lcStrF)>0
lcStrF = STRTRAN(m.lcStrF,'<','&lt;')
ENDIF
IF AT('"',m.lcStrF)>0
lcStrF = STRTRAN(m.lcStrF,'"','&quot;')
ENDIF
IF AT("'",m.lcStrF)>0
lcStrF = STRTRAN(m.lcStrF,"'",'&apos;')
ENDIF
* suggested by Koen Piller
lcStrF2 = STRCONV(CHRTRAN(m.lcStrF,m.lcStrBad,''),9)
*!* lcStrF2 = ''
*!* FOR lni=1 TO LEN(m.lcStrF)
*!* lcChar = SUBSTR(m.lcStrF,m.lni,1)
*!* lnChar = ASC(m.lcChar)
*!* * lcStrF2 = m.lcStrF2 + IIF(m.lnChar < 128 , m.lcChar , [&#]+STR(m.lnChar,3)+[;])
*!* lcStrF2 = m.lcStrF2 + IIF(m.lnChar < 128, IIF(m.lnChar > 31 OR INLIST(m.lnChar, 9, 10, 13) , m.lcChar, []), [&#]+STR(m.lnChar,3)+[;])
*!* NEXT
RETURN m.lcStrF2
ENDPROC
PROCEDURE langset
DO CASE
CASE UPPER(This.LangId) = "EN"
This.aErrMess[1] = "Abort"
This.aErrMess[2] = "Cannot create"
This.aErrMess[3] = "No xlsx generated"
This.aErrMess[4] = "Nothing to export"
This.aErrMess[5] = "Not a cursor/table name"
This.aErrMess[6] = "already exist."
This.aErrMess[7] = "Overwrite?"
* thanks to Koen Piller
CASE UPPER(This.LangId) = "NL"
This.aErrMess[1] = "Sluiten"
This.aErrMess[2] = "Niet te maken:"
This.aErrMess[3] = "Geen xlsx gemaakt"
This.aErrMess[4] = "Niets te exporteren"
This.aErrMess[5] = "Geen cursor- of tabelnaam"
This.aErrMess[6] = "bestaat al."
This.aErrMess[7] = "Overschrijven?"
CASE UPPER(This.LangId) = "ES"
This.aErrMess[1] = "Abortar"
This.aErrMess[2] = "No se puede crear"
This.aErrMess[3] = "Ning<6E>n xlsx generado"
This.aErrMess[4] = "Nada que exportar"
This.aErrMess[5] = "No es un nombre de cursor/tabla"
This.aErrMess[6] = "ya existe."
This.aErrMess[7] = "<22>Sobreescribir?"
CASE UPPER(This.LangId) = "RO"
This.aErrMess[1] = "Abandon"
This.aErrMess[2] = "Nu se poate crea"
This.aErrMess[3] = "Nu s-a generat xlsx"
This.aErrMess[4] = "Nimic de exportat"
This.aErrMess[5] = "Nume invalid de cursor/tabel"
This.aErrMess[6] = "exista deja."
This.aErrMess[7] = "Suprascrieti?"
ENDCASE
ENDPROC
PROCEDURE RightClick
LOCAL ofrm
ofrm = CREATEOBJECT("propxlsx",This)
ofrm.show(1)
ENDPROC
PROTECTED PROCEDURE testprop
LOCAL lni
************
IF VARTYPE(This.lHead) <> "L"
This.lHead = .F.
ENDIF
IF VARTYPE(This.nMaxIndexLen) $ "NFYBI"
This.nMaxIndexLen = INT(This.nMaxIndexLen)
ELSE
This.nMaxIndexLen = 60
ENDIF
This.nMaxIndexLen = MIN(MAX(This.nMaxIndexLen,19),120)
IF VARTYPE(This.cFields)<> "C"
This.cFields = ""
ENDIF
IF VARTYPE(This.cfieldstotal)<> "C"
This.cfieldstotal = ""
ENDIF
IF VARTYPE(This.cheaders)<> "C"
This.cheaders = ""
ENDIF
IF VARTYPE(This.autocolw)<> "L"
This.autocolw = .F.
ENDIF
IF VARTYPE(This.lMemoAsComment)<> "L"
This.lMemoAsCommen = .F.
ENDIF
************
IF VARTYPE(This.headbackcolor) <> "N"
This.headbackcolor = -1
ELSE
IF !BETWEEN(This.headbackcolor,-1,RGB(255,255,255))
This.headbackcolor = -1
ENDIF
ENDIF
IF VARTYPE(This.headfill) <> "L"
This.headfill = .F.
ENDIF
IF VARTYPE(This.headFontBold) <> "L"
This.headFontBold = .T.
ENDIF
IF VARTYPE(This.headFontItalic) <> "L"
This.headFontItalic = .F.
ENDIF
IF VARTYPE(This.HeadFontName) <> "C"
This.HeadFontName = ""
ENDIF
IF VARTYPE(This.Headfontsize) <>"N"
This.Headfontsize = 0
ELSE
IF This.Headfontsize < 0
This.Headfontsize = 0
ENDIF
ENDIF
IF VARTYPE(This.headforecolor) <> "N"
This.headforecolor = -1
ELSE
IF !BETWEEN(This.headforecolor,-1,RGB(255,255,255))
This.headforecolor = -1
ENDIF
ENDIF
************
IF VARTYPE(This.rowbackcolor) <> "N"
This.rowbackcolor = -1
ELSE
IF !BETWEEN(This.rowbackcolor,-1,RGB(255,255,255))
This.rowbackcolor = -1
ENDIF
ENDIF
IF VARTYPE(This.rowfill) <> "L"
This.rowfill = .F.
ENDIF
IF VARTYPE(This.rowFontBold) <> "L"
This.rowFontBold = .F.
ENDIF
IF VARTYPE(This.rowFontItalic) <> "L"
This.rowFontItalic = .F.
ENDIF
IF VARTYPE(This.rowFontName) <> "C"
This.rowFontName = ""
ENDIF
IF VARTYPE(This.rowfontsize) <>"N"
This.rowfontsize = 0
ELSE
IF This.rowfontsize < 0
This.rowfontsize = 0
ENDIF
ENDIF
IF VARTYPE(This.rowforecolor) <> "N"
This.rowforecolor = -1
ELSE
IF !BETWEEN(This.rowforecolor,-1,RGB(255,255,255))
This.rowforecolor = -1
ENDIF
ENDIF
************
IF VARTYPE(This.sheetFirstCol)<>"C"
This.sheetFirstCol = "A"
ELSE
This.sheetFirstCol = UPPER(ALLTRIM(This.sheetFirstCol))
IF EMPTY(This.sheetFirstCol) OR ;
LEN(This.sheetFirstCol) > LEN(This.LastCol) OR ;
LEN(This.sheetFirstCol) = LEN(This.LastCol) AND This.sheetFirstCol > This.LastCol
This.sheetFirstCol = "A"
ELSE
FOR lni = 1 TO LEN(This.sheetFirstCol)
IF !ISALPHA(This.sheetFirstCol)
This.sheetFirstCol = "A"
EXIT
ENDIF
NEXT
ENDIF
ENDIF
IF VARTYPE(This.sheetFirstRow) <> "N"
This.sheetFirstRow = 1
ELSE
IF !BETWEEN(This.sheetFirstRow,1,This.LastRow)
This.sheetFirstRow = 1
ELSE
This.sheetFirstRow = FLOOR(This.sheetFirstRow)
ENDIF
ENDIF
IF VARTYPE(This.sheetname)<>"C"
This.sheetname = "sheet1"
ELSE
This.sheetname = CHRTRAN(This.sheetname,"[]'","")
IF EMPTY(This.sheetname)
This.sheetname = "sheet1"
ENDIF
ENDIF
************
IF VARTYPE(This.lOpen) <> "L"
This.lOpen = .F.
ENDIF
IF VARTYPE(This.nCodePage) <> "N"
This.nCodePage = 0
ELSE
IF !INLIST(This.nCodePage,437,620,737,850,852,857,861,865,866,874,895,932,936,949,950,1250,1251,1252,1253,1254,1255,1256)
This.nCodePage = 0
ENDIF
ENDIF
ENDPROC
PROCEDURE thefirsttime
LOCAL lcField,lcField2,loCOl,oObj,lnFields,laFields[1],lnFFields,laFFields[1],lnHead,laHead[1],lni,lnPos
IF VARTYPE(This.grid)="O"
IF This.lFirst
This.cFields = ""
This.cHeaders = ""
FOR lni = 1 TO This.grid.ColumnCount
loCol = This.grid.Columns[m.lni]
IF !loCol.Visible
LOOP
ENDIF
FOR EACH m.oObj IN m.loCol.Objects
IF m.oObj.BaseClass="Header"
This.cHeaders = This.cHeaders + m.oObj.Caption + ","
EXIT
ENDIF
NEXT
lcField = m.loCol.ControlSource
lcField2 = IIF(RAT(".",m.lcField)=0,m.lcField,SUBSTR(m.lcField,RAT(".",m.lcField)+1))
This.cFields = This.cFields + m.lcField2 + ","
NEXT
This.cHeaders = RTRIM(This.cHeaders,1,',')
This.cFields = RTRIM(This.cFields,1,',')
This.lFirst = .F.
ENDIF
ELSE
IF This.lFirst
lnFields = AFIELDS(laFields,This.grid)
DO CASE
CASE EMPTY(This.cFields) AND EMPTY(This.cHeaders)
This.cFields = ""
This.cHeaders = ""
FOR lni = 1 TO m.lnFields
This.cFields = This.cFields + laFields[m.lni,1] + ","
This.cHeaders = This.cHeaders + laFields[m.lni,1] + ","
NEXT
This.cFields = RTRIM(This.cFields ,1,',')
This.cHeaders = RTRIM(This.cHeaders ,1,',')
CASE !EMPTY(This.cFields) AND EMPTY(This.cHeaders)
lnFFields = ALINES(laFFields,This.cFields,1+4,",")
This.cHeaders = ""
FOR lni = 1 TO m.lnFields
IF ASCAN(laFFields,laFields[m.lni,1],1,-1,-1,1+2+4) > 0
This.cHeaders = This.cHeaders + laFields[m.lni,1] + ","
ELSE
This.cHeaders = This.cHeaders + ","
ENDIF
NEXT
This.cHeaders = LEFT(This.cHeaders, LEN(This.cHeaders) -1)
CASE !EMPTY(This.cFields) AND !EMPTY(This.cHeaders)
lnFFields = ALINES(laFFields,This.cFields,1+4,",")
lnHead = ALINES(laHead,This.cHeaders,4,",")
This.cHeaders = ""
FOR lni = 1 TO m.lnFields
lnPos = ASCAN(laFFields,laFields[m.lni,1],1,-1,-1,1+2+4)
IF m.lnPos > 0 AND m.lnPos <= m.lnHead
This.cHeaders = This.cHeaders + laHead[m.lnPos] + ","
ELSE
This.cHeaders = This.cHeaders + ","
ENDIF
NEXT
This.cHeaders = LEFT(This.cHeaders, LEN(This.cHeaders) -1)
OTHERWISE
lnHead = ALINES(laHead,This.cHeaders,2,",")
This.cHeaders = ""
This.cFields = ""
FOR lni = 1 TO m.lnFields
This.cFields = This.cFields + laFields[m.lni,1] + ","
IF m.lni > 0 AND m.lni <= m.lnHead
This.cHeaders = This.cHeaders + laHead[m.lni] + ","
ELSE
This.cHeaders = This.cHeaders + ","
ENDIF
NEXT
This.cFields = RTRIM(This.cFields ,1,',')
This.cHeaders = RTRIM(This.cHeaders ,1,',')
ENDCASE
This.lFirst = .F.
ENDIF
ENDIF
ENDPROC
ENDDEFINE
DEFINE CLASS propxlsx AS form
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="Pageframe1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page1.chkBold" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page1.chkItalic" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page1.lstFont" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page1.txtSize" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page1.lblSize" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page1.lblFore" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page1.cmdFore" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page1.cmdBack" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page1.chkHead" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page1.chkBack" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page2.lstFont" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page2.txtSize" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page2.cmdFore" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page2.cmdBack" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page2.chkMemoAsComment" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page2.chkBold" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page2.chkItalic" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page2.lblSize" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page2.lblFore" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page2.chkBack" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page3.Grid1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page3.Grid1.Column1.Header1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page3.Grid1.Column1.Text1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page3.Grid1.Column2.Header1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page3.Grid1.Column2.Text1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page3.Grid1.Column3.Header1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page3.Grid1.Column3.Text1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page3.lblBlack" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page3.lblRed" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page3.chkautocolw" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page4.lblName" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page4.txtName" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page4.lblFirst" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Pageframe1.Page4.txtFirst" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="cmdOK" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="cmdCancel" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: langset
*p: autocolw
*p: ccols
*p: headbackcolor
*p: headfill
*p: headfontbold
*p: headfontitalic
*p: headfontname
*p: headfontsize
*p: headforecolor
*p: langid
*p: lhead
*p: lmemoascomment
*p: oobj
*p: rowbackcolor
*p: rowfill
*p: rowfontbold
*p: rowfontitalic
*p: rowfontname
*p: rowfontsize
*p: rowforecolor
*p: sheetfirstcol
*p: sheetfirstrow
*p: sheetname
*a: afonth[1,0]
*a: afontr[1,0]
*</DefinedPropArrayMethod>
*<PropValue>
AutoCenter = .T.
autocolw = .F.
BorderStyle = 2
Caption = "Settings"
ccols = (SYS(2015))
ControlBox = .F.
DoCreate = .T.
HalfHeightCaption = .T.
headbackcolor = (rgb(255,255,255))
headfill = .F.
headfontbold = .T.
headfontitalic = .F.
headfontname = Calibri
headfontsize = 11
headforecolor = 0
Height = 300
langid = RO
lhead = .T.
lmemoascomment = .F.
Name = "propxlsx"
oobj = 0
rowbackcolor = (rgb(255,255,255))
rowfill = .F.
rowfontbold = .F.
rowfontitalic = .F.
rowfontname = Calibri
rowfontsize = 11
rowforecolor = 0
sheetfirstcol = A
sheetfirstrow = 1
sheetname = Sheet1
ShowTips = .T.
Width = 252
WindowType = 1
*</PropValue>
ADD OBJECT 'cmdCancel' AS commandbutton WITH ;
Cancel = .T., ;
Caption = "Cancel", ;
Height = 27, ;
Left = 144, ;
Name = "cmdCancel", ;
Top = 268, ;
Width = 84
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'cmdOK' AS commandbutton WITH ;
Caption = "OK", ;
Default = .T., ;
Height = 27, ;
Left = 24, ;
Name = "cmdOK", ;
Top = 268, ;
Width = 84
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'Pageframe1' AS pageframe WITH ;
ErasePage = .T., ;
Height = 265, ;
Left = 0, ;
Name = "Pageframe1", ;
PageCount = 4, ;
Top = 0, ;
Width = 253, ;
Page1.Caption = "Header", ;
Page1.Name = "Page1", ;
Page2.Caption = "Rows", ;
Page2.Name = "Page2", ;
Page3.Caption = "Columns", ;
Page3.Name = "Page3", ;
Page4.Caption = "Sheet", ;
Page4.Name = "Page4"
*< END OBJECT: BaseClass="pageframe" />
ADD OBJECT 'Pageframe1.Page1.chkBack' AS checkbox WITH ;
Alignment = 0, ;
BackStyle = 0, ;
Caption = "BackColor", ;
ControlSource = "ThisForm.HeadFill", ;
Height = 33, ;
Left = 119, ;
Name = "chkBack", ;
TabIndex = 27, ;
Top = 151, ;
Value = .F., ;
Width = 75, ;
WordWrap = .T.
*< END OBJECT: BaseClass="checkbox" />
ADD OBJECT 'Pageframe1.Page1.chkBold' AS checkbox WITH ;
Alignment = 0, ;
BackStyle = 0, ;
Caption = "Bold", ;
ControlSource = "ThisForm.Headfontbold", ;
Height = 41, ;
Left = 131, ;
Name = "chkBold", ;
TabIndex = 15, ;
Top = 57, ;
Value = .T., ;
Width = 54, ;
WordWrap = .T.
*< END OBJECT: BaseClass="checkbox" />
ADD OBJECT 'Pageframe1.Page1.chkHead' AS checkbox WITH ;
Alignment = 0, ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Export headers", ;
ControlSource = "ThisForm.lHead", ;
Height = 17, ;
Left = 11, ;
Name = "chkHead", ;
TabIndex = 2, ;
Top = 10, ;
Value = .T., ;
Width = 101
*< END OBJECT: BaseClass="checkbox" />
ADD OBJECT 'Pageframe1.Page1.chkItalic' AS checkbox WITH ;
Alignment = 0, ;
BackStyle = 0, ;
Caption = "Italic", ;
ControlSource = "ThisForm.Headfontitalic", ;
Height = 41, ;
Left = 191, ;
Name = "chkItalic", ;
TabIndex = 20, ;
Top = 57, ;
Value = .F., ;
Width = 51, ;
WordWrap = .T.
*< END OBJECT: BaseClass="checkbox" />
ADD OBJECT 'Pageframe1.Page1.cmdBack' AS commandbutton WITH ;
Caption = "", ;
Height = 27, ;
Left = 202, ;
Name = "cmdBack", ;
TabIndex = 30, ;
Themes = .F., ;
Top = 154, ;
Width = 27
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'Pageframe1.Page1.cmdFore' AS commandbutton WITH ;
Caption = "", ;
Height = 27, ;
Left = 202, ;
Name = "cmdFore", ;
TabIndex = 25, ;
Themes = .F., ;
Top = 108, ;
Width = 27
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'Pageframe1.Page1.lblFore' AS label WITH ;
BackStyle = 0, ;
Caption = "Forecolor", ;
Height = 33, ;
Left = 131, ;
Name = "lblFore", ;
Top = 108, ;
Width = 65, ;
WordWrap = .T.
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'Pageframe1.Page1.lblSize' AS label WITH ;
BackStyle = 0, ;
Caption = "Size", ;
Height = 39, ;
Left = 131, ;
Name = "lblSize", ;
Top = 11, ;
Width = 37, ;
WordWrap = .T.
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'Pageframe1.Page1.lstFont' AS listbox WITH ;
Height = 194, ;
Left = 11, ;
Name = "lstFont", ;
TabIndex = 5, ;
Top = 32, ;
Width = 100
*< END OBJECT: BaseClass="listbox" />
ADD OBJECT 'Pageframe1.Page1.txtSize' AS textbox WITH ;
Alignment = 3, ;
Comment = "K", ;
ControlSource = "ThisForm.Headfontsize", ;
Height = 23, ;
Left = 175, ;
Name = "txtSize", ;
TabIndex = 10, ;
Top = 8, ;
Value = 11, ;
Width = 64
*< END OBJECT: BaseClass="textbox" />
ADD OBJECT 'Pageframe1.Page2.chkBack' AS checkbox WITH ;
Alignment = 0, ;
BackStyle = 0, ;
Caption = "BackColor", ;
ControlSource = "ThisForm.HeadFill", ;
Height = 33, ;
Left = 119, ;
Name = "chkBack", ;
TabIndex = 27, ;
Top = 151, ;
Value = .F., ;
Width = 75, ;
WordWrap = .T.
*< END OBJECT: BaseClass="checkbox" />
ADD OBJECT 'Pageframe1.Page2.chkBold' AS checkbox WITH ;
Alignment = 0, ;
BackStyle = 0, ;
Caption = "Bold", ;
ControlSource = "ThisForm.Headfontbold", ;
Height = 41, ;
Left = 131, ;
Name = "chkBold", ;
TabIndex = 15, ;
Top = 57, ;
Value = .T., ;
Width = 54, ;
WordWrap = .T.
*< END OBJECT: BaseClass="checkbox" />
ADD OBJECT 'Pageframe1.Page2.chkItalic' AS checkbox WITH ;
Alignment = 0, ;
BackStyle = 0, ;
Caption = "Italic", ;
ControlSource = "ThisForm.Headfontitalic", ;
Height = 41, ;
Left = 191, ;
Name = "chkItalic", ;
TabIndex = 20, ;
Top = 57, ;
Value = .F., ;
Width = 51, ;
WordWrap = .T.
*< END OBJECT: BaseClass="checkbox" />
ADD OBJECT 'Pageframe1.Page2.chkMemoAsComment' AS checkbox WITH ;
Alignment = 0, ;
BackStyle = 0, ;
Caption = "Memo=>comments", ;
ControlSource = "ThisForm.lMemoAsComment", ;
Height = 35, ;
Left = 119, ;
Name = "chkMemoAsComment", ;
TabIndex = 20, ;
ToolTipText = "When checked, Memo fields are placed into comments of a cell that contain the word MEMO", ;
Top = 195, ;
Value = .F., ;
Width = 125, ;
WordWrap = .T.
*< END OBJECT: BaseClass="checkbox" />
ADD OBJECT 'Pageframe1.Page2.cmdBack' AS commandbutton WITH ;
Caption = "", ;
Height = 27, ;
Left = 202, ;
Name = "cmdBack", ;
TabIndex = 30, ;
Themes = .F., ;
Top = 154, ;
Width = 27
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'Pageframe1.Page2.cmdFore' AS commandbutton WITH ;
Caption = "", ;
Height = 27, ;
Left = 202, ;
Name = "cmdFore", ;
TabIndex = 25, ;
Themes = .F., ;
Top = 108, ;
Width = 27
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'Pageframe1.Page2.lblFore' AS label WITH ;
BackStyle = 0, ;
Caption = "Forecolor", ;
Height = 33, ;
Left = 131, ;
Name = "lblFore", ;
Top = 108, ;
Width = 65, ;
WordWrap = .T.
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'Pageframe1.Page2.lblSize' AS label WITH ;
BackStyle = 0, ;
Caption = "Size", ;
Height = 39, ;
Left = 131, ;
Name = "lblSize", ;
Top = 11, ;
Width = 37, ;
WordWrap = .T.
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'Pageframe1.Page2.lstFont' AS listbox WITH ;
Height = 218, ;
Left = 11, ;
Name = "lstFont", ;
TabIndex = 5, ;
Top = 8, ;
Width = 100
*< END OBJECT: BaseClass="listbox" />
ADD OBJECT 'Pageframe1.Page2.txtSize' AS textbox WITH ;
Alignment = 3, ;
Comment = "K", ;
ControlSource = "ThisForm.Rowfontsize", ;
Height = 23, ;
Left = 175, ;
Name = "txtSize", ;
TabIndex = 10, ;
Top = 8, ;
Value = 11, ;
Width = 64
*< END OBJECT: BaseClass="textbox" />
ADD OBJECT 'Pageframe1.Page3.chkautocolw' AS checkbox WITH ;
Alignment = 0, ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Auto column width", ;
ControlSource = "ThisForm.autocolw", ;
Height = 17, ;
Left = 11, ;
Name = "chkautocolw", ;
Top = 212, ;
Value = .F., ;
Width = 118
*< END OBJECT: BaseClass="checkbox" />
ADD OBJECT 'Pageframe1.Page3.Grid1' AS grid WITH ;
AllowAddNew = .T., ;
AllowHeaderSizing = .F., ;
AllowRowSizing = .F., ;
ColumnCount = 3, ;
DeleteMark = .F., ;
GridLines = 2, ;
Height = 180, ;
Left = -1, ;
Name = "Grid1", ;
Panel = 1, ;
RecordMark = .F., ;
RecordSource = (ThisForm.cCols), ;
ScrollBars = 2, ;
Top = 8, ;
Width = 248, ;
Column1.Name = "Column1", ;
Column1.ToolTipText = "Field name", ;
Column2.Name = "Column2", ;
Column2.ToolTipText = "Column header in XLSX", ;
Column2.Width = 115, ;
Column3.Name = "Column3", ;
Column3.ToolTipText = ("T - this column is included in XLSX" + CHR(13) + "Click to switch between T and F"), ;
Column3.Width = 35
*< END OBJECT: BaseClass="grid" />
ADD OBJECT 'Pageframe1.Page3.Grid1.Column1.Header1' AS header WITH ;
Caption = "Name", ;
Name = "Header1", ;
ToolTipText = "Field name"
*< END OBJECT: BaseClass="header" />
ADD OBJECT 'Pageframe1.Page3.Grid1.Column1.Text1' AS textbox WITH ;
BackColor = 255,255,255, ;
BorderStyle = 0, ;
ForeColor = 0,0,0, ;
Margin = 0, ;
Name = "Text1", ;
ToolTipText = "Field name"
*< END OBJECT: BaseClass="textbox" />
ADD OBJECT 'Pageframe1.Page3.Grid1.Column2.Header1' AS header WITH ;
Caption = "Caption", ;
Name = "Header1", ;
ToolTipText = "Column header in XLSX"
*< END OBJECT: BaseClass="header" />
ADD OBJECT 'Pageframe1.Page3.Grid1.Column2.Text1' AS textbox WITH ;
BackColor = 255,255,255, ;
BorderStyle = 0, ;
ForeColor = 0,0,0, ;
Margin = 0, ;
Name = "Text1", ;
ToolTipText = "Column header in XLSX"
*< END OBJECT: BaseClass="textbox" />
ADD OBJECT 'Pageframe1.Page3.Grid1.Column3.Header1' AS header WITH ;
Caption = "Export", ;
Name = "Header1", ;
ToolTipText = ("T - this column is included in XLSX" + CHR(13) + "Click to switch between T and F")
*< END OBJECT: BaseClass="header" />
ADD OBJECT 'Pageframe1.Page3.Grid1.Column3.Text1' AS textbox WITH ;
BackColor = 255,255,255, ;
BorderStyle = 0, ;
ForeColor = 0,0,0, ;
Margin = 0, ;
Name = "Text1", ;
ToolTipText = ("T - this column is included in XLSX" + CHR(13) + "Click to switch between T and F")
*< END OBJECT: BaseClass="textbox" />
ADD OBJECT 'Pageframe1.Page3.lblBlack' AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Right click - Default", ;
Height = 17, ;
Left = 57, ;
Name = "lblBlack", ;
Top = 188, ;
Width = 107
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'Pageframe1.Page3.lblRed' AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Click", ;
ForeColor = 255,0,0, ;
Height = 17, ;
Left = 191, ;
Name = "lblRed", ;
Top = 188, ;
Width = 29
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'Pageframe1.Page4.lblFirst' AS label WITH ;
BackStyle = 0, ;
Caption = "First cell", ;
Height = 71, ;
Left = 11, ;
Name = "lblFirst", ;
ToolTipText = "The adress of top-left cell", ;
Top = 74, ;
Width = 48, ;
WordWrap = .T.
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'Pageframe1.Page4.lblName' AS label WITH ;
BackStyle = 0, ;
Caption = "Name", ;
Height = 44, ;
Left = 11, ;
Name = "lblName", ;
ToolTipText = "The name of the worksheet", ;
Top = 11, ;
Width = 47, ;
WordWrap = .T.
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'Pageframe1.Page4.txtFirst' AS textbox WITH ;
Format = "!KT", ;
Height = 23, ;
Left = 70, ;
Name = "txtFirst", ;
ToolTipText = "The adress of top-left cell", ;
Top = 71, ;
Value = A1, ;
Width = 100
*< END OBJECT: BaseClass="textbox" />
ADD OBJECT 'Pageframe1.Page4.txtName' AS textbox WITH ;
ControlSource = "ThisForm.SheetName", ;
Format = "KT", ;
Height = 23, ;
Left = 70, ;
Name = "txtName", ;
ToolTipText = "The name of the worksheet", ;
Top = 8, ;
Value = sheet1, ;
Width = 100
*< END OBJECT: BaseClass="textbox" />
PROCEDURE Init
LPARAMETERS toObj
LOCAL lnFont,laFont[1],loCol,lnCol,laCol[1],lnFCol,lafCol[1],lnHead,laHead[1],lcField,lcField2,llExcluded,oObj,lcHDefa,lcHCapt,lni
This.oObj = m.toObj
IF VARTYPE(This.oObj.grid) = "O" && grid
IF !USED(This.oObj.grid.RecordSource)
RETURN
ENDIF
ENDIF
This.Top = OBJTOCLIENT(This.oObj,1)+10
This.Left = OBJTOCLIENT(This.oObj,2)+10
This.langId = This.oObj.langId
This.LangSet
This.lHead = This.oObj.lHead
This.HeadBackColor = IIF(BETWEEN(This.oObj.HeadBackColor,0,RGB(255,255,255)) , This.oObj.HeadBackColor , RGB(255,255,255))
This.Headforecolor = IIF(BETWEEN(This.oObj.Headforecolor,0,RGB(255,255,255)) , This.oObj.Headforecolor , 0)
This.Headfontbold = This.oObj.Headfontbold
This.Headfontitalic = This.oObj.Headfontitalic
This.Headfontname = IIF(!EMPTY(This.oObj.Headfontname) , This.oObj.Headfontname , "Calibri")
This.Headfontsize = IIF(This.oObj.Headfontsize > 0 , This.oObj.Headfontsize , 11)
This.pageframe1.page1.chkBack.Value = This.oObj.HeadFill
This.HeadFill = This.oObj.HeadFill
This.rowBackColor = IIF(BETWEEN(This.oObj.rowBackColor,0,RGB(255,255,255)) , This.oObj.rowBackColor , RGB(255,255,255))
This.rowforecolor = IIF(BETWEEN(This.oObj.rowforecolor,0,RGB(255,255,255)) , This.oObj.rowforecolor , 0)
This.rowfontbold = This.oObj.rowfontbold
This.rowfontitalic = This.oObj.rowfontitalic
This.rowfontname = IIF(!EMPTY(This.oObj.rowfontname) , This.oObj.rowfontname , "Calibri")
This.rowfontsize = IIF(This.oObj.rowfontsize > 0 , This.oObj.rowfontsize , 11)
This.pageframe1.page2.txtSize.Value = This.rowfontsize
This.pageframe1.page2.chkBack.Value = This.oObj.RowFill
This.RowFill = This.oObj.RowFill
This.lMemoAsComment = This.oObj.lMemoAsComment
This.pageframe1.page2.chkMemoAsComment.Value = This.lMemoAsComment
This.pageframe1.page1.cmdback.BackColor = This.HeadBackColor
This.pageframe1.page1.CmdFore.BackColor = This.Headforecolor
This.pageframe1.page2.cmdback.BackColor = This.rowBackColor
This.pageframe1.page2.CmdFore.BackColor = This.rowforecolor
AFONT(laFont)
DIMENSION This.aFonth[ALEN(m.laFont)]
ACOPY(m.laFont,This.aFonth)
This.pageframe1.page1.lstFont.RowSourceType = 5
This.pageframe1.page1.lstFont.RowSource = "ThisForm.aFonth"
lnFont = ASCAN(This.aFonth,This.Headfontname,1,-1,-1,1+2+4)
IF m.lnFont > 0
This.pageframe1.page1.lstFont.ListIndex = m.lnFont
ELSE
lnFont = ASCAN(This.aFonth,'Calibri',1,-1,-1,1+2+4)
IF m.lnFont > 0
This.pageframe1.page1.lstFont.ListIndex = m.lnFont
ELSE
This.pageframe1.page1.lstFont.ListIndex = 1
ENDIF
ENDIF
DIMENSION This.aFontr[ALEN(m.laFont)]
ACOPY(m.laFont,This.aFontr)
This.pageframe1.page2.lstFont.RowSourceType = 5
This.pageframe1.page2.lstFont.RowSource = "ThisForm.aFontr"
lnFont = ASCAN(This.aFontr,This.Rowfontname,1,-1,-1,1+2+4)
IF m.lnFont > 0
This.pageframe1.page2.lstFont.ListIndex = m.lnFont
ELSE
lnFont = ASCAN(This.aFontr,'Calibri',1,-1,-1,1+2+4)
IF m.lnFont > 0
This.pageframe1.page2.lstFont.ListIndex = m.lnFont
ELSE
This.pageframe1.page2.lstFont.ListIndex = 1
ENDIF
ENDIF
This.oObj.Thefirsttime
This.cCols = SYS(2015)
CREATE CURSOR (This.cCols) (iPos I,cFName V(254),cHCaption C(254),cHDefault V(254),lToExport L)
IF EMPTY(This.oObj.cfields)
lnCol = 0
ELSE
lnCol = ALINES(laCol,This.oObj.cfields,1+4,',')
ENDIF
IF EMPTY(This.oObj.cheaders)
lnHead = 0
ELSE
lnHead = ALINES(laHead,This.oObj.cheaders,1+2,',')
ENDIF
IF VARTYPE(This.oObj.grid) = "O" && grid
FOR lni = 1 TO This.oObj.grid.ColumnCount
loCol = This.oObj.grid.Columns[m.lni]
IF loCol.Visible
lcField = loCol.ControlSource
lcField2 = IIF(RAT(".",m.lcField)=0,m.lcField,SUBSTR(m.lcField,RAT(".",m.lcField)+1))
llExcluded = ASCAN(laCol,m.lcField2,1,-1,-1,1+2+4) = 0
FOR EACH oObj IN loCol.Objects
IF oObj.BaseClass="Header"
lcHDefa = oObj.Caption
EXIT
ENDIF
NEXT
IF !m.llExcluded
lcHCapt = laHead[m.lni]
ELSE
lcHCapt = m.lcHDefa
ENDIF
INSERT INTO (This.cCols) VALUES (m.lni,m.lcField2,m.lcHCapt,m.lcHDefa,!m.llExcluded)
ENDIF
NEXT
ELSE
lnFCol = AFIELDS(laFCol,This.oObj.grid)
FOR lni = 1 TO m.lnFCol
lcField2 = m.laFCol[m.lni,1]
lcHDefa = m.laFCol[m.lni,1]
llExcluded = ASCAN(laCol,m.lcField2,1,-1,-1,1+2+4) = 0
IF !m.llExcluded
lcHCapt = laHead[m.lni]
ELSE
lcHCapt = m.lcHDefa
ENDIF
INSERT INTO (This.cCols) VALUES (m.lni,m.lcField2,m.lcHCapt,m.lcHDefa,!m.llExcluded)
NEXT
ENDIF
GO TOP IN (This.cCols)
This.pageframe1.Page3.grid1.RecordSource = This.cCols
This.pageframe1.Page3.grid1.Column1.ControlSource = This.cCols + ".cFName"
This.pageframe1.Page3.grid1.Column1.ReadOnly = .T.
This.pageframe1.Page3.grid1.Column2.ControlSource = This.cCols + ".cHCaption"
This.pageframe1.Page3.grid1.Column3.ControlSource = This.cCols + ".lToExport"
This.pageframe1.Page3.grid1.SetAll("DynamicBackColor", "IIF(" + This.cCols + ".lToExport,RGB(255,255,255),RGB(255,200,200))", "Column")
IF VARTYPE(ThisForm.oObj.autocolw)<>"L"
This.pageframe1.page3.chkautocolw.Value = .F.
This.autocolw = .F.
ELSE
This.pageframe1.page3.chkautocolw.Value = This.oObj.autocolw
This.autocolw = This.oObj.autocolw
ENDIF
IF VARTYPE(ThisForm.oObj.sheetFirstCol)<>"C"
ThisForm.sheetFirstCol = "A"
ELSE
IF EMPTY(ThisForm.oObj.sheetFirstCol) OR ;
LEN(ThisForm.oObj.sheetFirstCol) > LEN(ThisForm.oObj.LastCol) OR ;
LEN(ThisForm.oObj.sheetFirstCol) = LEN(ThisForm.oObj.LastCol) AND ThisForm.oObj.sheetFirstCol > ThisForm.oObj.LastCol
ThisForm.sheetFirstCol = "A"
ELSE
FOR lni = 1 TO LEN(ALLTRIM(ThisForm.oObj.sheetFirstCol))
IF !ISALPHA(SUBSTR(ALLTRIM(ThisForm.oObj.sheetFirstCol),m.lni,1))
ThisForm.sheetFirstCol = "A"
EXIT
ENDIF
NEXT
ThisForm.sheetFirstCol = UPPER(ALLTRIM(ThisForm.oObj.sheetFirstCol))
ENDIF
ENDIF
IF VARTYPE(ThisForm.oObj.sheetFirstRow) <> "N"
ThisForm.sheetFirstRow = 1
ELSE
IF !BETWEEN(ThisForm.oObj.sheetFirstRow,1,ThisForm.oObj.LastRow)
ThisForm.sheetFirstRow = 1
ELSE
ThisForm.sheetFirstRow = FLOOR(ThisForm.oObj.sheetFirstRow)
ENDIF
ENDIF
This.pageframe1.page4.txtFirst.Value = ThisForm.sheetFirstCol + TRANSFORM(ThisForm.sheetFirstRow)
IF VARTYPE(ThisForm.oObj.sheetname)<>"C"
This.pageframe1.page4.txtName.Value = "sheet1"
ThisForm.sheetname = "sheet1"
ELSE
IF EMPTY(CHRTRAN(ThisForm.oObj.sheetname,"[]'",""))
This.pageframe1.page4.txtName.Value = "sheet1"
ThisForm.sheetname = "sheet1"
ELSE
This.pageframe1.page4.txtName.Value = CHRTRAN(ThisForm.oObj.sheetname,"[]'","")
ThisForm.sheetname = CHRTRAN(ThisForm.oObj.sheetname,"[]'","")
ENDIF
ENDIF
FOR EACH loCol IN ThisForm.pageframe1.Page3.grid1.Columns
BINDEVENT(m.loCol,"MouseMove",ThisForm.pageframe1.Page3.grid1,"MouseMove")
BINDEVENT(m.loCol.Header1,"MouseMove",ThisForm.pageframe1.Page3.grid1,"MouseMove")
BINDEVENT(m.loCol.Text1,"MouseMove",ThisForm.pageframe1.Page3.grid1,"MouseMove")
BINDEVENT(m.loCol,"MouseEnter",ThisForm.pageframe1.Page3.grid1,"MouseMove")
BINDEVENT(m.loCol.Header1,"MouseEnter",ThisForm.pageframe1.Page3.grid1,"MouseMove")
BINDEVENT(m.loCol.Text1,"MouseEnter",ThisForm.pageframe1.Page3.grid1,"MouseMove")
BINDEVENT(m.loCol,"MouseLeave",ThisForm.pageframe1.Page3.grid1,"MouseLeave")
BINDEVENT(m.loCol.Header1,"MouseLeave",ThisForm.pageframe1.Page3.grid1,"MouseLeave")
BINDEVENT(m.loCol.Text1,"MouseLeave",ThisForm.pageframe1.Page3.grid1,"MouseLeave")
NEXT
ENDPROC
PROCEDURE langset
DO CASE
CASE UPPER(This.LangId) = "EN"
This.cmdOK.Caption = "OK"
This.cmdCancel.Caption = "Cancel"
WITH This.pageframe1
WITH .page1
.Caption = "Header"
.chkHead.Caption = "Export headers"
.lblSize.Caption = "Size"
.chkBold.Caption = "Bold"
.chkItalic.Caption = "Italic"
.lblFore.Caption = "Forecolor"
.chkBack.Caption = "BackColor"
ENDWITH
WITH .page2
.Caption = "Rows"
.lblSize.Caption = "Size"
.chkBold.Caption = "Bold"
.chkItalic.Caption = "Italic"
.lblFore.Caption = "Forecolor"
.chkBack.Caption = "BackColor"
.chkMemoAsComment.Caption = "Memo=>comments"
.chkMemoAsComment.ToolTipText = "When checked, Memo fields are placed into comments of a cell that contain the word MEMO"
ENDWITH
WITH .page3
.Caption = "Columns"
WITH .grid1.Column1
.Header1.Caption = "Name"
STORE "Field name" TO .ToolTipText, .Header1.ToolTipText, .Text1.ToolTipText
ENDWITH
WITH .grid1.Column2
.Header1.Caption = "Caption"
STORE "Column header in XLSX" TO .ToolTipText, .Header1.ToolTipText, .Text1.ToolTipText
ENDWITH
WITH .grid1.Column3
.Header1.Caption = "Export"
STORE "T - this column is included in XLSX" + CHR(13) + "Click to switch between T and F" TO .ToolTipText, .Header1.ToolTipText, .Text1.ToolTipText
ENDWITH
.lblBlack.Caption = "Right click - Default"
.lblRed.Caption = "Click"
.chkautocolw.Caption = "Auto column width"
ENDWITH
WITH .page4
.Caption = "Sheet"
.lblName.Caption = "Name"
STORE "The name of the worksheet" TO .lblName.ToolTipText, .txtName.ToolTipText
.lblFirst.Caption = "First cell"
STORE "The adress of top-left cell" TO .lblFirst.ToolTipText, .txtFirst.ToolTipText
ENDWITH
ENDWITH
CASE UPPER(This.LangId) = "RO"
This.cmdOK.Caption = "Validez"
This.cmdCancel.Caption = "Renunt"
WITH This.pageframe1
WITH .page1
.Caption = "Antet"
.chkHead.Caption = "Exporta antete"
.lblSize.Caption = "Dimen siune"
.chkBold.Caption = "Aldin"
.chkItalic.Caption = "Cursiv"
.lblFore.Caption = "Culoare text"
.chkBack.Caption = "Culoare fundal"
ENDWITH
WITH .page2
.Caption = "Randuri"
.lblSize.Caption = "Dimen siune"
.chkBold.Caption = "Aldin"
.chkItalic.Caption = "Cursiv"
.lblFore.Caption = "Culoare text"
.chkBack.Caption = "Culoare fundal"
.chkMemoAsComment.Caption = "Memo=>comentarii"
.chkMemoAsComment.ToolTipText = "Cand e bifat, campurile memo sunt plasate ca si comentarii ale unor celule ce contin cuvantul MEMO"
ENDWITH
WITH .page3
.Caption = "Coloane"
WITH .grid1.Column1
.Header1.Caption = "Denumire"
STORE "Denumirea campului" TO .ToolTipText, .Header1.ToolTipText, .Text1.ToolTipText
ENDWITH
WITH .grid1.Column2
.Header1.Caption = "Eticheta"
STORE "Antetul coloanei in XLSX" TO .ToolTipText, .Header1.ToolTipText, .Text1.ToolTipText
ENDWITH
WITH .grid1.Column3
.Header1.Caption = "Export"
STORE "T - aceasta coloana este inclusa in XLSX" + CHR(13) + "Clic pentru a comuta intre T si F" TO .ToolTipText, .Header1.ToolTipText, .Text1.ToolTipText
ENDWITH
.lblBlack.Caption = "Clic dreapta - implicit"
.lblRed.Caption = "Clic"
.chkautocolw.Caption = "Latimea coloanelor stabilita automat"
ENDWITH
WITH .page4
.Caption = "Foaie"
.lblName.Caption = "Denu mire"
STORE "Denumirea foii de calcul" TO .lblName.ToolTipText, .txtName.ToolTipText
.lblFirst.Caption = "Prima celula"
STORE "Adresa celulei din coltul stanga-sus" TO .lblFirst.ToolTipText, .txtFirst.ToolTipText
ENDWITH
ENDWITH
ENDCASE
ENDPROC
PROCEDURE cmdCancel.Click
ThisForm.Release
ENDPROC
PROCEDURE cmdOK.Click
ThisForm.oObj.lHead = ThisForm.lHead
ThisForm.oObj.HeadBackColor = ThisForm.HeadBackColor
ThisForm.oObj.Headforecolor = ThisForm.Headforecolor
ThisForm.oObj.Headfontbold = ThisForm.Headfontbold
ThisForm.oObj.Headfontitalic = ThisForm.Headfontitalic
ThisForm.oObj.Headfontname = ThisForm.Headfontname
ThisForm.oObj.Headfontsize = ThisForm.Headfontsize
ThisForm.oObj.HeadFill = ThisForm.HeadFill
ThisForm.oObj.rowBackColor = ThisForm.rowBackColor
ThisForm.oObj.rowforecolor = ThisForm.rowforecolor
ThisForm.oObj.rowfontbold = ThisForm.rowfontbold
ThisForm.oObj.rowfontitalic = ThisForm.rowfontitalic
ThisForm.oObj.rowfontname = ThisForm.rowfontname
ThisForm.oObj.rowfontsize = ThisForm.rowfontsize
ThisForm.oObj.rowFill = ThisForm.rowFill
ThisForm.oObj.lMemoAsComment = ThisForm.lMemoAsComment
ThisForm.oObj.cfields = ""
ThisForm.oObj.cheaders = ""
SELECT (ThisForm.cCols)
SCAN
IF lToExport
ThisForm.oObj.cfields = ThisForm.oObj.cfields + cFName + ","
ThisForm.oObj.cheaders = ThisForm.oObj.cheaders + RTRIM(cHCaption) + ","
ELSE
ThisForm.oObj.cfields = ThisForm.oObj.cfields + ","
ThisForm.oObj.cheaders = ThisForm.oObj.cheaders + ","
ENDIF
ENDSCAN
ThisForm.oObj.cfields = LEFT(ThisForm.oObj.cfields,LEN(ThisForm.oObj.cfields) - 1)
ThisForm.oObj.cheaders = LEFT(ThisForm.oObj.cheaders,LEN(ThisForm.oObj.cheaders) - 1)
USE IN (ThisForm.cCols)
ThisForm.oObj.autocolw = ThisForm.autocolw
ThisForm.oObj.sheetFirstCol = ThisForm.sheetFirstCol
ThisForm.oObj.sheetFirstRow = ThisForm.sheetFirstRow
ThisForm.oObj.sheetname = ThisForm.sheetname
ThisForm.Release
ENDPROC
PROCEDURE Pageframe1.Page1.cmdBack.Click
LOCAL lnColor
lnColor = GETCOLOR(ThisForm.Headbackcolor)
IF BETWEEN(m.lnColor,0,RGB(255,255,255))
ThisForm.Headbackcolor = m.lnColor
This.BackColor = m.lnColor
ENDIF
ENDPROC
PROCEDURE Pageframe1.Page1.cmdFore.Click
LOCAL lnColor
lnColor = GETCOLOR(ThisForm.Headforecolor)
IF BETWEEN(m.lnColor,0,RGB(255,255,255))
ThisForm.Headforecolor = m.lnColor
This.BackColor = m.lnColor
ENDIF
ENDPROC
PROCEDURE Pageframe1.Page1.lstFont.InteractiveChange
ThisForm.Headfontname=RTRIM(This.Value)
ENDPROC
PROCEDURE Pageframe1.Page1.txtSize.RangeLow
RETURN 1
ENDPROC
PROCEDURE Pageframe1.Page2.cmdBack.Click
LOCAL lnColor
lnColor = GETCOLOR(ThisForm.Rowbackcolor)
IF BETWEEN(m.lnColor,0,RGB(255,255,255))
ThisForm.Rowbackcolor = m.lnColor
This.BackColor = m.lnColor
ENDIF
ENDPROC
PROCEDURE Pageframe1.Page2.cmdFore.Click
LOCAL lnColor
lnColor = GETCOLOR(ThisForm.Rowforecolor)
IF BETWEEN(m.lnColor,0,RGB(255,255,255))
ThisForm.Rowforecolor = m.lnColor
This.BackColor = m.lnColor
ENDIF
ENDPROC
PROCEDURE Pageframe1.Page2.lstFont.InteractiveChange
ThisForm.rowfontname=RTRIM(This.Value)
ENDPROC
PROCEDURE Pageframe1.Page2.txtSize.RangeLow
RETURN 1
ENDPROC
PROCEDURE Pageframe1.Page3.Grid1.Column2.Text1.RightClick
SELECT (ThisForm.cCols)
replace cHCaption WITH cHDefault
GO RECNO(ThisForm.cCols) IN (ThisForm.cCols)
This.Parent.Parent.Refresh
ENDPROC
PROCEDURE Pageframe1.Page3.Grid1.Column3.Text1.Click
SELECT (ThisForm.cCols)
replace lToExport WITH !lToExport
GO RECNO(ThisForm.cCols) IN (ThisForm.cCols)
This.Parent.Parent.Refresh
ENDPROC
PROCEDURE Pageframe1.Page3.Grid1.MouseLeave
LPARAMETERS nButton, nShift, nXCoord, nYCoord
ThisForm.pageframe1.Page3.grid1.ToolTipText = ""
ENDPROC
PROCEDURE Pageframe1.Page3.Grid1.MouseMove
LPARAMETERS nButton, nShift, nXCoord, nYCoord
LOCAL nWhere_Out,nRelCol_Out
ThisForm.pageframe1.Page3.grid1.GridHitTest(m.nXCoord, m.nYCoord, @nWhere_Out,,@nRelCol_Out)
IF m.nWhere_Out = 1
ThisForm.pageframe1.Page3.grid1.ToolTipText = ThisForm.pageframe1.Page3.grid1.Columns[m.nRelCol_Out].Header1.ToolTipText
ELSE
IF m.nWhere_Out = 3
ThisForm.pageframe1.Page3.grid1.ToolTipText = ThisForm.pageframe1.Page3.grid1.Columns[m.nRelCol_Out].Text1.ToolTipText
ENDIF
ENDIF
WAIT WINDOW m.nWhere_Out NOWAIT
ENDPROC
PROCEDURE Pageframe1.Page4.txtFirst.LostFocus
LOCAL lni,lcCol,lcRow,lcChar,lcPrev
lcPrev = ThisForm.sheetFirstCol + TRANSFORM(ThisForm.sheetFirstRow)
lcCol = LEFT(This.Value,1)
lcRow = ""
IF !ISALPHA(m.lcCol)
This.Value = m.lcPrev
RETURN
ENDIF
FOR lni = 2 TO LEN(This.Value)
lcChar = SUBSTR(This.Value,m.lni,1)
DO CASE
CASE ISDIGIT(m.lcChar)
lcRow = m.lcRow + m.lcChar
CASE ISALPHA(m.lcChar) AND EMPTY(m.lcRow) AND LEN(m.lcCol) < LEN(ThisForm.oObj.LastCol)
lcCol = m.lcCol + m.lcCHar
OTHERWISE
This.Value = m.lcPrev
RETURN
ENDCASE
NEXT
IF LEN(m.lcCol) = LEN(ThisForm.oObj.LastCol) AND m.lcCol > ThisForm.oObj.LastCol
This.Value = m.lcPrev
RETURN
ENDIF
IF !BETWEEN(VAL(m.lcRow),1,ThisForm.oObj.LastRow)
This.Value = m.lcPrev
RETURN
ENDIF
ThisForm.sheetFirstCol = m.lcCol
ThisForm.sheetFirstRow = VAL(m.lcRow)
ENDPROC
PROCEDURE Pageframe1.Page4.txtName.LostFocus
This.Value = CHRTRAN(This.Value,"[]'","")
IF EMPTY(This.Value)
This.Value = "sheet1"
ENDIF
ENDPROC
ENDDEFINE
Reference in New Issue View Git Blame Copy Permalink