BCX : MIT and Open Source
1、修改PROPERTY满足Sub(Setter)和Function(Getter)功能.(利用C++函数多态特性"实现")
'*********************************************************************
' Transform METHOD, PROPERTY, PROPSET, and PROPGET - 787 MrBcx
'*********************************************************************
IF UseCpp THEN
IF iMatchNQ(Src$, "propget") THEN IREPLACe "propget" WITH "FUNCTION" IN Src$
IF iMatchNQ(Src$, "propset") THEN IREPLACE "propset" WITH "SUB" IN Src$
''PROPERTY Getter(Optional Value As DataType) AS DOUBLE==>"FUNCTION(Getter)"；PS:可增加临时变量(FSetter、FGetter),将之与Setter()、Getter()关联起来。
IF iMatchNQ(Src$, "property") AND ( iMatchNQ(Src$, ") AS ") OR iMatchNQ(Src$, ") AS ") OR iMatchNQ(Src$, ") AS ") OR iMatchNQ(Src$, ") AS") OR iMatchNQ(Src$, "%(") OR iMatchNQ(Src$, "!(") OR iMatchNQ(Src$, "#(") OR iMatchNQ(Src$, "$(") OR iMatchNQ(Src$, "`(") OR iMatchNQ(Src$, "@(") OR iMatchNQ(Src$, "*(")) THEN
DIM szTmp$
szTmp$ = SPC$ + Src$ + SPC$
IF INSTR(szTmp$, " property ", 0, 1) OR INSTR(szTmp$, " property=", 0, 1) THEN
IREPLACE "property" WITH "FUNCTION" IN Src$
END IF
''PROPERTY Getter(Optional Value As DataType)=... ==>"FUNCTION(Getter)=..."；PS：可增加临时变量(FSetter、FGetter),将之与Setter()、Getter()关联起来。
ELSEIF iMatchNQ(Src$, "property") AND iMatchNQ(Src$, "=") THEN
DIM szTmp$
szTmp$ = SPC$ + Src$ + SPC$
IF INSTR(szTmp$, " property ", 0, 1) OR INSTR(szTmp$, " property=", 0, 1) THEN
IREPLACE "property" WITH "FUNCTION" IN Src$
END IF
''PROPERTY Setter(n AS DOUBLE)==>"SUB(Setter)"；PS：可增加临时变量(FSetter、FGetter),将之与Setter()、Getter()关联起来。
ELSEIF iMatchNQ(Src$, "property") THEN
DIM szTmp$
szTmp$ = SPC$ + Src$ + SPC$
IF INSTR(szTmp$, " property ", 0, 1) THEN
IREPLACE "property" WITH "SUB" IN Src$
END IF
END IF
IF iMatchNQ(Src$, "method") THEN
DIM szTmp$
szTmp$ = SPC$ + Src$ + SPC$
IF INSTR(szTmp$, " method ", 0, 1) OR INSTR(szTmp$, " method=", 0, 1) THEN
IREPLACE "method" WITH "FUNCTION" IN Src$
END IF
END IF
END IF
2、修改To处理，兼容Select Case Case Condition1...Condition2范围方式。
''(增加：OR iMatchWrd(Stk$[i],"...") )''处理Case附近。CASE "case"
IF iMatchWrd(Stk$[i],"to") OR iMatchWrd(Stk$[i],"...") THEN
3、修改Type和Union字符串处理方式。(增加：OR i = vt_UNIOn)
FUNCTION IM_UDT_SINGLE (szArg$)
DIM RAW A$
DIM RAW VarName$ ' Variable Name ex. A.tree => "A"
DIM RAW Member$ ' Member Name ex. A.tree => "tree"
DIM RAW i
A$ = Clean$(szArg$)
i = INSTR(A$, ".")
IF i = 0 THEN FUNCTION = FALSE
INCR i
VarName$ = EXTRACT$(A$, ".")
Member$ = MId$(A$,INSTRREV (A$, ".") + 1) ' MrBcx 790 Changed from 789
i = CheckType(VarName$)
IF i = vt_UDT OR i = vt_STRUCT OR i = vt_UNIOn THEN
FOR INT y = 1 TO TypeDefsCnt
FOR INT z = 0 TO TypeDefs[y].EleCnt
IF TypeDefs[y].Elements[z].ElementName$ = Member$ AND _
TypeDefs[y].Elements[z].ElementType = vt_SINGLE THEN
FUNCTION = TRUE
END IF
NEXT
NEXT
END IF
FUNCTION = FALSE
END FUNCTION
FUNCTION IM_UDT_DOUBLE (szArg$)
DIM RAW A$
DIM RAW VarName$ ' Variable Name ex. A.tree => "A"
DIM RAW Member$ ' Member Name ex. A.tree => "tree"
DIM RAW i
A$ = Clean$(szArg$)
i = INSTR(A$, ".")
IF i = 0 THEN FUNCTION = FALSE
INCR i
VarName$ = EXTRACT$(A$, ".")
Member$ = MId$(A$,INSTRREV (A$, ".") + 1) ' MrBcx 790 Changed from 789
i = CheckType(VarName$)
IF i = vt_UDT OR i = vt_STRUCT OR i = vt_UNIOn THEN
FOR INT y = 1 TO TypeDefsCnt
FOR INT z = 0 TO TypeDefs[y].EleCnt
IF TypeDefs[y].Elements[z].ElementName$ = Member$ THEN
IF TypeDefs[y].Elements[z].ElementType = vt_DOUBLE OR _
TypeDefs[y].Elements[z].ElementType = vt_LDOUBLE THEN
FUNCTION = TRUE
END IF
END IF
NEXT
NEXT
END IF
FUNCTION = FALSE
END FUNCTION
FUNCTION IM_UDT_STRING(szArg$)
DIM RAW A$
DIM RAW VarName$ ' Variable Name ex. A.tree => "A"
DIM RAW Member$ ' Member Name ex. A.tree => "tree"
DIM RAW i
A$ = Clean$(szArg$)
i = INSTR(A$, ".")
IF i = 0 THEN FUNCTION = FALSE
INCR i
VarName$ = EXTRACT$(A$, ".")
Member$ = MId$(A$,INSTRREV (A$, ".") + 1) ' MrBcx 790 Changed from 789
i = CheckType(VarName$)
IF i = vt_UDT OR i = vt_STRUCT OR i = vt_UNIOn THEN
FOR INT y = 1 TO TypeDefsCnt
FOR INT z = 0 TO TypeDefs[y].EleCnt
IF TypeDefs[y].Elements[z].ElementName$ = Member$ THEN
IF TypeDefs[y].Elements[z].ElementType = vt_STRVAR OR _
TypeDefs[y].Elements[z].ElementType = vt_LPSTR OR _
TypeDefs[y].Elements[z].ElementType = vt_CHAR THEN
FUNCTION = TRUE
END IF
END IF
NEXT
NEXT
END IF
FUNCTION = FALSE
END FUNCTION
4、OOP "using"增加"extends"兼容；
搜索所有 "using"，增加OR ...="extends"，(小写，BcxKeyWords[]除外)。
5、增加注释掉#include
//#include
6、修改版本标识。
MACRO VERSION$ = "7.9.0(Mod By IBMInfo78) (06/18/2022)" ' Burn this into the executable
7、修改BCC32C编译#include
增加BCC32C对应stdbool.h、inttypes.h空文件。
''并在项目包含文件中添加以下宏定义：
#define _strlwr strlwr
#define _strupr strupr
#define _stricmp stricmp
#define _chdir chdir
#define _mkdir mkdir
//========================================================================
//========================================================================
''！！！修改后，可以处理如下Basic伪码(脚本???)。
''Test01:
CLASS bcx_vector
PROTECTED:
DIM RAW AS DOUBLE x
DIM RAW AS DOUBLE y
PUBLIC:
PROPERTY Prop_X (n AS DOUBLE) ''Setter
x = n
END PROPERTY
PROPERTY Prop_X() AS DOUBLE ''Getter
PROPERTY = x
END PROPERTY
PROPERTY Prop_Y(n AS DOUBLE) ''Setter
y = n
END PROPERTY
PROPERTY Prop_Y() AS DOUBLE ''Getter
PROPERTY = y
END PROPERTY
PROPERTY Surface() AS DOUBLE ''Function/Method
DIM RAW AS DOUBLE s
s = x * y
IF s < 0 THEN s = -s
PROPERTY = s
END PROPERTY
END CLASS
SUB MAIN
DIM RAW AS bcx_vector clsTest
clsTest.Prop_X(3)
clsTest.Prop_Y(4)
Print "The surface of clsTest: ", clsTest.Surface()
Print "Prop_X:",clsTest.Prop_X()
Print "Prop_Y:",clsTest.Prop_Y()
END SUB
''Test02:
Dim a$
a$="Some Value$"
Select Case a$
Case "a" ... "z" ''Both "to" and "..." done well.
print "Complex Select,case is LCase alpha"
Case "A" to "Z" ''Both "to" and "..." done well.
print "Complex Select,case is UCase alpha"
Case Else
print "Complex Select,case is not alpha."
End Select
