📄 scctext.prg
字号:
private cStartMark, cStartMark2
if at(MARKBINSTARTWORD, m.cLine) = 1
m.cFieldname = strtran(m.cLine, MARKBINSTARTWORD, "", 1, 1)
m.cFieldname = left(m.cFieldname, rat(MARKBINSTARTWORD2, m.cFieldname) - 1)
return .t.
endif
return .f.
endproc
procedure IsFieldMark
parameters cLine, cFieldname, cValue
if at(MARKFIELDSTART, m.cLine) = 1
m.cFieldname = strtran(m.cLine, MARKFIELDSTART, "", 1, 1)
m.cFieldname = left(m.cFieldname, at(MARKFIELDEND, m.cFieldname) - 1)
m.cValue = substr(m.cLine, at(MARKFIELDEND, m.cLine))
m.cValue = strtran(m.cValue, MARKFIELDEND, "", 1, 1)
return .t.
endif
return .f.
endproc
procedure RecordMark
parameters cUniqueId
=fputs(this.iHandle, "")
=fputs(this.iHandle, MARKRECORDSTART + MARKRECORDEND)
endproc
procedure IsRecordMark
parameters cLine
if left(m.cLine, len(MARKRECORDSTART)) == MARKRECORDSTART .and. ;
right(m.cLine, len(MARKRECORDEND)) == MARKRECORDEND
return .t.
else
return .f.
endif
endproc
procedure WriteText
private cExcludeList, cMemoAsCharList, cMemoAsBinList, cCharAsBinList
m.cExcludeList = ""
m.cMemoAsCharList = ""
m.cMemoAsBinList = ""
m.cCharAsBinList = ""
m.cMemoVariesList = ""
do case
case inlist(this.cType, PRJTYPE_FORM, PRJTYPE_VCX)
m.cExcludeFields = VCX_EXCLUDE_LIST
m.cMemoAsCharList = VCX_MEMOASCHAR_LIST
m.cMemoAsBinList = VCX_MEMOASBIN_LIST
m.cCharAsBinList = VCX_CHARASBIN_LIST
m.cMemoVariesList = VCX_MEMOVARIES_LIST
case inlist(this.cType, PRJTYPE_REPORT, PRJTYPE_LABEL)
m.cExcludeFields = FRX_EXCLUDE_LIST
m.cMemoAsCharList = FRX_MEMOASCHAR_LIST
m.cMemoAsBinList = FRX_MEMOASBIN_LIST
m.cCharAsBinList = FRX_CHARASBIN_LIST
m.cMemoVariesList = FRX_MEMOVARIES_LIST
case this.cType = PRJTYPE_MENU
m.cExcludeFields = MNX_EXCLUDE_LIST
m.cMemoAsCharList = MNX_MEMOASCHAR_LIST
m.cMemoAsBinList = MNX_MEMOASBIN_LIST
m.cCharAsBinList = MNX_CHARASBIN_LIST
m.cMemoVariesList = MNX_MEMOVARIES_LIST
case this.cType = PRJTYPE_DBC
m.cExcludeFields = DBC_EXCLUDE_LIST
m.cMemoAsCharList = DBC_MEMOASCHAR_LIST
m.cMemoAsBinList = DBC_MEMOASBIN_LIST
m.cCharAsBinList = DBC_CHARASBIN_LIST
m.cMemoVariesList = DBC_MEMOVARIES_LIST
otherwise
this.Cancel(ERR_UNSUPPORTEDFILETYPE_LOC + this.cType)
endcase
scan
this.oThermRef.Update(recno())
if type("UNIQUEID") <> 'U'
this.RecordMark(UNIQUEID)
endif
for i = 1 to fcount()
if SKIPEMPTYFIELD and empty(evaluate(field(i)))
loop
endif
do case
case " " + field(i) + " " $ m.cExcludeFields
&& skip this field
case " " + field(i) + " " $ m.cMemoAsCharList
&& memo fields treated as CHAR
this.CharWrite(field(i))
case type(field(i)) = "C"
if " " + field(i) + " " $ m.cCharAsBinList
this.MemoWrite(field(i), .t.)
else
this.CharWrite(field(i))
endif
case type(field(i)) = "M"
if " " + field(i) + " " $ m.cMemoVariesList
&& treat as text or binary based on contents of the memofield
if this.MemoIsBinary(field(i))
this.MemoWrite(field(i), .t.)
else
this.MemoWrite(field(i), .f.)
endif
else
if " " + field(i) + " " $ m.cMemoAsBinList
&& memo fields treated as BINARY
this.MemoWrite(field(i), .t.)
else
this.MemoWrite(field(i), .f.)
endif
endif
case type(field(i)) = "N"
this.NumWrite(field(i))
case type(field(i)) = "L"
this.BoolWrite(field(i))
otherwise
this.Alert(ERR_UNSUPPORTEDFIELDTYPE_LOC + type(field(i)))
endcase
endfor
endscan
this.EOFMark
endproc
procedure MemoIsBinary
* Scan the memo field to see if it contains binary characters
parameters cFieldname
private i, bIsBinary, cMemo
m.cMemo = &cFieldname
m.bIsBinary = .t.
do case
case chr(0) $ m.cMemo
otherwise
m.bIsBinary = .f.
if len(m.cMemo) < 126
for m.i = 1 to len(m.cMemo)
if asc(substr(m.cMemo, m.i, 1)) > 126
m.bIsBinary = .t.
exit
endif
endfor
else
for m.i = 126 to 255
if chr(m.i) $ m.cMemo
m.bIsBinary = .t.
exit
endif
endfor
endif
endcase
return m.bIsBinary
endproc
procedure EOFMark
=fputs(this.iHandle, MARKEOF)
endproc
procedure CharWrite
parameters cFieldname
private cTempfield
m.cTempfield = &cFieldname
=fputs(this.iHandle, MARKFIELDSTART + m.cFieldname + MARKFIELDEND + m.cTempfield)
endproc
procedure MemoWrite
parameters cFieldname, bBinary
private i, iLen, iStart, cBuf, cBinary, cBinaryProgress, iSeconds
=fputs(this.iHandle, this.SectionMark(m.cFieldname, .t., m.bBinary))
m.iLen = len(&cFieldname)
if m.bBinary
* If we don't support merging, simply write the checksum
if C_WRITECHECKSUMS .and. TextSupport(this.cType) == 1
=fputs(this.iHandle, MARKCHECKSUM + sys(2007, &cFieldname))
else
m.cBuf = repl(chr(0), 17)
m.cBinaryProgress = "0"
this.oThermRef.UpdateTaskMessage(C_BINARYCONVERSION_LOC)
m.iSeconds = seconds()
for m.i = 1 to int(m.iLen / MAXBINLEN) + iif(m.iLen % MAXBINLEN = 0, 0, 1)
if seconds() - m.iSeconds > 1
m.cBinaryProgress = alltrim(str(int(((m.i * MAXBINLEN) / m.iLen) * 100)))
this.oThermRef.UpdateTaskMessage(C_BINARYCONVERSION_LOC)
m.iSeconds = seconds()
endif
m.cBinary = substr(&cFieldname, ((m.i - 1) * MAXBINLEN) + 1, MAXBINLEN)
for m.j = 1 to int(len(m.cBinary) / 8)
sprintf(@cBuf, "%02X%02X%02X%02X%02X%02X%02X%02X", ;
asc(substr(m.cBinary, ((m.j - 1) * 8) + 1, 1)), ;
asc(substr(m.cBinary, ((m.j - 1) * 8) + 2, 1)), ;
asc(substr(m.cBinary, ((m.j - 1) * 8) + 3, 1)), ;
asc(substr(m.cBinary, ((m.j - 1) * 8) + 4, 1)), ;
asc(substr(m.cBinary, ((m.j - 1) * 8) + 5, 1)), ;
asc(substr(m.cBinary, ((m.j - 1) * 8) + 6, 1)), ;
asc(substr(m.cBinary, ((m.j - 1) * 8) + 7, 1)), ;
asc(substr(m.cBinary, ((m.j - 1) * 8) + 8, 1)))
fwrite(this.iHandle, m.cBuf, 16)
endfor
if len(m.cBinary) % 8 = 0
fputs(this.iHandle, "")
endif
endfor
if len(m.cBinary) % 8 <> 0
m.cBinary = right(m.cBinary, len(m.cBinary) % 8)
sprintf(@cBuf, replicate("%02X", len(m.cBinary)), ;
asc(substr(m.cBinary, 1, 1)), ;
asc(substr(m.cBinary, 2, 1)), ;
asc(substr(m.cBinary, 3, 1)), ;
asc(substr(m.cBinary, 4, 1)), ;
asc(substr(m.cBinary, 5, 1)), ;
asc(substr(m.cBinary, 6, 1)), ;
asc(substr(m.cBinary, 7, 1)), ;
asc(substr(m.cBinary, 8, 1)))
fwrite(this.iHandle, m.cBuf, len(m.cBinary) * 2)
fputs(this.iHandle, "")
endif
this.oThermRef.UpdateTaskMessage("")
endif
else
=fwrite(this.iHandle, &cFieldname)
endif
=fputs(this.iHandle, this.SectionMark(m.cFieldname, .f., m.bBinary))
endproc
procedure HexStr2BinStr
parameters cHexStr
private cBinStr, i
m.cBinStr = ""
m.cHexStr = strtran(m.cHexStr, 'A', chr(asc('9') + 1))
m.cHexStr = strtran(m.cHexStr, 'B', chr(asc('9') + 2))
m.cHexStr = strtran(m.cHexStr, 'C', chr(asc('9') + 3))
m.cHexStr = strtran(m.cHexStr, 'D', chr(asc('9') + 4))
m.cHexStr = strtran(m.cHexStr, 'E', chr(asc('9') + 5))
m.cHexStr = strtran(m.cHexStr, 'F', chr(asc('9') + 6))
for m.i = 1 to len(m.cHexStr) step 2
m.cBinStr = m.cBinStr + ;
chr((asc(substr(m.cHexStr, m.i, 1)) - 48) * 16 + asc(substr(m.cHexStr, m.i + 1, 1)) - 48)
endfor
return m.cBinStr
endproc
procedure NumWrite
* This procedure supports the numerics found in forms, reports, etc. (basically, integers)
parameters cFieldname
=fputs(this.iHandle, MARKFIELDSTART + m.cFieldname + ;
MARKFIELDEND + alltrim(str(&cFieldname, 20)))
endproc
procedure BoolWrite
parameters cFieldname
=fputs(this.iHandle, MARKFIELDSTART + m.cFieldname + ;
MARKFIELDEND + iif(&cFieldname, ".T.", ".F."))
endproc
procedure SectionMark
parameters cFieldname, lStart, bBinary
if m.lStart
if m.bBinary
return MARKBINSTARTWORD + m.cFieldname + MARKBINSTARTWORD2
else
return MARKMEMOSTARTWORD + m.cFieldname + MARKMEMOSTARTWORD2
endif
else
if m.bBinary
return MARKBINENDWORD + m.cFieldname + MARKBINENDWORD2
else
return MARKMEMOENDWORD + m.cFieldname + MARKMEMOENDWORD2
endif
endif
endproc
FUNCTION JustPath
* Returns just the pathname.
LPARAMETERS m.filname
m.filname = ALLTRIM(UPPER(m.filname))
IF "\" $ m.filname
m.filname = SUBSTR(m.filname,1,RAT("\",m.filname))
IF RIGHT(m.filname,1) = "\" AND LEN(m.filname) > 1 ;
AND SUBSTR(m.filname,LEN(m.filname)-1,1) <> ":"
filname = SUBSTR(m.filname,1,LEN(m.filname)-1)
ENDIF
RETURN m.filname
ELSE
RETURN ""
ENDIF
ENDFUNC
FUNCTION ForceExt
* Force filename to have a particular extension.
LPARAMETERS m.filname,m.ext
LOCAL m.ext
IF SUBSTR(m.ext,1,1) = "."
m.ext = SUBSTR(m.ext,2,3)
ENDIF
m.pname = THIS.justpath(m.filname)
m.filname = THIS.justfname(UPPER(ALLTRIM(m.filname)))
IF AT(".",m.filname) > 0
m.filname = SUBSTR(m.filname,1,AT(".",m.filname)-1) + "." + m.ext
ELSE
m.filname = m.filname + "." + m.ext
ENDIF
RETURN THIS.addbs(m.pname) + m.filname
ENDFUNC
FUNCTION JustFname
* Return just the filename (i.e., no path) from "filname"
LPARAMETERS m.filname
IF RAT("\",m.filname) > 0
m.filname = SUBSTR(m.filname,RAT("\",m.filname)+1,255)
ENDIF
IF AT(":",m.filname) > 0
m.filname = SUBSTR(m.filname,AT(":",m.filname)+1,255)
ENDIF
RETURN ALLTRIM(UPPER(m.filname))
ENDFUNC
FUNCTION AddBS
* Add a backslash unless there is one already there.
LPARAMETER m.pathname
LOCAL m.separator
m.separator = IIF(_MAC,":","\")
m.pathname = ALLTRIM(UPPER(m.pathname))
IF !(RIGHT(m.pathname,1) $ "\:") AND !EMPTY(m.pathname)
m.pathname = m.pathname + m.separator
ENDIF
RETURN m.pathname
ENDFUNC
FUNCTION JustStem
* Return just the stem name from "filname"
LPARAMETERS m.filname
IF RAT("\",m.filname) > 0
m.filname = SUBSTR(m.filname,RAT("\",m.filname)+1,255)
ENDIF
IF RAT(":",m.filname) > 0
m.filname = SUBSTR(m.filname,RAT(":",m.filname)+1,255)
ENDIF
IF AT(".",m.filname) > 0
m.filname = SUBSTR(m.filname,1,AT(".",m.filname)-1)
ENDIF
RETURN ALLTRIM(UPPER(m.filname))
ENDFUNC
FUNCTION justext
* Return just the extension from "filname"
PARAMETERS m.filname
LOCAL m.ext
m.filname = this.justfname(m.filname) && prevents problems with ..\ paths
m.ext = ""
IF AT(".", m.filname) > 0
m.ext = SUBSTR(m.filname, AT(".", m.filname) + 1, 3)
ENDIF
RETURN UPPER(m.ext)
ENDFUNC
procedure SetCodePage
parameters m.fname, m.iCodePage
private iHandle, cpbyte
do case
case m.iCodePage = 437
m.cpbyte = 1
case m.iCodePage = 850
m.cpbyte = 2
case m.iCodePage = 1252
m.cpbyte = 3
case m.iCodePage = 10000
m.cpbyte = 4
case m.iCodePage = 852
m.cpbyte = 100
case m.iCodePage = 866
m.cpbyte = 101
case m.iCodePage = 865
m.cpbyte = 102
case m.iCodePage = 861
m.cpbyte = 103
case m.iCodePage = 895
m.cpbyte = 104
case m.iCodePage = 620
m.cpbyte = 105
case m.iCodePage = 737
m.cpbyte = 106
case m.iCodePage = 857
m.cpbyte = 107
case m.iCodePage = 863
m.cpbyte = 108
case m.iCodePage = 10007
m.cpbyte = 150
case m.iCodePage = 10029
m.cpbyte = 151
case m.iCodePage = 10006
m.cpbyte = 152
case m.iCodePage = 1250
m.cpbyte = 200
case m.iCodePage = 1251
m.cpbyte = 201
case m.iCodePage = 1253
m.cpbyte = 203
case m.iCodePage = 1254
m.cpbyte = 202
case m.iCodePage = 1257
m.cpbyte = 204
otherwise
* Handle the error
return .f.
endcase
m.iHandle = fopen(m.fname, 2)
if m.iHandle = -1
return .f.
else
=fseek(m.iHandle, 29)
=fwrite(m.iHandle, chr(m.cpbyte))
=fclose(m.iHandle)
endif
return .t.
endproc
procedure GetReportStructure
parameters aStruct
aStruct[1, 1] = "PLATFORM"
aStruct[1, 2] = "C"
aStruct[1, 3] = 8
aStruct[1, 4] = 0
aStruct[2, 1] = "UNIQUEID"
aStruct[2, 2] = "C"
aStruct[2, 3] = 10
aStruct[2, 4] = 0
aStruct[3, 1] = "TIMESTAMP"
aStruct[3, 2] = "N"
aStruct[3, 3] = 10
aStruct[3, 4] = 0
aStruct[4, 1] = "OBJTYPE"
aStruct[4, 2] = "N"
aStruct[4, 3] = 2
aStruct[4, 4] = 0
aStruct[5, 1] = "OBJCODE"
aStruct[5, 2] = "N"
aStruct[5, 3] = 3
aStruct[5, 4] = 0
aStruct[6, 1] = "NAME"
aStruct[6, 2] = "M"
aStruct[6, 3] = 4
aStruct[6, 4] = 0
aStruct[7, 1] = "EXPR"
aStruct[7, 2] = "M"
aStruct[7, 3] = 4
aStruct[7, 4] = 0
aStruct[8, 1] = "VPOS"
aStruct[8, 2] = "N"
aStruct[8, 3] = 9
aStruct[8, 4] = 3
aStruct[9, 1] = "HPOS"
aStruct[9, 2] = "N"
aStruct[9, 3] = 9
aStruct[9, 4] = 3
aStruct[10, 1] = "HEIGHT"
aStruct[10, 2] = "N"
aStruct[10, 3] = 9
aStruct[10, 4] = 3
aStruct[11, 1] = "WIDTH"
aStruct[11, 2] = "N"
aStruct[11, 3] = 9
aStruct[11, 4] = 3
aStruct[12, 1] = "STYLE"
aStruct[12, 2] = "M"
aStruct[12, 3] = 4
aStruct[12, 4] = 0
aStruct[13, 1] = "PICTURE"
aStruct[13, 2] = "M"
aStruct[13, 3] = 4
aStruct[13, 4] = 0
aStruct[14, 1] = "ORDER"
aStruct[14, 2] = "M"
aStruct[14, 3] = 4
aStruct[14, 4] = 0
aStruct[15, 1] = "UNIQUE"
aStruct[15, 2] = "L"
aStruct[15, 3] = 1
aStruct[15, 4] = 0
aStruct[16, 1] = "COMMENT"
aStruct[16, 2] = "M"
aStruct[16, 3] = 4
aStruct[16, 4] = 0
aStruct[17, 1] = "ENVIRON"
aStruct[17, 2] = "L"
aStruct[17, 3] = 1
aStruct[17, 4] = 0
aStruct[18, 1] = "BOXCHAR"
aStruct[18, 2] = "C"
aStruct[18, 3] = 1
aStruct[18, 4] = 0
aStruct[19, 1] = "FILLCHAR"
aStruct[19, 2] = "C"
aStruct[19, 3] = 1
aStruct[19, 4] = 0
aStruct[20, 1] = "TAG"
aStruct[20, 2] = "M"
aStruct[20, 3] = 4
aStruct[20, 4] = 0
aStruct[21, 1] = "TAG2"
aStruct[21, 2] = "M"
aStruct[21, 3] = 4
aStruct[21, 4] = 0
aStruct[22, 1] = "PENRED"
aStruct[22, 2] = "N"
aStruct[22, 3] = 5
aStruct[22, 4] = 0
aStruct[23, 1] = "PENGREEN"
aStruct[23, 2] = "N"
aStruct[23, 3] = 5
aStruct[23, 4] = 0
aStruct[24, 1] = "PENBLUE"
aStruct[24, 2] = "N"
aStruct[24, 3] = 5
aStruct[24, 4] = 0
aStruct[25, 1] = "FILLRED"
aStruct[25, 2] = "N"
aStruct[25, 3] = 5
aStruct[25, 4] = 0
aStruct[26, 1] = "FILLGREEN"
aStruct[26, 2] = "N"
aStruct[26, 3] = 5
aStruct[26, 4] = 0
aStruct[27, 1] = "FILLBLUE"
aStruct[27, 2] = "N"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -