Routines to write syntax highlighted code

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
IchMagBier
Posts: 52
Joined: Jan 13, 2018 8:47
Location: Germany
Contact:
Contact IchMagBier

Routines to write syntax highlighted code

Post by IchMagBier »

ImageImage

Hello

I wrote two routines to write syntax highlighted code. The first one, "PrintCode", is used in textmode. The second routine, "DrawCode", is used in graphis mode. It supports the following programming and script languages:
- Assembler (Intel Syntax, NASM)
- Bash Script (Linux)
- Batch Script (Windows/DOS)
- C
- C++
- C#
- FreeBasic
- Lua
- Pascal
- Python

You use the routines like this:

Code: Select all

PrintCode( text , language)
PrintCode("Dim As Integer test",FreeBasic)

DrawCode( x , y , text , language)
DrawCode(10,10,"Dim As Integer test",FreeBasic)
The colors for DrawCode are based on Kugel. All colors are defined as constants in the first few lines of the code, so you can easily change them. You can add other languages aswell. You just need to create a "PLanguage" for every language you want, define the keywords and the signs the language uses for comments and strings and change "case_sensitive", if the keywords are case sensitive or insensitive (See code for more details).

Code + Demo:

Code: Select all

Const Use_Assembler=True
Const Use_Bash=True
Const Use_Batch=True
Const Use_C=True
Const Use_CPP=True
Const Use_CSharp=True
Const Use_FreeBasic=True
Const Use_Lua=True
Const Use_Python=True
Const Use_Pascal=True

Const color_command=&h729fcf
Const color_command2=&h1e90ff
Const color_string=&hdd4040
Const color_operator=&hfcaf3e
Const color_comment=&h888a85
Const color_else=&he5e5e5

Const colortext_command=9
Const colortext_command2=1
Const colortext_string=4
Const colortext_operator=6
Const colortext_comment=8
Const colortext_else=15

Const Assembler=0
Const Bash=1
Const Batch=2
Const C=3
Const CPP=4
Const CSharp=5
Const FreeBasic=6
Const Lua=7
Const Python=8
Const FreePascal=9


Type PLanguage
   As String commands(Any)   
   As String commands2(Any)   'Preprocessor, Labels ... etc
   As Boolean case_sensitive   'C is case sensitive, FreeBasic is not
   As String comment_sign,comment_sign2,comment_sign_start,comment_sign_end
   As UByte string_
End Type

Dim Shared As PLanguage PLanguages(9)

If Use_Assembler=True Then
   With PLanguages(Assembler)
      .string_=34
      .case_sensitive=False
      .comment_sign=";"
      Redim .commands(0 To 56)
      .commands(0)="hlt"
      .commands(1)="lad"
      .commands(2)="spi"
      .commands(3)="add"
      .commands(4)="sub"
      .commands(5)="mul"
      .commands(6)="div"
      .commands(7)="jmp"
      .commands(8)="jez"
      .commands(9)="jgz"
      .commands(10)="jlz"
      .commands(11)="swap"
      .commands(12)="jsr"
      .commands(13)="ret"
      .commands(14)="pushac"
      .commands(15)="popac"
      .commands(16)="addst"
      .commands(17)="subst"
      .commands(18)="mulst"
      .commands(19)="divst"
      .commands(20)="lsa"
      .commands(21)="lds"
      .commands(22)="push"
      .commands(23)="pop"
      .commands(24)="cli"
      .commands(25)="ldi"
      .commands(26)="ink"
      .commands(27)="lia"
      .commands(28)="dek"
      .commands(29)="ldx"
      .commands(30)="adc"
      .commands(31)="sbb"
      .commands(32)="ja"
      .commands(33)="jb"
      .commands(34)="jna"
      .commands(35)="jnb"
      .commands(36)="je"
      .commands(37)="jne"
      .commands(38)="cmp"
      .commands(39)="int"
      .commands(40)="call"
      .commands(41)="jz"
      .commands(42)="jnz"
      .commands(43)="shl"
      .commands(44)="shr"
      .commands(45)="mov"
      .commands(46)="sar"
      .commands(47)="sal"
      .commands(48)="rol"
      .commands(49)="ror"
      .commands(50)="lea"
      .commands(51)="nop"
      .commands(52)="inc"
      .commands(53)="dec"
      .commands(54)="and"
      .commands(55)="xor"
      .commands(56)="or"
      Redim .commands2(0 To 16)
      .commands2(0)="%define"
      .commands2(1)="%xdefine"
      .commands2(2)="%undef"
      .commands2(3)="%assign"
      .commands2(4)="%ifdef"
      .commands2(5)="%ifndef"
      .commands2(6)="%ifmacro"
      .commands2(7)="%if"
      .commands2(8)="%error"
      .commands2(9)="%else"
      .commands2(10)="%endif"
      .commands2(11)="%endmacro"
      .commands2(12)="%macro"
      .commands2(13)="%define"
      .commands2(14)="%elifdef"
      .commands2(15)="%define"
      .commands2(16)="%include"
   End With
End If

If Use_Bash=True Then
   With PLanguages(Bash)
      .string_=34
      .case_sensitive=True
      .comment_sign="#"
      Redim .commands(0 To 23)
      .commands(0)="break"
      .commands(1)="case"
      .commands(2)="continue"
      .commands(3)="done"
      .commands(4)="do"
      .commands(5)="elif"
      .commands(6)="else"
      .commands(7)="esac"
      .commands(8)="eval"
      .commands(9)="exit"
      .commands(10)="export"
      .commands(11)="fi"
      .commands(12)="for"
      .commands(13)="function"
      .commands(14)="goto"
      .commands(15)="if"
      .commands(16)="integer"
      .commands(17)="in"
      .commands(18)="return"
      .commands(19)="set"
      .commands(20)="shift"
      .commands(21)="then"
      .commands(22)="until"
      .commands(23)="while"
   End With
End If

If Use_Batch=True Then
   With PLanguages(Batch)
      .string_=34
      .case_sensitive=False
      .comment_sign="REM"
      .comment_sign2="::"
      Redim .commands(0 To 51)
      .commands(1)="set"
      .commands(2)="if"
      .commands(3)="else"
      .commands(4)="exist"
      .commands(5)="errorlevel"
      .commands(6)="for"
      .commands(7)="in"
      .commands(8)="do"
      .commands(9)="break"
      .commands(10)="call"
      .commands(11)="copy"
      .commands(12)="chcp"
      .commands(13)="cd"
      .commands(14)="chdir"
      .commands(15)="choice"
      .commands(16)="cls"
      .commands(17)="country"
      .commands(18)="ctty"
      .commands(19)="date"
      .commands(20)="del"
      .commands(21)="erase"
      .commands(22)="dir"
      .commands(23)="echo"
      .commands(24)="exit"
      .commands(25)="goto"
      .commands(26)="loadfix"
      .commands(27)="loadhigh"
      .commands(28)="mkdir"
      .commands(29)="md"
      .commands(30)="move"
      .commands(31)="path"
      .commands(32)="pause"
      .commands(33)="prompt"
      .commands(34)="rename"
      .commands(35)="ren"
      .commands(36)="rmdir"
      .commands(37)="rd"
      .commands(38)="shift"
      .commands(39)="time"
      .commands(40)="type"
      .commands(41)="verify"
      .commands(42)="ver"
      .commands(43)="vol"
      .commands(44)="com"
      .commands(45)="con"
      .commands(46)="lpt"
      .commands(47)="nul"
      .commands(48)="defined"
      .commands(49)="not"
      .commands(50)="errorlevel"
      .commands(51)="cmdextversion"
   End With
End If

If Use_C=True Then
   With PLanguages(C)
      .string_=34
      .case_sensitive=True
      .comment_sign="//"
      .comment_sign_start="/*"
      .comment_sign_end="*/"
      Redim .commands(0 To 49)
      .commands(0)="asm"
      .commands(1)="auto"
      .commands(2)="break"
      .commands(3)="case"
      .commands(4)="char"
      .commands(5)="const"
      .commands(6)="continue"
      .commands(7)="default"
      .commands(8)="double"
      .commands(9)="do"
      .commands(10)="else"
      .commands(11)="enum"
      .commands(12)="extern"
      .commands(13)="float"
      .commands(14)="for"
      .commands(15)="goto"
      .commands(16)="if"
      .commands(17)="inline"
      .commands(18)="int"
      .commands(19)="long"
      .commands(20)="register"
      .commands(21)="restrict"
      .commands(22)="return"
      .commands(23)="short"
      .commands(24)="signed"
      .commands(25)="sizeof"
      .commands(26)="static"
      .commands(27)="struct"
      .commands(28)="switch"
      .commands(29)="typedef"
      .commands(30)="union"
      .commands(31)="unsigned"
      .commands(32)="void"
      .commands(33)="volatile"
      .commands(34)="while"
      .commands(35)="Alignas"
      .commands(36)="Alignof"
      .commands(37)="Atomic"
      .commands(38)="Bool"
      .commands(39)="Complex"
      .commands(40)="Generic"
      .commands(41)="Imaginary"
      .commands(42)="Noreturn"
      .commands(43)="Static"
      .commands(44)="assert"
      .commands(45)="Thread"
      .commands(46)="local"
      .commands(47)="FALSE"
      .commands(48)="NULL"
      .commands(49)="TRUE"
      Redim .commands2(0 To 10)
      .commands2(0)="#include"
      .commands2(1)="#define"
      .commands2(2)="#undef"
      .commands2(3)="#ifndef"
      .commands2(4)="#ifdef"
      .commands2(5)="#if"
      .commands2(6)="#error"
      .commands2(7)="#pragma"
      .commands2(8)="#elif"
      .commands2(9)="#else"
      .commands2(10)="#endif"
   End With
End If

If Use_CPP=True Then
   With PLanguages(CPP)
      .string_=34
      .case_sensitive=True
      .comment_sign="//"
      .comment_sign_start="/*"
      .comment_sign_end="*/"
      Redim .commands(0 To 98)
      .commands(0)="alignas"
      .commands(1)="alignof"
      .commands(2)="and"
      .commands(4)="eq"
      .commands(5)="asm"
      .commands(6)="auto"
      .commands(7)="bitand"
      .commands(8)="bitor"
      .commands(9)="bool"
      .commands(10)="break"
      .commands(11)="case"
      .commands(12)="catch"
      .commands(13)="char32"
      .commands(14)="char16"
      .commands(16)="char"
      .commands(18)="class"
      .commands(19)="compl"
      .commands(20)="const"
      .commands(22)="cast"
      .commands(23)="constexpr"
      .commands(24)="continue"
      .commands(25)="decltype"
      .commands(26)="default"
      .commands(27)="delete"
      .commands(28)="double"
      .commands(29)="do"
      .commands(30)="dynamic"
      .commands(31)="cast"
      .commands(32)="else"
      .commands(33)="enum"
      .commands(34)="explicit"
      .commands(35)="export"
      .commands(36)="extern"
      .commands(37)="false"
      .commands(38)="final"
      .commands(39)="float"
      .commands(40)="for"
      .commands(41)="friend"
      .commands(42)="goto"
      .commands(43)="if"
      .commands(44)="inline"
      .commands(45)="int"
      .commands(46)="long"
      .commands(47)="mutable"
      .commands(48)="namespace"
      .commands(49)="new"
      .commands(50)="noexcept"
      .commands(51)="not"
      .commands(53)="eq"
      .commands(54)="nullptr"
      .commands(55)="operator"
      .commands(56)="or"
      .commands(58)="eq"
      .commands(59)="override"
      .commands(60)="private"
      .commands(61)="protected"
      .commands(62)="public"
      .commands(63)="register"
      .commands(64)="reinterpret"
      .commands(65)="cast"
      .commands(66)="return"
      .commands(67)="short"
      .commands(68)="signed"
      .commands(69)="sizeof"
      .commands(70)="static"
      .commands(72)="assert"
      .commands(74)="cast"
      .commands(75)="struct"
      .commands(76)="switch"
      .commands(77)="template"
      .commands(78)="this"
      .commands(79)="thread"
      .commands(80)="local"
      .commands(81)="throw"
      .commands(82)="true"
      .commands(83)="try"
      .commands(84)="typedef"
      .commands(85)="typeid"
      .commands(86)="typename"
      .commands(87)="union"
      .commands(88)="unsigned"
      .commands(89)="using"
      .commands(90)="virtual"
      .commands(91)="void"
      .commands(92)="volatile"
      .commands(93)="wchar"
      .commands(95)="while"
      .commands(96)="xor"
      .commands(98)="eq"
      Redim .commands2(0 To 10)
      .commands2(0)="#include"
      .commands2(1)="#define"
      .commands2(2)="#undef"
      .commands2(3)="#ifndef"
      .commands2(4)="#ifdef"
      .commands2(5)="#if"
      .commands2(6)="#error"
      .commands2(7)="#pragma"
      .commands2(8)="#elif"
      .commands2(9)="#else"
      .commands2(10)="#endif"
   End With
End If

If Use_CSharp=True Then
   With PLanguages(CSharp)
      .string_=34
      .case_sensitive=True
      .comment_sign="//"
      .comment_sign_start="/*"
      .comment_sign_end="*/"
      Redim .commands(0 To 76)
      .commands(0)="abstract"
      .commands(1)="as"
      .commands(2)="base"
      .commands(3)="bool"
      .commands(4)="break"
      .commands(5)="byte"
      .commands(6)="case"
      .commands(7)="catch"
      .commands(8)="char"
      .commands(9)="checked"
      .commands(10)="class"
      .commands(11)="const"
      .commands(12)="continue"
      .commands(13)="decimal"
      .commands(14)="default"
      .commands(15)="delegate"
      .commands(16)="double"
      .commands(17)="do"
      .commands(18)="else"
      .commands(19)="enum"
      .commands(20)="event"
      .commands(21)="explicit"
      .commands(22)="extern"
      .commands(23)="false"
      .commands(24)="finally"
      .commands(25)="fixed"
      .commands(26)="float"
      .commands(27)="foreach"
      .commands(28)="for"
      .commands(29)="goto"
      .commands(30)="if"
      .commands(31)="implicit"
      .commands(32)="internal"
      .commands(33)="interface"
      .commands(34)="int"
      .commands(35)="in"
      .commands(36)="is"
      .commands(37)="lock"
      .commands(38)="long"
      .commands(39)="namespace"
      .commands(40)="new"
      .commands(41)="null"
      .commands(42)="object"
      .commands(43)="operator"
      .commands(44)="out"
      .commands(45)="override"
      .commands(46)="params"
      .commands(47)="private"
      .commands(48)="protected"
      .commands(49)="public"
      .commands(50)="readonly"
      .commands(51)="ref"
      .commands(52)="return"
      .commands(53)="sbyte"
      .commands(54)="sealed"
      .commands(55)="short"
      .commands(56)="sizeof"
      .commands(57)="stackalloc"
      .commands(58)="static"
      .commands(59)="string"
      .commands(60)="struct"
      .commands(61)="switch"
      .commands(62)="this"
      .commands(63)="throw"
      .commands(64)="true"
      .commands(65)="try"
      .commands(66)="typeof"
      .commands(67)="uint"
      .commands(68)="ulong"
      .commands(69)="unchecked"
      .commands(70)="unsafe"
      .commands(71)="ushort"
      .commands(72)="using"
      .commands(73)="virtual"
      .commands(74)="void"
      .commands(75)="volatile"
      .commands(76)="while"
      Redim .commands2(0 To 14)
      .commands2(0)="#include"
      .commands2(1)="#define"
      .commands2(2)="#undef"
      .commands2(3)="#ifndef"
      .commands2(4)="#ifdef"
      .commands2(5)="#if"
      .commands2(6)="#error"
      .commands2(7)="#pragma"
      .commands2(8)="#elif"
      .commands2(9)="#else"
      .commands2(10)="#endif"
      .commands2(11)="#warning"
      .commands2(12)="#line"
      .commands2(13)="#region"
      .commands2(14)="#endregion"   
   End With
End If

If Use_FreeBasic=True Then
   With PLanguages(FreeBasic)
      .string_=34
      .case_sensitive=False
      .comment_sign="'"
      .comment_sign_start="/'"
      .comment_sign_end="'/"   
      Redim .commands(0 To 408)
      .commands(0)="abs"
      .commands(1)="access"
      .commands(2)="acos"
      .commands(3)="alias"
      .commands(4)="allocate"
      .commands(5)="alpha"
      .commands(6)="andalso"
      .commands(7)="and"
      .commands(8)="any"
      .commands(9)="append"
      .commands(10)="asc"
      .commands(11)="asm"
      .commands(12)="asin"
      .commands(13)="assertwarn"
      .commands(14)="assert"
      .commands(15)="as"
      .commands(16)="atan2"
      .commands(17)="atn"
      .commands(18)="base"
      .commands(19)="beep"
      .commands(20)="binary"
      .commands(21)="bin"
      .commands(22)="bitset"
      .commands(23)="bitreset"
      .commands(24)="bit"
      .commands(25)="bload"
      .commands(26)="bsave"
      .commands(27)="byref"
      .commands(28)="byte"
      .commands(29)="byval"
      .commands(30)="callocate"
      .commands(31)="call"
      .commands(32)="case"
      .commands(33)="cast"
      .commands(34)="cbyte"
      .commands(35)="cdbl"
      .commands(36)="cdecl"
      .commands(37)="chain"
      .commands(38)="chdir"
      .commands(39)="chr"
      .commands(40)="cint"
      .commands(41)="circle"
      .commands(42)="class"
      .commands(43)="clear"
      .commands(44)="clngint"
      .commands(45)="clng"
      .commands(46)="close"
      .commands(47)="cls"
      .commands(48)="color"
      .commands(50)="command"
      .commands(51)="common"
      .commands(52)="condbroadcast"
      .commands(53)="condcreate"
      .commands(54)="conddestroy"
      .commands(55)="condsignal"
      .commands(56)="condwait"
      .commands(57)="constructor"
      .commands(58)="const"
      .commands(59)="cons"
      .commands(60)="continue"
      .commands(61)="cos"
      .commands(62)="cptr"
      .commands(63)="cshort"
      .commands(64)="csign"
      .commands(65)="csng"
      .commands(66)="csrlin"
      .commands(67)="cubyte"
      .commands(68)="cuint"
      .commands(69)="culngint"
      .commands(70)="culng"
      .commands(71)="cunsg"
      .commands(72)="curdir"
      .commands(73)="cushort"
      .commands(74)="custom"
      .commands(75)="cvd"
      .commands(76)="cvi"
      .commands(77)="cvl"
      .commands(78)="cvlongint"
      .commands(79)="cvshort"
      .commands(80)="cvs"
      .commands(81)="data"
      .commands(82)="datevalue"
      .commands(83)="dateadd"
      .commands(84)="datediff"
      .commands(85)="datepart"
      .commands(86)="dateserial"
      .commands(87)="date"
      .commands(88)="day"
      .commands(89)="deallocate"
      .commands(90)="declare"
      .commands(91)="defbyte"
      .commands(92)="defdbl"
      .commands(93)="defint"
      .commands(94)="deflngint"
      .commands(95)="deflng"
      .commands(96)="defshort"
      .commands(97)="defsng"
      .commands(98)="defstr"
      .commands(99)="defubyte"
      .commands(100)="defuint"
      .commands(101)="defulngint"
      .commands(102)="defushort"
      .commands(103)="delete"
      .commands(104)="destructor"
      .commands(105)="dim"
      .commands(106)="dir"
      .commands(107)="double"
      .commands(108)="do"
      .commands(109)="draw"
      .commands(110)="dylibfree"
      .commands(111)="dylibload"
      .commands(112)="dylibsymbol"
      .commands(113)="dynamic"
      .commands(114)="elseif"
      .commands(115)="else"
      .commands(116)="encoding"
      .commands(117)="endif"
      .commands(118)="end"
      .commands(119)="enum"
      .commands(120)="environ"
      .commands(121)="eof"
      .commands(122)="eqv"
      .commands(123)="erase"
      .commands(124)="erfn"
      .commands(125)="erl"
      .commands(126)="ermn"
      .commands(127)="error"
      .commands(128)="err"
      .commands(129)="escape"
      .commands(130)="exec"
      .commands(131)="exepath"
      .commands(132)="exit"
      .commands(133)="explicit"
      .commands(134)="exp"
      .commands(135)="export"
      .commands(136)="extends"
      .commands(137)="extern"
      .commands(138)="false"
      .commands(139)="fboolean"
      .commands(140)="field"
      .commands(141)="fileattr"
      .commands(142)="filecopy"
      .commands(143)="filedatetime"
      .commands(144)="fileexists"
      .commands(145)="filelen"
      .commands(146)="fix"
      .commands(147)="flip"
      .commands(148)="format"
      .commands(149)="for"
      .commands(150)="frac"
      .commands(151)="freefile"
      .commands(152)="fre"
      .commands(153)="function"
      .commands(154)="getmouse"
      .commands(155)="getjoystick"
      .commands(156)="getkey"
      .commands(157)="get"
      .commands(158)="gosub"
      .commands(159)="goto"
      .commands(160)="hex"
      .commands(161)="hibyte"
      .commands(162)="hiword"
      .commands(163)="hour"
      .commands(164)="if"
      .commands(165)="iif"
      .commands(166)="imageconvertrow"
      .commands(167)="imagecreate"
      .commands(168)="imagedestroy"
      .commands(169)="import"
      .commands(170)="implements"
      .commands(171)="inkey"
      .commands(172)="input"
      .commands(173)="input"
      .commands(174)="inp"
      .commands(175)="instrrev"
      .commands(176)="instr"
      .commands(177)="integer"
      .commands(178)="int"
      .commands(179)="interface"
      .commands(180)="is"
      .commands(181)="isdate"
      .commands(182)="kill"
      .commands(183)="lbound"
      .commands(184)="lcase"
      .commands(185)="left"
      .commands(186)="len"
      .commands(187)="let"
      .commands(188)="lib"
      .commands(189)="line"
      .commands(190)="lobyte"
      .commands(191)="loc"
      .commands(192)="local"
      .commands(193)="locate"
      .commands(194)="lock"
      .commands(195)="lof"
      .commands(196)="log"
      .commands(197)="longint"
      .commands(198)="long"
      .commands(199)="loop"
      .commands(200)="loword"
      .commands(201)="lpos"
      .commands(202)="lprint"
      .commands(203)="lpt"
      .commands(204)="lset"
      .commands(205)="ltrim"
      .commands(206)="mid"
      .commands(207)="minute"
      .commands(208)="mkd"
      .commands(209)="mkdir"
      .commands(210)="mki"
      .commands(211)="mklongint"
      .commands(212)="mkl"
      .commands(213)="mkshort"
      .commands(214)="mks"
      .commands(215)="mod"
      .commands(216)="month"
      .commands(217)="monthname"
      .commands(218)="multikey"
      .commands(219)="mutexcreate"
      .commands(220)="mutexdestroy"
      .commands(221)="mutexlock"
      .commands(222)="mutexunlock"
      .commands(223)="namespace"
      .commands(224)="name"
      .commands(225)="new"
      .commands(226)="next"
      .commands(227)="nokeyword"
      .commands(228)="not"
      .commands(229)="now"
      .commands(230)="object"
      .commands(231)="oct"
      .commands(232)="offsetof"
      .commands(233)="once"
      .commands(234)="on"
      .commands(235)="open"
      .commands(236)="operator"
      .commands(237)="option"
      .commands(238)="orelse"
      .commands(239)="or"
      .commands(240)="output"
      .commands(241)="out"
      .commands(242)="overload"
      .commands(243)="paint"
      .commands(244)="palette"
      .commands(245)="pascal"
      .commands(246)="pcopy"
      .commands(247)="peek"
      .commands(248)="pipe"
      .commands(249)="pmap"
      .commands(250)="pointer"
      .commands(251)="point"
      .commands(252)="poke"
      .commands(253)="pos"
      .commands(254)="preserve"
      .commands(255)="preset"
      .commands(256)="print"
      .commands(257)="private"
      .commands(258)="procptr"
      .commands(259)="property"
      .commands(260)="protected"
      .commands(261)="pset"
      .commands(262)="ptr"
      .commands(263)="public"
      .commands(264)="put"
      .commands(265)="randomize"
      .commands(266)="random"
      .commands(267)="read"
      .commands(268)="reallocate"
      .commands(269)="redim"
      .commands(270)="rem"
      .commands(271)="reset"
      .commands(272)="restore"
      .commands(273)="resume"
      .commands(274)="return"
      .commands(275)="rgba"
      .commands(276)="rgb"
      .commands(277)="right"
      .commands(278)="rmdir"
      .commands(279)="rnd"
      .commands(280)="rset"
      .commands(281)="rtrim"
      .commands(282)="run"
      .commands(283)="sadd"
      .commands(284)="scope"
      .commands(285)="screenunlock"
      .commands(286)="screencontrol"
      .commands(287)="screencopy"
      .commands(288)="screenevent"
      .commands(289)="screenglproc"
      .commands(290)="screeninfo"
      .commands(291)="screenlist"
      .commands(292)="screenlock"
      .commands(293)="screenptr"
      .commands(294)="screenres"
      .commands(295)="screenset"
      .commands(296)="screensync"
      .commands(297)="screen"
      .commands(298)="scrn"
      .commands(299)="second"
      .commands(300)="seek"
      .commands(301)="select"
      .commands(302)="setdate"
      .commands(303)="setenviron"
      .commands(304)="setmouse"
      .commands(305)="settime"
      .commands(306)="sgn"
      .commands(307)="shared"
      .commands(308)="shell"
      .commands(309)="shl"
      .commands(310)="short"
      .commands(311)="shr"
      .commands(312)="single"
      .commands(313)="sin"
      .commands(314)="sizeof"
      .commands(315)="sleep"
      .commands(316)="space"
      .commands(317)="spc"
      .commands(318)="sqr"
      .commands(319)="static"
      .commands(320)="stdcall"
      .commands(321)="step"
      .commands(322)="stop"
      .commands(323)="string"
      .commands(324)="strptr"
      .commands(325)="str"
      .commands(326)="sub"
      .commands(327)="swap"
      .commands(328)="system"
      .commands(329)="tab"
      .commands(330)="tan"
      .commands(331)="then"
      .commands(332)="this"
      .commands(333)="threadcreate"
      .commands(334)="threadwait"
      .commands(335)="timer"
      .commands(336)="time"
      .commands(337)="timeserial"
      .commands(338)="timevalue"
      .commands(339)="to"
      .commands(340)="trans"
      .commands(341)="trim"
      .commands(342)="true"
      .commands(343)="type"
      .commands(344)="ubound"
      .commands(345)="ubyte"
      .commands(346)="ucase"
      .commands(347)="uinteger"
      .commands(348)="ulongint"
      .commands(349)="ulong"
      .commands(350)="union"
      .commands(351)="unlock"
      .commands(352)="unsigned"
      .commands(353)="until"
      .commands(354)="ushort"
      .commands(355)="using"
      .commands(356)="va"
      .commands(357)="arg"
      .commands(358)="va"
      .commands(359)="first"
      .commands(360)="valulng"
      .commands(361)="valuint"
      .commands(362)="vallng"
      .commands(363)="valint"
      .commands(364)="val"
      .commands(365)="va"
      .commands(366)="next"
      .commands(367)="varptr"
      .commands(368)="var"
      .commands(369)="view"
      .commands(370)="virtual"
      .commands(371)="wait"
      .commands(372)="wbin"
      .commands(373)="wchr"
      .commands(374)="weekdayname"
      .commands(375)="weekday"
      .commands(376)="wend"
      .commands(377)="whex"
      .commands(378)="while"
      .commands(379)="width"
      .commands(380)="windowtitle"
      .commands(381)="window"
      .commands(382)="winput"
      .commands(383)="with"
      .commands(384)="woct"
      .commands(385)="write"
      .commands(386)="wspace"
      .commands(387)="wstring"
      .commands(388)="wstr"
      .commands(389)="xor"
      .commands(390)="year"
      .commands(391)="zstring"
      .commands(392)="abstract"
      .commands(394)="boolean"
      .commands(395)="imp"
      .commands(396)="naked"
      .commands(397)="override"
      .commands(398)="add"
      .commands(399)="threaddetach"
      .commands(400)="cbool"
      .commands(401)="deflongint"
      .commands(402)="defulongint"
      .commands(403)="imageinfo"
      .commands(404)="nogosub "
      .commands(405)="stick"
      .commands(406)="strig"
      .commands(407)="threadcall"
      .commands(408)="val64"
      Redim .commands2(0 To 21)
      .commands2(0)="#assert"
      .commands2(1)="#defined"
      .commands2(2)="#define"
      .commands2(3)="#elseif"
      .commands2(4)="#else"
      .commands2(5)="#endif"
      .commands2(6)="#endmacro"
      .commands2(7)="#error"
      .commands2(8)="#ifndef"
      .commands2(9)="#ifdef"
      .commands2(10)="#if"
      .commands2(11)="#inclib"
      .commands2(12)="#include"
      .commands2(13)="#lang"
      .commands2(14)="#libpath"
      .commands2(15)="#line"
      .commands2(16)="#macro"
      .commands2(17)="#once"
      .commands2(18)="#pragma"
      .commands2(19)="#print"
      .commands2(20)="#typeof"
      .commands2(21)="#undef"
   End With
End If

If Use_Lua=True Then
   With PLanguages(Lua)
      .string_=34
      .case_sensitive=True
      .comment_sign="--"
      .comment_sign_start="--[["
      .comment_sign_end="]]--"
      Redim .commands(0 To 20)
      .commands(0)="and"
      .commands(1)="break"
      .commands(2)="do"
      .commands(3)="else"
      .commands(4)="elseif"
      .commands(5)="end"
      .commands(6)="false"
      .commands(7)="for"
      .commands(8)="function"
      .commands(9)="if"
      .commands(10)="in"
      .commands(11)="local"
      .commands(12)="nil"
      .commands(13)="not"
      .commands(14)="or"
      .commands(15)="repeat"
      .commands(16)="return"
      .commands(17)="then"
      .commands(18)="true"
      .commands(19)="until"
      .commands(20)="while"
      Redim .commands2(0 To 55)
      .commands2(0)="ALERT"
      .commands2(1)="assert"
      .commands2(2)="call"
      .commands2(3)="collectgarbage"
      .commands2(4)="coroutine"
      .commands2(5)="debug"
      .commands2(6)="dofile"
      .commands2(7)="dostring"
      .commands2(8)="ERRORMESSAGE"
      .commands2(9)="error"
      .commands2(10)="foreachi"
      .commands2(11)="foreach"
      .commands2(12)="globals"
      .commands2(13)="gcinfo"
      .commands2(14)="getfenv"
      .commands2(15)="getmetatable"
      .commands2(16)="getn"
      .commands2(17)="G"
      .commands2(18)="INPUT"
      .commands2(19)="io"
      .commands2(20)="ipairs"
      .commands2(21)="loadstring"
      .commands2(22)="loadfile"
      .commands2(23)="loadlib"
      .commands2(24)="load"
      .commands2(25)="math"
      .commands2(26)="module"
      .commands2(27)="newtype"
      .commands2(28)="next"
      .commands2(29)="os"
      .commands2(30)="OUTPUT"
      .commands2(31)="pairs"
      .commands2(32)="pcall"
      .commands2(33)="print"
      .commands2(34)="PROMPT"
      .commands2(35)="rawequal"
      .commands2(36)="rawget"
      .commands2(37)="rawset"
      .commands2(38)="require"
      .commands2(39)="select"
      .commands2(40)="setfenv"
      .commands2(41)="setmetatable"
      .commands2(42)="sort"
      .commands2(43)="STDERR"
      .commands2(44)="STDIN"
      .commands2(45)="STDOUT"
      .commands2(46)="string"
      .commands2(47)="table"
      .commands2(48)="tinsert"
      .commands2(49)="tonumber"
      .commands2(50)="tostring"
      .commands2(51)="tremove"
      .commands2(52)="type"
      .commands2(53)="unpack"
      .commands2(54)="VERSION"
      .commands2(55)="xpcall"
   End With
End If

If Use_Python=True Then
   With PLanguages(Python)
      .string_=34
      .case_sensitive=True
      .comment_sign="#"
      Redim .commands(0 To 34)
      .commands(0)="False"
      .commands(1)="None"
      .commands(2)="True"
      .commands(3)="and"
      .commands(4)="assert"
      .commands(5)="as"
      .commands(6)="break"
      .commands(7)="class"
      .commands(8)="continue"
      .commands(9)="def"
      .commands(10)="del"
      .commands(11)="elif"
      .commands(12)="else"
      .commands(13)="except"
      .commands(14)="exec"
      .commands(15)="finally"
      .commands(16)="for"
      .commands(17)="from"
      .commands(18)="global"
      .commands(19)="if"
      .commands(20)="import"
      .commands(21)="in"
      .commands(22)="is"
      .commands(23)="lambda"
      .commands(24)="nonlocal"
      .commands(25)="not"
      .commands(26)="or"
      .commands(27)="pass"
      .commands(28)="print"
      .commands(29)="raise"
      .commands(30)="return"
      .commands(31)="try"
      .commands(32)="while"
      .commands(33)="with"
      .commands(34)="yield"
      Redim .commands2(0 To 94)
      .commands2(0)="build"
      .commands2(1)="class"
      .commands2(2)="debug"
      .commands2(3)="doc"
      .commands2(4)="import"
      .commands2(5)="loader"
      .commands2(6)="name"
      .commands2(7)="package"
      .commands2(8)="spec"
      .commands2(9)="abs"
      .commands2(10)="all"
      .commands2(11)="any"
      .commands2(12)="apply"
      .commands2(13)="ascii"
      .commands2(14)="basestring"
      .commands2(15)="bin"
      .commands2(16)="bool"
      .commands2(17)="buffer"
      .commands2(18)="bytearray"
      .commands2(19)="bytes"
      .commands2(20)="callable"
      .commands2(21)="chr"
      .commands2(22)="classmethod"
      .commands2(23)="cmp"
      .commands2(24)="coerce"
      .commands2(25)="compile"
      .commands2(26)="complex"
      .commands2(27)="copyright"
      .commands2(28)="credits"
      .commands2(29)="delattr"
      .commands2(30)="dict"
      .commands2(31)="dir"
      .commands2(32)="divmod"
      .commands2(33)="enumerate"
      .commands2(34)="eval"
      .commands2(35)="execfile"
      .commands2(36)="exit"
      .commands2(37)="file"
      .commands2(38)="filter"
      .commands2(39)="float"
      .commands2(40)="format"
      .commands2(41)="frozenset"
      .commands2(42)="getattr"
      .commands2(43)="globals"
      .commands2(44)="hasattr"
      .commands2(45)="hash"
      .commands2(46)="help"
      .commands2(47)="hex"
      .commands2(48)="id"
      .commands2(49)="input"
      .commands2(50)="intern"
      .commands2(51)="int"
      .commands2(52)="isinstance"
      .commands2(53)="issubclass"
      .commands2(54)="iter"
      .commands2(55)="len"
      .commands2(56)="license"
      .commands2(57)="list"
      .commands2(58)="locals"
      .commands2(59)="long"
      .commands2(60)="map"
      .commands2(61)="max"
      .commands2(62)="memoryview"
      .commands2(63)="min"
      .commands2(64)="next"
      .commands2(65)="object"
      .commands2(66)="oct"
      .commands2(67)="open"
      .commands2(68)="ord"
      .commands2(69)="pow"
      .commands2(70)="property"
      .commands2(71)="quit"
      .commands2(72)="range"
      .commands2(73)="raw"
      .commands2(74)="input"
      .commands2(75)="reduce"
      .commands2(76)="reload"
      .commands2(77)="repr"
      .commands2(78)="reversed"
      .commands2(79)="round"
      .commands2(80)="setattr"
      .commands2(81)="set"
      .commands2(82)="slice"
      .commands2(83)="sorted"
      .commands2(84)="staticmethod"
      .commands2(85)="str"
      .commands2(86)="sum"
      .commands2(87)="super"
      .commands2(88)="tuple"
      .commands2(89)="type"
      .commands2(90)="unichr"
      .commands2(91)="unicode"
      .commands2(92)="vars"
      .commands2(93)="xrange"
      .commands2(94)="zip"
   End With
End If

If Use_Pascal=True Then
   With PLanguages(FreePascal)
      .string_=34
      .case_sensitive=False
      .comment_sign="{"
      Redim .commands(0 To 120)
      .commands(0)="absolute"
      .commands(1)="abstract"
      .commands(2)="add"
      .commands(3)="and"
      .commands(4)="array"
      .commands(5)="assembler"
      .commands(6)="asm"
      .commands(7)="as"
      .commands(8)="automated"
      .commands(9)="begin"
      .commands(10)="boolean"
      .commands(11)="break"
      .commands(12)="byte"
      .commands(13)="case"
      .commands(14)="cdecl"
      .commands(15)="char"
      .commands(16)="class"
      .commands(17)="constructor"
      .commands(18)="const"
      .commands(19)="contains"
      .commands(20)="default"
      .commands(21)="deprecated"
      .commands(22)="destructor"
      .commands(23)="dispid"
      .commands(24)="dispinterface"
      .commands(25)="div"
      .commands(26)="downto"
      .commands(27)="do"
      .commands(28)="dynamic"
      .commands(29)="else"
      .commands(30)="end"
      .commands(31)="except"
      .commands(32)="exports"
      .commands(33)="export"
      .commands(34)="external"
      .commands(35)="far"
      .commands(36)="file"
      .commands(37)="finally"
      .commands(38)="finalization"
      .commands(39)="final"
      .commands(40)="forwar"
      .commands(41)="for"
      .commands(42)="function"
      .commands(43)="goto"
      .commands(44)="if"
      .commands(45)="implementation"
      .commands(46)="implements"
      .commands(47)="interface"
      .commands(48)="index"
      .commands(49)="inherited"
      .commands(50)="initialization"
      .commands(51)="inline"
      .commands(52)="integer"
      .commands(53)="in"
      .commands(54)="is"
      .commands(55)="label"
      .commands(56)="library"
      .commands(57)="message"
      .commands(58)="mod"
      .commands(59)="name"
      .commands(60)="near"
      .commands(61)="nil"
      .commands(62)="nodefault"
      .commands(63)="not"
      .commands(64)="object"
      .commands(65)="of"
      .commands(66)="on"
      .commands(67)="or"
      .commands(68)="out"
      .commands(69)="overload"
      .commands(70)="override"
      .commands(71)="package"
      .commands(72)="packed"
      .commands(73)="pascal"
      .commands(74)="platform"
      .commands(75)="private"
      .commands(76)="procedure"
      .commands(77)="program"
      .commands(78)="property"
      .commands(79)="protected"
      .commands(80)="public"
      .commands(81)="published"
      .commands(82)="raise"
      .commands(83)="readonly"
      .commands(84)="read"
      .commands(85)="real"
      .commands(86)="record"
      .commands(87)="register"
      .commands(88)="reintroduce"
      .commands(89)="remove"
      .commands(90)="repeat"
      .commands(91)="requires"
      .commands(92)="resourcestring"
      .commands(93)="safecall"
      .commands(94)="sealed"
      .commands(95)="set"
      .commands(96)="shl"
      .commands(97)="shr"
      .commands(98)="static"
      .commands(99)="stdcall"
      .commands(100)="stored"
      .commands(101)="strict"
      .commands(102)="string"
      .commands(103)="then"
      .commands(104)="threadvar"
      .commands(105)="to"
      .commands(106)="try"
      .commands(107)="type"
      .commands(108)="unit"
      .commands(109)="unsafe"
      .commands(110)="until"
      .commands(111)="uses"
      .commands(112)="varargs"
      .commands(113)="var"
      .commands(114)="virtual"
      .commands(115)="while"
      .commands(116)="with"
      .commands(117)="word"
      .commands(118)="writeonly"
      .commands(119)="write"
      .commands(120)="xor"
   End With
End If

Dim Shared As Boolean comment
Dim Shared As UByte oldlanguage

Sub PrintCode(text As String, language As UByte=0)
   Dim As UByte strings
   If oldlanguage<>language Then
      comment=False
      oldlanguage=language
   End If   
   With PLanguages(language)
      If comment=True Then   'Multiline comments
         Color colortext_comment
         Print text;
         If Instr(Ucase(text),Ucase(.comment_sign_end)) Then comment=False
         Exit Sub
      End If
      
      For i As Integer=0 To Len(text)-1
         For i2 As Integer=0 To UBound(.commands)
            If .case_sensitive=True Then
               If Mid(text,i+1,Len(.commands(i2)))=.commands(i2) And text[i-1]<48 Then
                  Color colortext_command
                  Print Mid(text,i+1,Len(.commands(i2)));
                  i+=Len(.commands(i2))
               End If
            Else
               If Ucase(Mid(text,i+1,Len(.commands(i2))))=Ucase(.commands(i2)) And text[i-1]<48 Then
                  Color colortext_command
                  Print Mid(text,i+1,Len(.commands(i2)));
                  i+=Len(.commands(i2))
               End If
            End If
         Next
         
         For i2 As Integer=0 To UBound(.commands2)
            If .case_sensitive=True Then
               If Mid(text,i+1,Len(.commands2(i2)))=.commands2(i2) And text[i-1]<48 Then
                  Color colortext_command2
                  Print Mid(text,i+1,Len(.commands2(i2)));
                  i+=Len(.commands2(i2))
               End If
            Else
               If Ucase(Mid(text,i+1,Len(.commands2(i2))))=Ucase(.commands2(i2)) And text[i-1]<48 Then
                  Color colortext_command2
                  Print Mid(text,i+1,Len(.commands2(i2)));
                  i+=Len(.commands2(i2))
               End If
            End If
         Next
         
         If Ucase(Mid(text,i+1,Len(.comment_sign)))=Ucase(.comment_sign) And strings=0 Then
            Color colortext_comment
            Print Mid(text,i);
            Exit For
         ElseIf Ucase(Mid(text,i+1,Len(.comment_sign2)))=Ucase(.comment_sign2) And Len(.comment_sign2)<>0 And strings=0 Then
            Color colortext_comment
            Print Mid(text,i);
            Exit For
         ElseIf Ucase(Mid(text,i+1,Len(.comment_sign_start)))=Ucase(.comment_sign_start) And Len(.comment_sign_start)<>0 And strings=0 Then
            Color colortext_comment
            Print Mid(text,i);
            comment=True
            Exit For
         ElseIf (text[i]=40 Or text[i]=41 Or text[i]=123 Or text[i]=125 Or text[i]=91 Or text[i]=93 Or text[i]=61 Or text[i]=43 Or text[i]=45 Or text[i]=42 Or text[i]=47 Or text[i]=60 Or text[i]=62 Or text[i]=59 Or text[i]=44 Or text[i]=37 Or text[i]=58 Or text[i]=46 Or text[i]=64) And strings=0 Then
            Color colortext_operator
            Print Chr(text[i]);
         ElseIf text[i]=.string_ And strings=0 Then
            strings=1
            Color colortext_string
            Print Chr(text[i]);
         ElseIf text[i]=.string_ And strings=1 Then
            strings=0
            Color colortext_string
            Print Chr(text[i]);
         
         Else
            If strings=1 Then
               Color colortext_string
               Print Chr(text[i]);
            Else
               Color colortext_else
               Print Chr(text[i]);
            End If
            
         End If
         
      Next
   End With
End Sub

Sub DrawCode(x As Integer, y As Integer, text As String, language As UByte=0)
   Dim As Integer curx
   Dim As UByte strings
   If oldlanguage<>language Then
      comment=False
      oldlanguage=language
   End If   
   With PLanguages(language)
      If comment=True Then   'Multiline comments
         Draw String (x,y),text,color_comment
         If Instr(Ucase(text),Ucase(.comment_sign_end)) Then comment=False
         Exit Sub
      End If
      
      For i As Integer=0 To Len(text)-1
         For i2 As Integer=0 To UBound(.commands)
            If .case_sensitive=True Then
               If Mid(text,i+1,Len(.commands(i2)))=.commands(i2) And text[i-1]<48 Then
                  Draw String (x+curx,y),Mid(text,i+1,Len(.commands(i2))),color_command
                  curx+=Len(.commands(i2))*8
                  i+=Len(.commands(i2))
               End If
            Else
               If Ucase(Mid(text,i+1,Len(.commands(i2))))=Ucase(.commands(i2)) And text[i-1]<48 Then
                  Draw String (x+curx,y),Mid(text,i+1,Len(.commands(i2))),color_command
                  curx+=Len(.commands(i2))*8
                  i+=Len(.commands(i2))
               End If
            End If
         Next
         
         For i2 As Integer=0 To UBound(.commands2)
            If .case_sensitive=True Then
               If Mid(text,i+1,Len(.commands2(i2)))=.commands2(i2) And text[i-1]<48 Then
                  Draw String (x+curx,y),Mid(text,i+1,Len(.commands2(i2))),color_command2
                  curx+=Len(.commands2(i2))*8
                  i+=Len(.commands2(i2))
               End If
            Else
               If Ucase(Mid(text,i+1,Len(.commands2(i2))))=Ucase(.commands2(i2)) And text[i-1]<48 Then
                  Draw String (x+curx,y),Mid(text,i+1,Len(.commands2(i2))),color_command2
                  curx+=Len(.commands2(i2))*8
                  i+=Len(.commands2(i2))
               End If
            End If
         Next
         
         If Ucase(Mid(text,i,Len(.comment_sign)))=Ucase(.comment_sign) And strings=0 Then
            Draw String (x+curx-8,y),Mid(text,i),color_comment
            Exit For
         ElseIf Ucase(Mid(text,i,Len(.comment_sign2)))=Ucase(.comment_sign2) And Len(.comment_sign2)<>0 And strings=0 Then
            Draw String (x+curx-8,y),Mid(text,i),color_comment
            Exit For
         ElseIf Ucase(Mid(text,i,Len(.comment_sign_start)))=Ucase(.comment_sign_start) And Len(.comment_sign_start)<>0 And strings=0 Then
            Draw String (x+curx-8,y),Mid(text,i),color_comment
            comment=True
            Exit For
         ElseIf text[i]=.string_ And strings=0 Then
            strings=1
            Draw String (x+curx,y),Chr(text[i]),color_string
            curx+=8
         ElseIf text[i]=.string_ And strings=1 Then
            strings=0
            Draw String (x+curx,y),Chr(text[i]),color_string
            curx+=8
         ElseIf (text[i]=40 Or text[i]=41 Or text[i]=123 Or text[i]=125 Or text[i]=91 Or text[i]=93 Or text[i]=61 Or text[i]=43 Or text[i]=45 Or text[i]=42 Or text[i]=47 Or text[i]=60 Or text[i]=62 Or text[i]=59 Or text[i]=44 Or text[i]=37 Or text[i]=58 Or text[i]=46 Or text[i]=64) And strings=0 Then
            Draw String (x+curx,y),Chr(text[i]),color_operator
            curx+=8
         Else
            If strings=1 Then
               Draw String (x+curx,y),Chr(text[i]),color_string
               curx+=8
            Else
               Draw String (x+curx,y),Chr(text[i]),color_else
               curx+=8
            End If
            
         End If
         
      Next
   End With
End Sub

Print "FreeBasic:"
PrintCode(" #Include Once "+Chr(34)+"test.bi"+Chr(34),FreeBasic):Print
PrintCode(" Dim As UInteger testvar=42 'Comment",FreeBasic):Print
PrintCode(" Function testfunc (parameter As UByte) As Integer",FreeBasic):Print
PrintCode("    Print "+Chr(34)+"Hello World"+Chr(34),FreeBasic):Print
PrintCode("    Return 43",FreeBasic):Print
PrintCode(" End Function",FreeBasic):Print
Print
Color 7:Print "C:"
PrintCode(" #include <test.h>",C):Print
PrintCode(" unsigned int testvar=42; //Comment",C):Print
PrintCode(" /*int testfunc (unsigned char parameter) {",C):Print
PrintCode("    puts("+Chr(34)+"Hallo Welt"+Chr(34)+");",C):Print
PrintCode("    return 43;*/",C):Print
PrintCode(" }",C):Print
Print
Color 7:Print "Assembler:"
PrintCode(" %include "+Chr(34)+"test.asm"+Chr(34),Assembler):Print
PrintCode(" mov rax,42 ;Comment",Assembler):Print
PrintCode(" testfunc:",Assembler):Print
PrintCode("    call printf",Assembler):Print
PrintCode("    push 43",Assembler):Print
PrintCode(" ret",Assembler):Print
Sleep

ScreenRes 640,480,24
Width 640/8,480/16
Line (0,0)-(640,480),&h2d3335,BF

Draw String (5,5),"FreeBasic:"
DrawCode(10,25,"#Include Once "+Chr(34)+"test.bi"+Chr(34),FreeBasic)
DrawCode(10,40,"Dim As UInteger testvar=42 'Comment",FreeBasic)
DrawCode(10,70,"Function testfunc (parameter As UByte) As Integer",FreeBasic)
DrawCode(10,85,"   Print "+Chr(34)+"Hello World"+Chr(34),FreeBasic)
DrawCode(10,100,"   Return 43",FreeBasic)
DrawCode(10,115,"End Function",FreeBasic)

Line (5,140)-(635,140),&hffffff

Draw String (5,150),"C:"
DrawCode(10,170,"#include <test.h>",C)
DrawCode(10,185,"unsigned int testvar=42; //Comment",C)
DrawCode(10,215,"/*int testfunc (unsigned char parameter) {",C)
DrawCode(10,230,"   puts("+Chr(34)+"Hallo Welt"+Chr(34)+");",C)
DrawCode(10,245,"   return 43;*/",C)
DrawCode(10,260,"}",C)

Line (5,285)-(635,285),&hffffff

Draw String (5,295),"Assembler:"
DrawCode(10,315,"%include "+Chr(34)+"test.asm"+Chr(34),Assembler)
DrawCode(10,330,"mov rax,42 ;Comment",Assembler)
DrawCode(10,360,"testfunc:",Assembler)
DrawCode(10,375,"   call printf",Assembler)
DrawCode(10,390,"   push 43",Assembler)
DrawCode(10,405,"ret",Assembler)

Sleep
EDIT:
- Now supports multiline-comments in C, CPP, C#, Lua and FreeBasic.
- In case you only need one language in your application, you can disable the others with "Use_Pascal=False" for example
- Added the missing keywords in FreeBasic
Last edited by IchMagBier on Jan 19, 2018 3:13, edited 4 times in total.
Top
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Routines to write syntax highlighted code

Post by MrSwiss »

@IchMagBier,

welcome to the forum. It is a good job so far.

However, there is room for improvement:
  • Console Colors: I'd only use >= 7 (for readability, to dark currently)
    Console Positioning, is missing (analogue to Graphics-Functions(x, y,,) parameters)
    Graphics: currently set to 16bit but, colors defined are: (24bit) extended to 32bit,
    aka: ScreenRes(w, h, 32)
    Speed improvement: just load selected Language (to a single Type), ask at start ...
    (from a practical point of view: you don't usually mix different Languages)
    ... there is more possible (like source code loading from file etc.)
IchMagBier wrote:It doesn't support multiline-comments in C or Lua.
This clearly needs a extension of the Type (Block-Comment-End, definition).
And of course the necessary checks, in the evaluation code.
Btw: FreeBASIC also has Block-Comments [/' .... '/]
Top
lizard
Posts: 440
Joined: Oct 17, 2017 11:35
Location: Germany

Re: Routines to write syntax highlighted code

Post by lizard »

Looks really good. That kind of code i would use in my own programs. Works perfectly here on Linux Mint 18.2 .
Top
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Routines to write syntax highlighted code

Post by grindstone »

Nice work. But the initialization of the keyword arrays could be done much easier. See the freeBasic section as example:

Code: Select all

Const color_command=&h729fcf
Const color_command2=&h1e90ff
Const color_string=&hdd4040
Const color_operator=&hfcaf3e
Const color_comment=&h888a85
Const color_else=&he5e5e5

Const colortext_command=9
Const colortext_command2=1
Const colortext_string=4
Const colortext_operator=6
Const colortext_comment=8
Const colortext_else=15

Const Assembler=0
Const Bash=1
Const Batch=2
Const C=3
Const CPP=4
Const CSharp=5
Const FreeBasic=6
Const Lua=7
Const Python=8
Const FreePascal=9


Type PLanguage
   As String commands(Any)   
   As String commands2(Any)   'Preprocessor, Labels ... etc
   As Boolean case_sensitive   'C is case sensitive, FreeBasic is not
   As String comment_sign,comment_sign2
   As UByte string_
   Declare Sub SetCommands(kw As String, array() As String)
End Type

Sub pLanguage.SetCommands(kw As String, array() As String)
	Dim As Integer b = 1, e, x
		
	Do 'parse the keywords string to an array
		e = InStr(b, kw, ",")
		ReDim Preserve array(x)
		array(x) = Mid(kw, b, e - b)
		x += 1
		b = e + 1
	Loop While b < Len(kw)
	
End Sub


Dim Shared As PLanguage PLanguages(9)
Dim As String keywords

With PLanguages(Assembler)
   .string_=34
   .case_sensitive=False
   .comment_sign=";"
   Redim .commands(0 To 56)
   .commands(0)="hlt"
   .commands(1)="lad"
   .commands(2)="spi"
   .commands(3)="add"
   .commands(4)="sub"
   .commands(5)="mul"
   .commands(6)="div"
   .commands(7)="jmp"
   .commands(8)="jez"
   .commands(9)="jgz"
   .commands(10)="jlz"
   .commands(11)="swap"
   .commands(12)="jsr"
   .commands(13)="ret"
   .commands(14)="pushac"
   .commands(15)="popac"
   .commands(16)="addst"
   .commands(17)="subst"
   .commands(18)="mulst"
   .commands(19)="divst"
   .commands(20)="lsa"
   .commands(21)="lds"
   .commands(22)="push"
   .commands(23)="pop"
   .commands(24)="cli"
   .commands(25)="ldi"
   .commands(26)="ink"
   .commands(27)="lia"
   .commands(28)="dek"
   .commands(29)="ldx"
   .commands(30)="adc"
   .commands(31)="sbb"
   .commands(32)="ja"
   .commands(33)="jb"
   .commands(34)="jna"
   .commands(35)="jnb"
   .commands(36)="je"
   .commands(37)="jne"
   .commands(38)="cmp"
   .commands(39)="int"
   .commands(40)="call"
   .commands(41)="jz"
   .commands(42)="jnz"
   .commands(43)="shl"
   .commands(44)="shr"
   .commands(45)="mov"
   .commands(46)="sar"
   .commands(47)="sal"
   .commands(48)="rol"
   .commands(49)="ror"
   .commands(50)="lea"
   .commands(51)="nop"
   .commands(52)="inc"
   .commands(53)="dec"
   .commands(54)="and"
   .commands(55)="or"
   .commands(56)="xor"
   Redim .commands2(0 To 16)
   .commands2(0)="%define"
   .commands2(1)="%xdefine"
   .commands2(2)="%undef"
   .commands2(3)="%assign"
   .commands2(4)="%ifdef"
   .commands2(5)="%ifndef"
   .commands2(6)="%ifmacro"
   .commands2(7)="%if"
   .commands2(8)="%error"
   .commands2(9)="%else"
   .commands2(10)="%endif"
   .commands2(11)="%endmacro"
   .commands2(12)="%macro"
   .commands2(13)="%define"
   .commands2(14)="%elifdef"
   .commands2(15)="%define"
   .commands2(16)="%include"
End With

With PLanguages(Bash)
   .string_=34
   .case_sensitive=True
   .comment_sign="#"
   Redim .commands(0 To 23)
   .commands(0)="break"
   .commands(1)="case"
   .commands(2)="continue"
   .commands(3)="do"
   .commands(4)="done"
   .commands(5)="elif"
   .commands(6)="else"
   .commands(7)="esac"
   .commands(8)="eval"
   .commands(9)="exit"
   .commands(10)="export"
   .commands(11)="fi"
   .commands(12)="for"
   .commands(13)="function"
   .commands(14)="goto"
   .commands(15)="if"
   .commands(16)="in"
   .commands(17)="integer"
   .commands(18)="return"
   .commands(19)="set"
   .commands(20)="shift"
   .commands(21)="then"
   .commands(22)="until"
   .commands(23)="while"
End With

With PLanguages(Batch)
   .string_=34
   .case_sensitive=False
   .comment_sign="REM"
   .comment_sign2="::"
   Redim .commands(0 To 51)
   .commands(1)="set"
   .commands(2)="if"
   .commands(3)="else"
   .commands(4)="exist"
   .commands(5)="errorlevel"
   .commands(6)="for"
   .commands(7)="in"
   .commands(8)="do"
   .commands(9)="break"
   .commands(10)="call"
   .commands(11)="copy"
   .commands(12)="chcp"
   .commands(13)="cd"
   .commands(14)="chdir"
   .commands(15)="choice"
   .commands(16)="cls"
   .commands(17)="country"
   .commands(18)="ctty"
   .commands(19)="date"
   .commands(20)="del"
   .commands(21)="erase"
   .commands(22)="dir"
   .commands(23)="echo"
   .commands(24)="exit"
   .commands(25)="goto"
   .commands(26)="loadfix"
   .commands(27)="loadhigh"
   .commands(28)="mkdir"
   .commands(29)="md"
   .commands(30)="move"
   .commands(31)="path"
   .commands(32)="pause"
   .commands(33)="prompt"
   .commands(34)="rename"
   .commands(35)="ren"
   .commands(36)="rmdir"
   .commands(37)="rd"
   .commands(38)="shift"
   .commands(39)="time"
   .commands(40)="type"
   .commands(41)="ver"
   .commands(42)="verify"
   .commands(43)="vol"
   .commands(44)="com"
   .commands(45)="con"
   .commands(46)="lpt"
   .commands(47)="nul"
   .commands(48)="defined"
   .commands(49)="not"
   .commands(50)="errorlevel"
   .commands(51)="cmdextversion"
End With

With PLanguages(C)
   .string_=34
   .case_sensitive=True
   .comment_sign="//"
   .comment_sign2="/*"
   Redim .commands(0 To 49)
   .commands(0)="asm"
   .commands(1)="auto"
   .commands(2)="break"
   .commands(3)="case"
   .commands(4)="char"
   .commands(5)="const"
   .commands(6)="continue"
   .commands(7)="default"
   .commands(8)="do"
   .commands(9)="double"
   .commands(10)="else"
   .commands(11)="enum"
   .commands(12)="extern"
   .commands(13)="float"
   .commands(14)="for"
   .commands(15)="goto"
   .commands(16)="if"
   .commands(17)="inline"
   .commands(18)="int"
   .commands(19)="long"
   .commands(20)="register"
   .commands(21)="restrict"
   .commands(22)="return"
   .commands(23)="short"
   .commands(24)="signed"
   .commands(25)="sizeof"
   .commands(26)="static"
   .commands(27)="struct"
   .commands(28)="switch"
   .commands(29)="typedef"
   .commands(30)="union"
   .commands(31)="unsigned"
   .commands(32)="void"
   .commands(33)="volatile"
   .commands(34)="while"
   .commands(35)="Alignas"
   .commands(36)="Alignof"
   .commands(37)="Atomic"
   .commands(38)="Bool"
   .commands(39)="Complex"
   .commands(40)="Generic"
   .commands(41)="Imaginary"
   .commands(42)="Noreturn"
   .commands(43)="Static"
   .commands(44)="assert"
   .commands(45)="Thread"
   .commands(46)="local"
   .commands(47)="FALSE"
   .commands(48)="NULL"
   .commands(49)="TRUE"
   Redim .commands2(0 To 10)
    .commands2(0)="#include"
    .commands2(1)="#define"
    .commands2(2)="#undef"
    .commands2(3)="#if"
    .commands2(4)="#ifdef"
    .commands2(5)="#ifndef"
    .commands2(6)="#error"
    .commands2(7)="#pragma"
    .commands2(8)="#elif"
    .commands2(9)="#else"
    .commands2(10)="#endif"
End With

With PLanguages(CPP)
   .string_=34
   .case_sensitive=True
   .comment_sign="//"
   .comment_sign2="/*"
   Redim .commands(0 To 98)
   .commands(0)="alignas"
   .commands(1)="alignof"
   .commands(2)="and"
   .commands(3)="and"
   .commands(4)="eq"
   .commands(5)="asm"
   .commands(6)="auto"
   .commands(7)="bitand"
   .commands(8)="bitor"
   .commands(9)="bool"
   .commands(10)="break"
   .commands(11)="case"
   .commands(12)="catch"
   .commands(13)="char"
   .commands(14)="char16"
   .commands(15)="t"
   .commands(16)="char32"
   .commands(17)="t"
   .commands(18)="class"
   .commands(19)="compl"
   .commands(20)="const"
   .commands(21)="const"
   .commands(22)="cast"
   .commands(23)="constexpr"
   .commands(24)="continue"
   .commands(25)="decltype"
   .commands(26)="default"
   .commands(27)="delete"
   .commands(28)="do"
   .commands(29)="double"
   .commands(30)="dynamic"
   .commands(31)="cast"
   .commands(32)="else"
   .commands(33)="enum"
   .commands(34)="explicit"
   .commands(35)="export"
   .commands(36)="extern"
   .commands(37)="false"
   .commands(38)="final"
   .commands(39)="float"
   .commands(40)="for"
   .commands(41)="friend"
   .commands(42)="goto"
   .commands(43)="if"
   .commands(44)="inline"
   .commands(45)="int"
   .commands(46)="long"
   .commands(47)="mutable"
   .commands(48)="namespace"
   .commands(49)="new"
   .commands(50)="noexcept"
   .commands(51)="not"
   .commands(52)="not"
   .commands(53)="eq"
   .commands(54)="nullptr"
   .commands(55)="operator"
   .commands(56)="or"
   .commands(57)="or"
   .commands(58)="eq"
   .commands(59)="override"
   .commands(60)="private"
   .commands(61)="protected"
   .commands(62)="public"
   .commands(63)="register"
   .commands(64)="reinterpret"
   .commands(65)="cast"
   .commands(66)="return"
   .commands(67)="short"
   .commands(68)="signed"
   .commands(69)="sizeof"
   .commands(70)="static"
   .commands(71)="static"
   .commands(72)="assert"
   .commands(73)="static"
   .commands(74)="cast"
   .commands(75)="struct"
   .commands(76)="switch"
   .commands(77)="template"
   .commands(78)="this"
   .commands(79)="thread"
   .commands(80)="local"
   .commands(81)="throw"
   .commands(82)="true"
   .commands(83)="try"
   .commands(84)="typedef"
   .commands(85)="typeid"
   .commands(86)="typename"
   .commands(87)="union"
   .commands(88)="unsigned"
   .commands(89)="using"
   .commands(90)="virtual"
   .commands(91)="void"
   .commands(92)="volatile"
   .commands(93)="wchar"
   .commands(94)="t"
   .commands(95)="while"
   .commands(96)="xor"
   .commands(97)="xor"
   .commands(98)="eq"
   Redim .commands2(0 To 10)
    .commands2(0)="#include"
    .commands2(1)="#define"
    .commands2(2)="#undef"
    .commands2(3)="#if"
    .commands2(4)="#ifdef"
    .commands2(5)="#ifndef"
    .commands2(6)="#error"
    .commands2(7)="#pragma"
    .commands2(8)="#elif"
    .commands2(9)="#else"
    .commands2(10)="#endif"
End With

With PLanguages(CSharp)
   .string_=34
   .case_sensitive=True
   .comment_sign="//"
   .comment_sign2="/*"
   Redim .commands(0 To 76)
   .commands(0)="abstract"
   .commands(1)="as"
   .commands(2)="base"
   .commands(3)="bool"
   .commands(4)="break"
   .commands(5)="byte"
   .commands(6)="case"
   .commands(7)="catch"
   .commands(8)="char"
   .commands(9)="checked"
   .commands(10)="class"
   .commands(11)="const"
   .commands(12)="continue"
   .commands(13)="decimal"
   .commands(14)="default"
   .commands(15)="delegate"
   .commands(16)="do"
   .commands(17)="double"
   .commands(18)="else"
   .commands(19)="enum"
   .commands(20)="event"
   .commands(21)="explicit"
   .commands(22)="extern"
   .commands(23)="false"
   .commands(24)="finally"
   .commands(25)="fixed"
   .commands(26)="float"
   .commands(27)="for"
   .commands(28)="foreach"
   .commands(29)="goto"
   .commands(30)="if"
   .commands(31)="implicit"
   .commands(32)="in"
   .commands(33)="int"
   .commands(34)="interface"
   .commands(35)="internal"
   .commands(36)="is"
   .commands(37)="lock"
   .commands(38)="long"
   .commands(39)="namespace"
   .commands(40)="new"
   .commands(41)="null"
   .commands(42)="object"
   .commands(43)="operator"
   .commands(44)="out"
   .commands(45)="override"
   .commands(46)="params"
   .commands(47)="private"
   .commands(48)="protected"
   .commands(49)="public"
   .commands(50)="readonly"
   .commands(51)="ref"
   .commands(52)="return"
   .commands(53)="sbyte"
   .commands(54)="sealed"
   .commands(55)="short"
   .commands(56)="sizeof"
   .commands(57)="stackalloc"
   .commands(58)="static"
   .commands(59)="string"
   .commands(60)="struct"
   .commands(61)="switch"
   .commands(62)="this"
   .commands(63)="throw"
   .commands(64)="true"
   .commands(65)="try"
   .commands(66)="typeof"
   .commands(67)="uint"
   .commands(68)="ulong"
   .commands(69)="unchecked"
   .commands(70)="unsafe"
   .commands(71)="ushort"
   .commands(72)="using"
   .commands(73)="virtual"
   .commands(74)="void"
   .commands(75)="volatile"
   .commands(76)="while"
   Redim .commands2(0 To 14)
    .commands2(0)="#include"
    .commands2(1)="#define"
    .commands2(2)="#undef"
    .commands2(3)="#if"
    .commands2(4)="#ifdef"
    .commands2(5)="#ifndef"
    .commands2(6)="#error"
    .commands2(7)="#pragma"
    .commands2(8)="#elif"
    .commands2(9)="#else"
    .commands2(10)="#endif"
    .commands2(11)="#warning"
    .commands2(12)="#line"
    .commands2(13)="#region"
    .commands2(14)="#endregion"   
End With

With PLanguages(FreeBasic)
   .string_=34
   .case_sensitive=False
   .comment_sign="'"
   
   keywords = "abs,access,acos,alias,allocate,alpha,andalso,and,any,append,asc," & _
              "as,asin,asm,assertwarn,assert,atan,atn,base,beep,binary,bin," & _
              "bitset,bitreset,bit,bload,bsave,byref,byte,byval,callocate,call," & _
              "case,cast,cbyte,cdbl,cdecl,chain,chdir,chr,cint,circle,class," & _
              "clear,clngint,clng,close,cls,color,command,common,condbroadcast," & _
              "condcreate,conddestroy,condsignal,condwait,constructor,const,cons," & _
              "continue,cos,cptr,cshort,csign,csng,csrlin,cubyte,cuint,culngint," & _
              "culng,cunsg,curdir,cushort,custom,cvd,cvi,cvl,cvlongint,cvs," & _
              "cvshort,data,datevalue,dateadd,datediff,datepart,dateserial,date," & _
              "day,deallocate,declare,defbyte,defdbl,defint,deflngint,deflng," & _
              "defshort,defsng,defstr,defubyte,defuint,defulngint,defushort,delete," & _
              "destructor,dim,dir,do,double,draw,dylibfree,dylibload,dylibsymbol," & _
              "dynamic,elseif,else,encoding,endif,end,enum,environ,eof,eqv,erase," & _
              "erfn,erl,ermn,err,error,escape,exec,exepath,exit,exp,explicit," & _
              "export,extends,extern,false,fboolean,field,fileattr,filecopy," & _
              "filedatetime,fileexists,filelen,fix,flip,format,for,frac,freefile," & _
              "fre,function,getmouse,getjoystick,getkey,get,gosub,goto,hex,hibyte," & _
              "hiword,hour,if,iif,imageconvertrow,imagecreate,imagedestroy,import," & _
              "imp,inkey,input,input,inp,instrrev,instr,integer,int,interface,is," & _
              "isdate,kill,lbound,lcase,left,len,let,lib,line,lobyte,loc,local," & _
              "locate,lock,lof,log,long,longint,loop,loword,lpos,lprint,lpt," & _
              "lset,ltrim,mid,minute,mkd,mkdir,mki,mkl,mklongint,mks,mkshort," & _
              "mod,month,monthname,multikey,mutexcreate,mutexdestroy,mutexlock," & _
              "mutexunlock,name,namespace,new,next,nokeyword,not,now,object,oct," & _
              "offsetof,once,on,open,operator,option,orelse,or,output,out," & _
              "overload,paint,palette,pascal,pcopy,peek,pipe,pmap,pointer,point," & _
              "poke,pos,preserve,preset,print,private,procptr,property,protected," & _
              "pset,ptr,public,put,randomize,random,read,reallocate,redim,rem," & _
              "reset,restore,resume,return,rgba,rgb,right,rmdir,rnd,rset,rtrim," & _
              "run,sadd,scope,screenunlock,screencontrol,screencopy,screenevent," & _
              "screenglproc,screeninfo,screenlist,screenlock,screenptr,screenres," & _
              "screenset,screensync,screen,scrn,second,seek,select,setdate,setenviron," & _
              "setmouse,settime,sgn,shared,shell,shl,short,shr,sin,single,sizeof," & _
              "sleep,space,spc,sqr,static,stdcall,step,stop,string,strptr,str," & _
              "sub,swap,system,tab,tan,then,this,threadcreate,threadwait,timer," & _
              "time,timeserial,timevalue,to,trans,trim,true,type,ubound,ubyte," & _
              "ucase,uinteger,ulongint,ulong,union,unlock,unsigned,until,ushort," & _
              "using,va,arg,va,first,valulng,valuint,vallng,valint,val,va," & _
              "next,varptr,var,view,virtual,wait,wbin,wchr,weekdayname,weekday," & _
              "wend,whex,while,width,windowtitle,window,winput,with,woct,write," & _
              "wspace,wstring,wstr,xor,year,zstring,"
   .SetCommands(keywords, .commands())
   
		keywords = "#assert,#defined,#define,#elseif,#else,#endif,#endmacro,#error,#ifndef," & _
		           "#ifdef,#if,#inclib,#include,#lang,#libpath,#line,#macro,#once,#pragma," & _
		           "#print,#typeof,#undef,"
   .SetCommands(keywords, .commands2())
End With

With PLanguages(Lua)
   .string_=34
   .case_sensitive=True
   .comment_sign="--"
   .comment_sign2="--[["
   Redim .commands(0 To 20)
   .commands(0)="and"
   .commands(1)="break"
   .commands(2)="do"
   .commands(3)="else"
   .commands(4)="elseif"
   .commands(5)="end"
   .commands(6)="false"
   .commands(7)="for"
   .commands(8)="function"
   .commands(9)="if"
   .commands(10)="in"
   .commands(11)="local"
   .commands(12)="nil"
   .commands(13)="not"
   .commands(14)="or"
   .commands(15)="repeat"
   .commands(16)="return"
   .commands(17)="then"
   .commands(18)="true"
   .commands(19)="until"
   .commands(20)="while"
   Redim .commands2(0 To 55)
   .commands2(0)="ALERT"
   .commands2(1)="assert"
   .commands2(2)="call"
   .commands2(3)="collectgarbage"
   .commands2(4)="coroutine"
   .commands2(5)="debug"
   .commands2(6)="dofile"
   .commands2(7)="dostring"
   .commands2(8)="error"
   .commands2(9)="ERRORMESSAGE"
   .commands2(10)="foreach"
   .commands2(11)="foreachi"
   .commands2(12)="G"
   .commands2(13)="gcinfo"
   .commands2(14)="getfenv"
   .commands2(15)="getmetatable"
   .commands2(16)="getn"
   .commands2(17)="globals"
   .commands2(18)="INPUT"
   .commands2(19)="io"
   .commands2(20)="ipairs"
   .commands2(21)="load"
   .commands2(22)="loadfile"
   .commands2(23)="loadlib"
   .commands2(24)="loadstring"
   .commands2(25)="math"
   .commands2(26)="module"
   .commands2(27)="newtype"
   .commands2(28)="next"
   .commands2(29)="os"
   .commands2(30)="OUTPUT"
   .commands2(31)="pairs"
   .commands2(32)="pcall"
   .commands2(33)="print"
   .commands2(34)="PROMPT"
   .commands2(35)="rawequal"
   .commands2(36)="rawget"
   .commands2(37)="rawset"
   .commands2(38)="require"
   .commands2(39)="select"
   .commands2(40)="setfenv"
   .commands2(41)="setmetatable"
   .commands2(42)="sort"
   .commands2(43)="STDERR"
   .commands2(44)="STDIN"
   .commands2(45)="STDOUT"
   .commands2(46)="string"
   .commands2(47)="table"
   .commands2(48)="tinsert"
   .commands2(49)="tonumber"
   .commands2(50)="tostring"
   .commands2(51)="tremove"
   .commands2(52)="type"
   .commands2(53)="unpack"
   .commands2(54)="VERSION"
   .commands2(55)="xpcall"
End With

With PLanguages(Python)
   .string_=34
   .case_sensitive=True
   .comment_sign="#"
   Redim .commands(0 To 34)
   .commands(0)="False"
   .commands(1)="None"
   .commands(2)="True"
   .commands(3)="and"
   .commands(4)="as"
   .commands(5)="assert"
   .commands(6)="break"
   .commands(7)="class"
   .commands(8)="continue"
   .commands(9)="def"
   .commands(10)="del"
   .commands(11)="elif"
   .commands(12)="else"
   .commands(13)="except"
   .commands(14)="exec"
   .commands(15)="finally"
   .commands(16)="for"
   .commands(17)="from"
   .commands(18)="global"
   .commands(19)="if"
   .commands(20)="import"
   .commands(21)="in"
   .commands(22)="is"
   .commands(23)="lambda"
   .commands(24)="nonlocal"
   .commands(25)="not"
   .commands(26)="or"
   .commands(27)="pass"
   .commands(28)="print"
   .commands(29)="raise"
   .commands(30)="return"
   .commands(31)="try"
   .commands(32)="while"
   .commands(33)="with"
   .commands(34)="yield"
   Redim .commands2(0 To 94)
   .commands2(0)="build"
   .commands2(1)="class"
   .commands2(2)="debug"
   .commands2(3)="doc"
   .commands2(4)="import"
   .commands2(5)="loader"
   .commands2(6)="name"
   .commands2(7)="package"
   .commands2(8)="spec"
   .commands2(9)="abs"
   .commands2(10)="all"
   .commands2(11)="any"
   .commands2(12)="apply"
   .commands2(13)="ascii"
   .commands2(14)="basestring"
   .commands2(15)="bin"
   .commands2(16)="bool"
   .commands2(17)="buffer"
   .commands2(18)="bytearray"
   .commands2(19)="bytes"
   .commands2(20)="callable"
   .commands2(21)="chr"
   .commands2(22)="classmethod"
   .commands2(23)="cmp"
   .commands2(24)="coerce"
   .commands2(25)="compile"
   .commands2(26)="complex"
   .commands2(27)="copyright"
   .commands2(28)="credits"
   .commands2(29)="delattr"
   .commands2(30)="dict"
   .commands2(31)="dir"
   .commands2(32)="divmod"
   .commands2(33)="enumerate"
   .commands2(34)="eval"
   .commands2(35)="execfile"
   .commands2(36)="exit"
   .commands2(37)="file"
   .commands2(38)="filter"
   .commands2(39)="float"
   .commands2(40)="format"
   .commands2(41)="frozenset"
   .commands2(42)="getattr"
   .commands2(43)="globals"
   .commands2(44)="hasattr"
   .commands2(45)="hash"
   .commands2(46)="help"
   .commands2(47)="hex"
   .commands2(48)="id"
   .commands2(49)="input"
   .commands2(50)="int"
   .commands2(51)="intern"
   .commands2(52)="isinstance"
   .commands2(53)="issubclass"
   .commands2(54)="iter"
   .commands2(55)="len"
   .commands2(56)="license"
   .commands2(57)="list"
   .commands2(58)="locals"
   .commands2(59)="long"
   .commands2(60)="map"
   .commands2(61)="max"
   .commands2(62)="memoryview"
   .commands2(63)="min"
   .commands2(64)="next"
   .commands2(65)="object"
   .commands2(66)="oct"
   .commands2(67)="open"
   .commands2(68)="ord"
   .commands2(69)="pow"
   .commands2(70)="property"
   .commands2(71)="quit"
   .commands2(72)="range"
   .commands2(73)="raw"
   .commands2(74)="input"
   .commands2(75)="reduce"
   .commands2(76)="reload"
   .commands2(77)="repr"
   .commands2(78)="reversed"
   .commands2(79)="round"
   .commands2(80)="set"
   .commands2(81)="setattr"
   .commands2(82)="slice"
   .commands2(83)="sorted"
   .commands2(84)="staticmethod"
   .commands2(85)="str"
   .commands2(86)="sum"
   .commands2(87)="super"
   .commands2(88)="tuple"
   .commands2(89)="type"
   .commands2(90)="unichr"
   .commands2(91)="unicode"
   .commands2(92)="vars"
   .commands2(93)="xrange"
   .commands2(94)="zip"
End With

With PLanguages(FreePascal)
   .string_=34
   .case_sensitive=False
   .comment_sign="{"
   Redim .commands(0 To 120)
   .commands(0)="absolute"
   .commands(1)="abstract"
   .commands(2)="add"
   .commands(3)="and"
   .commands(4)="array"
   .commands(5)="as"
   .commands(6)="asm"
   .commands(7)="assembler"
   .commands(8)="automated"
   .commands(9)="begin"
   .commands(10)="boolean"
   .commands(11)="break"
   .commands(12)="byte"
   .commands(13)="case"
   .commands(14)="cdecl"
   .commands(15)="char"
   .commands(16)="class"
   .commands(17)="const"
   .commands(18)="constructor"
   .commands(19)="contains"
   .commands(20)="default"
   .commands(21)="deprecated"
   .commands(22)="destructor"
   .commands(23)="dispid"
   .commands(24)="dispinterface"
   .commands(25)="div"
   .commands(26)="do"
   .commands(27)="downto"
   .commands(28)="dynamic"
   .commands(29)="else"
   .commands(30)="end"
   .commands(31)="except"
   .commands(32)="export"
   .commands(33)="exports"
   .commands(34)="external"
   .commands(35)="far"
   .commands(36)="file"
   .commands(37)="final"
   .commands(38)="finalization"
   .commands(39)="finally"
   .commands(40)="for"
   .commands(41)="forward"
   .commands(42)="function"
   .commands(43)="goto"
   .commands(44)="if"
   .commands(45)="implementation"
   .commands(46)="implements"
   .commands(47)="in"
   .commands(48)="index"
   .commands(49)="inherited"
   .commands(50)="initialization"
   .commands(51)="inline"
   .commands(52)="integer"
   .commands(53)="interface"
   .commands(54)="is"
   .commands(55)="label"
   .commands(56)="library"
   .commands(57)="message"
   .commands(58)="mod"
   .commands(59)="name"
   .commands(60)="near"
   .commands(61)="nil"
   .commands(62)="nodefault"
   .commands(63)="not"
   .commands(64)="object"
   .commands(65)="of"
   .commands(66)="on"
   .commands(67)="or"
   .commands(68)="out"
   .commands(69)="overload"
   .commands(70)="override"
   .commands(71)="package"
   .commands(72)="packed"
   .commands(73)="pascal"
   .commands(74)="platform"
   .commands(75)="private"
   .commands(76)="procedure"
   .commands(77)="program"
   .commands(78)="property"
   .commands(79)="protected"
   .commands(80)="public"
   .commands(81)="published"
   .commands(82)="raise"
   .commands(83)="read"
   .commands(84)="readonly"
   .commands(85)="real"
   .commands(86)="record"
   .commands(87)="register"
   .commands(88)="reintroduce"
   .commands(89)="remove"
   .commands(90)="repeat"
   .commands(91)="requires"
   .commands(92)="resourcestring"
   .commands(93)="safecall"
   .commands(94)="sealed"
   .commands(95)="set"
   .commands(96)="shl"
   .commands(97)="shr"
   .commands(98)="static"
   .commands(99)="stdcall"
   .commands(100)="stored"
   .commands(101)="strict"
   .commands(102)="string"
   .commands(103)="then"
   .commands(104)="threadvar"
   .commands(105)="to"
   .commands(106)="try"
   .commands(107)="type"
   .commands(108)="unit"
   .commands(109)="unsafe"
   .commands(110)="until"
   .commands(111)="uses"
   .commands(112)="var"
   .commands(113)="varargs"
   .commands(114)="virtual"
   .commands(115)="while"
   .commands(116)="with"
   .commands(117)="word"
   .commands(118)="write"
   .commands(119)="writeonly"
   .commands(120)="xor"
End With

Sub PrintCode(text As String, language As UByte=0)
   Dim As UByte strings
   With PLanguages(language)
      For i As Integer=0 To Len(text)-1
         For i2 As Integer=0 To UBound(.commands)
            If .case_sensitive=True Then
               If Mid(text,i+1,Len(.commands(i2)))=.commands(i2) And text[i-1]<48 Then
                  Color colortext_command
                  Print Mid(text,i+1,Len(.commands(i2)));
                  i+=Len(.commands(i2))
               End If
            Else
               If Ucase(Mid(text,i+1,Len(.commands(i2))))=Ucase(.commands(i2)) And text[i-1]<48 Then
                  Color colortext_command
                  Print Mid(text,i+1,Len(.commands(i2)));
                  i+=Len(.commands(i2))
               End If
            End If
         Next
         
         For i2 As Integer=0 To UBound(.commands2)
            If .case_sensitive=True Then
               If Mid(text,i+1,Len(.commands2(i2)))=.commands2(i2) And text[i-1]<48 Then
                  Color colortext_command2
                  Print Mid(text,i+1,Len(.commands2(i2)));
                  i+=Len(.commands2(i2))
               End If
            Else
               If Ucase(Mid(text,i+1,Len(.commands2(i2))))=Ucase(.commands2(i2)) And text[i-1]<48 Then
                  Color colortext_command2
                  Print Mid(text,i+1,Len(.commands2(i2)));
                  i+=Len(.commands2(i2))
               End If
            End If
         Next
         
         If Ucase(Mid(text,i+1,Len(.comment_sign)))=Ucase(.comment_sign) And strings=0 Then
            Color colortext_comment
            Print Mid(text,i);
            Exit For
         ElseIf Ucase(Mid(text,i+1,Len(.comment_sign2)))=Ucase(.comment_sign2) And Len(.comment_sign2)<>0 And strings=0 Then
            Color colortext_comment
            Print Mid(text,i);
            Exit For
         ElseIf text[i]=40 Or text[i]=41 Or text[i]=123 Or text[i]=125 Or text[i]=91 Or text[i]=93 Or text[i]=61 Or text[i]=43 Or text[i]=45 Or text[i]=42 Or text[i]=47 Or text[i]=60 Or text[i]=62 Or text[i]=59 Then
            Color colortext_operator
            Print Chr(text[i]);
         ElseIf text[i]=.string_ And strings=0 Then
            strings=1
            Color colortext_string
            Print Chr(text[i]);
         ElseIf text[i]=.string_ And strings=1 Then
            strings=0
            Color colortext_string
            Print Chr(text[i]);
         
         Else
            If strings=1 Then
               Color colortext_string
               Print Chr(text[i]);
            Else
               Color colortext_else
               Print Chr(text[i]);
            End If
            
         End If
         
      Next
   End With
End Sub


Sub DrawCode(x As Integer, y As Integer, text As String, language As UByte=0)
   Dim As Integer curx
   Dim As UByte strings
   With PLanguages(language)
      For i As Integer=0 To Len(text)-1
         For i2 As Integer=0 To UBound(.commands)
            If .case_sensitive=True Then
               If Mid(text,i+1,Len(.commands(i2)))=.commands(i2) And text[i-1]<48 Then
                  Draw String (x+curx,y),Mid(text,i+1,Len(.commands(i2))),color_command
                  curx+=Len(.commands(i2))*8
                  i+=Len(.commands(i2))
               End If
            Else
               If Ucase(Mid(text,i+1,Len(.commands(i2))))=Ucase(.commands(i2)) And text[i-1]<48 Then
                  Draw String (x+curx,y),Mid(text,i+1,Len(.commands(i2))),color_command
                  curx+=Len(.commands(i2))*8
                  i+=Len(.commands(i2))
               End If
            End If
         Next
         
         For i2 As Integer=0 To UBound(.commands2)
            If .case_sensitive=True Then
               If Mid(text,i+1,Len(.commands2(i2)))=.commands2(i2) And text[i-1]<48 Then
                  Draw String (x+curx,y),Mid(text,i+1,Len(.commands2(i2))),color_command2
                  curx+=Len(.commands2(i2))*8
                  i+=Len(.commands2(i2))
               End If
            Else
               If Ucase(Mid(text,i+1,Len(.commands2(i2))))=Ucase(.commands2(i2)) And text[i-1]<48 Then
                  Draw String (x+curx,y),Mid(text,i+1,Len(.commands2(i2))),color_command2
                  curx+=Len(.commands2(i2))*8
                  i+=Len(.commands2(i2))
               End If
            End If
         Next
         
         If Ucase(Mid(text,i,Len(.comment_sign)))=Ucase(.comment_sign) And strings=0 Then
            Draw String (x+curx-8,y),Mid(text,i),color_comment
            Exit For
         ElseIf Ucase(Mid(text,i,Len(.comment_sign2)))=Ucase(.comment_sign2) And Len(.comment_sign2)<>0 And strings=0 Then
            Draw String (x+curx-8,y),Mid(text,i),color_comment
            Exit For
         ElseIf text[i]=.string_ And strings=0 Then
            strings=1
            Draw String (x+curx,y),Chr(text[i]),color_string
            curx+=8
         ElseIf text[i]=.string_ And strings=1 Then
            strings=0
            Draw String (x+curx,y),Chr(text[i]),color_string
            curx+=8
         ElseIf text[i]=40 Or text[i]=41 Or text[i]=123 Or text[i]=125 Or text[i]=91 Or text[i]=93 Or text[i]=61 Or text[i]=43 Or text[i]=45 Or text[i]=42 Or text[i]=47 Or text[i]=60 Or text[i]=62 Or text[i]=59 Then
            Draw String (x+curx,y),Chr(text[i]),color_operator
            curx+=8
         Else
            If strings=1 Then
               Draw String (x+curx,y),Chr(text[i]),color_string
               curx+=8
            Else
               Draw String (x+curx,y),Chr(text[i]),color_else
               curx+=8
            End If
            
         End If
         
      Next
   End With
End Sub

Print "FreeBasic:"
PrintCode(" #Include Once "+Chr(34)+"test.bi"+Chr(34),FreeBasic):Print
PrintCode(" Dim As UInteger testvar=42 'Comment",FreeBasic):Print
PrintCode(" Function testfunc (parameter As UByte) As Integer",FreeBasic):Print
PrintCode("    Print "+Chr(34)+"Hello World"+Chr(34),FreeBasic):Print
PrintCode("    Return 43",FreeBasic):Print
PrintCode(" End Function",FreeBasic):Print
Print
Color 7:Print "C:"
PrintCode(" #include <test.h>",C):Print
PrintCode(" unsigned int testvar=42; //Comment",C):Print
PrintCode(" int testfunc (unsigned char parameter) {",C):Print
PrintCode("    puts("+Chr(34)+"Hallo Welt!"+Chr(34)+");",C):Print
PrintCode("    return 43;",C):Print
PrintCode(" }",C):Print
Print
Color 7:Print "Assembler:"
PrintCode(" %include "+Chr(34)+"test.asm"+Chr(34),Assembler):Print
PrintCode(" mov rax,42 ;Comment",Assembler):Print
PrintCode(" testfunc:",Assembler):Print
PrintCode("    call printf",Assembler):Print
PrintCode("    push 43",Assembler):Print
PrintCode(" ret",Assembler):Print
Sleep

ScreenRes 640,480,16
Width 640/8,480/16
Line (0,0)-(640,480),&h2d3335,BF

Draw String (5,5),"FreeBasic:"
DrawCode(10,25,"#Include Once "+Chr(34)+"test.bi"+Chr(34),FreeBasic)
DrawCode(10,40,"Dim As UInteger testvar=42 'Comment",FreeBasic)
DrawCode(10,70,"Function testfunc (parameter As UByte) As Integer",FreeBasic)
DrawCode(10,85,"   Print "+Chr(34)+"Hello World"+Chr(34),FreeBasic)
DrawCode(10,100,"   Return 43",FreeBasic)
DrawCode(10,115,"End Function",FreeBasic)

Line (5,140)-(635,140),&hffffff

Draw String (5,150),"C:"
DrawCode(10,170,"#include <test.h>",C)
DrawCode(10,185,"unsigned int testvar=42; //Comment",C)
DrawCode(10,215,"int testfunc (unsigned char parameter) {",C)
DrawCode(10,230,"   puts("+Chr(34)+"Hallo Welt!"+Chr(34)+");",C)
DrawCode(10,245,"   return 43;",C)
DrawCode(10,260,"}",C)

Line (5,285)-(635,285),&hffffff

Draw String (5,295),"Assembler:"
DrawCode(10,315,"%include "+Chr(34)+"test.asm"+Chr(34),Assembler)
DrawCode(10,330,"mov rax,42 ;Comment",Assembler)
DrawCode(10,360,"testfunc:",Assembler)
DrawCode(10,375,"   call printf",Assembler)
DrawCode(10,390,"   push 43",Assembler)
DrawCode(10,405,"ret",Assembler)

Sleep
Top
Munair
Posts: 1286
Joined: Oct 19, 2017 15:00
Location: Netherlands
Contact:
Contact Munair

Re: Routines to write syntax highlighted code

Post by Munair »

grindstone wrote:Nice work. But the initialization of the keyword arrays could be done much easier.
The number of keywords are usually quite fixed. So I wouldn't redim preserve an array 400 times. I also wouldn't concatenate strings to build a single keywords string that needs to be searched for keywords and delimiters afterwards.

It is much faster and easier to use data sections and read the keywords alphabetically preceded by the number of keywords per letter. It's easier to maintain and only 25 redims are required if you want to store all keywords in a single array. (I would probably use different arrays per letter to speed up keyword lookup.)

The data section could be something like this:

Code: Select all

FreeBasic:
data 20
data "Abs", "Abstract", "Access", "ACos", "Add", "Alias", "Allocate", _
"Alpha", "And", "AndAlso", "Any", "Append", "As", "Assert", _
"AssertWarn", "Asc", "ASin", "Asm", "ATan2", "Atn"
data 13
data "Base", "Beep", "Bin", "Binary", "Bit", "BitReset", "BitSet", _
"BLoad", "Boolean", "BSave", "ByRef", "Byte", "ByVal"
Top
IchMagBier
Posts: 52
Joined: Jan 13, 2018 8:47
Location: Germany
Contact:
Contact IchMagBier

Re: Routines to write syntax highlighted code

Post by IchMagBier »

MrSwiss wrote:This clearly needs a extension of the Type (Block-Comment-End, definition).
And of course the necessary checks, in the evaluation code.
Btw: FreeBASIC also has Block-Comments [/' .... '/]
Wow, I had no idea FreeBasic supports this. This has to be some kind of secret, not even my editor(Geany) knows about this, or at least it doesn't highlight them.
I added two elements for the type: "comment_sign_start" and "comment_sign_end". I updated the example in my first post, where it uses them in the C-Code.
MrSwiss wrote:Speed improvement: just load selected Language (to a single Type), ask at start ...
Good Idea. I added the possibility to disable unneeded Languages. See my first post.
MrSwiss wrote:there is more possible (like source code loading from file etc.)
This is what I want to do in my project, but since there are more cases, where you could use this, I don't want to add a special routine for it. You could use it as a better "cat"-program on Linux, to display scripts in a game/application or to render file-previews in a file-manager.
Top
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:
Contact jj2007

Re: Routines to write syntax highlighted code

Post by jj2007 »

IchMagBier wrote:
MrSwiss wrote:Btw: FreeBASIC also has Block-Comments [/' .... '/]
Wow, I had no idea FreeBasic supports this. This has to be some kind of secret, not even my editor(Geany) knows about this, or at least it doesn't highlight them.
There is another type of block comments supported by many languages, including FreeBasic:

Code: Select all

#if 0  ' What I always wanted to write:
    This is about the simplest
    way to implement block
    comments
#endif
Top
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Routines to write syntax highlighted code

Post by MrSwiss »

IchMagBier wrote:... I don't want to add a special routine for it.
You don't have to, however, a FB routine (can be 'ordinary') to, load Text
from a File is quite handy, for such cases.

Personally, I don't usually want to have, external dependencies like 'cat'.
(no cat on WIN/DOS!)
I've just posted one, which might be useful, for such cases (see below link).
Function LoadFileText()
Top
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Routines to write syntax highlighted code

Post by grindstone »

Munair wrote:The number of keywords are usually quite fixed. So I wouldn't redim preserve an array 400 times.
With a slight modification the array will be redimmed only twice:

Code: Select all

Sub pLanguage.SetCommands(kw As String, array() As String)
	Dim As Integer b = 1, e, x
		
	ReDim array(Len(kw) / 3)
	Do 'parse the keywords string to an array
		e = InStr(b, kw, ",")
		array(x) = Mid(kw, b, e - b)
		x += 1
		b = e + 1
	Loop While b < Len(kw)
	ReDim Preserve array(x - 1)
	
End Sub
But there's no noticeabe difference in execution speed.
Munair wrote: I also wouldn't concatenate strings to build a single keywords string that needs to be searched for keywords and delimiters afterwards.
You can code the string without concatenation, but then you will get a looooooooong line that's not very readable.
Munair wrote:It is much faster and easier to use data sections...
IMHO there are multiple reasons to avoid DATA:
  • 1) Do you know how to submit a label (for RESTORE) in a sub's parameter list? If yes, please let me know, I didn't find a way to do it, yet.
    2) I doubt that the READ statement works faster than a pointer based string parser.
    3) Using a string is more flexible. You can either hardcode it or read it from an external file or (optionally) even both.
    4) And last but not least you save typing two quotation marks per keyword.
Munair wrote:I would probably use different arrays per letter to speed up keyword lookup.
If you really want to speed it up you'll have to use a linked list instead of an array. But that's a little more complicated to implement.
Top
Munair
Posts: 1286
Joined: Oct 19, 2017 15:00
Location: Netherlands
Contact:
Contact Munair

Re: Routines to write syntax highlighted code

Post by Munair »

grindstone wrote:I doubt that the READ statement works faster than a pointer based string parser.
Compare your parsing example with InStr, Redim and Mid:

Code: Select all

Do 'parse the keywords string to an array
      e = InStr(b, kw, ",")
      ReDim Preserve array(x)
      array(x) = Mid(kw, b, e - b)
      x += 1
      b = e + 1
   Loop While b < Len(kw)
to a single read statement

Code: Select all

restore FreeBasic
read n
redim array(n)
for i = 0 to n
  read array(i)
next
and then tell me how that parsing is faster, not to mention the additional arithmetics involved.
grindstone wrote:Using a string is more flexible. You can either hardcode it or read it from an external file or (optionally) even both.
You can store the data section in an include file which can be easily maintained. It is basically a one-time setup.
grindstone wrote:And last but not least you save typing two quotation marks per keyword.
As if typing should be considered when writing optimal code. As I said, it is a one-time setup. But if that is an obstacle, then you can also write a small utility that loads the list of keywords and dumps it in the right data-format to an include file. This is what I usually do (less than 10 minutes work). I cannot recall how many times I wrote converters that produced data sections. ;-)
Top
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Routines to write syntax highlighted code

Post by grindstone »

Remains the problem of passing a label as a parameter.
Top
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Routines to write syntax highlighted code

Post by MrSwiss »

grindstone wrote:Remains the problem of passing a label as a parameter.
Can't be solved, because the label is required to be, a "String-Litteral", AFAIK.

Remark:
I think it's time, to return to the topic: "write syntax highlighted code",
since it has turned into a "sideline battle", that tends to go "off topic".
Top
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Routines to write syntax highlighted code

Post by grindstone »

It's not a great issue, the RESTORE <label> could be done before calling the array setting procedure, for the DATA pointer is global.

@Munair: I compared the string parser with a DATA implementation. Reading DATAs it takes 0.01537782341577731 seconds vs. 0.0003080922873213154 seconds with the string parser. That's about 50 times faster.

@MrSwiss: I don't consider the current discussion really off topic, but I think it becomes a little going over IchMagBier's head.

@IchMagBier: If you're interested in I could try to implement your program using a linked list instead of an array. That would make it really fast (not only the creation but also the lookup function).
Last edited by grindstone on Jan 14, 2018 22:23, edited 1 time in total.
Top
Munair
Posts: 1286
Joined: Oct 19, 2017 15:00
Location: Netherlands
Contact:
Contact Munair

Re: Routines to write syntax highlighted code

Post by Munair »

grindstone wrote:Remains the problem of passing a label as a parameter.
During 30 years of programming (Quick)BASIC, I have never encountered a single case where I needed or wanted to pass a label to a procedure. The general programming practice is to load data at program startup, or to reset to the required label for the next read operation by means of an IF or SELECT CASE structure. Passing labels as parameters would seem fancy programming practice to me.

This is not meant to be a "battle", as far as I'm concerned. FreeBasic has some great programming features and I consider data sections one of them, not found in many programming languages. And since it is about storing keywords, it isn't off-topic and may add to optimization of the code as provided by the OP.

I will do a speed test on this one too. Unless FreeBASIC does clumsy data reading, it should be faster than string parsing.
Last edited by Munair on Jan 15, 2018 8:08, edited 1 time in total.
Top
sancho3
Posts: 358
Joined: Sep 30, 2017 3:22

Re: Routines to write syntax highlighted code

Post by sancho3 »

@Grindstone:
Double check that your code actually gets all the commands. My transcription in the following code is missing the last command.
I have checked it again and there is definitely a problem in that loop.
EDIT: I see now that you add a trailing , to the text string to bypass this problem.

My times do not reflect what you say. I rejigged the code to make the test fairer by pulling out the redim's inside it.

Code: Select all

dim as double atime, btime, ctime, dtime
dim as string a, b = "1,2,3,4,5,6,7,8,9,0", array()
dim as integer e, f, n

atime = timer
redim array(9)
for n as integer = 1 to 1000
	for x as integer = 0 to 9
		read array(x)
	next
next
btime = timer - atime

for x as integer = 0 to 9
	array(x) = ""
next 

ReDim array(9)
ctime = timer 
for x as integer = 1 to 1000
n = 0: f = 1
Do 
  e = InStr(f, b, ",")
  array(n) = Mid(b, f, e - f)
  n += 1
  f = e + 1
Loop While f < Len(b)
n = 0
next
dtime = timer - ctime

print btime , dtime

data "1", "2", "3", "4", "5", "6", "7", "8", "9", "0"

Code: Select all

Data statements time: 0.0003569030668586493
          Instr time: 0.004437990370206535

Thats 10x slower for the instr method.
Top
Post Reply

Return to “Sources, Examples, Tips and Tricks”