User Tools

Site Tools


examples

Table of Contents

KBasic Examples

This is a listing of various examples using small code snippets. If you would prefer to view project examples, you will have to open KBasic's IDE and run the project examples from the menu bar under Examples ⇒ KBasic Projects, as they are not listed here.

__class__.kbasic

  
  Class lordoftherings
    
    Sub test()
      Print "h"      
    End Sub 
    
    Sub gandalf()
      
      Dim s As String 
      test()
      Dim l As Label
                   
      
      If __IsClass__ Then
        s = __Class__       
      Else
        s = ""       
      End If

      Print "Gandalf is inside the class " + s
      
    End Sub    
    
  End Class
  
  
  ' main part
  CLS 
  
  Dim c As lordoftherings
  
  c = New lordoftherings
  c.gandalf()
  
  If __IsClass__ Then
    Print "inside a class"
  Else
    Print "is not inside a class!"
  EndIf
  
  Print 
  

__file__.kbasic

Print "Should print something with ../examples/kbasic/builtin/__file__.kbasic"
Print __file__

__isclass__.kbasic


Class lordoftherings
  
  Sub gandalf()
    
    Dim s As String
    
    If __IsClass__ Then
      s = "class"
    Else
      s = ""       
    End If
    
    Print "Gandalf is inside a " + s
    
  End Sub    
  
End Class


' main part

Dim c As lordoftherings

c = New lordoftherings
c.gandalf()

If __IsClass__ Then
  Print "inside a class" ' should not be printed
Else
  Print "is not inside a class"
EndIf

__islinux__.kbasic

Print "Is KBasic running on a linux machine?"

If __IsLinux__ Then
  Print "Yes"
Else
  print "No" 
End If

__ismacos__.kbasic

Print "Is KBasic running on a mac machine?"

If __IsMacOS__ Then   
  Print "Yes"
Else
  print "No" 
End If

__ismodule__.kbasic

Module lordoftherings
  
  Sub frodo()
    
    Dim s As String
    
    If __IsModule__ Then
      s = "module"
    Else
      s = ""       
    End If
    
    Print "Frodo is inside a " + s
    
  End Sub    
  
End Module


' main part

frodo()

If __IsModule__ Then
  Print "inside a module" ' should not be printed
Else
  Print "is not inside a module"
EndIf

  

__issub__.kbasic


Class lordoftherings
  
  Sub gandalf()
    
    Dim s As String
    
    If __IsSub__ Then
      s = "sub or method"
    Else
      s = ""       
    End If
    
    Print "Gandalf is inside a " + s
    
  End Sub    
  
End Class


' main part

Dim c As lordoftherings

c = New lordoftherings
c.gandalf()

If __IsSub__ Then
  Print "inside a sub or method" ' should not be printed
Else
  Print "is not inside a sub or method"
EndIf

__iswindows__.kbasic

Print "Is KBasic running on a windows machine?"

If __IsWindows__ Then
  Print "Yes"
Else
  print "No" 
End If

__line__.kbasic

Print "Should print 3"
Print "This is line " + __Line__

__module__.kbasic

Module starwars
  
  Sub luke()
    Print "Luke lives in the " + __Module__ + "-universe."     
  End Sub
  
  Sub lea()
    Print __Sub__ + " lives in the " + __Module__ + "-universe as well."     
  End Sub 
   
End Module
      
' main part
luke()
lea()

__scope__.kbasic


Class scope1

  Static Sub undersea   
    Print "Is class scope?: " + __Scope__
  End Sub
  
End Class


Module scope2
  
  Sub oversea
    Print "Is module scope?: " + __Scope__
  End Sub
  
End Module

Print "Is global scope?: " + __Scope__

scope1.undersea 
scope2.oversea()

__sub__.kbasic



Sub funnySub
  Print "Hi! I was printed inside the sub " + __Sub__   
End Sub

funnySub()

abs.kbasic

Dim value1 As Integer 
Dim value2 As Integer 


'Print Abs ( 35.5 - 100 ) 


'use ABS to find the difference
'between 2 values
value1 = 112
value2 = 178
Print "The difference is "; Abs(value1 - value2)


asc.kbasic

'
Print Asc("Bernd")






bin.kbasic

PRINT BIN$(128)

cbool.kbasic


Print CBool(8.8)

Print CBool(0)



cbyte.kbasic


Print CByte(8.8)


cdbl.kbasic


Print CDbl(8.8)


chr.kbasic

CLS

'PRINT CHR(34)
Print "My name is " + Chr(34) + "Bernd" + Chr(32 + 2)






cint.kbasic

Print CInt(30.05)

clng.kbasic


Print CLng(8.8)

cos.kbasic

Print Cos(232)


csng.kbasic


Print CSng(8.8)

exp.kbasic

Print Exp(2)


filecopy.kbasic

  
FILECOPY "c:\kbasic\examples\test\test.dat", "c:\kbasic\examples\test\test2.dat"
'FILECOPY "c:\kbasic\examples\test\test2.dat", "c:\kbasic\examples\test\test.dat"

filelen.kbasic

Print FileLen("c:\kbasic\parser.cpp")

fix.kbasic

Print Fix(33.78)

hex.kbasic

Print Hex(255)





inputbox.kbasic

Dim Msg, Titel, default2, val1

Msg = "Input value between 1 and 3"
Titel = "InputBox-Demo"
default2 = "1"



val1 = InputBox(Msg /*, Titel , default2*/ )


MsgBox("You have inputted: " + val1)
 

instr.kbasic

DIM s$

s$ = "Bernd Noetscher's KBasic"
PRINT "string position = "& INSTR(1, s$, "KBasic")


instrev.kbasic


Dim x As String, y As String

x = "This is a string"
y = "s"

Print InStRev(x, y)

lcase.kbasic

PRINT LCASE$("KBASIC")


left.kbasic

DIM src AS STRING
src = "What a nice day"
PRINT LEFT$(src, 4)




len.kbasic

Dim s As String 

s = "Bernd Noetscher's KBasic"

Print Len(s) 
''Print s.Len() 
''? "hi".Len() 

log.kbasic

PRINT LOG(675)

ltrim.kbasic


PRINT LTRIM$("  bedazzeled  ")


max.kbasic

PRINT MAX(44, 3)

mid.kbasic

OPTION OLDBASIC 


text$ = "The dog bites the cat"

text$ = MID$(text$, 10, 1)

PRINT text$


min.kbasic

PRINT MIN(45, 4)

msgbox.kbasic

Dim n



' text in richtext is possible as well
'n = MsgBox("<b>message</b> or <i>not</i>", kbOKOnly, "title text")

'n = MsgBox("message", kbOKOnly, "title text")
'n = MsgBox("message", kbOKCancel, "title text")
'n = MsgBox("message", kbAbortRetryIgnore, "title text")
'n = MsgBox("message", kbYesNoCancel, "title text")
'n = MsgBox("message", kbYesNo, "title text")
'n = MsgBox("message", kbRetryCancel, "title text")
'    
'n = MsgBox("message", kbOKOnly Or kbCritical, "title text")
'n = MsgBox("message", kbOKOnly Or kbQuestion, "title text")
'n = MsgBox("message", kbOKCancel Or kbExclamation, "title text")
'n = MsgBox("message", kbOKOnly Or kbInformation, "title text")
'    
'n = MsgBox("message", kbYesNoCancel Or kbDefaultButton1, "title text")
'n = MsgBox("message", kbYesNoCancel Or kbDefaultButton2, "title text")
'n = MsgBox("message", kbAbortRetryIgnore Or kbDefaultButton3, "title text")
'

n = MsgBox(" to save succeeding generations from the scourge of war, which twice in our lifetime has brought untold sorrow to mankind, and", kbOKOnly, "WE THE PEOPLES OF THE UNITED NATIONS DETERMINED")

now.kbasic

PRINT NOW()

nz.kbasic

 
Function test()
  Return Null   
End Function

Print "'_" + Nz(test) + "_'" ' --> ""

print.kbasic

'PRINT #1, USING "##.###  "; 12.12345

PRINT "Hello baby!"; ":-)", "----"

DIM s AS STRING = "1"
DIM s2 AS STRING = "2"
DIM s3 AS STRING = "3"
 
PRINT s, s2, s3

random.kbasic

OPTION OLDBASIC

TYPE TestRecord
    Student AS STRING * 20
    Result AS SINGLE
END TYPE

DIM meineKlasse AS TestRecord

OPEN "c:\kbasic\examples\test\ENDRESULTS.DAT" FOR RANDOM AS #1 LEN = LEN(meineKlasse)
meineKlasse.Student = "Bernd Noetscher"
meineKlasse.Result = 99
PUT #1, 1, meineKlasse
CLOSE #1

OPEN "c:\kbasic\examples\test\ENDRESULTS.DAT" FOR RANDOM AS #1 LEN = LEN(meineKlasse)
GET #1, 1, meineKlasse
PRINT "STUDENT:", meineKlasse.Student
PRINT "SCORE:", meineKlasse.Result
CLOSE #1

randomize.kbasic

OPTION OLDBASIC 
OPTION EXPLICIT OFF


RANDOMIZE TIMER
x% = INT(RND * 6) + 1
y% = INT(RND * 6) + 1
PRINT "2 throws with one dice: 1st throw ="; x%; "and 2nd throw ="; y%

replace.kbasic


DIM s = "Das ist alles was wir brauchen. Fang nochmal von vorne an." AS STRING
DIM pattern AS STRING = "vorne"
DIM replaceBy AS STRING = "hinten99999999999999999999999999"
'DIM replaceBy AS STRING = "vorne"

s = REPLACE(s, pattern, replaceBy)

PRINT s

 

right.kbasic

PRINT RIGHT$("I'm living in Germany", 7)
'PRINT RIGHT$("I'm living in Germany", LEN("Germany"))

END

rnd.kbasic

OPTION OLDBASIC
OPTION EXPLICIT OFF

RANDOMIZE TIMER
x% = INT(RND * 6) + 1
y% = INT(RND * 6) + 1
PRINT "2 turns with one dice: turn 1 ="; x%; "and turn 2 ="; y%

rtrim.kbasic

PRINT RTRIM$("  bedazzeled  ")

shell.kbasic

SHELL ("DIR")
'SHELL ("LS")

sin.kbasic

PRINT SIN(44)

space.kbasic

PRINT SPACE$(4.3 + 2)

PRINT "*" + SPACE(5) + "*"

stop.kbasic

' normally repeating endlessly, but we use stop!
DO WHILE TRUE
    
    STOP
    
LOOP


strcomp.kbasic

Dim Text1 As String, Text2 As String, Vergl As Integer


Text1 = "ABCD" : Text2 = "abcd" ' 

Vergl = StrComp(Text1, Text2, 1) ' result:0.
Print Vergl

Vergl = StrComp(Text1, Text2, 0) ' result:-1.
Print Vergl
 
Vergl = StrComp(Text2, Text1) ' result:1.
Print Vergl

string.kbasic

Dim v AS STRING = String$(23, "*")

Print v

strreverse.kbasic


DIM s = "Mondscheinsonate von Beethoven" AS STRING 
 
PRINT STRREVERSE(s) ' --> nevohteeB nov etanosniehcsdnoM

tan.kbasic

PRINT TAN(333)

trim.kbasic

PRINT TRIM$("  bedazzeled  ")


ucase.kbasic


PRINT UCASE$("kbasic")

val.kbasic

DIM s AS STRING

s = "43.8"

PRINT VAL(s)

DIM d = VAL(s)

access.kbasic

Dim TextLine As String, ff As Integer

ff = FreeFile ' next availaible filehandle

Open "c:\kbasic15\examples\test\test.txt" For Input Access Read As #ff ' open test file

Do While Not EOF(ff) ' while end of file has not been reached
   Line Input #ff, TextLine ' store next line in string
   print TextLine 
Loop

Close #ff ' close file

append.kbasic

OPTION OLDBASIC

DIM Rec1$, Rec2$   
 
CLS
 OPEN "c:\kbasic15\examples\test\LISTEN.TXT" FOR APPEND AS #1
 DO
     INPUT "   NAME:       ", Name$
     INPUT "   AGE:        ", Age$
     WRITE #1, Name$, Age$
     INPUT "More entries?"; R$
 LOOP WHILE UCASE$(R$) = "Y"
CLOSE #1

 'print file on screen
 OPEN "c:\kbasic15\examples\test\LISTEN.TXT" FOR INPUT AS #1
 CLS
 PRINT "Entries of file:": PRINT
DO WHILE NOT EOF(1)
    INPUT #1, Rec1$, Rec2$   
    PRINT Rec1$, Rec2$       
LOOP
CLOSE #1
KILL "LIST"

array.kbasic

/*
Dim A As Variant
A = Array(10,20,30)
Dim B As Variant = A
*/

Dim A As Variant
A = Array(10, 20, 30)
Dim B As Variant = Array(10, 20, 30)
B = A
B = A(1)
B(2) = A(2)



beep.kbasic

BEEP

binary.kbasic

OPTION OLDBASIC 

DIM Name$, Age$, R$, Rec1$, Rec2$



CLS
OPEN "c:\kbasic15\examples\test\LISTEN2.txt" FOR BINARY AS #1
DO
     INPUT "   NAME:       ", Name$
     INPUT "   AGE:        ", Age$
     WRITE #1, Name$, Age$
     INPUT "More entries?"; R$
LOOP WHILE UCASE$(R$) = "Y"
CLOSE #1

'print file on screen
OPEN "c:\kbasic15\examples\test\LISTEN2.txt" FOR INPUT AS #1
CLS
PRINT "Entries of file:": PRINT
DO WHILE NOT EOF(1)
    INPUT #1, Rec1$, Rec2$
    PRINT Rec1$, Rec2$       
LOOP
CLOSE #1
 

ccur.kbasic


PRINT CCUR(8.8)

cdate.kbasic


'PRINT CDATE(899999998) ' integer not allowed
PRINT CDATE("2006-12-12") ' must be like this format yyyy-mm-dd

   

chdir.kbasic

CHDIR("/home/bernd")

chdrive.kbasic

CHDRIVE "C"	' change to D:

clear.kbasic

Dim Msg

On Error Resume Next

Err.Clear
Err.Raise(6)

If Err.Number <> 0 Then
  
   Msg = "Error # " & Str(Err.Number) & " " _
       & Err.Source & Chr(10) & Err.Description
  
    Print Msg
  
End If

close.kbasic

Dim I As Integer, filename As String

For I = 1 To 3 ' repeat loop 3 times
  
  filename = "c:\kbasic\examples\test\TESTING" & I ' create filename
  Open filename For Output As #I ' open file
  Print #I, "Ein Test.", "Oder mehr?" ' write string into file

Next I

Close ' close all 3 opened files

cls.kbasic

Option OldBasic 



' CLS clearing the terminal screen
' with a new background color

Print "This is to show the CLS command"
Input "To clear the screen, press [Return]", keypressed$


' changes the background color:
Color(2, 1)
CLS 
Print "This is green text on a blue screen!"

color.kbasic

Color(14)
Print "Hi............"
Color(14, 1)
Print "Nadja......."

command.kbasic

Dim s As String

s = Command$

Print s

csrlin.kbasic

Option OldBasic 

Print Pos(0)

Input s$

Print CsrLin 

Print s$


curdir.kbasic

' Windows:
' current path of C: ist "C:\WINDOWS\SYSTEM32".
' current path of D: ist "D:\kbasic".
' C: is the active drive.
Dim path As String

path = CurDir' returns "C:\WINDOWS\SYSTEM32".
path = CurDir("C") ' returns "C:\WINDOWS\SYSTEM32".
path = CurDir("D") ' returns "D:\kbasic".

cverr.kbasic

Option OldBasic




Function doubleit (ByVal no As Variant) As Variant
  
  If IsNumeric(no) Then
    doubleit = no * 2 ' return result
  Else
    doubleit = CVErr(2001) ' return user defined error
  End If
End Function



Sub test()
  Dim k = doubleit("395.45')bernd")
  

  
  Print IsError(k) : Print k
  
End Sub



CLS

test()

date.kbasic

PRINT DATE$


dateadd.kbasic

Dim Date1 As Date
Dim Interval As String
Dim Number As Integer
Dim Msg
Interval = "m"
Date1 = InputBox("Input the date") ' #yyyy-mm-dd#
Number = Val(InputBox("Input the number of months to add"))
Msg = "New date: " & DateAdd(Interval, Number, Date1)
MsgBox Msg

datediff.kbasic


     
Dim Date1 As Date
Dim Msg
Date1 = InputBox("Input the date")
Msg = "Days till today: " & DateDiff("d", Now, Date1)
MsgBox Msg



$End
 
Dim a As Currency = 1.2
Dim b As Currency = 2.5
 
a = a + b

$End



Dim k As Date

Dim s As String

s = s + k
'Print k + s
'Print k + 99

datepart.kbasic

Dim Date1 As Date	
Dim Msg	
Date1 = InputBox("Input a date:")
Msg = "quarter: " & DatePart("q", Date1)
MsgBox Msg

dateserial.kbasic

Dim Date1
Date1 = DateSerial(1969, 2, 12)	' return Date1

datevalue.kbasic

Dim Date1
Date1 = DateValue("1979-02-03")

day.kbasic

Dim Date1, Day1
Date1 = #2006-12-12#
Day1 = Day(Date1) ' --> 12
   
        

dir.kbasic

Option OldBasic 


CLS

'file1 = Dir("C:\WINDOWS\*.INI")
'file1 = Dir("/opt/kde/*.*") ' for linux

Dim Name1 As String

Name1 = Dir("c:\kbasic15\i*" /*, kbDirectory*/ )' first entry
Do While Name1 <> "" ' loop
' If Name1 <> "." And Name1 <> ".." Then

  If (GetAttr(/*Path1 & */Name1) And kbDirectory) = kbDirectory Then
    Print "Dir --> " + Name1
  Else
    Print "File " + Name1
      
  End If
  
 'End If
 Name1 = Dir ' next entry
Loop

eof.kbasic

OPTION OLDBASIC 

DIM a$

CLS
OPEN "c:\kbasic\examples\test\TEST2.DAT" FOR OUTPUT AS #1
FOR i% = 1 TO 10
    WRITE #1, "" + i%, 2 * i%, 5 * i%
NEXT i%
CLOSE #1

OPEN "c:\kbasic\examples\test\TEST2.DAT" FOR INPUT AS #1
DO
    LINE INPUT #1, a$
    PRINT a$
LOOP UNTIL (EOF(1))

erl.kbasic

PRINT ERL

err.kbasic

Dim Msg
On Error Resume Next
Err.Clear
Err.Raise (65)
If ERR.Number <> 0 Then   
 Msg = "Error # " & Str(Err.Number) & " " _
   & Err.Source & Chr(13) & Err.Description
  Print Msg, , "Error"

End If

error.kbasic

CLS

Dim Msg2

On Error GoTo myError
'On Error Resume Next 
 
Print ""

Dim m = 0

Dim i As Integer = 3 / m

Print "yes"

End

/*
Err.Clear
Err.Raise(6, "cool-error?", "in sourcefile xyz")

If Err.Number <> 0 Then
  Msg2 = "Error # " & Str(Err.Number) & " "  & Err.Source & Chr(13) & Err.Description
  Print Msg2
End If

End 
*/

myError:
Msg2 = "myError  # " & Str(Err.Number) & "("  & Err.Source & ") " & Err.Description
Print Msg2
Print Err
Print Erl

m = 1
Resume

End 

/*
Dim Msg2

On Error Resume Next
Print ""

Err.Clear
Err.Raise(6, "cool-error?", "in sourcefile xyz")
Err.Clear
If Err.Number <> 0 Then
  Msg2 = "Error # " & Str(Err.Number) & " "  & Err.Source & Chr(13) & Err.Description
  Print Msg2
End If
 

*/

fileattr.kbasic

Dim filehandle, Mode

filehandle = 1

Open "c:\kbasic14\examples\test\liste.txt" For Append As filehandle
Mode = FileAttr(filehandle, 1) ' returns 8 (Append).

Close filehandle ' close file

filedatetime.kbasic


Print FileDateTime("c:\kbasic14\examples\test\liste.txt")

files.kbasic

FILES

fre.kbasic

PRINT FRE("")

freefile.kbasic

Dim Index1, filehandle


For Index1 = 1 To 5

  filehandle = FreeFile ' next free available file handle 

  Open "c:\kbasic\examples\test\TESTER" & Index1 & ".txt" For Output As #filehandle
  Write #filehandle, "example text."
  Close #filehandle
  
Next

get.kbasic

TYPE TestRecord
    Student AS STRING * 20
    Result AS SINGLE
END TYPE

DIM meineKlasse AS TestRecord

OPEN "c:\kbasic15\examples\test\ENDRESULTS2.DAT" FOR RANDOM AS #1 LEN = LEN(meineKlasse)
meineKlasse.Student = "Bernd Noetscher"
meineKlasse.Result = 99
PUT #1, 1, meineKlasse
CLOSE #1

meineKlasse.Student = ""
meineKlasse.Result = 0

OPEN "c:\kbasic15\examples\test\ENDRESULTS2.DAT" FOR RANDOM AS #1 LEN = LEN(meineKlasse)
GET #1, 1, meineKlasse
PRINT "STUDENT:", meineKlasse.Student
PRINT "SCORE:", meineKlasse.Result
CLOSE #1

getattr.kbasic

Dim Attr1

Attr1 = GetAttr("c:\kbasic14\examples\test\liste.txt")	

hour.kbasic

Dim dd As Date = "#2006-12-12 4:35:17"

Dim Time1, Hour1
Time1 = #4:35:17 PM#
Hour1 = Hour(Time1)
 

inkey.kbasic

CLS

Print "Press Esc, to stop ..."

Do 
Loop Until Inkey = Chr(27) '27 is the ASCII-Code for Esc.
















input.kbasic

OPTION OLDBASIC


DIM REC$

CLS
OPEN "c:\kbasic\examples\test\LISTE.TXT" FOR OUTPUT AS #1
DO
    INPUT "   NAME:       ", Name$  'input from keyboard
    INPUT "   Age:        ", Age$
    WRITE #1, Name$, Age$
    INPUT "Type a new entry"; R$
LOOP WHILE UCASE$(R$) = "Y"
CLOSE #1

'print content of file
OPEN "c:\kbasic\examples\test\LISTE.TXT" FOR INPUT AS #1
CLS
PRINT "entries of file:": PRINT
DO WHILE NOT EOF(1)
    LINE INPUT #1, REC$  
    PRINT REC$           
LOOP
CLOSE #1

input2.kbasic

Option OldBasic

Type myRecordset ' define type
 id As Integer
 Name2 As String * 20
End Type

Dim DSet1 As myRecordset, MaxSize, DSetNo 

' file with random access
Open "c:\kbasic\examples\test\file1.txt" For Random As #1 Len = Len(DSet1)
MaxSize = LOF(1) \ Len(DSet1) ' define count of records in file
For DSetNo = MaxSize To 1 Step - 1
  Seek #1, DSetNo ' set position
  
  DSet1.id = DSetNo
  DSet1.Name2= "Bernd" + DSetNo * 1000
  
  Put #1, , DSet1  ' read recordset
Next
Close #1 ' close file

' file with random access
Open "c:\kbasic\examples\test\file1.txt" For Random As #1 Len = Len(DSet1)
MaxSize = LOF(1) \ Len(DSet1) ' define count of records in file
For DSetNo = MaxSize To 1 Step - 1
 Seek #1, DSetNo  ' set position
 Get #1, , DSet1 ' read recordset
 print DSet1.Name2

Next
Close #1 ' close file

/*
Dim CharacterPos, Character1, Zeichen1

Open "c:\kbasic\examples\test\file1.txt" For Input As #1 ' open file for reading
MaxSize = LOF(1) ' define file size

For CharacterPos = MaxSize To 1 Step -1 
 Seek #1, CharacterPos ' set position
 Zeichen1 = Input(1, #1) ' read character
Next
Close #1 ' close file
*/

isarray.kbasic

Dim i[8] As Integer
Dim x As String

Print IsArray(i)
Print IsArray(x)

isboolean.kbasic

Dim x As Boolean

Print IsBoolean(x)

isbyte.kbasic

Dim i As Byte 
Dim x As String

Print IsByte(i) 
Print IsByte(x)

iscurrency.kbasic

Dim c As Currency


c = 23

Print IsCurrency(c)

isdate.kbasic

PRINT ISDATE(34)
PRINT ISDATE(#2006-12-12#)

isdouble.kbasic

Dim i As Double 
Dim x As String

Print IsDouble(i) 
Print IsDouble(x)

isempty.kbasic

Dim v As Variant
Dim n As Integer

v = Empty

Print IsEmpty(v)
Print IsEmpty(n)

v = 99

Print IsEmpty(v)

iserror.kbasic


Dim v As Variant
'Dim v As integer

v = Error 

Print IsError(v)

isinteger.kbasic

Dim i As Integer
Dim k As String

Print IsInteger(i)
Print IsInteger(k)

islong.kbasic

Dim i As Long
Dim k As String

Print IsLong(i)
Print IsLong(k)

ismissing.kbasic

Sub test(Optional k As String)
  
  If IsMissing(k) Then
    Print "k is missing"     
  Else
    Print "k: " + k     
  End If
End Sub


test()
test("hello here is k")

isnull.kbasic

Dim o As Object

o = Null

Print IsNull(o)

'
'Dim f As New Form
'
'Print IsNull(f)
'

isnumeric.kbasic

Dim v As Variant
v = 12
v = "!"

Print IsNumeric(v)
Print IsNumeric(3343.678)
Print IsNumeric("hey")

isobject.kbasic

Class t
  
End Class

Dim k As New t

Dim o As New Object
Dim z As Integer

Print IsObject(k)
Print IsObject(o)
Print IsObject(z)


isshort.kbasic

Dim i As Short 
Dim x As String

Print IsShort(i) 
Print IsShort(x)

issingle.kbasic

Dim i As Single 
Dim x As String

Print IsSingle(i) 
Print IsSingle(x)

isstring.kbasic

Dim i As Long
Dim k As String

Print IsString(i)
Print IsString(k)

isvariant.kbasic

Dim i As Variant   
Dim x As String

Print IsVariant(i) 
Print IsVariant(x)

echo.kbasic

ECHO "<HTML>"
ECHO "<HEAD>"
ECHO "<TITLE>Web pages on the fly</TITLE>"
ECHO "</HEAD>"
ECHO "<BODY>"
ECHO "<TABLE WIDTH=100% BORDER=0>"
ECHO "<TR>"
ECHO "<TD>"
ECHO "Hello World! Dynamically created HTML files...<br>"

FOR i AS INTEGER = 1 TO 100
  ECHO "i=" + i + "<br>"
    
NEXT

ECHO "</TD>"
ECHO "</TR>"
ECHO "</TABLE>"
ECHO "</BODY>"
ECHO "</HTML>"


/*
ECHO "_
<HTML>_
"<HEAD>"_
"<TITLE>Web pages on the fly</TITLE>"_
"</HEAD>"_
"<BODY>"_
"<TABLE WIDTH=100% BORDER=0>"_
"<TR>"_
"<TD>"_
"Hello World! Dynamically created HTML files..."_
"</TD>"_
"</TR>"_
"</TABLE>"_
"</BODY>"_
"</HTML>"


*/

kill.kbasic

' This deletes the file "test.xml":
KILL "c:\kbasic\examples\test\test.xml"

lineinput.kbasic




Dim text2 As String

Open "c:\kbasic14\examples\test\test.txt" For Input As #1	' open file
Do While Not EOF(1)	' loop until end of file
	Line Input #1, text2	' read line into variable
	Print text2
Loop
Close #1

ln.kbasic

PRINT LN(33)

loc.kbasic

Dim Position1, Line1$, Line2$

Open "c:\kbasic\examples\test\LISTEN.TXT" For Input As #1

Do While Not EOF(1)
 Input(#1, Line2) 
 Line1 = Line1 & Line2
 Position1 = Loc(1) 

  Print Line1; "-->"; Position1
  
Loop
Close #1

locate.kbasic

OPTION OLDBASIC


CLS
LOCATE 5, 5
row% = CSRLIN
column% = POS(0)
PRINT "position 1 (press any key)"
DO
LOOP WHILE INKEY$ = ""
LOCATE (row% + 2), (column% + 2)
PRINT "position 2"

lof.kbasic

OPTION OLDBASIC 

 
INPUT "input filename: "; f$
'f$ = "c:\capture.avi"

OPEN f$ FOR BINARY AS #1
PRINT "file len is = "; LOF(1)
CLOSE

minute.kbasic

Dim Time1, Minute1
Time1 = #4:35:17 PM#	
Minute1 = Minute(Time1)	' Minute1 contains 35.

mkdir.kbasic

MKDIR "C:\TEMP\TEST"
CHDIR "C:\TEMP"
FILES
RMDIR "TEST"

month.kbasic

Dim Date1, Month1
Date1 = #1979-02-02#
Month1 = Month(Date1)	' Month1 contains 2.
Print Month1

monthname.kbasic

Dim strMonatsname 

strMonatsname = MonthName(1)  ' January
strMonatsname = MonthName(1, True)  ' Jan

name.kbasic

NAME "old.txt" AS "new.txt"

oct.kbasic

PRINT OCT$(8)


open.kbasic

Dim TextLine As String, ff As Integer

ff = FreeFile ' next availaible filehandle

Open "c:\kbasic15\examples\test\test.txt" For Input As #ff ' open test file

Do While Not EOF(ff) ' while end of file has not been reached
   Line Input #ff, TextLine ' store next line in string
   Print TextLine 
Loop

Close #ff ' close file

open2.kbasic

Dim TextLine As String, ff As Integer

ff = FreeFile ' next availaible filehandle

' SYNTAX: OPEN mode$,[#]fileno%,file$[,recordlen%]
' mode$   "O" or "o" for output, "I" or "i" for input, "A" or "a" for append

Open "I", #ff, "c:\kbasic\examples\test\test.txt" ' open test file

Do While Not EOF(ff) ' while end of file has not been reached
   Line Input #ff, TextLine ' store next line in string
   Print TextLine 
Loop

Close #ff ' close file

output.kbasic

OPTION OLDBASIC 

 
CLS
OPEN "c:\kbasic\examples\test\LISTEN.TXT" FOR OUTPUT AS #1
DO
    INPUT "   NAME:       ", Name$  'input from keyboard
    INPUT "   Age:        ", Age$
    WRITE #1, Name$, Age$
    INPUT "Type a new entry"; R$
LOOP WHILE UCASE$(R$) = "Y"
CLOSE #1

'print content of file
OPEN "c:\kbasic\examples\test\LISTEN.TXT" FOR INPUT AS #1
CLS
PRINT "entries of file:": PRINT
DO WHILE NOT EOF(1)
    LINE INPUT #1, REC$  
    PRINT REC$           
LOOP
CLOSE #1

pos.kbasic

OPTION OLDBASIC 


PRINT POS(0)

INPUT s$

PRINT CSRLIN

PRINT s$

print2.kbasic

OPTION OLDBASIC 

DIM Name$, Age$

 
CLS

OPEN "c:\kbasic14\examples\test\LIST4.txt" FOR OUTPUT AS #1
DO
  INPUT "   NAME:       ", Name$
  INPUT "   AGE:        ", Age$
  PRINT #1, Name$, Age$   
  INPUT "More entries?"; R$
LOOP WHILE UCASE$(R$) = "Y"
CLOSE #1

pset.kbasic



OPTION OLDBASIC
OPTION EXPLICIT OFF 


FOR y% = 0 TO 200
  FOR x% = 0 TO 320
    PSET(x%, y%)
  NEXT
NEXT
 

put.kbasic

TYPE TestRecord
    Student AS STRING * 20
    Result AS SINGLE
END TYPE

DIM meineKlasse AS TestRecord

OPEN "ENDRESULTS.DAT" FOR RANDOM AS #1 LEN = LEN(meineKlasse)
meineKlasse.Student = "Bernd Noetscher"
meineKlasse.Result = 99
PUT #1, 1, meineKlasse
CLOSE #1

OPEN "ENDRESULTS.DAT" FOR RANDOM AS #1 LEN = LEN(meineKlasse)
GET #1, 1, meineKlasse
PRINT "STUDENT:", meineKlasse.Student
PRINT "SCORE:", meineKlasse.Result
CLOSE #1

KILL "ENDRESULTS.DAT"

reset.kbasic

RESET

rgb.kbasic

Dim red As Integer

red = RGB(255, 0, 0)

Print Hex(red)

rmdir.kbasic

MKDIR "C:\TEMP\TEST"
CHDIR "C:\TEMP"
FILES
RMDIR "TEST"

second.kbasic

Dim Time1, Second1
Time1 = #4:35:47 PM#	
Second1 = Second(Time1)	' Second1 contains 47

seek.kbasic

Option OldBasic

Type myRecordset ' define type
 id As Integer
 Name2 As String * 20
End Type

Dim DSet1 As myRecordset, MaxSize, DSetNo 

' file with random access
Open "c:\kbasic\examples\test\file1.txt" For Random As #1 Len = Len(DSet1)
MaxSize = 10 ' define count of records in file

For DSetNo = MaxSize To 1 Step - 1
  Seek #1, DSetNo ' set position
  
  DSet1.id = DSetNo
  DSet1.Name2 = "Bernd" + DSetNo * 1000
  
  Put #1, , DSet1  ' write recordset
Next
Close #1 ' close file


' file with random access
Open "c:\kbasic\examples\test\file1.txt" For Random As #1 Len = Len(DSet1)
MaxSize = LOF(1) \ Len(DSet1) ' define count of records in file
Print "MaxSize = " + MaxSize

For DSetNo = MaxSize To 1 Step - 1
  Seek #1, DSetNo  ' set position
  Get #1, , DSet1 ' read recordset
  
  Print DSet1.id
  'Print DSet1.Name2

Next
Close #1 ' close file




sgn.kbasic

PRINT SGN(77)

PRINT SGN(1), SGN(-1), SGN(0)    '  1  -1  0

sleep.kbasic

PRINT "Pausing 10 seconds..."
SLEEP 10
PRINT "Continue..."

spc.kbasic

PRINT "Text1"; SPC(10) "Text2"

sqr.kbasic

PRINT SQR(44)

tab.kbasic

CLS

Print "1", Tab(25) "Hio"
 
'Print "Hi", "2"

time.kbasic

PRINT TIME$

timeserial.kbasic

Dim Time1
Time1 = TimeSerial(16, 35, 17)	' in integer format --> 16:35:17

timevalue.kbasic

Dim Time1
Time1 = TimeValue("4:35:19") ' return time as date

  

typename.kbasic

Class k
   
End Class

Enum e
  o 
End Enum
  
Type t
  o As Integer
End Type
  
   
Dim kk As k
Dim ee As e
Dim tt As t
Dim ll As Label
 
Dim NullVar, Type1, StrVar As String, IntVar As Integer, CurVar As Currency
Dim ArrayVar(1 To 5) As Integer

NullVar = Null ' Null zuweisen.
'NullVar = CVERR(2)
'NullVar = Empty 
 
Type1 = TypeName(StrVar) ' returns "String".
Type1 = TypeName(IntVar) ' returns "Integer".
Type1 = TypeName(CurVar) ' returns "Currency".

Type1 = TypeName(NullVar) ' returns "Null".

Type1 = TypeName(ArrayVar) ' returns "Integer()"
 
Type1 = TypeName(kk)

Type1 = TypeName(ee) ' returns the internal id only
Type1 = TypeName(tt) ' returns the internal id only

Type1 = TypeName(ll)
  

using.kbasic

CLS

' numeric

PRINT USING "###"; 1


'PRINT USING "#####"; 12.12545 
'PRINT USING "###.##"; 12.12545 ' rounds automatically

'PRINT USING "+###"; +12.12345
'PRINT USING "+####"; -12.12345

'PRINT USING "x###x"; 12.12345
'PRINT USING "###.###"; 12.12345

'PRINT USING "$$####"; -12.12345
'PRINT USING "$$####"; -1234.12345
'PRINT USING "**####"; -12.12345
'PRINT USING "**$###"; -1.12345

'PRINT USING "$####"; -1.12345
'PRINT USING "*####"; - 1.12345

'PRINT USING "$$####"; -1.12345
'PRINT USING "####"; -12.12345

'PRINT USING "**$####-x"; -12.12345
'PRINT USING "####-x"; -12.12345
'PRINT USING "####-x"; 12.12345

'PRINT USING "+^^^^"; 12.12345 ' not allowed


'PRINT USING "**^^^^"; 290.12345
'PRINT USING "**^^^^^"; -999912.12345


'PRINT USING "##,.##"; 1.12345
'PRINT USING "##,.##"; 12.12345
'PRINT USING "##,.##"; 1234.12345
'PRINT USING "##,.##"; 123456.12345
'PRINT USING "##,.##"; 1234567.12345




' string

PRINT USING "x&x x&x"; "Hello World!", "Bernd"
'PRINT USING "x&x x&x"; "Hello World!"
'PRINT USING "x&x x&x"; "Hello World!",
'PRINT USING "x&x x&x"; "Hello World!";
'PRINT USING "x&x"; "Hello World!"
'PRINT USING "&"; "Hello World!"

'PRINT USING "_!_"; "Hello World!"

'PRINT USING "_\   \_"; "Hello World!"

'PRINT "Hello World!"

' escape code

'PRINT USING "x_&x&x"; "Hello World!"

vartype.kbasic

Dim s As String

Print VarType(s)

 

weekday.kbasic

Dim Date1, Weekday1
Date1 = #2006-05-10#
Weekday1 = Weekday(Date1)	' Weekday1 contains 4

weekdayname.kbasic


Dim sWDay As String
 
Dim n As Integer = Weekday(#2006-05-10#)

sWDay = WeekdayName(n)
 
MsgBox sWDay

write.kbasic

OPTION OLDBASIC 

DIM Name$, Age$
DIM Rec1$, Rec2$
 
CLS

OPEN "c:\kbasic\examples\test\LIST.txt " FOR OUTPUT AS #1
DO
  INPUT "   NAME:       ", Name$
  INPUT "   AGE:        ", Age$
  WRITE #1, Name$, Age$
  INPUT "More entries?"; R$
LOOP WHILE UCASE$(R$) = "Y"
CLOSE #1

'print file on screen
OPEN "c:\kbasic\examples\test\LIST.txt" FOR INPUT AS #1
CLS
PRINT "Entries of file:" : PRINT
DO WHILE NOT EOF(1)
  INPUT #1, Rec1$, Rec2$   
  PRINT Rec1$, Rec2$       
LOOP
CLOSE #1

year.kbasic

Dim Date1, Year1
Date1 = #2006-12-12#	
Year1 = Year(Date1)	' Year1 contains 1969.

class.kbasic




Class Salsa 

  Static    
    Print "Static part of class"
  End Static 
' 
'   Public Sub test()    
'     Print "test!!!"    
'   End Sub 
  
  
/*
  Private pvtFname As String 
  
  Public Property Nickname As String 

    Get
'      return pvtFname  
      print "Hi"
    End Get 

    Set ( ByVal Value As String ) 
      print "Hi"
      'pvtFname = Value
    End Set 

  End Property 

  */
End Class



Class rumba


  Private latein As Integer  
  Public englisch As String
  Dim k 
  'Public mySalsa As New Salsa 

  'PRIVATE CONST kbAccess = 0

  Public Sub dance_rumba()    
    Print "rumba!!!"
    
    'print mySalsa.var
  END SUB

'   CONSTRUCTOR rumba2()
'     PRINT "constructor"
'   END CONSTRUCTOR
' 
'   DESTRUCTOR rumba3()
'     PRINT "destructor"
'   END DESTRUCTOR

END CLASS


'Dim Emp As rumba = New rumba
DIM m AS NEW rumba

m.dance_rumba() 
'Print m.latein 
'Print m.mySalsa.var



END
$END






CLASS jive INHERITS rumba

  PUBLIC SUB test() THROWS rumba
    THROW NEW rumba
  END SUB

  PUBLIC SUB dance()

    dance_rumba()
    PRINT "dancing Bernd"

  END SUB

  FUNCTION monique(BYREF i, BYVAL h AS DOUBLE) AS INTEGER

    DIM hh AS rumba

    dance()
    latein = 0
    englisch = "Do you speak English?"

    Me.dance()
    Parent.latein = 99
    Me.latein = 99
    hh.latein = 10000

    monique = i
  END FUNCTION

END CLASS


DIM m AS NEW jive

m.dance()
m.dance_rumba()

TRY
  m.test()
CATCH (b AS rumba)
  PRINT "got you!"
END CATCH

m.test()

'm.latein = 0
'm.englisch = "Do you speak English?"

'PRINT m.monique( m, 12.2 )



class_abstract.kbasic

CLASS ABSTRACT rumba
  
  PUBLIC ABSTRACT SUB dance_rumba()

  PRIVATE latein AS INTEGER
  PUBLIC englisch AS STRING
  PRIVATE CONST kbAccess = 0

  CONSTRUCTOR rumba()     
    DIM p = 77777777
  END CONSTRUCTOR

  DESTRUCTOR rumba()     
    DIM a = 3333
  END DESTRUCTOR
  
END CLASS


CLASS jive INHERITS rumba

  CONSTRUCTOR jive()
    DIM b = 99
    FOR i AS INTEGER = 1 TO 10
      PRINT i
    NEXT
  END CONSTRUCTOR

  DESTRUCTOR jive()
    DIM a = 888
  END DESTRUCTOR
 
  PUBLIC SUB dance_rumba()
    PRINT "rumba!!!"
  END SUB

END CLASS



DIM m AS VARIANT

m = NEW jive
' m = NEW rumba ' this line would cause an error, because the class is declared as abstract

'PRINT ISNULL(m)

class_array.kbasic

'Dim o As New face
'Print o.mind2


' class example

Class body

  Public mind2 As Integer
  Static Public brain2 As Integer

  Constructor body()     
    Print "body.Constructor!!!!"
    mind2 = 1979
  End Constructor

  Destructor body()        
    Print "body.Destructor!!!!"     
  End Destructor
    
  Constructor body(n As Integer)     
    Print "body22.Constructor!!!!"
    mind2 = n       
  End Constructor
   
  Sub cry()     
    Print "body.cry"
    mind2 = 777
  End Sub
 
  Static Sub smile()   
    Print "body.smile"     
  End Sub
  
  Static
    Print "body::Class static code block!!!!"            
    'face.brain = 1 ' not accessable forwardly inside static code block of class
  End Static
  
End Class


Class face Inherits body
  
  Type class_type
    a As Integer
    b[10] As Integer    
  End Type
  
    
  Public mind[10] As class_type
  
  Static Public brain As Integer
  
  
  Constructor face()
   ' Parent.body(99999)   ' call directly parent constructor with other arguments  
    Print "Constructor!!!!"     
  End Constructor
  
  Destructor face
    Print "Destructor!!!!"            
  End Destructor
  
  Static
    Print "face::Class static code block!!!!"            
    Dim i As Integer     
    i = 99
    brain = 123456789
    brain2 = 66666666
  End Static
  
  Static Sub smile()   
    Print "smile"     
  '  mind = 77  ' instance variable not accessable by static method
  End Sub
  
  Sub laugh()
    Print "laugh"
  End Sub

  Sub cry()     
    Print "cry"
    mind[3].b[5] = 99
    
    
    Me.mind[3].b[5] = 88
    
    
    mind2 = 11111
    Parent.mind2 = 88      
    
'    body.smile() ' allowed: static method called inside instance method
'    'face.smile()' allowed: static method called inside instance method

    'Me.laugh()     
    'Parent.cry()
    
  End Sub
  
End Class



'body.smile()
face.smile()
'l.smile() ' variable name not allowed to access static method; use class name instead
 


'Dim l As face
'l = New face

Dim l As New face

l.laugh()
l.cry()

'Print "l.mind = " + l.mind
Print l.mind[3].b[5]

l.mind[3].b[5] = l.mind[3].b[5] + 1

Print l.mind[3].b[5]

'l = Null ' release object of l

class_array2.kbasic

'Dim o As New face
'Print o.mind2


' class example

Class body

  Public mind2 As Integer
  Static Public brain2 As Integer

  Constructor body()     
    Print "body.Constructor!!!!"
    mind2 = 1979
  End Constructor

  Destructor body()        
    Print "body.Destructor!!!!"     
  End Destructor
    
  Constructor body(n As Integer)     
    Print "body22.Constructor!!!!"
    mind2 = n       
  End Constructor
   
  Sub cry()     
    Print "body.cry"
    mind2 = 777
  End Sub
 
  Static Sub smile()   
    Print "body.smile"     
  End Sub
  
  Static
    Print "body::Class static code block!!!!"            
    'face.brain = 1 ' not accessable forwardly inside static code block of class
  End Static
  
End Class


Class face Inherits body
  
  Type class_type
    a As Integer
    b[10] As Integer     
  End Type
  
    
  Public mind[10] As class_type
  Static Public brain As Integer
  
  
  Constructor face()
   ' Parent.body(99999)   ' call directly parent constructor with other arguments  
    Print "Constructor!!!!"     
  End Constructor
  
  Destructor face
    Print "Destructor!!!!"            
  End Destructor
  
  Static
    Print "face::Class static code block!!!!"            
    Dim i As Integer     
    i = 99
    brain = 123456789
    brain2 = 66666666
  End Static
  
  Static Sub smile()   
    Print "smile"     
  '  mind = 77  ' instance variable not accessable by static method
  End Sub
  
  Sub laugh()
    Print "laugh"
  End Sub

  Sub cry()     
    Print "cry"
    mind[3].b[5] = 99
    Me.mind[3].b[5] = 88
    
    mind2 = 11111
    Parent.mind2 = 88      
    
'    body.smile() ' allowed: static method called inside instance method
'    'face.smile()' allowed: static method called inside instance method

    'Me.laugh()     
    'Parent.cry()
    
  End Sub
  
End Class



'body.smile()
face.smile()
'l.smile() ' variable name not allowed to access static method; use class name instead
 


'Dim l As face
'l = New face

Dim l As New face

l.laugh()
l.cry()

'Print "l.mind = " + l.mind
Print l.mind[3].b[5]
l.mind[3].b[5] = l.mind[3].b[5] + 1
Print l.mind[3].b[5]

'l = Null ' release object of l

class_classvar.kbasic

'Dim o As New face
'Print o.mind2


' class example

Class body

  Type class_type2
    a As Integer
    b[10] As Integer     
  End Type

  Public mind3[10] As class_type2

  Public mind2 As Integer
  Static Public brain2 As Integer

  Constructor body()     
    Print "body.Constructor!!!!"
    mind2 = 1979
  End Constructor

  Destructor body()        
    Print "body.Destructor!!!!"     
  End Destructor
    
  Constructor body(n As Integer)     
    Print "body22.Constructor!!!!"
    mind2 = n       
  End Constructor
   
  Sub cry()     
    Print "body.cry"
    mind2 = 777
  End Sub
 
  Static Sub smile()   
    Print "body.smile"     
  End Sub
  
'  Static
'    Print "body::Class static code block!!!!"            
'    'face.brain = 1 ' not accessable forwardly inside static code block of class
'  End Static
  
End Class


Class face 'Inherits body
  
  Type class_type
    a As Integer
    b[10] As Integer     
  End Type
  
    
  'Public mind[10] As class_type
  Public mind4[10] As body
  'Static Public brain As Integer
     
  
  Constructor face()
   ' Parent.body(99999)   ' call directly parent constructor with other arguments  
    Print "Constructor!!!!"     
  End Constructor
  
  Destructor face
    Print "Destructor!!!!"            
  End Destructor
  
'  Static
'    Print "face::Class static code block!!!!"            
'    Dim i As Integer     
'    i = 99
'    brain = 123456789
'    'brain2 = 66666666
'  End Static
  
  Static Sub smile()   
    Print "smile"     
  '  mind = 77  ' instance variable not accessable by static method
  End Sub
  
  Sub laugh()
    Print "laugh"
  End Sub

  Sub cry()     
    Print "cry"
    mind4[1].mind3[4].b[3] = 9
    
    'mind[3].a = 99
'    mind[3].b[5] = 99
'    Print mind[3].b[5]
    
    'Me.mind[3].b[5] = 88
    
    'mind2 = 11111
    'Parent.mind2 = 88      
    
'    body.smile() ' allowed: static method called inside instance method
'    'face.smile()' allowed: static method called inside instance method

    'Me.laugh()     
    'Parent.cry()
    
  End Sub
  
End Class



'body.smile()
'face.smile()
'l.smile() ' variable name not allowed to access static method; use class name instead
 


'Dim l As face
'l = New face

Dim l[10] As face
l[4] = New face

'l[4].cry()

l[4].mind4[1] = New body

'l[4].mind4[1].cry()

l[4].cry()

l[4].mind4 [1].mind3 [4].b[3] = l[4].mind4 [1].mind3 [4].b[3] + 91

Print l[4].mind4[1].mind3[4].b[3]

/*


'l[4].laugh()
l[4].cry()

l[4].mind[3].b[5] = 88
Print l[4].mind[3].b[5]

l[4].mind[3].b[5] = l[4].mind[3].b[5] + 1
Print l[4].mind[3].b[5]

'l[4] = Null ' release object of l

*/

class_destructor.kbasic

'Dim o As New face
'Print o.mind2


' class example

Class body

  Type class_type2
    a As Integer
    b[10] As Integer     
  End Type

  Public mind3[10] As class_type2

  Public mind2 As Integer
  Static Public brain2 As Integer

  Constructor body()     
    Print "body.Constructor!!!!"
    'mind2 = 1979
  End Constructor
  
  Destructor body()        
    Print "body.Destructor!!!!"     
  End Destructor
    
  Constructor body(n As Integer)     
    Print "body22.Constructor!!!!"
   ' mind2 = n       
  End Constructor
   
  Sub cry()     
    Print "body.cry"
   ' mind2 = 777
  End Sub
 
  Static Sub smile()   
    Print "body.smile"     
  End Sub
  
'  Static
'    Print "body::Class static code block!!!!"            
'    'face.brain = 1 ' not accessable forwardly inside static code block of class
'  End Static
  
End Class


Class face Inherits body
  
  Type class_type
    a As Integer
    b[10] As Integer     
  End Type
  
    
  'Public mind[10] As class_type
  Public mind4[10] As body
  'Static Public brain As Integer
     
  
  Constructor face()
   ' Parent.body(99999)   ' call directly parent constructor with other arguments  
    Print "Constructor!!!!"     
  End Constructor
  
  Destructor face
    Print "Destructor!!!!"            
  End Destructor
  
'  Static
'    Print "face::Class static code block!!!!"            
'    Dim i As Integer     
'    i = 99
'    brain = 123456789
'    'brain2 = 66666666
'  End Static
  
  Static Sub smile()   
    Print "smile"     
  '  mind = 77  ' instance variable not accessable by static method
  End Sub
  
  Sub laugh()
    Print "laugh"
  End Sub

  Sub cry()     
    Print "cry"
    mind4[1].mind3[4].b[3] = 69
    
    'mind[3].a = 99
'    mind[3].b[5] = 99
'    Print mind[3].b[5]
    
    'Me.mind[3].b[5] = 88
    
    'mind2 = 11111
    'Parent.mind2 = 88      
    
'    body.smile() ' allowed: static method called inside instance method
'    'face.smile()' allowed: static method called inside instance method

    'Me.laugh()     
    'Parent.cry()
    
  End Sub
  
End Class



'body.smile()
'face.smile()
'l.smile() ' variable name not allowed to access static method; use class name instead
 


'Dim l As face
'l = New face

Dim l[10] As face
l[4] = New face
l[4] = null
End

'Public mind4[10] As body
  
l[4].mind4[1] = New body
l[4].mind4[1] = Null

End

l[4].cry()
'l[4].mind4[1].cry()

l[3] = l[4]


l[4].mind4[1].mind3[4].b[3] = 9
Print l[4].mind4[1].mind3[4].b[3]

/*

'l[4].laugh()
l[4].cry()

l[4].mind[3].b[5] = 88
Print l[4].mind[3].b[5]

l[4].mind[3].b[5] = l[4].mind[3].b[5] + 1
Print l[4].mind[3].b[5]

'l[4] = Null ' release object of l

*/

class_method_overriding.kbasic


' class example
Class being

  Constructor being()     
    Print "being.Constructor!!!!"
  End Constructor

  Sub cry()     
    Print "being.cry"
  End Sub
 
End Class


Class body Inherits being
  
  Constructor body()     
    Print "body.Constructor!!!!"
  End Constructor
     
  Sub cry()     
    Print "body.cry"
  End Sub
    
End Class


Class face Inherits being      
  
  Constructor face()
    Print "face.Constructor!!!!"     
  End Constructor
  
  Sub cry()     
    Print "face.cry"
  End Sub
  
End Class


Dim l[10] As being

l[3] = New being
l[4] = New face
l[5] = New body

' polymorphism
l[3].cry()
l[4].cry()
l[5].cry()

/*
If l[3] Is l[4] Then
  Print "H"
  
End If

*/

class_null.kbasic



' class example

Class body

  Type class_type2
    a As Integer
    b[10] As Integer     
  End Type

  Public mind3[10] As class_type2

  Public mind2 As Integer
  Static Public brain2 As Integer

  Constructor body()     
    Print "body.Constructor!!!!"
    'mind2 = 1979
  End Constructor
  
  Destructor body()        
    Print "body.Destructor!!!!"     
  End Destructor
    
  Constructor body(n As Integer)     
    Print "body22.Constructor!!!!"
   ' mind2 = n       
  End Constructor
   
  Sub cry()     
    Print "body.cry"
   ' mind2 = 777
  End Sub
 
  Static Sub smile()   
    Print "body.smile"     
  End Sub
  
'  Static
'    Print "body::Class static code block!!!!"            
'    'face.brain = 1 ' not accessable forwardly inside static code block of class
'  End Static
  
End Class


Class face 'Inherits body
  
  Type class_type
    a As Integer
    b[10] As Integer     
  End Type
  
    
  'Public mind[10] As class_type
  Public mind4[10] As body
  'Static Public brain As Integer
     
  
  Constructor face()
   ' Parent.body(99999)   ' call directly parent constructor with other arguments  
    Print "Constructor!!!!"     
  End Constructor
  
  Destructor face
    Print "Destructor!!!!"            
  End Destructor
  
'  Static
'    Print "face::Class static code block!!!!"            
'    Dim i As Integer     
'    i = 99
'    brain = 123456789
'    'brain2 = 66666666
'  End Static
  
  Static Sub smile()   
    Print "smile"     
  '  mind = 77  ' instance variable not accessable by static method
  End Sub
  
  Sub laugh()
    Print "laugh"
  End Sub

  Sub cry()     
    Print "cry"
    mind4[1].mind3[4].b[3] = 69
    
    'mind[3].a = 99
'    mind[3].b[5] = 99
'    Print mind[3].b[5]
    
    'Me.mind[3].b[5] = 88
    
    'mind2 = 11111
    'Parent.mind2 = 88      
    
'    body.smile() ' allowed: static method called inside instance method
'    'face.smile()' allowed: static method called inside instance method

    'Me.laugh()     
    'Parent.cry()
    
  End Sub
  
End Class



'body.smile()
'face.smile()
'l.smile() ' variable name not allowed to access static method; use class name instead
 


'Dim l As face
'l = New face

Dim l[10] As face
l[4] = New face

'Public mind4[10] As body
  
l[4].mind4[1] = New body
l[4].mind4[1] = Null

End

l[4].cry()
'l[4].mind4[1].cry()

l[3] = l[4]


l[4].mind4[1].mind3[4].b[3] = 9
Print l[4].mind4[1].mind3[4].b[3]

/*


'l[4].laugh()
l[4].cry()

l[4].mind[3].b[5] = 88
Print l[4].mind[3].b[5]

l[4].mind[3].b[5] = l[4].mind[3].b[5] + 1
Print l[4].mind[3].b[5]

'l[4] = Null ' release object of l

*/

class_parent_constructor_call_explicit.kbasic

Class movies
  
  Protected sMovieName As String   
  
  Sub printName     
    print sMovieName
  End Sub
  
  Constructor movies(s As String)
    sMovieName = s
  End Constructor
  
End Class


Class movies2 Inherits movies

  Constructor movies2(ByRef s As String)
    Parent.movies(s + "2")
    
  End Constructor
    
End Class

Dim k As Integer = 9

Dim m As New movies2("final fantasy")

m.printName()


class_parent_constructor_call_implicit.kbasic

Class movies
  
  Protected sMovieName As String   
  
  Sub printName     
    print sMovieName
  End Sub
  
  Constructor movies(ByRef s As String)
    sMovieName = s 
  End Constructor
  
End Class


Class movies2 Inherits movies

  Constructor movies2(ByRef s As String)
    sMovieName = "?"
  End Constructor
    
End Class

Dim k As Integer = 9

Dim m As New movies2("final fantasy")

m.printName()

class_parent_constructor_call_implicit2.kbasic

Class movies
  
  Protected sMovieName As String   
  
  Protected Sub printName     
    print sMovieName
  End Sub
  
  Constructor movies(ByRef s As String)
    sMovieName = s 
  End Constructor
  
End Class


Class movies2 Inherits movies

  Public h As Integer

  Constructor movies2(ByRef s As String)
  End Constructor
  
  Sub test
    printName()     
  End Sub
    
End Class

Dim k As Integer = 9

Dim m As New movies2("final fantasy")

'Print m.h

m.test()
'm.printName() ' would cause an error


class_polymorphism.kbasic


' class example
Class being

  Constructor being()     
    Print "being.Constructor!!!!"
  End Constructor

  Sub cry()     
    Print "being.cry"
  End Sub

   
End Class


Class body Inherits being
  
  Constructor body()     
    Print "body.Constructor!!!!"
  End Constructor
     
  Sub cry()     
    Print "body.cry"
  End Sub
    
End Class


Class face Inherits being      
  
  Constructor face()
    Print "face.Constructor!!!!"     
  End Constructor
  
  Sub cry()     
    Print "face.cry"
  End Sub
  
End Class


Dim l[10] As being

l[3] = New being
l[4] = New face
l[5] = New body

' polymorphism
l[3].cry()
l[4].cry()
l[5].cry()






class_static_block.kbasic

' @filepic kde.jpg
' BTW demonstrates loading docu pic...

Class Salsa 
 
  Static 
    Print "Static part of class" 
  
  End Static 

  Public Sub test ( ) 
    Print "test!!!" 
  End Sub 

  Private pvtFname As String 
  
End Class

class_switched.kbasic

 
' class example


Class face Inherits body
    
  Public mind As Integer
  Static Public brain As Integer
  
  
  Constructor face()
    Print "Constructor!!!!"     
  End Constructor
  
  Destructor face
    Print "Destructor!!!!"            
  End Destructor
  
  Static
    Print "face::Class static code block!!!!"            
    Dim i As Integer     
    i = 99
    brain = 123456789
  End Static
  
  Static Sub smile()   
    Print "smile"     
  '  mind = 77  ' instance variable not accessable by static method
  End Sub
  
  Sub laugh()
    Print "laugh"
   ' Me.mind = 88
  End Sub

  Sub cry()     
    Print "cry"
    mind = 99
    mind2 = 11111
    brain2 = 66666666
  End Sub
  
End Class


Class body

  Public mind2 As Integer
  Static Public brain2 As Integer

  Constructor body()
    Print "body.Constructor!!!!"     
  End Constructor
  
  Sub cry()     
    Print "body.cry"
    mind2 = 777
  End Sub

  Static
    Print "body::Class static code block!!!!"            

  End Static
  
End Class


'CLS

face.smile()
'End

'Dim l As face
'l = New face
Dim l As New face

l.laugh()
l.cry()


'l.smile() ' not allowed use class name instead
 

class_switched2.kbasic



Class b
  
  Dim v As Integer
  
End Class




Class a Inherits b
    
  Sub t()
    
    Dim k As Integer = Parent.v
    
  End Sub    
    
End Class

class_switched3.kbasic



Class a Inherits b
    
  Sub t()
    
    Dim k As Integer = Parent.v
    Print k
    
  End Sub    
'    
End Class


Class b
  
  Public v As Integer
  
End Class

Dim aa As New a
aa.v = 99
aa.t

class_type.kbasic

 
  
  
Class Dict
  
  Type node 
    item As Integer 
    info As Integer
  End Type

  Public a As node
  
  Constructor Dict()
    a.item = 1234
    a.info = 6789
  End Constructor
  
  Destructor Dict()
    Print "Dict destructor" 
  End Destructor
  
End Class

Dim d As New Dict   

CLS

Print d.a.item; d.a.info


End

array.kbasic



Type book  
  bkname As String * 100  
  isbn(1000) As Integer  
End Type

Type address
  books(10) AS book
  age(100) As Integer  
  Names As String * 1000
  a As book   
End Type


Dim j(1 To 10) As address


j(5).age(99) = 123
Print j[5].age[99]

j(6).a.isbn(10) = 1000
Print j(6).a.isbn(10)

j[5].books[3].bkname = "isn't it funny"
Print j(5).books(3).bkname
print j(5).Names

'j(8).nn(99) + j(1).a.isbn(10)

'PRINT LBOUND(j, 1)

array2.kbasic


TYPE aa
  'v AS VARIANT
  bkname AS STRING * 100
  isbn(1000) AS INTEGER
  
  

END TYPE

TYPE book
  nn(100) AS INTEGER
  a AS aa
END TYPE

DIM j(10) AS book
DIM m(100) AS INTEGER
DIM n AS INTEGER

m(11) = 44
 

'j(3).nn(99) = 123
'j(1).a.isbn(10) = 1000
'j(2).nn(1) = j(3).nn(99) + j(1).a.isbn(10)
'm = m
'm(1) = m
'm = m(1)
'm(1) = m(1)
'm = 111

j(5) = j(5)
'j = j(5)
'j(5) = j
'j = j
'j = 111

j(3).nn(5) = 77

j(3).nn(99) = 5

n = j(3).nn( j(3).nn(99) )






j(6).nn(88) = 10
'j = j(3)
'DIM j(10, 5, 7), m(100, 20) AS book

'$END
'DIM n = 4 AS INTEGER
n = 4
j(n).a.isbn(6) = 888


j(  j(5).a.isbn(66)  ).a.isbn(99) = 99
'j(n).a.isbn(99) = 99 'j(n).a.isbn(3)
'PRINT j(n).a.isbn(6)




DIM g AS book

g.a.bkname = "Bernd Noetscher"
g.a.isbn(5) = 12

array3.kbasic



Type Point3D
  Coord(1 To 4) As Single ' Original coordinates.
  Trans(1 To 4) As Single ' Translated coordinates.
End Type


Const Xmin = -10
Const Xmax = 15
Const Ymin = -10
Const Ymax = 15
Dim Points(Xmin To Xmax, Ymin To Ymax) As Point3D


For x As Integer = Xmin To Xmax  
  For y As Integer = Ymin To Ymax
    Points(x, y).Coord(1) = y ' X coordinate.
  Next
Next
For x = Xmin To Xmax  
  For y = Ymin To Ymax
    print Points(x, y).Coord(1)
  Next
Next


$End


Dim k[0 To 2, 0 To 10] As Integer

k[1, 5] = 9


For y As Integer = 0 To 2
  For x As Integer = 0 To 5
    k[y, x] = x
  Next
Next

CLS

For y = 0 To 2
  For x = 0 To 5
    Print "y" + y + "x" + x + "=" + k[y, x]
    
  Next
Next


'k[15, 51] = 6
'k[15, 52] = 7





CLS
Print k[15, 50] :
Print k[15, 51]
Print k[15, 52]

/*


Dim k[10 To 55, 0 To 88, 10] As Integer

k[15, 50, 5] = 5 : k[15, 50, 6] = 600
k[15, 51, 6] = 6
k[15, 52, 7] = 7

Print k[15, 50, 5] : Print k[15, 50, 6]

Print k[15, 51, 6]
Print k[15, 52, 7]
*/


'Dim k[ - 10 To 100, 0 To 100] As Integer
'
'k[ - 5, 50] = 99














'Points(-5, -5).Coord(1) = 111

benchmark.kbasic

For i As Integer = 1 To 1000
  Print "hello" + i   
Next

cast.kbasic

Option OldBasic 

a% = CINT(12)
b& = CLNG(12)
c! = CSNG(12)
d# = CDBL(12)
'e@ = CCUR(12)
f = CBOOL(12)
g = CBYTE(12)
'h = CDATE(12)

comment.kbasic

Rem 
'   This is yet another test ' c = 3.14

Rem This is another test ' a = 4

Print "The end!" ' another rem here!



'End Rem definitely the end


  Dim n As Integer
  Dim s As String 
  


  /**  
  this is a documentation comment
  
  */ Print "Hi"
  

/*
this is mulitlinecomment

*/ Print "Hi"

Print "Hi again"
   
/*
s = "to be or not to be"


n = 200
*/


REM n = 9999

Rem n fkdjfalksjfd

'fdnklfsflsgdngndl dflyjvn

REM This is a test of REM ' x = 2

Print "Gloria in exelsis deo."

constructor.kbasic

CLASS rumba


  PRIVATE latein AS INTEGER
  PUBLIC englisch AS STRING
  Dim k 

  'PRIVATE CONST kbAccess = 0

  PUBLIC SUB dance_rumba()
    PRINT "rumba!!!"
   ' RETURN
    
    Print "1!!!" 
    Print "2!!!" 
    Print "3!!!" 
    'print mySalsa.var
  END SUB

   CONSTRUCTOR rumba()
     PRINT "constructor"
   END CONSTRUCTOR
  
   DESTRUCTOR rumba()
     PRINT "destructor"
   END DESTRUCTOR

END CLASS

DIM r AS NEW rumba
r.dance_rumba()
r = NULL

  
  

currency_literal.kbasic


DIM c AS Currency
c = 21.56@

PRINT c

debug.kbasic

Dim b As Boolean = True

Dim s As String = "What"

Dim n1 As Byte = 88
Dim n2 As Short = 666
Dim n3 As Integer = 777
Dim n4 As Long = 333


Dim si As Single = 67.8
Dim d As Double = 367.8
  
Dim v As Variant

v = d

v = 67
v = "Gut"

s = s

destructor.kbasic


CLASS rumba

  PRIVATE latein AS INTEGER
  PUBLIC englisch AS STRING

  PUBLIC SUB dance_rumba()
    Print "rumba!!!" 
  END SUB

   CONSTRUCTOR rumba()
     PRINT "constructor"
   END CONSTRUCTOR
  
  DESTRUCTOR rumba()'s AS INTEGER)    
     PRINT "destructor"
   END DESTRUCTOR

END CLASS
  
  
DIM r AS NEW rumba
r.dance_rumba()


r = NULL

dim.kbasic

' without 'As TYPE' means always 'As Variant'

Dim A, B As Integer ' --> A As Variant, B As Integer


Dim A2 As Integer, B2 As Integer ' --> A2 As Integer, B2 As Integer


Dim A3 As Integer, B3 ' --> A3 As Integer, B3 As Variant
 

dll.kbasic

' DLL USING (old style)
' Warning! If you use predeclared DECLARE statements of VB6, be aware
' that the size of the datatypes differs between VB6 and KBasic,
' namely Long in VB6 must be Integer in KBasic! You have to change it.


Declare Function GetComputerName Lib "kernel32" Alias _
"GetComputerNameA"(ByVal lpBuffer As String, nSize As Integer) As Integer
       
Dim Buffer As String
Dim compname As String
Dim Ret As Integer
Buffer = Space(255)

Dim n As Integer = Len(Buffer)
      

 
Ret = GetComputerName(Buffer, n)
If Ret > 0 Then compname = Left(Buffer, n)
  
Print "name of your computer: " + compname + " : " + n


/*
       
Dim Buffer[50] As String
Dim compname As String
Dim Ret As Long
Buffer[25] = Space(255)
'Buffer = "he"
Dim n As Integer = Len(Buffer[25])
      
Buffer[24] = "hi"
 
Ret = GetComputerName(Buffer[25], n)
If Ret > 0 Then compname = Left(Buffer[25], n)
  
Print "name of your computer: " + compname + " : " + n
Print Buffer[24]


*/

dll2.kbasic

' DLL USING (old style)
' Warning! If you use predeclared DECLARE statements of VB6, be aware
' that the size of the datatypes differs between VB6 and KBasic,
' namely Long in VB6 must be Integer in KBasic! You have to change it.

' WARNING! This program will work as expected, when you compile it to exe and then 
' run the exe, because the started program 'edit' here won't appear on screen, if not
 

'zunächst die benötigten API-Deklarationen
     
 
Private Declare Function CloseHandle Lib "kernel32" _
  (ByVal hObject As Integer) As Integer
     
Private Declare Function OpenProcess Lib "kernel32"_
  (ByVal dwDesiredAccess As Integer,_
  ByVal bInheritHandle As Integer,_
  ByVal dwProcessId As Integer) As Integer

Private Declare Function WaitForSingleObject Lib _
  "kernel32"(ByVal hHandle As Integer,_
  ByVal dwMilliseconds As Integer) As Integer

Private Const INFINITE = &HFFFF
Private Const SYNCHRONIZE = &H100000

'Warten bis Anwendung beendet
Public Sub AppStartAndWait(ByVal sFile As String)

  'Parameterbeschreibung
  'sFile:  Anwendung, die gestartet werden soll
 
  Dim lHandle As Integer
  Dim lRet As Integer
  Dim lRetVal As Integer

  
    
  lRetVal = Shell(sFile)
      
 
  lHandle = OpenProcess(SYNCHRONIZE, 0, lRetVal)
  If lHandle <> 0 Then
    
    
    lRet = WaitForSingleObject(lHandle, INFINITE)
    
    
    CloseHandle (lHandle)
  End If
  
End Sub


AppStartAndWait("edit")
   


dll3.kbasic


' DLL USING (old style)
' Warning! If you use predeclared DECLARE statements of VB6, be aware
' that the size of the datatypes differs between VB6 and KBasic,
' namely Long in VB6 must be Integer in KBasic! You have to change it.

  

Private Declare Function ExitWindowsEx Lib "user32"(ByVal uFlags As Integer,_
dwReserved As Integer) As Integer

Private Const EWX_FORCE = 4
Private Const EWX_LOGOFF = 0
Private Const EWX_REBOOT = 2
Private Const EWX_SHUTDOWN = 1
Private Const EWX_POWEROFF = 8

 
  Dim Retval As Integer, MsgResult As Integer

  MsgResult = MsgBox("Would you like to restart your computer now?",_
  kbQuestion + kbYesNo, "Restart")
  
  If MsgResult = kbYes Then
    Retval = ExitWindowsEx(EWX_LOGOFF, 0)
    If Retval = 0 Then MsgBox "Restarting " & _
    "failed.", kbInformation
  End If 
 
 Retval = Retval

dll4.kbasic

 
' DLL USING (old style)
' Warning! If you use predeclared DECLARE statements of VB6, be aware
' that the size of the datatypes differs between VB6 and KBasic,
' namely Long in VB6 must be Integer in KBasic! You have to change it.

Private Declare Function ChooseColor_Dlg Lib "comdlg32.dll" Alias "ChooseColorA"_
(lpcc As CHOOSECOLOR_TYPE) As Integer
  
Type CHOOSECOLOR_TYPE
  lStructSize As Integer
  hwndOwner As Integer
  hInstance As Integer
  rgbResult As Integer
  lpCustColors As Integer
  flags As Integer
  lCustData As Integer
  lpfnHook As Integer
  lpTemplateName As String
End Type
  
' Anwender kann alle Farben wählen
Const CC_ANYCOLOR = &H100
' Nachrichten können "abgefangen" werden
Const CC_ENABLEHOOK = &H10
' Dialogbox Template
Const CC_ENABLETEMPLATE = &H20
' Benutzt Template, ignoriert aber den Template-Namen
Const CC_ENABLETEMPLATEHANDLE = &H40
' Vollauswahl aller Farben anzeigen
Const CC_FULLOPEN = &H2
' Deaktiviert den Button zum Öffnen der Dialogbox-Erweiterung
Const CC_PREVENTFULLOPEN = &H4
' Vorgabe einer Standard-Farbe
Const CC_RGBINIT = &H1
' Hilfe-Button anzeigen
Const CC_SHOWHELP = &H8
' nur Grundfarben auswählbar
Const CC_SOLIDCOLOR = &H80
   
 
Dim CC_T As CHOOSECOLOR_TYPE, Retval As Integer
Dim BDF(16) As Integer

'Dim k As String
'CC_T.lpTemplateName = AddressOf(k)

'CC_T.lpTemplateName = "fdgfg"
'Print CC_T.lpTemplateName
 
'Einige Farben vordefinieren (Benutzerdefinierte Farben)
BDF(0) = RGB(255, 255, 255)
BDF(1) = RGB(125, 125, 125)
BDF(2) = RGB(90, 90, 90)
 
'Print Len(CC_T) 'Strukturgröße
With CC_T
  .lStructSize = Len(CC_T) 'Strukturgröße
  .hInstance = 0'App.hInstance    'Anwendungs-Instanz
  .hwndOwner = 0 'Me.hWnd 'Fenster-Handle
  .flags = CC_RGBINIT Or CC_ANYCOLOR Or CC_FULLOPEN Or _
    CC_PREVENTFULLOPEN 'Flags
  .rgbResult = RGB(0, 255, 0)      'Farbe voreinstellen
  .lpCustColors = AddressOf(BDF(0)) 'Benutzerdefinierte Farben zuweisen
End With

Retval = ChooseColor_Dlg(CC_T) 'Dialog anzeigen
  
  
 
If Retval <> 0 Then
  Print Hex$(CC_T.rgbResult) 'gewählte Farbe als Hintergrund setzen
Else
  MsgBox "Das Auswählen einer Farbe ist fehlgeschlagen," & _
  "oder Sie haben Abbrechen gedrückt", kbCritical, "Fehler"
End If

doevents.kbasic

DOEVENTS

doloopuntil.kbasic

DIM n = 0 AS INTEGER
DIM b = FALSE AS BOOLEAN

DO

  n = n + 1
  IF n = 4 THEN b = TRUE
  PRINT n   

LOOP UNTIL b = TRUE

doloopwhile.kbasic

DIM x = 0 AS DOUBLE, p = 1.9 AS INTEGER
DIM n = 0 AS INTEGER, ms = 9.9 AS INTEGER
DIM mddd = 8989, fff = 9 AS INTEGER
DIM b = TRUE AS BOOLEAN


'b = TRUE
DO
  
  DIM mmm AS BOOLEAN

  n = n + 1
  IF n = 4 THEN EXIT LOOP

' ITERATE LOOP

  PRINT n


LOOP WHILE b

PRINT b

END


'b = TRUE
DO
  n = n + 1
  IF n = 4 THEN b = FALSE   
  PRINT n
LOOP WHILE b

PRINT b

STOP

dountilloop.kbasic

DIM n AS INTEGER
DIM i AS INTEGER
DIM b AS BOOLEAN

b = FALSE
DO UNTIL b
  n = n + 1
  IF n = 4 THEN b = TRUE
  
  PRINT n   

LOOP


STOP

dowhileloop.kbasic

DIM n AS INTEGER
DIM b AS BOOLEAN





b = TRUE
DO WHILE b
  n = n + 1
  IF n = 4 THEN b = FALSE
  PRINT n
  
LOOP


DIM i AS INTEGER

empty.kbasic

' this kbasic program contains no lines except this comment and many empty lines, to test how the scanner and parser acts on such a situation





empty2.kbasic



error.kbasic

' using the error

ERROR 4 ' throw an error

'PRINT ERR
'PRINT ERL

exit_do.kbasic

CLS

Dim b As Boolean
Dim g As Boolean

Dim n As Integer = 0
Dim k As Integer = 0


b = True

Do While b
  
  g = True

  n = n + 1
  Print "n = " + n   
  If n = 3 Then b = False
  
/* 
  Do While g
    k = k + 1
    Print k     
    If k >= 4 Then Exit Do
  '  If k >= 3 Then g = False     
  Loop
  */
  /*
  Do 
    k = k + 1
    Print k     
    If k >= 4 Then Exit Do
  '  If k >= 3 Then g = False     
  Loop Until g = False   
*/
/*
  Do 
    k = k + 1
    Print k     
    If k >= 4 Then Exit Do
  '  If k >= 3 Then g = False     
  Loop while g
*/
  Do until g = false
    k = k + 1
    Print k     
    If k >= 4 Then Exit Do
  '  If k >= 3 Then g = False     
  Loop 
  
Loop

expression.kbasic

Option OldBasic
Option Explicit Off


CLS

Dim e As Integer 

e = 59
PRINT 8 + e

'$END

PRINT 0 * (2 ^ 2) + 1 * (2 ^ 1) + 1 * (2 ^ 0)
   
'$END


PRINT "a" >= "b"

'$END

p = (ii + 6) * 34 + 9

INPUT "say something: ", add$


n% = 99
s$ = "1" + ("" + n% + "2 is shown to me: "  + 23.56 ) + add$

PRINT s$

d = 55
b = 66
u = d + b

s$ = "kkkkkk"



' test type check


s = "Hours: "

'n = n + s ' throws an error
'n = s

s = s + n

'$END

'TYPE address
' name AS STRING
'END TYPE

'DIM j AS address

's = s + j.name

IF 12.234 = 12 + 0.234 THEN
 'PRINT "it's equal :-)"
ENDIF


DIM y AS DOUBLE


n = 1 + (0 + (2 + 3) * (4 + 5))
n = 1 * (2 + 3)
n = (2 + 3) * 1
n = (2 + 3) * (4 * 5)
n = 1 * (2 + 3) * (4 - 5)
n = 1 - (2 + 3) * 4
n = 1 * (2 + 3) * 4
n = 1 + (3 - 4 + 5 * 6)

n = 1 + 2 - (3 - 4 + 5 * 6)
n = &Hff - &H01 + &H100

n = +(1 + 2 - (3 * (4 + 5) * 6))
n = 1 * 2 + 3 + 4 * 5
n = 1 + 2 + 3 - 4 - 5
n = 1 + 2 * 3 * 4 / 5 * 6

y = 1 = 2 + 4 AND 4 * 5
'y = (12 * )  2
'y = 12 (*)  2

$END

DIM uu = "Bernd" AS STRING
DIM gg = "Bern" AS STRING
DIM i = &b1111 OR &b10000 AS INTEGER

'PRINT gg + uu
'PRINT gg

' PRINT NOT (12 * 2)

'PRINT NOT 12 * 2
i = NOT NOT NOT NOT NOT (12 * 2)

'uu = (12 * (8))
'uu = NOT y
'uu = y + NOT y
'uu = y + NOT (y)
'uu = y + (NOT y)
'uu = y + NOT (NOT y)

'IF uu = gg + "d" AND NOT (NOT y - i) THEN
' LOCATE 5, 13
' PRINT uu
'ENDIF



$END

FOR y = 1 TO 7
' COLOR y
' PRINT uu
NEXT


'uu = "Input your name: " & uu & " Noetscher"

'string1$ = "Hello world\n"      ' Test escape sequence
'string2$ = "He said,""Hello"""   ' He said,"Hello" is equivalent using 2 double-quotes
'string3$ = "He said,Hello"  ' He said,"Hello" is equivalent using escape sequence
'string4$ = "He said," & chr$(34) & "Hello" & chr$(34)  ' He said,"Hello" is equivalent

$END

expression2.kbasic

Dim n As Integer

n = 1 + 55 And 55
Print n

expression3.kbasic

Dim i As Integer

Dim k As String = "What a nice day!"
Print k.Len()

i = 100 + .5

If (i > 5) Or (i + 3) Then
  
  Print "1"
  
End If

fornext.kbasic

CLS

FOR i AS INTEGER = 1 TO 10

 PRINT "i = " + i

NEXT


'$END





DIM z# ' test something
DIM y#
DIM n AS INTEGER

FOR z# = 1 TO 2 STEP 1

 FOR y# = 1 TO 10
  
  PRINT "y# = " + y#
  
  IF y# = 5 THEN EXIT FOR
  n = 99
  PRINT "n = " + n
 NEXT

NEXT

n = 100


$END


fornext2.kbasic

OPTION VERYOLDBASIC

FOR i = 200 TO 100 STEP -2
  PRINT "The nifty numeral is now:"; i
NEXT i

PRINT i

function_return.kbasic

Option OldBasic

CLS

Function nadja(ByRef h As Double) As Integer
       
  'Print "h = " + h
  h = h + 99
  
  'Return h + 1000
  
  nadja = h
  
  ' insert always automatically a hidden return line

End Function


Dim m = 1 As Integer

m = nadja(25)
nadja(25)


Print "m = " + m

function_return_2ndcall.kbasic

'Option OldBasic

CLS

Function nadja(ByRef h As Double) As Integer
  
'  h = h + 99
'       
'  Print "h = " + h
  
  'Exit Function
  
  'nadja = h + 99
  Return h + 99

   
  ' insert always automatically a hidden return line

End Function


Dim m = 1 As Integer

'm = 
Print nadja(m)

Print "m = " + m


gosub.kbasic

OPTION VERYOLDBASIC

FOR i% = 1 TO 20
    GOSUB square
NEXT i%
END

square:
PRINT i% * i%

RETURN

goto.kbasic

DIM b AS INTEGER
DIM n AS INTEGER

b = 45
GOTO bernd
b = 99999
bernd:

n = 0
ok:
n = n + 1
PRINT "n = " + n
IF n < 5 THEN GOTO ok

goto2.kbasic

Sub t
  ' ex cannot be used inside the sub, must be at the same level of scope
  ' jump outside sub not allowed
  'GoTo ex ' would case an error

End Sub


t()

End

ex:
Print "ex reached"

hallo_bernd.kbasic

CLS
Locate 11, 11
Print "Hallo Berfnd :-)"

hello.kbasic

 

' ------------------------------------------------------------------
'
'
'  Dear KBasic user!
'
'
'  Thank you for your interest in trying out KBasic. 
'  This is the free Personal Editon. If you are
'  interested in the Professional version without ads and more
'  features, just visit www.kbasic.com.
'
'                                                  ****
'  Enjoy it!                                  *     *     *
'                                            *     ****     *
'                                           *   ***********  *
'  Best Regards,                            *    *********   *
'   Bernd Noetscher                         *     *******   *
'                                            *    *     * **
'                                              *         **
'                                                  ****
'
'
'  Hit the [run/play button] to start your first kbasic program
'
' ------------------------------------------------------------------


' program beginning

CLS
Print "Hello World!"
Print
Print                                  
Print "                / `._      .      .      _.' \"
Print "              '.@ = `.     \     /     .' = @.'"
Print "               \ @`.@ `.    \   /    .' @.'@ / "
Print "                \;`@`.@ `.   \ /   .' @.'@`;/  "
Print "                 \`.@ `.@ `'.(*).'` @.' @.'/   "
Print "                  \ '=._`. @ :=: @ .'_.=' /    "
Print "                   \ @  '.'..'='..'.'  @ /     "
Print "                    \_@_.==.: = :.==._@_/      "
Print "                    /  @ @_.: = :._@ @  \      "
Print "                   /@ _.-'  : = :  '-._ @\     "
Print "                  /`'@ @ .-': = :'-.@ @`'`\    "
Print "                  \.@_.=` .-: = :-. `=._@./    "
Print "                    \._.-'   '.'   '-._./      "
Print
Print "... did your first kbasic program!"

' program ending

if.kbasic

DIM j AS INTEGER = 6
DIM i = 4 AS INTEGER
DIM n AS INTEGER

IF i = 5 THEN n = 66: n = 55
IF i = 4 THEN n = 77: n = 99
'IF i = 4 THEN : n = 4: n = 10

'$END

IF i <> 1 THEN:  n = 11111: ENDIF

IF i <> 1 THEN
  n = 11111 : n = 9
ELSEIF i = 2 * 10 THEN
  n = 22222
ELSE
  n = 33333
ENDIF

IF i <> 1 THEN
  n = 11111
END IF

PRINT "i = " + i
PRINT "n = " + n
 

$END

DIM nReturn AS INTEGER
nReturn = (-.5) + (-1) + 99
nReturn = (-(+5 - -1) * -2) * 4 / -4

END


DIM x,y AS INTEGER


' must be MSC_ID_INTEGER
DIM integer__%
' must be MSC_ID_DOUBLE
DIM double__#
' must be MSC_ID_SINGLE
DIM single__!
' must be MSC_ID_STRING
DIM string__$
' must be MSC_ID_LONG
DIM long__&

long__& = 12

double__& = 10 / 3
double__& = 10 \ 3 ' integer division!

'single__! = 10.10!
double__# = 22.22#
string__$ = "kbasic"
integer__% = 123434%
'long__& = 2134&

END



x=1
y=1
y = x AND y

END


DIM b AS BOOLEAN
DIM t AS SINGLE
DIM ll AS LONG
DIM aa AS LONG

DIM b1=1, b2=0 AS BOOLEAN

ll = 234
aa = 99
t = 2.8

IF b1 OR b2 AND ll THEN
'IF ll = 234 AND t = 2.8 THEN
 aa = 123456
ENDIF

b = false

END

DIM n AS INTEGER
DIM i AS INTEGER
DIM x AS INTEGER

i = &O4

IF i <> 1 THEN n = 11111  ELSE n = 33333

print i

IF i = 1 THEN
n = 11111
ELSEIF i = 2 THEN
n = 22222
ELSEIF i = 3 THEN
n = 33333
ELSEIF i = 4 THEN
n = 44444
ELSE
n = 55555
ENDIF


END

i = 20


i = 20

IF i <> 1 THEN
  n = 11111
ELSEIF i = 2 * 10 THEN
  n = 22222
ELSE
  n = 33333
ENDIF

'FOR i = 1 TO 10
'   n = 123
'NEXT


DIM bRet AS BOOLEAN
DIM b AS BOOLEAN
DIM nReturn AS INTEGER
'GOTO ok
bRet = TRUE
'ok:
b = 45




'nReturn = 5 - 1 * (2 * 4) * 7 / 8
nReturn = ((+5 - -1) * -2) * 4 / -4 + 9 * 88 - 88
'nReturn = (-.5) + (-1) + 6
'nReturn = 4 + 5 * 6
4000 n = +10 * +8
8000 n = TRUE
9000 nReturn = 4 + 5 MOD 2
' IF i = 10 THEN
'   PRINT i
' ENDIF

iif.kbasic

DIM s AS STRING
DIM i AS INTEGER
i = 2
s = IIF(i = 1, "Der Menschen Hörigkeit", "Casanova")

PRINT s

isarray2.kbasic

Dim a = 1, b, c = 5
Dim d(10), e(55)

Dim array1(1 To 5) As Integer, array2, Test1
array2 = Array(1, 2, 3)

Test1 = IsArray(array1) ' returns True.
Print Test1

Test1 = IsArray(array2) ' returns True.
Print Test1

isempty2.kbasic

DIM v AS VARIANT
PRINT ISEMPTY(v)

iserror2.kbasic

Function Benutzerfunktion()
  Dim v = Error   
  Return v 
End Function


Dim result, Test1
result = Benutzerfunktion()
Test1 = IsError(result) ' return true.

ismissing2.kbasic

Option OldBasic

Dim result

result = doubleit() ' returns 0.
Print result

result = doubleit(2) ' returns 4.
Print result

 
Function doubleit(Optional ByVal A)
  
  If IsMissing(A) Then
    ' if no argument, then return 0
    doubleit = 0
  Else
    ' if argument, then return double value
    doubleit = A * 2
  End If

End Function

isnull2.kbasic

DIM v AS VARIANT
DIM f AS Form

v = NULL

PRINT "v = " + ISNULL(v)

PRINT "f = " + ISNULL(f)

isnumeric2.kbasic

PRINT ISNUMERIC(67)

isobject2.kbasic

DIM m AS OBJECT
PRINT ISOBJECT(m)

kbasic_binding.kbasic

/*  TODO2
Sub l_Click(m As Mouse)
  Print "hi"   
End Sub
*/
 

 

Dim f As New Form
' 
f.X = 120
f.Y = 120
f.Width = 333
f.Height = 320
f.Caption = "A form generated by a kbasic program at runtime"


Dim l As New Label(f)

l.BackImage = "c:\kbasic\ide\9.jpg"
l.Caption = "Hi"
l.X = 12
l.Y = 33


Dim kk As CheckBox
kk = New CheckBox(f)
kk.Value = True
  
Dim a As New TextArea(f)
a.Value = "<h1>This is a <u>textarea</u>...</h1>"
a.X = 120
a.Y = 33
a.Width = 333
a.Height = 320

Dim ll As New TextBox(f)
ll.Value = "Hi"
ll.X = 53

Dim k As New ProgressBar(f)
k.Y = 133

  



f.Open()

a.SetFocus()

Do While True  
  For i As Integer = 1 To 1000
    l.Caption = i
    k.Value = i / 10
   

  Next
Loop

 

label.kbasic

DIM b AS INTEGER
DIM n AS INTEGER


b = 45
GOTO goout
b = 999999999
goout:


n = 0
ok:
n = n + 1
IF n < 5 THEN GOTO ok

line.kbasic

'SCREEN 12
'LINE (110, 70)-(190, 120), , B
'LINE (0, 0)-(302, 200), 3, , &HFF00
CLS

LINE(0, 0) - (302, 200), 14

macro.kbasic

CLASS rumba

  PRIVATE latein AS INTEGER
  PUBLIC englisch AS STRING
  DIM k 
  PRIVATE CONST kbAccess = 0

  PRIVATE SUB Class_Initialize()
    DIM b = 99
  END SUB

  PUBLIC SUB dance_rumba()
    PRINT "rumba!!!"

    PRINT "__LINE__ = " + __LINE__     
    PRINT "__MODULE__ = " + __MODULE__
    PRINT "__SCOPE__ = " + __SCOPE__
    PRINT "__CLASS__ = " + __CLASS__
    PRINT "__SUB__ = " + __SUB__

  END SUB

END CLASS

CLS

DIM m AS NEW rumba


m.dance_rumba()


PRINT 
PRINT "Press Esc, to stop ..."
DO
LOOP UNTIL INKEY$ = CHR$(27)    '27 is the ASCII-Code for Esc.
 


module.kbasic

MODULE einkauf

  PUBLIC m AS INTEGER

END MODULE


MODULE verkauf

  DIM m2 AS INTEGER
  PRIVATE m3 AS INTEGER   

END MODULE

'm3 = 45
m = 77
m2 = 99

Print m 
Print m2 
Print einkauf.m 
Print verkauf.m2 

ongosub.kbasic

Option OldBasic

Sub OnGosubGotoDemo()
Dim dday, Text1
 dday = 2

 On dday GoSub Sub1, Sub2 

 On dday GoTo row1, row2

 Exit Sub
Sub1:
 Text1 = "In Sub1" : Return
Sub2:
 Text1 = "In Sub2" : Return
row1: 
 Text1 = "In row1"
row2: 
 Text1 = "In row2"

End Sub


OnGosubGotoDemo()

ongosub2.kbasic

OPTION OLDBASIC

 FOR i% = 1 TO 2
    On i% GoSub Eins, Zwei
    
 NEXT i%
 END

Eins: Print "Eins"

 RETURN
 Zwei: PRINT "Zwei"
 RETURN

ongoto.kbasic

DIM i% 

 FOR i% = 1 TO 2
     ON i% goto Eins, Zwei
 NEXT i%
 END

 Eins: PRINT "Eins"
end
 Zwei: PRINT "Zwei"
end

ontimer.kbasic

OPTION VERYOLDBASIC

ON TIMER(1) GOSUB TimeUpdate

TIMER ON
CLS
PRINT "Zeit: "; TIME$
DIM Start = TIMER
DIM Past

WHILE Past < 10
    Past = TIMER - Start
WEND
END


TimeUpdate:
     LOCATE 1, 8: PRINT TIME$
     RETURN

operator.kbasic

Dim b As Boolean 

  
b = TRUE AndAlso FALSE AndAlso FALSE
'b = FALSE OrElse TRUE
Print b


'Dim i As Integer 
'i = 1 SHL 4
'i = 1 << 4
'i = 1 SHR 4
'i = 1 >> 4
'i++
'INC(i)
'DEC(i)
'i--
'i += 5
'i -= 7
'i /= 8
'i *= 7
'i |= 7
'i &= 8
'i = 1 BITAND 5
'i = 1 BITOR 5
'i = 1 BITXOR 5
'i = 1 BITNOT 5
'i = i + 1
'i = i - 1
'i = i * 1
'i = i / 1
'i = i MOD 1
'i = i = 1
'i = i <> 1
'i = i <= 5
'i = i > 5
'i = i < 5
'i = i AND 5
'i = 1 OR 2
'i = NOT TRUE
'i = 2 ^ 8
'PRINT "i: " & i
'i = 1 XOR 4
'i = 9 \ 6
'i = i EQV 2
'i = i IMP 5 

option.kbasic

' There are several OPTION expressions defined for Basic (option range, option base, option explicit, option compare...)
OPTION OLDBASIC
  
OPTION EXPLICIT OFF ' turn off 
'OPTION EXPLICIT ON ' turn on


i$ = "Heyoi"

paramarray.kbasic


Function monique(ByRef i As Integer, ByVal h As Double, ParamArray b() As Variant) As Integer   
    
  If LBound(b) < UBound(b) Then
    
    For i = LBound(b) To UBound(b)       
      Print b(i)     
    Next i
    
  End If

  Return i

End Function


CLS

Dim m = 12 As Integer

'Print monique(h := 12.2, i := m)
'Print monique(m, 12.2)
'monique(m, 12.2, 1, 2, 3, 4, 5, 6)
monique(m, 12.2, 1, 2, 3, 4, 5, 6)
Print "m = " + m





performance.kbasic


Dim i As Integer


For i = 1 To 1000
  Print i
Next


CLS
Locate 3 , 75
Print "123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890"

private_sub.kbasic

Class movies
  
  Private sMovieName As String
  
  Private Sub printName     
    print sMovieName
  End Sub
  
  Constructor movies(s As String)
    sMovieName = s
  End Constructor
  
End Class


Dim m As New movies("final fantasy")

'm.printName()' would cause an error


private_variable.kbasic

Class movies
  
  Private sMovieName As String
  
  Sub printName     
    print sMovieName
  End Sub
  
  Constructor movies(s As String)
    sMovieName = s
  End Constructor
  
End Class


Dim m As New movies("final fantasy")

m.printName()

'm.sMovieName = "test"


property.kbasic


Class snowBerries


Private MonthNum As Integer ' = 1 ' Internal storage for property value. 

Property Month2() As Integer
    
  Get     
    Return MonthNum 
  End Get
  
  Set(Value As Integer) 
    If Value < 1 Or Value > 12 Then 
        ' Error processing for invalid value. 
    Else 
      MonthNum = Value 
    End If 
  End Set
  
End Property   ' Month 

Sub doIt()
  'Me.Month2 = 9
  'Print Me.Month2
  Month2 = 12
  Print Month2
End Sub

End Class



Class snowBerries2

Sub doIt()
  Dim m As New snowBerries
  
  m.Month2 = 6
  m.Month2 = 499
  Print m.Month2
  
End Sub

End Class


'Dim m As New snowBerries
Dim m2 As New snowBerries2

/*
Sub kkk()
  m.Month2 = 6
  m.Month2 = 499
  Print m.Month2
  
End Sub
*/
'kkk()
'm.Month2 = 8

'm.doIt()
m2.doIt()


property2.kbasic

Class Salsa 
  
  Public Sub test ( ) 
    Print "test!!!" 
  End Sub 

  Private pvtFname As String 
  
  Public Property Name2 As String 

    Get
      Return pvtFname 
    End Get 

    Set (ByVal Value As String)
      pvtFname = Value
    End Set 

  End Property 

End Class


CLASS rumba


  PRIVATE latein AS INTEGER
  PUBLIC englisch AS STRING
  Dim k 
  Public mySalsa As Salsa 

  PUBLIC SUB dance_rumba()
    Print "rumba!!!"
    mySalsa = New Salsa
    
    mySalsa.Name2 = "rumba!!!999"
    print mySalsa.Name2
  END SUB

  CONSTRUCTOR rumba()
    PRINT "constructor"
  END CONSTRUCTOR

  DESTRUCTOR rumba()
    PRINT "destructor"
  END DESTRUCTOR

END CLASS


'Dim Emp As rumba = New rumba
DIM m AS NEW rumba

m.dance_rumba() 
'Print m.latein 






property3.kbasic

' old syntax of property methods, still supported

Class snowBerries


Private MonthNum As Integer ' = 1 ' Internal storage for property value. 

Property Get Month2() As Integer
  Return MonthNum 
End Property    
  
Property Set Month2(Value As Integer) 
    If Value < 1 Or Value > 12 Then 
        ' Error processing for invalid value. 
    Else 
      MonthNum = Value 
    End If  
End Property   ' Month 

Sub doIt()
  'Me.Month2 = 9
  'Print Me.Month2
  Month2 = 12
  Print Month2
End Sub

End Class



Class snowBerries2

Sub doIt()
  Dim m As New snowBerries
  
  m.Month2 = 6
  m.Month2 = 499
  Print m.Month2
  
End Sub

End Class


'Dim m As New snowBerries
Dim m2 As New snowBerries2

/*
Sub kkk()
  m.Month2 = 6
  m.Month2 = 499
  Print m.Month2
  
End Sub
*/
'kkk()
'm.Month2 = 8

'm.doIt()
m2.doIt()


public_sub.kbasic

Class movies
  
  Public sMovieName As String   
  
  Public Sub printName     
    print sMovieName
  End Sub
  
  Constructor movies(s As String)
    sMovieName = s
  End Constructor
  
End Class


Dim m As New movies("final fantasy")

m.printName()

public_variable.kbasic

Class movies
  
  Public sMovieName As String   
  
  Sub printName     
    print sMovieName
  End Sub
  
  Constructor movies(s As String)
    sMovieName = s
  End Constructor
  
End Class


Dim m As New movies("final fantasy")

m.printName()

Print m.sMovieName

m.sMovieName = "test"

Print m.sMovieName

screen_test.kbasic

CLS

Dim s As String
Input "do", s

For i As Integer = 1 To 40
  Print "1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 " + i
Next

selectcase.kbasic


DIM i AS DOUBLE
DIM n AS INTEGER

i = 4 + 6 * 5

SELECT CASE i
 CASE 0
  n = 0
 CASE 1, 2
  n = 1122
 CASE 4 TO 10
  n = 441000
 CASE IS = 9
  n = 9999
 CASE ELSE
  n = 88888
END SELECT  

CLS 
PRINT "i = " + i
PRINT "n = " + n
 
$END


i = 9884

SELECT CASE i
 CASE 0: n = 0: CASE 1, 2:  n = 1122
 CASE 4 TO 10:  n = 441000: CASE IS = 9:  n = 9999
 CASE ELSE:  n = 999999
END SELECT  


static.kbasic

' make all local vars implicitly static
SUB myMsgbox(i AS INTEGER)   
'STATIC SUB myMsgbox(i AS INTEGER)   
   'DIM s AS STRING
   STATIC s AS STRING

  PRINT "s??? " + s
  
  IF i = 0 THEN s = "Je suis Bernd. Tu't appelles comment?"


 
END SUB

CLS

myMsgbox (0)
myMsgbox (1)

string.kbasic

/*
*/

DIM uu AS STRING
uu = """"" """"""""""1Help""you"""""
 
/* 
CLS
PRINT uu

uu = "2Help""""you"
   
uu = " ""3Help""you"" "
uu = """"" """"""""""4Help""you"""""
uu = " """" """"""""""5Help""you"""" " 
 

DIM z AS STRING * 80
z = "he"
DIM a = "Langsamer" AS STRING 
DIM b = " Walzer" AS STRING 
DIM c AS STRING

c = "Langsamer" + " Walzer" ' static string + static string
c = a + b ' string + string


'uu = "111"
uu = uu + "222"

DIM n = "hello" AS STRING * 1000 ' max length of 1000 characters, like "char s[1000]" in C++ 
DIM s AS STRING

s = "I really knew it, KBasic will be great!" ' static string

PRINT uu

'CLS

PRINT s
PRINT uu


LOCATE 15, 3
PRINT uu

STOP


*/

string2.kbasic


PRINT STRING$(10, "*")
PRINT STRING$(22, 65)

PRINT "Welcome to " + STRING$(10, "*")


strings.kbasic

OPTION OLDBASIC


uu$ = "Input your name: " & uu$ & " Noetscher"
PRINT  uu$

'string1$ = "Hello world\n"      ' Test escape sequence

string2$ = "He said,""Hello""" ' He said,"Hello" is equivalent using 2 double-quotes
PRINT string2$

string3$ = "He said,Hello"  ' He said,"Hello" is equivalent using escape sequence
PRINT string3$

string4$ = "He said," & chr$(34) & "Hello" & chr$(34)  ' He said,"Hello" is equivalent
PRINT string4$

sub_byref_array.kbasic

  
CLS
  
Dim n(8) As Integer

' fixed size array arguement not allowed
Sub test(ByRef t() As Integer)
  
  Print t(8)
  t(8) = 88
  
End Sub


Print "--"

n(8) = 99
test(n)
Print "-- end --"

Print n(8)

sub_byval_array.kbasic

  
CLS
   
Dim n(8) As Long 

Sub test(/*ByVal*/ t() As Long) ' array passing ByVal not allowed


  
  Print t(8)
  
End Sub


Print "--"

n(8) = 99
test(n)
Print "-- end --"
 
'Print n

test_mid.kbasic

OPTION OLDBASIC
B$ = "12345678"
A$ = MID$(B$, 3, 4)

PRINT A$

throw2.kbasic

CLASS rumba
  
  SUB dance
    PRINT "dance"     
  END SUB
  
END CLASS


PUBLIC SUB test() THROWS rumba   
  'EXIT SUB
  
  THROW NEW rumba  ' return rumba = new rumba
  ' return rumba = 0
END SUB

PUBLIC SUB tt
    
  test()
  ' 1. if rumba gesetzt, goto catch rumba
  ' goto finally
  ' 2. if throws and if rumba gesetzt, goto parent, throw rumba
CATCH (b AS rumba)
  ' dim b as rumba = rumba
  PRINT "got you!"
  b.dance()
  ' goto finally
FINALLY
  PRINT "will be always executed, whatever happend"   

END SUB

tt()

throw3.kbasic

CLASS rumba
  
  SUB dance
    PRINT "rumba.dance"     
  END SUB
  
END CLASS

CLASS samba
  
  SUB dance
    PRINT "samba.dance"     
  END SUB
  
END CLASS


PUBLIC SUB test2() THROWS rumba, samba  
  'EXIT SUB
  
  THROW NEW rumba  ' return rumba = new rumba
 'THROW NEW samba  
  ' return rumba = 0
END SUB

PUBLIC SUB tt2() THROWS samba  
  
  TRY
    test2()
  CATCH (b AS rumba)
    PRINT "tt2: got you!"
    b.dance()
'  CATCH (c AS samba)
'    ' dim b as samba = samba
'    PRINT "got you!"
'    c.dance()
  FINALLY
    PRINT "tt2: will be always executed, whatever happend"   
  END CATCH

END SUB


PUBLIC SUB tt()
  
  tt2()    
        
CATCH (c AS samba)
  PRINT "tt: got you!"
  c.dance()
FINALLY
  PRINT "tt: will be always executed, whatever happend"
END SUB


tt()

var_const_name_collision.kbasic


Dim b = 6
'Const b = 99

b = 7

variable.kbasic

/* 
  test it
  p+ op
   
*/

/*
Module module1 

  ' class scope
  
  Function ttt() As CommandButton 
    
  End Function

  Dim c As CommandButton
  c = FormControl("Button1") ' Button1 is declared as CommandButton in this form
  c.SetFocus()
  c.Icon 
  

  
  Class Walzer
  
    Public var As integer 
  End Class 
  walzer.var.var..
  r..
  Salsa..meExplicit....classSubWithArgument.publicClassVar = 111
 */ 
 

  Class Walzer
  
    Public var As integer
  End Class 
  
  Const globalConst = 1
  Const globalConst2 As Integer = 2
  
  Dim globalVar As Integer = 4
  Dim globalVar2 As test
   
  globalVar2 = test.Entry
  
  ' global scope 
  
  Enum test
    Entry = 666
    Entry2
    Security = Entry
    securus
    secura
    securum
  End Enum
  
  Type book  
    bkname As String * 100
    
    isbn(1000) As Integer   
  End Type
  
  Type address
    books(50) As book   
    age As book   
    Name[9] As Integer   
  End Type 
  
  
  Sub globalSub()
    Dim localVar = 99    
  End Sub
  
  
  ' module scope
  
  Module module1 
  
    Public Type address2    
      age As Integer     
    End Type 
  
    Public Type module_type    
      element AS integer
    End Type   
  
    Public Enum module_enum    
       Entry
       Entry2
       Security = Entry
    End Enum 
  
    Const moduleConst = 7  
  
    Public publicModuleVar As Integer  
    Private privateModuleVar As Integer  
                   
  
    Sub moduleExplicit()
      
      Dim localVar = module1.publicModuleVar  
      Dim localVar2 = module1.moduleConst
      
   '   Dim localVar3 As module1.module_enum '  full type name not allowed after AS
      Dim localVar3 As module_enum
      localVar3 = module1.module_enum.Entry
      'Dim localVar4 As module1.module_type     '  full type name not allowed after AS
      Dim localVar5 As module_type     '  full type name not allowed after AS
    End Sub 
  
    Sub moduleImplicit()
      dim localVar = publicModuleVar
      dim localVar2 = moduleConst 
      dim localVar3 as module_enum
      localVar3 = module_enum.Entry
      Dim localVar4 As module_type
      Dim localVar5 As module_type
      Dim localVar6 = module1.publicModuleVar
      
       
    End Sub 
  
    Sub moduleSubWithDefaultArgument(ko as integer = 6)
      Dim localVar = ko
    End Sub 
  
    Sub moduleSubWithOptionalArgument(Optional ko As Integer)
      If Not IsMissing(ko) Then
        dim localVar = ko      
      End If
    End Sub
    
    Sub moduleSub()
      Const localConst = 6 
      dim n = localConst
    End Sub 
  
    Sub moduleSubWithArgument(i as integer)
      dim localVar = i
    End Sub 
  
    Sub moduleSubWithArgumentShadowing(i2 as integer)
      Dim localVar = i2
      Dim i2 = localVar + 99
      dim i3 = i2
    End Sub 
      
    Sub subOverloading ( )
      print "sub1"
    End Sub 
    
    Sub subOverloading ( i as integer = 1)
      print "sub2"    
    End Sub
  
    Function moduleFunction() As String
      
      subOverloading()
      subOverloading(88)
      
      return "hello"
    End function 
  
    function moduleFunctionRecursive(byref i as integer) as integer
      if i > 6 then return 1''i
  
      ''i = i + 1
      return moduleFunctionRecursive(1)''i)
    End function 
  
  End Module
  

  
  
  Class Salsa inherits Walzer
  
    public Enum class_enum
       Entry
       Entry2
       Security = Entry
    End Enum 
  
    public type class_type
      element AS integer
    End Type 
  
    const classConst = 4
  
    public publicInstanceVar as integer
    Private privateInstanceVar As Integer 
    'Protected protectedInstanceVar As Integer 
  
    Static Public publicClassVar As Integer' = 8 
    'dim publicModuleType as module1.module_type
    dim publicModuleType2 as module_type
  
    ' parent constructor call inside constructor
  
    Sub meExplicit()
      dim localVar = Me.publicInstanceVar '  it is the same with Parent
      dim localVar2 = Me.publicClassVar  
      dim localVar3 = Salsa.publicClassVar 
      dim localVar4 = Salsa.classConst 
      Dim localVar5 = classConst
      
      'Dim localVar5b = Me.classConst 
  '    left
  
      Dim localVar6 As class_enum 
      localVar6 = Salsa.class_enum.Entry 
  '    Dim localVar7 As Me.class_enum   '  full type name not allowed after AS
      dim localVar8 as class_type 
    End Sub 
  
    Sub meImplicit()
      dim localVar = publicInstanceVar
      dim localVar2 = publicClassVar 
      dim localVar3 = classConst 
      Dim localVar4 As class_enum 
      dim localVar5 as class_type
  
    End Sub 
    
    Sub classSub()
      const localConst = 6
      dim n = localConst
    End Sub 
  
    Sub classSubWithArgument(i as integer)
      dim localVar = i
    End Sub 
    
    Function classFunction() As String       
      return "hello"
    End Function 
  
    
  '  Static Public Sub test() Throws Walzer     
  '    Throw New Walzer     
  '  End Sub 
    
   
  '  Private pvtFname As String 
  '  
  '  Public Property Nickname As String 
  '
  '    Get
  '      print "Hi"
  '    End Get 
  '
  '    Set ( ByVal Value As String ) 
  '      print "Hi"
  '    End Set 
  '
  '  End Property 
    
  End Class
  
  
  
  CLASS rumba
  
    Public latein AS INTEGER
    'Public mySalsa As New Salsa 
    'Public mySalsa2[10] As Salsa 
   ' Public mySalsa3[] As Salsa  
  
  
    PUBLIC SUB dance_rumba()
      Print "rumba!!!" 
      'print mySalsa.var
    End Sub 
  
    ' default constructor 
  
    Constructor rumba ()
      print "constructor"
    End Constructor
  
    Constructor rumba ( _latein as integer)
      Print "constructor2" 
      latein = _latein
    End Constructor
  
    Destructor rumba ( ) 
      print "destructor"
    End Destructor
    
    Static Sub myMsgBox(ByRef m As Double)  
     '' m = m + 1  
    End Sub 
   
    Static Sub myMsgbox2(Optional m As Integer)
      If IsMissing(m) Then
       '' m = m + 1  
      Else
        Print "do nothing"       
      End If
    End Sub 
  
    Static Function monique(ByRef i As Integer, ByVal h As Double, ParamArray b() As Variant) As Integer  
  
      For i = LBound(b) To UBound(b)
        Print b(i)     
      Next i  
    
      Return i
      
    End Function  
  
  
    static SUB structByReference(byref m AS address)
      ''m.name[2] = 71  
    End Sub 
  
  '  static SUB structByValue(byval m AS address) ' struct passed byval not allowed
  '    m.name[2] = 71  
  '  End Sub 
  
  '  Static Function returnStructByVal() as address ' struct returned not allowed
  '    dim m AS address
  '    ''m.Name[2] = 71 
  '    return m
  '  End Sub 
  
  '   static SUB arrayByRef(byref m[] AS address) ' array arguement not allowed
  '     m[8].name[2] = 71  
  '   End Sub  
  
  '    Sub test(ByRef t(8) As Long)    ' fixed size array arguement not allowed
  '    End Sub
  
  '    Sub test2(ByVal t(8) As Long)    ' fixed size array arguement not allowed
  '    End Sub
  
  '   Static Function returnArrayByRef() as adress[] ' open array returned not allowed
  '     dim m[8] AS address
  '     m[1].Name[2] = 71 
  '     return m
  '   End Sub 
  
  '   static SUB arrayByRef(byref m[][] AS address)
  '     m[8][9].name[2] = 71  
  '   End Sub 
  ' 
  '   Static Function returnArrayByRef() as adress[][] ' open array returned not allowed
  '     dim m[8][6] AS address
  '     m[1][4].Name[2] = 71 
  '     return m
  '   End Sub 
  
  END CLASS
  
  
  DIM j(5 TO 10) AS address
  
  
  
  ''j(3).namer(6) = 123
  ''j(1).age.isbn(10) = 1000
  ''j[2].namer[1] = j(3).namer(6) + j(1).age.isbn(10)
  
  
  
  'Dim Emp As rumba = New rumba
  DIM r AS NEW rumba
  
  r.dance_rumba()
  
  'With r
  '  .dance_rumba()
  'End With
  
  'Print r.latein 
  'Print r.mySalsa.var
  
  Print globalVar ' accessable from everywhere 
  Print globalVar2 ' accessable from everywhere 
  Print globalConst ' accessable from everywhere 
  publicModuleVar = 99
  module1.publicModuleVar = 99
  
  'moduleFunctionRecursive(1)
 ' module1.moduleFunctionRecursive(1)
  
  Print publicModuleVar
  Salsa.publicClassVar = 111
  Print Salsa.publicClassVar
  print moduleConst 
  
  DIM m = 1 AS INTEGER
  
  
  
  'PRINT rumba.monique( h:=12.2, i:=m )
  ''Print rumba.monique(m, 12.2, 5, 8, 7)
  
  
  ' TRY
  '   Salsa.test()
  ' CATCH (b AS Walzer)
  '   PRINT "got you!"
  ' End Catch 
  ' 
  
  
  

whileendwhile.kbasic

DIM n AS INTEGER
DIM i AS INTEGER
DIM b AS BOOLEAN

b = TRUE

WHILE b
  n = n + 1
  IF n = 4 THEN b = FALSE
  PRINT n   

END WHILE


STOP

with2.kbasic


CLASS rumba

  PUBLIC SUB dance_rumba()
    PRINT "rumba!!!"
    
    WITH ME
      .test()
    END WITH
    
  END SUB
  
  PRIVATE SUB test()
    PRINT "test"     
  END SUB  

END CLASS


DIM m AS NEW rumba


WITH m
     .dance_rumba() 
 /*jjj*/  '   .dance_rumba() 
'      .dance_rumba() :.dance_rumba()       
END WITH



3d.kbasic

Type Point3D
    Coord(1 To 4) As Single ' Original coordinates.
    Trans(1 To 4) As Single ' Translated coordinates.
End Type


Const Xmin = 0
Const Xmax = 1
Const Ymin = 0
Const Ymax = 3

Dim Points(Xmin To Xmax, Ymin To Ymax) As Point3D



Dim T(1 To 4, 1 To 4) As Single
Dim T1(1 To 4, 1 To 4) As Single
Dim T2(1 To 4, 1 To 4) As Single


Dim EyeX As Single
Dim EyeY As Single
Dim EyeZ As Single

Dim Axes(1 To 3) As Point3D


' ********************************************************
' Perform vector-matrix multiplication. Set Rpt = Ppt * A.
' ********************************************************
Sub VectorMatrixMult1(x As Integer, y As Integer)
  
Dim i As Integer
Dim j As Integer
Dim value As Single

    For i = 1 To 4
        value = 0
        For j = 1 To 4
            value = value + Points(x, y).Coord(j) * T(j, i)
        Next j
        Points(x, y).Trans(i) = value
    Next i
    

    ' Renormalize the point.
    ' Note that value still holds Rpt(4).
    Points(x, y).Trans(1) = Points(x, y).Trans(1) / value
    Points(x, y).Trans(2) = Points(x, y).Trans(2) / value
    Points(x, y).Trans(3) = Points(x, y).Trans(3) / value
    Points(x, y).Trans(4) = 1
End Sub


' ********************************************************
' Return the angle with tangent y / x.
' ********************************************************
Function Atan(x As Single, y As Single)
Const PI = 3.14159

Dim angle As Single

    If x = 0 Then
        angle = 0
    Else
        angle = Atn(y / x)
        If x < 0 Then angle = PI + angle
    End If
    
    Return angle
    
End Function

' ********************************************************
' Make M an identity matrix.
' ********************************************************
Sub MakeIdentity1()
Dim i As Integer
Dim j As Integer

    For i = 1 To 4
        For j = 1 To 4
            If i = j Then
                T1(i, j) = 1
            Else
                T1(i, j) = 0
            End If
        Next j
    Next i
End Sub

Sub MakeIdentity2()
Dim i As Integer
Dim j As Integer

    For i = 1 To 4
        For j = 1 To 4
            If i = j Then
                T2(i, j) = 1
            Else
                T2(i, j) = 0
            End If
        Next j
    Next i
End Sub

' ********************************************************
' Perform matrix-matrix multiplication. Set R = A * B.
' ********************************************************
Sub MatrixMatrixMult()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim value As Single

    For i = 1 To 4
        For j = 1 To 4
            value = 0
            For k = 1 To 4
                value = value + T1(i, k) * T2(k, j)
            Next k
            T(i, j) = value
        Next j
    Next i
End Sub



' ********************************************************
' Calculate the transformation matrix.
' ********************************************************
Private Sub CalculateTransformation()

Dim r1 As Single
Dim r2 As Single
Dim ctheta As Single
Dim stheta As Single
Dim cphi As Single
Dim sphi As Single

    ' Rotate around the Z axis so the
    ' eye lies in the Y-Z plane.
    r1 = Sqr(EyeX * EyeX + EyeY * EyeY)
    stheta = EyeX / r1
    ctheta = EyeY / r1
    MakeIdentity1
    T1(1, 1) = ctheta
    T1(1, 2) = stheta
    T1(2, 1) = -stheta
    T1(2, 2) = ctheta

    ' Rotate around the X axis so the
    ' eye lies in the Z axis.
    r2 = Sqr(EyeX * EyeX + EyeY * EyeY + EyeZ * EyeZ)
    sphi = -r1 / r2
    cphi = -EyeZ / r2
    MakeIdentity2
    T2(2, 2) = cphi
    T2(2, 3) = sphi
    T2(3, 2) = -sphi
    T2(3, 3) = cphi

    ' Project along the Z axis. (Actually we do nothing
    ' here. We just ignore the Z coordinate when drawing.)

    ' Combine the transformations.
    MatrixMatrixMult
End Sub

' ********************************************************
' Draw the surface.
' ********************************************************
Private Sub DrawSurface()
Dim x As Integer
Dim y As Integer

    

    ' Calculate the transformation matrix.
    CalculateTransformation
    

   ' Transform the axes.
    For x = 1 To 3
        VectorMatrixMult2 x
    Next x
    
    
    ' Apply the transformation matrix to the points.
    For x = Xmin To Xmax
        
        For y = Ymin To Ymax
            VectorMatrixMult1 x, y
        Next y
    Next x

    Dim CurrentX As Integer, CurrentY As Integer
    
    CLS
    Print "Rotate with a, d, w or x     ESC = exit"

    ' draw the axes.
    For x = 1 To 3
        Line(512, 384) - (512 + Axes(x).Trans(1) * 30, 384 + Axes(x).Trans(2) * 30), 4        
    Next x
    

    Line(512 + Points(0, 0).Trans(1) * 20, 384 + Points(0, 0).Trans(2) * 20) - (512 + Points(0, 1).Trans(1) * 20, 384 + Points(0, 1).Trans(2) * 20), 15
    Line(512 + Points(0, 1).Trans(1) * 20, 384 + Points(0, 1).Trans(2) * 20) - (512 + Points(0, 2).Trans(1) * 20, 384 + Points(0, 2).Trans(2) * 20), 15
    Line(512 + Points(0, 2).Trans(1) * 20, 384 + Points(0, 2).Trans(2) * 20) - (512 + Points(0, 3).Trans(1) * 20, 384 + Points(0, 3).Trans(2) * 20), 15
    Line(512 + Points(0, 3).Trans(1) * 20, 384 + Points(0, 3).Trans(2) * 20) - (512 + Points(0, 0).Trans(1) * 20, 384 + Points(0, 0).Trans(2) * 20), 15

    Line(512 + Points(1, 0).Trans(1) * 20, 384 + Points(1, 0).Trans(2) * 20) - (512 + Points(1, 1).Trans(1) * 20, 384 + Points(1, 1).Trans(2) * 20), 10
    Line(512 + Points(1, 1).Trans(1) * 20, 384 + Points(1, 1).Trans(2) * 20) - (512 + Points(1, 2).Trans(1) * 20, 384 + Points(1, 2).Trans(2) * 20), 10
    Line(512 + Points(1, 2).Trans(1) * 20, 384 + Points(1, 2).Trans(2) * 20) - (512 + Points(1, 3).Trans(1) * 20, 384 + Points(1, 3).Trans(2) * 20), 10
    Line(512 + Points(1, 3).Trans(1) * 20, 384 + Points(1, 3).Trans(2) * 20) - (512 + Points(1, 0).Trans(1) * 20, 384 + Points(1, 0).Trans(2) * 20), 10
  
    Line(512 + Points(0, 0).Trans(1) * 20, 384 + Points(0, 0).Trans(2) * 20) - (512 + Points(1, 0).Trans(1) * 20, 384 + Points(1, 0).Trans(2) * 20), 15
    Line(512 + Points(0, 1).Trans(1) * 20, 384 + Points(0, 1).Trans(2) * 20) - (512 + Points(1, 1).Trans(1) * 20, 384 + Points(1, 1).Trans(2) * 20), 15
    Line(512 + Points(0, 3).Trans(1) * 20, 384 + Points(0, 3).Trans(2) * 20) - (512 + Points(1, 3).Trans(1) * 20, 384 + Points(1, 3).Trans(2) * 20), 15
    Line(512 + Points(0, 2).Trans(1) * 20, 384 + Points(0, 2).Trans(2) * 20) - (512 + Points(1, 2).Trans(1) * 20, 384 + Points(1, 2).Trans(2) * 20), 15
  
  
    /*
    ' Draw lines parallel to the X axis.
    'ForeColor = RGB(0, 0, 0)
    For x = Xmin To Xmax
        CurrentX = Points(x, Ymin).Trans(1)
        CurrentY = Points(x, Ymin).Trans(2)
        For y = Ymin + 1 To Ymax
           
            Line(512 + CurrentX * 20, 384 + CurrentY * 20) - (512 + Points(x, y).Trans(1) * 20, 384 + Points(x, y).Trans(2) * 20), 7
            
        Next y
    Next x

    ' Draw lines parallel to the Y axis.
    For y = Ymin To Ymax
        CurrentX = Points(Xmin, y).Trans(1)
        CurrentY = Points(Xmin, y).Trans(2)
        For x = Xmin + 1 To Xmax
            Line(512 + CurrentX * 20, 384 + CurrentY * 20) - (512 + Points(x, y).Trans(1) * 20, 384 + Points(x, y).Trans(2) * 20), 15
            
        Next x
    Next y
*/

End Sub


Private Sub getkey()
Const PI = 3.14159
Const PI2 = -3.14159
Const Dtheta = PI / 16
Const Dphi = PI / 8

Dim theta As Single
Dim phi As Single
Dim r1 As Single
Dim r2 As Single
Dim i$

re:
Do
  i$ = inkey
Loop While i$ = ""


    theta = Atan(EyeX, EyeY)
    r1 = Sqr(EyeX * EyeX + EyeY * EyeY)
    r2 = Sqr(EyeX * EyeX + EyeY * EyeY + EyeZ * EyeZ)
    phi = Atan(r1, EyeZ)


    Select Case i$
        Case "a" 
            theta = theta - Dtheta
        
        Case "w" 
            phi = phi + Dphi
            If phi > PI / 2 Then phi = PI / 2

        Case "d" 
            theta = theta + Dtheta

        Case "x" 
            phi = phi - Dphi
            If phi < PI2 / 2 Then phi = PI2 / 2
        Case Else
            End
            
    End Select
    
    EyeX = r1 * Cos(theta)
    EyeY = r1 * Sin(theta)
    EyeZ = r2 * Sin(phi)
    DrawSurface
    goto re
End Sub


Sub VectorMatrixMult2(x As Integer)
Dim i As Integer
Dim j As Integer
Dim value As Single


    For i = 1 To 4
        value = 0
        For j = 1 To 4
            value = value + Axes(x).Coord(j) * T(j, i)
        Next j
        Axes(x).Trans(i) = value
    Next i
    
    ' Renormalize the point.
    ' Note that value still holds Rpt(4).
    Axes(x).Trans(1) = Axes(x).Trans(1) / value
    Axes(x).Trans(2) = Axes(x).Trans(2) / value
    Axes(x).Trans(3) = Axes(x).Trans(3) / value
    Axes(x).Trans(4) = 1
End Sub

Private Sub Main()
  
Dim x As Integer
Dim y As Integer
Dim R As Single

    ' Initialize the viewing location.
    EyeX = 40
    EyeY = 20
    EyeZ = 20


    
    Points(0, 0).Coord(1) = 0   ' X coordinate.
    Points(0, 0).Coord(2) = 0   ' Y coordinate.
    Points(0, 0).Coord(3) = 1   ' Z  
    Points(0, 0).Coord(4) = 1   ' Scale factor.  

    Points(0, 1).Coord(1) = 10   ' X coordinate.
    Points(0, 1).Coord(2) = 0   ' Y coordinate.
    Points(0, 1).Coord(3) = 1   ' Z 
    Points(0, 1).Coord(4) = 1   ' Scale factor.  

    Points(0, 2).Coord(1) = 10   ' X coordinate.
    Points(0, 2).Coord(2) = 10   ' Y coordinate.
    Points(0, 2).Coord(3) = 1   ' Z 
    Points(0, 2).Coord(4) = 1   ' Scale factor.  

    Points(0, 3).Coord(1) = 0   ' X coordinate.
    Points(0, 3).Coord(2) = 10   ' Y coordinate.
    Points(0, 3).Coord(3) = 1   ' Z
    Points(0, 3).Coord(4) = 1   ' Scale factor.  



    Points(1, 0).Coord(1) = 0   ' X coordinate.
    Points(1, 0).Coord(2) = 0   ' Y coordinate.
    Points(1, 0).Coord(3) = 10   ' Z  
    Points(1, 0).Coord(4) = 1   ' Scale factor.  

    Points(1, 1).Coord(1) = 10   ' X coordinate.
    Points(1, 1).Coord(2) = 0   ' Y coordinate.
    Points(1, 1).Coord(3) = 10   ' Z 
    Points(1, 1).Coord(4) = 1   ' Scale factor.  

    Points(1, 2).Coord(1) = 10   ' X coordinate.
    Points(1, 2).Coord(2) = 10   ' Y coordinate.
    Points(1, 2).Coord(3) = 10   ' Z 
    Points(1, 2).Coord(4) = 1   ' Scale factor.  

    Points(1, 3).Coord(1) = 0   ' X coordinate.
    Points(1, 3).Coord(2) = 10   ' Y coordinate.
    Points(1, 3).Coord(3) = 10   ' Z
    Points(1, 3).Coord(4) = 1   ' Scale factor.  

/*
    ' Initialize the data points.
    For x = Xmin To Xmax
        For y = Ymin To Ymax
            Points(x, y).Coord(1) = x   ' X coordinate.
            Points(x, y).Coord(2) = y   ' Y coordinate.
            Points(x, y).Coord(4) = 1   ' Scale factor.
        
            ' Z coordinate.
            R = Sqr(x * x + y * y)
            Points(x, y).Coord(3) = Cos(R)
        Next y
    Next x
*/
    ' Initialize the axes.
    Axes(1).Coord(1) = 10   ' X axis.
    Axes(1).Coord(4) = 1
    Axes(2).Coord(2) = 10   ' Y axis.
    Axes(2).Coord(4) = 1
    Axes(3).Coord(3) = 10   ' Z axis.
    Axes(3).Coord(4) = 1
    
    
    DrawSurface
    getkey()
End Sub

Main()

abs.kbasic

Dim value1 As Integer 
Dim value2 As Integer 


'Print Abs ( 35.5 - 100 ) 


'use ABS to find the difference
'between 2 values
value1 = 112
value2 = 108
Print "The difference is " ; Abs ( value1 - value2 ) 

abstract.kbasic



CLASS ABSTRACT rumba
  
  PUBLIC ABSTRACT SUB dance_rumba()

  PRIVATE latein AS INTEGER
  PUBLIC englisch AS STRING
  PRIVATE CONST kbAccess = 0

  CONSTRUCTOR rumba()     
    DIM p = 77777777
  END CONSTRUCTOR

  DESTRUCTOR rumba()     
    DIM a = 3333
  END DESTRUCTOR
  
END CLASS


CLASS jive INHERITS rumba

  CONSTRUCTOR jive()
    DIM b = 99
  END CONSTRUCTOR

  DESTRUCTOR jive()
    DIM a = 888
  END DESTRUCTOR
 
  PUBLIC SUB dance_rumba()
    PRINT "rumba!!!"
  END SUB

END CLASS


'DIM k AS NEW rumba
DIM m AS NEW jive


m.dance_rumba()

array2.kbasic

Dim A, B As Variant
A = Array(10, 20, 30)

A(2) = 999
B = A(2)

Print B

ascii.kbasic

'ASCII tester
' This pogram waits for you to press a key and then displays the ASCII code
' of the key you pressed, along with any leading zero's and the character
' generated by the key you pressed.
'
' Suggested use: find out ASCII codes that belong to certain key you want to
' use in your programs.
'

DIM i$

CLS
DO
        i$ = ""
        WHILE i$ = ""
                i$ = INKEY$
        WEND
        LOCATE 1, 1
        IF LEN(i$) = 1 THEN PRINT "ASCII="+ASC(i$);
        IF LEN(i$) = 2 THEN PRINT "0 +" + STR$(ASC(RIGHT$(i$, 1)));
        PRINT "....you pressed: " + i$ + SPACE$(10)
        
LOOP UNTIL i$ = CHR$(27)

bigsize.kbasic

'****************************************************************************
'**
'** Copyright ( C ) 1992-2000 Trolltech AS.  All rights reserved.
'**
'** This file is part of an example program for Qt.  This example
'** program may be used, distributed and modified without limitation.
'**
'*****************************************************************************/

'$END

' Analog Clock
' This example displays an analog clock widget. 

Class AnalogClock Inherits QWidget
  


Private clickPos As QPoint 
Private time2 As QTime 
Private internalTimer As QTimer 

  

Constructor AnalogClock()
  time2 = QTime.currentTime()                ' get current time
  internalTimer = New QTimer(Me) ' create internal timer    
  connect(internalTimer, Signal(timeout()), Me, Slot(timeout()))    
  internalTimer.start(5000, False) ' emit signal every 5 seconds     
  
End Constructor




Sub mousePressEvent(e As QMouseEvent)
  If isTopLevel() Then
      
    Dim x1 As Integer = e.pos().x()       
    Dim y1 = e.pos().y()
      
    Dim x2 = geometry().topLeft().x() - frameGeometry().topLeft().x()
    Dim y2 = geometry().topLeft().y() - frameGeometry().topLeft().y()
      
    clickPos = New QPoint(x1 + x2, y1 + y2)       

  End If     
End Sub


Sub mouseMoveEvent(e As QMouseEvent)
  If isTopLevel() Then
    Dim x = e.globalPos().x() - clickPos.x()
    Dim y = e.globalPos().y() - clickPos.y()
      
    move(x, y)       
      
  End If    
End Sub


'
' When we set an explicit time we don't want the timeout() slot to be
' called anymore as this relies on currentTime()
'
Public Slot setTime(t As QTime)   
  time2 = t
  ' TODO2 disconnect( internalTimer, SIGNAL(timeout()), me, SLOT(timeout()) )
  If autoMask() Then
    updateMask()
  Else       
    update ( ) 
  End If     
End Slot


'
' The QTimer.timeout() signal is received by this slot.
'
Private Slot timeout()
  Dim old_time As QTime = time2
    
  time2 = QTime.currentTime()
  If old_time.minute() <> time2.minute()_
         OrElse old_time.hour() <> time2.hour() Then ' minute or hour has changed
        
      If autoMask() Then
        updateMask()
      Else           
        update()
      End If
  End If
End Slot


Sub paintEvent(e As QPaintEvent)
    
  If autoMask() Then End 

  Dim p As New QPainter(Me)
 
  drawClock( p )
  
End Sub


' The clock is painted using a 1000x1000 square coordinate system, in
' the a centered square, as big as possible.  The painter's pen and
' brush colors are used.
Sub drawClock(p As QPainter)
  p.save()

  p.setWindow( -500,-500, 1000,1000 )

  Dim v As QRect = p.viewport()    
  
  Dim d As Integer = 0
  
  If v.width() > v.height() Then
    d = v.height()
  Else
    d = v.width()    
  End If
  
  p.setViewport(v.left() + (v.width() - d) / 2, v.top() + (v.height() - d) / 2, d, d)

  p.save()
  p.rotate(30 * (time2.hour() Mod 12 - 3) + time2.minute() / 2)
  
  p.setPen(new QPen(new QColor(0, 0, 0), 4, Qt.DashLine))
  p.drawLine(0, 0, 300, 0)

  p.restore()

  p.save()
  p.rotate((time2.minute() - 15) * 6)   
  
  p.setPen(new QPen(new QColor(0, 0, 0), 4, Qt.DashLine))
  p.drawLine(0, 0, 400, 0)

  
  p.restore()

  For i As Integer = 0 To 11
      p.drawLine(440, 0, 460, 0)       
      p.rotate(30)       
  Next

  p.restore()
  
End Sub

' If the clock is transparent, we use updateMask()
' instead of paintEvent()
Sub updateMask() ' paint clock mask
  
  Dim bm As New QBitmap(size())
         
  Dim color0 As QColor = New QColor(255, 255, 255)   
   
  bm.fill(color0) 'transparent

  Dim p As New QPainter
  
  p.begin(bm, Me)      
  
  drawClock(p)

  p.end()
  
  setMask( bm )
End Sub
  
  
  

Sub setAutoMask(b As Boolean)
  If b Then
    setBackgroundMode( Qt.PaletteForeground )
  Else       
    setBackgroundMode( Qt.PaletteBackground )
  End If
    
  Parent.setAutoMask(b)
End Sub


End Class




Dim clock As New AnalogClock()


'clock.setAutoMask(true)
clock.resize(650, 400)
clock.setCaption("Qt Example - Analog Clock")
'clock.setPaletteBackgroundPixmap(new QPixmap(new QImage("c:\kbasic\ide\9.jpg")))
clock.show()

'clock.setTime(new QTime(6, 44))

'****************************************************************************
'**
'** Copyright ( C ) 1992-2000 Trolltech AS.  All rights reserved.
'**
'** This file is part of an example program for Qt.  This example
'** program may be used, distributed and modified without limitation.
'**
'*****************************************************************************/


' Analog Clock
' This example displays an analog clock widget. 


Class AnalogClock2 Inherits QWidget
  


Private clickPos As QPoint 
Private time2 As QTime 
Private internalTimer As QTimer 

  

Constructor AnalogClock2()
  time2 = QTime.currentTime()                ' get current time
  internalTimer = New QTimer(Me) ' create internal timer    
  connect(internalTimer, Signal(timeout()), Me, Slot(timeout()))    
  internalTimer.start(5000, False) ' emit signal every 5 seconds     
  
End Constructor




Sub mousePressEvent(e As QMouseEvent)
  If isTopLevel() Then
      
    Dim x1 As Integer = e.pos().x()       
    Dim y1 = e.pos().y()
      
    Dim x2 = geometry().topLeft().x() - frameGeometry().topLeft().x()
    Dim y2 = geometry().topLeft().y() - frameGeometry().topLeft().y()
      
    clickPos = New QPoint(x1 + x2, y1 + y2)       

  End If     
End Sub


Sub mouseMoveEvent(e As QMouseEvent)
  If isTopLevel() Then
    Dim x = e.globalPos().x() - clickPos.x()
    Dim y = e.globalPos().y() - clickPos.y()
      
    move(x, y)       
      
  End If    
End Sub


'
' When we set an explicit time we don't want the timeout() slot to be
' called anymore as this relies on currentTime()
'
Public Slot setTime(t As QTime)   
  time2 = t
  ' TODO2 disconnect( internalTimer, SIGNAL(timeout()), me, SLOT(timeout()) )
  If autoMask() Then
    updateMask()
  Else       
    update ( ) 
  End If     
End Slot


'
' The QTimer.timeout() signal is received by this slot.
'
Private Slot timeout()
  Dim old_time As QTime = time2
    
  time2 = QTime.currentTime()
  If old_time.minute() <> time2.minute()_
         OrElse old_time.hour() <> time2.hour() Then ' minute or hour has changed
        
      If autoMask() Then
        updateMask()
      Else           
        update()
      End If
  End If
End Slot


Sub paintEvent(e As QPaintEvent)
    
  If autoMask() Then End 

  Dim p As New QPainter(Me)
 
  drawClock( p )
  
End Sub


' The clock is painted using a 1000x1000 square coordinate system, in
' the a centered square, as big as possible.  The painter's pen and
' brush colors are used.
Sub drawClock(p As QPainter)
  p.save()

  p.setWindow( -500,-500, 1000,1000 )

  Dim v As QRect = p.viewport()    
  
  Dim d As Integer = 0
  
  If v.width() > v.height() Then
    d = v.height()
  Else
    d = v.width()    
  End If
  
  p.setViewport(v.left() + (v.width() - d) / 2, v.top() + (v.height() - d) / 2, d, d)

  p.save()
  p.rotate(30 * (time2.hour() Mod 12 - 3) + time2.minute() / 2)
  
  p.setPen(new QPen(new QColor(0, 0, 0), 4, Qt.DashLine))
  p.drawLine(0, 0, 300, 0)

  p.restore()

  p.save()
  p.rotate((time2.minute() - 15) * 6)   
  
  p.setPen(new QPen(new QColor(0, 0, 0), 4, Qt.DashLine))
  p.drawLine(0, 0, 400, 0)

  
  p.restore()

  For i As Integer = 0 To 11
      p.drawLine(440, 0, 460, 0)       
      p.rotate(30)       
  Next

  p.restore()
  
End Sub

' If the clock is transparent, we use updateMask()
' instead of paintEvent()
Sub updateMask() ' paint clock mask
  
  Dim bm As New QBitmap(size())
         
  Dim color0 As QColor = New QColor(255, 255, 255)   
   
  bm.fill(color0) 'transparent

  Dim p As New QPainter
  
  p.begin(bm, Me)      
  
  drawClock(p)

  p.end()
  
  setMask( bm )
End Sub
  
  
  

Sub setAutoMask(b As Boolean)
  If b Then
    setBackgroundMode( Qt.PaletteForeground )
  Else       
    setBackgroundMode( Qt.PaletteBackground )
  End If
    
  Parent.setAutoMask(b)
End Sub


End Class




Dim clock As New AnalogClock()


'clock.setAutoMask(true)
clock.resize(650, 400)
clock.setCaption("Qt Example - Analog Clock")
'clock.setPaletteBackgroundPixmap(new QPixmap(new QImage("c:\kbasic\ide\9.jpg")))
clock.show()

'clock.setTime(new QTime(6, 44))


Do While true  
Loop




Do While true  
Loop

'****************************************************************************
'**
'** Copyright ( C ) 1992-2000 Trolltech AS.  All rights reserved.
'**
'** This file is part of an example program for Qt.  This example
'** program may be used, distributed and modified without limitation.
'**
'*****************************************************************************/


' Analog Clock
' This example displays an analog clock widget. 


Class AnalogClock3 Inherits QWidget
  


Private clickPos As QPoint 
Private time2 As QTime 
Private internalTimer As QTimer 

  

Constructor AnalogClock3()
  time2 = QTime.currentTime()                ' get current time
  internalTimer = New QTimer(Me) ' create internal timer    
  connect(internalTimer, Signal(timeout()), Me, Slot(timeout()))    
  internalTimer.start(5000, False) ' emit signal every 5 seconds     
  
End Constructor




Sub mousePressEvent(e As QMouseEvent)
  If isTopLevel() Then
      
    Dim x1 As Integer = e.pos().x()       
    Dim y1 = e.pos().y()
      
    Dim x2 = geometry().topLeft().x() - frameGeometry().topLeft().x()
    Dim y2 = geometry().topLeft().y() - frameGeometry().topLeft().y()
      
    clickPos = New QPoint(x1 + x2, y1 + y2)       

  End If     
End Sub


Sub mouseMoveEvent(e As QMouseEvent)
  If isTopLevel() Then
    Dim x = e.globalPos().x() - clickPos.x()
    Dim y = e.globalPos().y() - clickPos.y()
      
    move(x, y)       
      
  End If    
End Sub


'
' When we set an explicit time we don't want the timeout() slot to be
' called anymore as this relies on currentTime()
'
Public Slot setTime(t As QTime)   
  time2 = t
  ' TODO2 disconnect( internalTimer, SIGNAL(timeout()), me, SLOT(timeout()) )
  If autoMask() Then
    updateMask()
  Else       
    update ( ) 
  End If     
End Slot


'
' The QTimer.timeout() signal is received by this slot.
'
Private Slot timeout()
  Dim old_time As QTime = time2
    
  time2 = QTime.currentTime()
  If old_time.minute() <> time2.minute()_
         OrElse old_time.hour() <> time2.hour() Then ' minute or hour has changed
        
      If autoMask() Then
        updateMask()
      Else           
        update()
      End If
  End If
End Slot


Sub paintEvent(e As QPaintEvent)
    
  If autoMask() Then End 

  Dim p As New QPainter(Me)
 
  drawClock( p )
  
End Sub


' The clock is painted using a 1000x1000 square coordinate system, in
' the a centered square, as big as possible.  The painter's pen and
' brush colors are used.
Sub drawClock(p As QPainter)
  p.save()

  p.setWindow( -500,-500, 1000,1000 )

  Dim v As QRect = p.viewport()    
  
  Dim d As Integer = 0
  
  If v.width() > v.height() Then
    d = v.height()
  Else
    d = v.width()    
  End If
  
  p.setViewport(v.left() + (v.width() - d) / 2, v.top() + (v.height() - d) / 2, d, d)

  p.save()
  p.rotate(30 * (time2.hour() Mod 12 - 3) + time2.minute() / 2)
  
  p.setPen(new QPen(new QColor(0, 0, 0), 4, Qt.DashLine))
  p.drawLine(0, 0, 300, 0)

  p.restore()

  p.save()
  p.rotate((time2.minute() - 15) * 6)   
  
  p.setPen(new QPen(new QColor(0, 0, 0), 4, Qt.DashLine))
  p.drawLine(0, 0, 400, 0)

  
  p.restore()

  For i As Integer = 0 To 11
      p.drawLine(440, 0, 460, 0)       
      p.rotate(30)       
  Next

  p.restore()
  
End Sub

' If the clock is transparent, we use updateMask()
' instead of paintEvent()
Sub updateMask() ' paint clock mask
  
  Dim bm As New QBitmap(size())
         
  Dim color0 As QColor = New QColor(255, 255, 255)   
   
  bm.fill(color0) 'transparent

  Dim p As New QPainter
  
  p.begin(bm, Me)      
  
  drawClock(p)

  p.end()
  
  setMask( bm )
End Sub
  
  
  

Sub setAutoMask(b As Boolean)
  If b Then
    setBackgroundMode( Qt.PaletteForeground )
  Else       
    setBackgroundMode( Qt.PaletteBackground )
  End If
    
  Parent.setAutoMask(b)
End Sub


End Class


Dim i As Integer

'****************************************************************************
'**
'** Copyright ( C ) 1992-2000 Trolltech AS.  All rights reserved.
'**
'** This file is part of an example program for Qt.  This example
'** program may be used, distributed and modified without limitation.
'**
'*****************************************************************************/


' Analog Clock
' This example displays an analog clock widget. 


Class AnalogClock4 Inherits QWidget
  


Private clickPos As QPoint 
Private time2 As QTime 
Private internalTimer As QTimer 

  

Constructor AnalogClock4()
  time2 = QTime.currentTime()                ' get current time
  internalTimer = New QTimer(Me) ' create internal timer    
  connect(internalTimer, Signal(timeout()), Me, Slot(timeout()))    
  internalTimer.start(5000, False) ' emit signal every 5 seconds     
  
End Constructor




Sub mousePressEvent(e As QMouseEvent)
  If isTopLevel() Then
      
    Dim x1 As Integer = e.pos().x()       
    Dim y1 = e.pos().y()
      
    Dim x2 = geometry().topLeft().x() - frameGeometry().topLeft().x()
    Dim y2 = geometry().topLeft().y() - frameGeometry().topLeft().y()
      
    clickPos = New QPoint(x1 + x2, y1 + y2)       

  End If     
End Sub


Sub mouseMoveEvent(e As QMouseEvent)
  If isTopLevel() Then
    Dim x = e.globalPos().x() - clickPos.x()
    Dim y = e.globalPos().y() - clickPos.y()
      
    move(x, y)       
      
  End If    
End Sub


'
' When we set an explicit time we don't want the timeout() slot to be
' called anymore as this relies on currentTime()
'
Public Slot setTime(t As QTime)   
  time2 = t
  ' TODO2 disconnect( internalTimer, SIGNAL(timeout()), me, SLOT(timeout()) )
  If autoMask() Then
    updateMask()
  Else       
    update ( ) 
  End If     
End Slot


'
' The QTimer.timeout() signal is received by this slot.
'
Private Slot timeout()
  Dim old_time As QTime = time2
    
  time2 = QTime.currentTime()
  If old_time.minute() <> time2.minute()_
         OrElse old_time.hour() <> time2.hour() Then ' minute or hour has changed
        
      If autoMask() Then
        updateMask()
      Else           
        update()
      End If
  End If
End Slot


Sub paintEvent(e As QPaintEvent)
    
  If autoMask() Then End 

  Dim p As New QPainter(Me)
 
  drawClock( p )
  
End Sub


' The clock is painted using a 1000x1000 square coordinate system, in
' the a centered square, as big as possible.  The painter's pen and
' brush colors are used.
Sub drawClock(p As QPainter)
  p.save()

  p.setWindow( -500,-500, 1000,1000 )

  Dim v As QRect = p.viewport()    
  
  Dim d As Integer = 0
  
  If v.width() > v.height() Then
    d = v.height()
  Else
    d = v.width()    
  End If
  
  p.setViewport(v.left() + (v.width() - d) / 2, v.top() + (v.height() - d) / 2, d, d)

  p.save()
  p.rotate(30 * (time2.hour() Mod 12 - 3) + time2.minute() / 2)
  
  p.setPen(new QPen(new QColor(0, 0, 0), 4, Qt.DashLine))
  p.drawLine(0, 0, 300, 0)

  p.restore()

  p.save()
  p.rotate((time2.minute() - 15) * 6)   
  
  p.setPen(new QPen(new QColor(0, 0, 0), 4, Qt.DashLine))
  p.drawLine(0, 0, 400, 0)

  
  p.restore()

  For i As Integer = 0 To 11
      p.drawLine(440, 0, 460, 0)       
      p.rotate(30)       
  Next

  p.restore()
  
End Sub

' If the clock is transparent, we use updateMask()
' instead of paintEvent()
Sub updateMask() ' paint clock mask
  
  Dim bm As New QBitmap(size())
         
  Dim color0 As QColor = New QColor(255, 255, 255)   
   
  bm.fill(color0) 'transparent

  Dim p As New QPainter
  
  p.begin(bm, Me)      
  
  drawClock(p)

  p.end()
  
  setMask( bm )
End Sub
  
  
  

Sub setAutoMask(b As Boolean)
  If b Then
    setBackgroundMode( Qt.PaletteForeground )
  Else       
    setBackgroundMode( Qt.PaletteBackground )
  End If
    
  Parent.setAutoMask(b)
End Sub


End Class




Dim clock As New AnalogClock()


'clock.setAutoMask(true)
clock.resize(650, 400)
clock.setCaption("Qt Example - Analog Clock")
'clock.setPaletteBackgroundPixmap(new QPixmap(new QImage("c:\kbasic\ide\9.jpg")))
clock.show()

'clock.setTime(new QTime(6, 44))


Do While true  
Loop





Dim clock As New AnalogClock()


'clock.setAutoMask(true)
clock.resize(650, 400)
clock.setCaption("Qt Example - Analog Clock")
'clock.setPaletteBackgroundPixmap(new QPixmap(new QImage("c:\kbasic\ide\9.jpg")))
clock.show()

'clock.setTime(new QTime(6, 44))


Do While true  
Loop


'****************************************************************************
'**
'** Copyright ( C ) 1992-2000 Trolltech AS.  All rights reserved.
'**
'** This file is part of an example program for Qt.  This example
'** program may be used, distributed and modified without limitation.
'**
'*****************************************************************************/


' Analog Clock
' This example displays an analog clock widget. 


Class AnalogClock5 Inherits QWidget
  


Private clickPos As QPoint 
Private time2 As QTime 
Private internalTimer As QTimer 

  

Constructor AnalogClock5()
  time2 = QTime.currentTime()                ' get current time
  internalTimer = New QTimer(Me) ' create internal timer    
  connect(internalTimer, Signal(timeout()), Me, Slot(timeout()))    
  internalTimer.start(5000, False) ' emit signal every 5 seconds     
  
End Constructor




Sub mousePressEvent(e As QMouseEvent)
  If isTopLevel() Then
      
    Dim x1 As Integer = e.pos().x()       
    Dim y1 = e.pos().y()
      
    Dim x2 = geometry().topLeft().x() - frameGeometry().topLeft().x()
    Dim y2 = geometry().topLeft().y() - frameGeometry().topLeft().y()
      
    clickPos = New QPoint(x1 + x2, y1 + y2)       

  End If     
End Sub


Sub mouseMoveEvent(e As QMouseEvent)
  If isTopLevel() Then
    Dim x = e.globalPos().x() - clickPos.x()
    Dim y = e.globalPos().y() - clickPos.y()
      
    move(x, y)       
      
  End If    
End Sub


'
' When we set an explicit time we don't want the timeout() slot to be
' called anymore as this relies on currentTime()
'
Public Slot setTime(t As QTime)   
  time2 = t
  ' TODO2 disconnect( internalTimer, SIGNAL(timeout()), me, SLOT(timeout()) )
  If autoMask() Then
    updateMask()
  Else       
    update ( ) 
  End If     
End Slot


'
' The QTimer.timeout() signal is received by this slot.
'
Private Slot timeout()
  Dim old_time As QTime = time2
    
  time2 = QTime.currentTime()
  If old_time.minute() <> time2.minute()_
         OrElse old_time.hour() <> time2.hour() Then ' minute or hour has changed
        
      If autoMask() Then
        updateMask()
      Else           
        update()
      End If
  End If
End Slot


Sub paintEvent(e As QPaintEvent)
    
  If autoMask() Then End 

  Dim p As New QPainter(Me)
 
  drawClock( p )
  
End Sub


' The clock is painted using a 1000x1000 square coordinate system, in
' the a centered square, as big as possible.  The painter's pen and
' brush colors are used.
Sub drawClock(p As QPainter)
  p.save()

  p.setWindow( -500,-500, 1000,1000 )

  Dim v As QRect = p.viewport()    
  
  Dim d As Integer = 0
  
  If v.width() > v.height() Then
    d = v.height()
  Else
    d = v.width()    
  End If
  
  p.setViewport(v.left() + (v.width() - d) / 2, v.top() + (v.height() - d) / 2, d, d)

  p.save()
  p.rotate(30 * (time2.hour() Mod 12 - 3) + time2.minute() / 2)
  
  p.setPen(new QPen(new QColor(0, 0, 0), 4, Qt.DashLine))
  p.drawLine(0, 0, 300, 0)

  p.restore()

  p.save()
  p.rotate((time2.minute() - 15) * 6)   
  
  p.setPen(new QPen(new QColor(0, 0, 0), 4, Qt.DashLine))
  p.drawLine(0, 0, 400, 0)

  
  p.restore()

  For i As Integer = 0 To 11
      p.drawLine(440, 0, 460, 0)       
      p.rotate(30)       
  Next

  p.restore()
  
End Sub

' If the clock is transparent, we use updateMask()
' instead of paintEvent()
Sub updateMask() ' paint clock mask
  
  Dim bm As New QBitmap(size())
         
  Dim color0 As QColor = New QColor(255, 255, 255)   
   
  bm.fill(color0) 'transparent

  Dim p As New QPainter
  
  p.begin(bm, Me)      
  
  drawClock(p)

  p.end()
  
  setMask( bm )
End Sub
  
  
  

Sub setAutoMask(b As Boolean)
  If b Then
    setBackgroundMode( Qt.PaletteForeground )
  Else       
    setBackgroundMode( Qt.PaletteBackground )
  End If
    
  Parent.setAutoMask(b)
End Sub


End Class




Dim clock As New AnalogClock()


'clock.setAutoMask(true)
clock.resize(650, 400)
clock.setCaption("Qt Example - Analog Clock")
'clock.setPaletteBackgroundPixmap(new QPixmap(new QImage("c:\kbasic\ide\9.jpg")))
clock.show()

'clock.setTime(new QTime(6, 44))


Do While true  
Loop



'****************************************************************************
'**
'** Copyright ( C ) 1992-2000 Trolltech AS.  All rights reserved.
'**
'** This file is part of an example program for Qt.  This example
'** program may be used, distributed and modified without limitation.
'**
'*****************************************************************************/


' Analog Clock
' This example displays an analog clock widget. 


Class AnalogClock6 Inherits QWidget
  


Private clickPos As QPoint 
Private time2 As QTime 
Private internalTimer As QTimer 

  

Constructor AnalogClock6()
  time2 = QTime.currentTime()                ' get current time
  internalTimer = New QTimer(Me) ' create internal timer    
  connect(internalTimer, Signal(timeout()), Me, Slot(timeout()))    
  internalTimer.start(5000, False) ' emit signal every 5 seconds     
  
End Constructor




Sub mousePressEvent(e As QMouseEvent)
  If isTopLevel() Then
      
    Dim x1 As Integer = e.pos().x()       
    Dim y1 = e.pos().y()
      
    Dim x2 = geometry().topLeft().x() - frameGeometry().topLeft().x()
    Dim y2 = geometry().topLeft().y() - frameGeometry().topLeft().y()
      
    clickPos = New QPoint(x1 + x2, y1 + y2)       

  End If     
End Sub


Sub mouseMoveEvent(e As QMouseEvent)
  If isTopLevel() Then
    Dim x = e.globalPos().x() - clickPos.x()
    Dim y = e.globalPos().y() - clickPos.y()
      
    move(x, y)       
      
  End If    
End Sub


'
' When we set an explicit time we don't want the timeout() slot to be
' called anymore as this relies on currentTime()
'
Public Slot setTime(t As QTime)   
  time2 = t
  ' TODO2 disconnect( internalTimer, SIGNAL(timeout()), me, SLOT(timeout()) )
  If autoMask() Then
    updateMask()
  Else       
    update ( ) 
  End If     
End Slot


'
' The QTimer.timeout() signal is received by this slot.
'
Private Slot timeout()
  Dim old_time As QTime = time2
    
  time2 = QTime.currentTime()
  If old_time.minute() <> time2.minute()_
         OrElse old_time.hour() <> time2.hour() Then ' minute or hour has changed
        
      If autoMask() Then
        updateMask()
      Else           
        update()
      End If
  End If
End Slot


Sub paintEvent(e As QPaintEvent)
    
  If autoMask() Then End 

  Dim p As New QPainter(Me)
 
  drawClock( p )
  
End Sub


' The clock is painted using a 1000x1000 square coordinate system, in
' the a centered square, as big as possible.  The painter's pen and
' brush colors are used.
Sub drawClock(p As QPainter)
  p.save()

  p.setWindow( -500,-500, 1000,1000 )

  Dim v As QRect = p.viewport()    
  
  Dim d As Integer = 0
  
  If v.width() > v.height() Then
    d = v.height()
  Else
    d = v.width()    
  End If
  
  p.setViewport(v.left() + (v.width() - d) / 2, v.top() + (v.height() - d) / 2, d, d)

  p.save()
  p.rotate(30 * (time2.hour() Mod 12 - 3) + time2.minute() / 2)
  
  p.setPen(new QPen(new QColor(0, 0, 0), 4, Qt.DashLine))
  p.drawLine(0, 0, 300, 0)

  p.restore()

  p.save()
  p.rotate((time2.minute() - 15) * 6)   
  
  p.setPen(new QPen(new QColor(0, 0, 0), 4, Qt.DashLine))
  p.drawLine(0, 0, 400, 0)

  
  p.restore()

  For i As Integer = 0 To 11
      p.drawLine(440, 0, 460, 0)       
      p.rotate(30)       
  Next

  p.restore()
  
End Sub

' If the clock is transparent, we use updateMask()
' instead of paintEvent()
Sub updateMask() ' paint clock mask
  
  Dim bm As New QBitmap(size())
         
  Dim color0 As QColor = New QColor(255, 255, 255)   
   
  bm.fill(color0) 'transparent

  Dim p As New QPainter
  
  p.begin(bm, Me)      
  
  drawClock(p)

  p.end()
  
  setMask( bm )
End Sub
  
  
  

Sub setAutoMask(b As Boolean)
  If b Then
    setBackgroundMode( Qt.PaletteForeground )
  Else       
    setBackgroundMode( Qt.PaletteBackground )
  End If
    
  Parent.setAutoMask(b)
End Sub


End Class




Dim clock As New AnalogClock()


'clock.setAutoMask(true)
clock.resize(650, 400)
clock.setCaption("Qt Example - Analog Clock")
'clock.setPaletteBackgroundPixmap(new QPixmap(new QImage("c:\kbasic\ide\9.jpg")))
clock.show()

'clock.setTime(new QTime(6, 44))


Do While true  
Loop





catch.kbasic

CLASS rumba
  
  SUB dance
    PRINT "rumba.dance"     
  END SUB
  
END CLASS

PUBLIC SUB test() THROWS rumba
  THROW NEW rumba
End Sub 


TRY
  test()
CATCH (b AS rumba)
  PRINT "got you!"
END CATCH

chdir.kbasic

CHDIR("/home/bernd")

chdrive.kbasic

CHDRIVE "C"	' change to D:

choose.kbasic

DIM s AS STRING

s = CHOOSE(2, "un", "deux", "troi")

PRINT s

close.kbasic

Dim I, filename
For I = 1 To 3	' repeat loop 3 times
	filename = "TEST" & I	' create filename
	Open filename For Output As #I	' open file
	Print #I, "Ein Test."	' write string into file
Next I
Close	' close all 3 opened files

cls.kbasic

OPTION OLDBASIC
' CLS clearing the terminal screen
' with a new background color

PRINT "This is to show the CLS command"
INPUT "To clear the screen, press [Return]", keypressed$

' changes the background color:
COLOR (2, 1)
CLS
PRINT "This is green text on a blue screen!"

color.kbasic

COLOR(5)
PRINT "Hi"
COLOR(15,1)
PRINT "Nadja"

const.kbasic

Sub Namer (  ) 
  Const pi = 3.14 
  Print pi 

End Sub
  

Namer()

Sub test
  Dim k As Integer
  
  k = 9 + 23
  Print k
  
End Sub

CONST a = 123.88 * 2, bb = 6
Const k As Integer = 2 

DIM i AS DOUBLE

i = bb

test


'a = i ' would cause a parser error

constructor.kbasic

CLASS rumba


  PRIVATE latein AS INTEGER
  PUBLIC englisch AS STRING
  Dim k 

  'PRIVATE CONST kbAccess = 0

  PUBLIC SUB dance_rumba()
    Print "rumba!!!" 
    'print mySalsa.var
  END SUB

   CONSTRUCTOR rumba()
     PRINT "constructor"
   END CONSTRUCTOR
 
   DESTRUCTOR rumba()
     PRINT "destructor"
   END DESTRUCTOR

END CLASS


DIM t AS NEW rumba

cos.kbasic

PRINT COS(232)

csrlin.kbasic

OPTION OLDBASIC

PRINT "row = " + POS(0)

INPUT s$

PRINT "line = " + CSRLIN

PRINT s$

curdir.kbasic

' Windows:
' C: is the active drive.
Dim path
path = CurDir' 
path = CurDir("C")	
path = CurDir("D")	

cverr.kbasic

Option OldBasic

Sub test()
 Print doubleit("395.45bernd")
End Sub

Function doubleit(no)
 If IsNumeric(no) Then
  doubleit = no* 2 ' return result
 Else
  doubleit = CVErr(2001) ' return user defined error
 End If
End Function


test()

destructor.kbasic

CLASS rumba


  PRIVATE latein AS INTEGER
  PUBLIC englisch AS STRING
  Dim k 

  'PRIVATE CONST kbAccess = 0

  PUBLIC SUB dance_rumba()
    Print "rumba!!!" 
    'print mySalsa.var
  END SUB

   CONSTRUCTOR rumba()
     PRINT "constructor"
   END CONSTRUCTOR
 
   DESTRUCTOR rumba()
     PRINT "destructor"
   END DESTRUCTOR

END CLASS


DIM r AS NEW rumba

dim.kbasic

DIM x AS INTEGER
x = 1 * x + 100000 / 47323

DIM n = 999 AS INTEGER
DIM i AS INTEGER

i = 3
i = 333333

dir.kbasic

Dim Name1 As String

Name1 = Dir("c:\", kbDirectory) ' first entry
Do While Name1 <> "" ' loop
 If Name1 <> "." And Name1 <> ".." Then
  If (GetAttr(Name1) And kbDirectory) = kbDirectory Then
   Print Name1
  End If
 End If
 Name1 = Dir ' next entry
Loop


 

double_literal.kbasic

Dim d As Double

d = 0#

end.kbasic

END

endless.kbasic

Dim i As Integer


Do While True
  i = i + 1
Loop

enum.kbasic

Enum Level
   Mo= -1
   Di = 0
   Fr = 1
   Sa = 1 + Fr AND 2
End Enum

Enum test
   Entry
   Entry2
   Security = Entry
End Enum


'Debug.
Print 3 + Level.Mo
Print test.Entry
Print test.Security

enum_test.kbasic

Enum unit_type
  people
  pilot
  scientist
  soldier
End Enum


Dim r As unit_type
r = unit_type.people
 

eof.kbasic

OPTION OLDBASIC

CLS
OPEN "TEST.DAT" FOR OUTPUT AS #1
FOR i% = 1 TO 10
    WRITE #1, i%, 2 * i%, 5 * i%
NEXT i%
CLOSE #1
OPEN "TEST.DAT" FOR INPUT AS #1
DO
    LINE INPUT #1, a$
    PRINT a$
LOOP UNTIL (EOF(1))

eol.kbasic



CLS

DIM im _
AS INTEGER

' test the multi line symbol _

DIM i _
AS INTEGER
DIM n = 12 AS INTEGER

i _
= _
33 _
 + 9

PRINT i

IF (i = 77 OR i = 0 _
 AND 1) THEN

  n = 33
  PRINT n
  


END IF 

i = 2 * _
99 * 4 _ 
/ _ 
 n _
* 77


IF (i = 42 _
 OR i = 42) THEN
  PRINT i 
END IF

PRINT i


erl.kbasic

PRINT ERL

err.kbasic

Dim Msg
On Error Resume Next
Err.Clear
Err.Raise 6
If ERR.Number <> 0 Then   
 Msg = "Error # " & Str(Err.Number) & " " _
   & Err.Source & Chr(13) & Err.Description
 MsgBox Msg, , "Error"
End If

fileattr.kbasic

Dim filehandle, Mode
filehandle = 1
Open "file1" For Append As filehandle
Mode = FileAttr(filehandle, 1)	' returns 8 (Append).
Close filehandle	' close file

fileselect.kbasic

 
Sub FileDialog(sDir As String, n As Integer, ByRef sReturn As String)
  
  CLS
  Print "File Dialog"
  Print "************************************************************"
 

       
  Dim Name1 As String
   
  Name1 = Dir(sDir) ' first entry
  Do While Name1 <> "" ' loop
     
    If (GetAttr(Name1) And n) = n Then
      Print "Dir --> " + Name1
    Else
      Print "File " + Name1
          
    End If
      
     
   Name1 = Dir ' next entry
  Loop
  Print "************************************************************"
  
      
  Input "Bitte wählen Sie eine Datei:"; Name1
  sReturn = Name1

      
End Sub
  
 
Dim sFilename As String

FileDialog("c:\kbasic15\i*.cpp", kbDirectory, sFilename)

Print "Sie haben Datei " + sFilename + " gewählt."
 

freefile.kbasic

Dim Index1, filehandle
For Index1 = 1 To 5

  filehandle = FreeFile	' next free available file handle 

	Open "TEST" & Index1 For Output As #filehandle
  Write #filehandle, "example text."
	Close #filehandle	
Next

get.kbasic

TYPE TestRecord
    Student AS STRING * 20
    Result AS SINGLE
END TYPE

DIM MyClass2 AS TestRecord

OPEN "ENDRESULTS.DAT" FOR RANDOM AS #1 LEN = LEN(MyClass2)
MyClass2.Student = "Bernd Noetscher"
MyClass2.Result = 99
PUT #1, 1, MyClass2
CLOSE #1

OPEN "ENDRESULTS.DAT" FOR RANDOM AS #1 LEN = LEN(MyClass2)
GET #1, 1, MyClass2
PRINT "STUDENT:", MyClass2.Student
PRINT "SCORE:", MyClass2.Result
CLOSE #1

KILL "ENDRESULTS.DAT"

getattr.kbasic

Dim Attr1
' "hidden" has been set for TSTFILE
Attr1 = GetAttr("TSTFILE")	' returns 2.

goto.kbasic

DIM b AS INTEGER
DIM n AS INTEGER

b = 45
GOTO bernd
b = 99999
bernd:

n = 0
ok:
n = n + 1
IF n < 5 THEN GOTO ok

if.kbasic

DIM j AS INTEGER = 6
DIM i = 4 AS INTEGER
DIM n AS INTEGER

IF i = 5 THEN n = 66: n = 55
IF i = 4 THEN n = 77: n = 99
'IF i = 4 THEN : n = 4: n = 10

'$END

IF i <> 1 THEN:  n = 11111: ENDIF

IF i <> 1 THEN
  n = 11111 : n = 9
ELSEIF i = 2 * 10 THEN
  n = 22222
ELSE
  n = 33333
ENDIF

IF i <> 1 THEN
  n = 11111
END IF

PRINT n 

$END

DIM nReturn AS INTEGER
nReturn = (-.5) + (-1) + 99
nReturn = (-(+5 - -1) * -2) * 4 / -4

END


DIM x,y AS INTEGER


' must be MSC_ID_INTEGER
DIM integer__%
' must be MSC_ID_DOUBLE
DIM double__#
' must be MSC_ID_SINGLE
DIM single__!
' must be MSC_ID_STRING
DIM string__$
' must be MSC_ID_LONG
DIM long__&

long__& = 12

double__& = 10 / 3
double__& = 10 \ 3 ' integer division!

'single__! = 10.10!
double__# = 22.22#
string__$ = "kbasic"
integer__% = 123434%
'long__& = 2134&

END



x=1
y=1
y = x AND y

END


DIM b AS BOOLEAN
DIM t AS SINGLE
DIM ll AS LONG
DIM aa AS LONG

DIM b1=1, b2=0 AS BOOLEAN

ll = 234
aa = 99
t = 2.8

IF b1 OR b2 AND ll THEN
'IF ll = 234 AND t = 2.8 THEN
 aa = 123456
ENDIF

b = false

END

DIM n AS INTEGER
DIM i AS INTEGER
DIM x AS INTEGER

i = &O4

IF i <> 1 THEN n = 11111  ELSE n = 33333

print i

IF i = 1 THEN
n = 11111
ELSEIF i = 2 THEN
n = 22222
ELSEIF i = 3 THEN
n = 33333
ELSEIF i = 4 THEN
n = 44444
ELSE
n = 55555
ENDIF


END

i = 20


i = 20

IF i <> 1 THEN
  n = 11111
ELSEIF i = 2 * 10 THEN
  n = 22222
ELSE
  n = 33333
ENDIF

'FOR i = 1 TO 10
'   n = 123
'NEXT


DIM bRet AS BOOLEAN
DIM b AS BOOLEAN
DIM nReturn AS INTEGER
'GOTO ok
bRet = TRUE
'ok:
b = 45




'nReturn = 5 - 1 * (2 * 4) * 7 / 8
nReturn = ((+5 - -1) * -2) * 4 / -4 + 9 * 88 - 88
'nReturn = (-.5) + (-1) + 6
'nReturn = 4 + 5 * 6
4000 n = +10 * +8
8000 n = TRUE
9000 nReturn = 4 + 5 MOD 2
' IF i = 10 THEN
'   PRINT i
' ENDIF

iif.kbasic

DIM s AS STRING
DIM i AS INTEGER
i = 1
s = IIF(i = 1, "Der Menschen Hörigkeit", "Casanova")

PRINT s

inkey.kbasic

cls
PRINT "Press Esc, to stop ..."
DO
LOOP UNTIL INKEY$ = CHR$(27)    '27 is the ASCII-Code for Esc.

input.kbasic

OPTION OLDBASIC
CLS
OPEN "LIST" FOR OUTPUT AS #1
DO
    INPUT "   NAME:       ", Name$  'input from keyboard
    INPUT "   Age:      ", Age$
    WRITE #1, Name$, Age$
    INPUT "Type a new entry"; R$
LOOP WHILE UCASE$(R$) = "Y"
CLOSE #1
'print content of file
OPEN "LIST" FOR INPUT AS #1
CLS
PRINT "entries of file:": PRINT
DO WHILE NOT EOF(1)
    LINE INPUT #1, REC$  
    PRINT REC$           
LOOP
CLOSE #1

inputbox.kbasic


Dim Msg, Titel, defv, Wert1

Msg = "Input value between 1 and 3"
Titel = "InputBox-Demo"
defv = "1" 

Wert1 = InputBox ( Msg , Titel , defv ) 

instr.kbasic

DIM s$

s$ = "Bernd Noetscher's KBasic"
PRINT "string position = "; INSTR(1, s$, "KBasic")


instrev.kbasic

dim x as string, y as string
x = "This is a string"
y = "s"
PRINT INSTREV(x, y)

isarray.kbasic

Dim array1(1 To 5) As Integer, array2, Test1
array2 = Array(1, 2, 3)

Test1 = IsArray(array1) ' returns True.
Print Test1

Test1 = IsArray(array2) ' returns True.
Print Test1

isempty.kbasic

DIM v AS VARIANT
PRINT ISEMPTY(v)

iserror.kbasic

Function Benutzerfunktion()
  
  'Return 0
  Return CVERR(23)
  
End Function
 


Dim result, Test1
result = Benutzerfunktion()
Test1 = IsError(result)	' return true.

ismissing.kbasic

Option OldBasic



Dim result

result = doubleit() ' returns 0.
Print result

result = doubleit(2) ' returns 4.
Print result

Function doubleit(Optional ByVal A)   
 If IsMissing(A) Then
  ' if no argument, then return 0
  doubleit = 0
 Else
  ' if argument, then return double value
  doubleit = A * 2
 End If
End Function

isnull.kbasic

DIM v AS VARIANT
v = Null
PRINT ISNULL(v)

iterate.kbasic

DIM n = 0 AS INTEGER
DIM b = FALSE AS BOOLEAN

DO

  n = n + 1
  PRINT n
  IF n = 3 THEN b = TRUE ELSE IF n = 6 THEN b = TRUE ELSE b = FALSE
  
  IF n = 4 THEN b = TRUE ELSE ITERATE DO
  

  PRINT "something"

LOOP UNTIL b = TRUE

kill.kbasic

' This deletes the file "test.xml":
KILL "test.xml"

lbound.kbasic

TYPE book
  bkname AS STRING * 100
  
  isbn(1000) AS INTEGER
END TYPE

TYPE address
  books(50) AS book
  age AS INTEGER
  name AS STRING * 100
END TYPE

DIM j(5 TO 10) AS book


PRINT LBOUND(j, 1)

lcase.kbasic

PRINT LCASE$("KBASIC")


left.kbasic

DIM src AS STRING
src = "What a nice day"
PRINT LEFT$(src, 4)




len.kbasic

Dim s As String 

s = "Bernd Noetscher's KBasic"

Print Len(s) 
'Print s.Len() 
'? "hi".Len() 

line2.kbasic

CLS

For a As Integer = 1 To 15
  Line(10, a * 80) - (1000, a * 80), 15
Next

For a = 1 To 15
  Line(a * 80, 10) - (a * 80, 1000), 15
Next


For y As Integer = 1 To 100
    
  For i As Integer = 1 To 600
    Locate 1, 1 : Print "y=" + y + " : i=" + i
    
    Line(11 + i + y, 11 + i + y) - (2 * i + y, 11 + i + y), i / 10
    
  Next

Next
    
    
    
    
    

lineinput.kbasic

Dim text
Open "file1" For Input As #1	' open file
Do While Not EOF(1)	' loop until end of file
	Line Input #1, text	' read line into variable
	Print text
Loop
Close #1	

ln.kbasic

PRINT LN(33)

locate.kbasic

OPTION OLDBASIC
CLS
LOCATE 5, 5
row% = CSRLIN
column% = POS(0)
PRINT "position 1 (press any key)"
DO
LOOP WHILE INKEY$ = ""
LOCATE (row% + 2), (column% + 2)
PRINT "position 2"

lof.kbasic

OPTION OLDBASIC
INPUT "input filename: "; f$
OPEN f$ FOR BINARY AS #1
PRINT "file len is = "; LOF(1)
CLOSE

log.kbasic

PRINT LOG(675)

ltrim.kbasic


PRINT LTRIM$("  bedazzeled  ")


marked_comment.kbasic

  ~' if then else example
  
  Dim itsFunny As Boolean = True
  
  If itsFunny Then
    ~ Print "Laughing :-)"   
  Else 
    ~ Print "...BORING!"
  
  End If
  
  

  Do
  loop While True

marked_line.kbasic

~' if then else example

Dim itsFunny As Boolean = True

If itsFunny Then
  ~ Print "Laughing :-)"   
Else 
  ~ Print "...BORING!"

End If

max.kbasic

PRINT MAX(44, 3)

method_call.kbasic

Class k
  
  Sub julie
    Print "Julie"
    nadja
  End Sub
  
  Sub nadja
    Print "Nadja"
    
  End Sub

End Class


Dim kk As New k

kk.julie

mid.kbasic

OPTION OLDBASIC


text$ = "The dog bites the cat"

text$ = MID$(text$, 10, 1)

PRINT text$


mid2.kbasic

OPTION OLDBASIC


DIM txt AS STRING, replacement AS STRING, originaltxt AS STRING

txt = "The dog bites the cat"
MID(txt, 5)  = "cat"
PRINT txt



MID(txt, 19) = "dog"
PRINT txt

MID(txt, 5) = "text is too long for the string"
PRINT txt

$END

replacement = "The power of KBasic"
originaltxt = "*********************"
FOR i = 1 to LEN(replacement)
         MID(originaltxt, 2, i) = replacement
         PRINT originaltxt
NEXT i

mid3.kbasic

OPTION OLDBASIC


DIM txt AS STRING, replacement AS STRING, originaltxt AS STRING


replacement = "The power of KBasic"
originaltxt = "*********************"
FOR i = 1 to LEN(replacement)
         MID(originaltxt, 2, i) = replacement
         PRINT originaltxt
NEXT i

min.kbasic

PRINT MIN(45, 4)

mkdir.kbasic

MKDIR "C:\TEMP\TEST"
CHDIR "C:\TEMP"
FILES
RMDIR "TEST"

module.kbasic

MODULE einkauf

  PUBLIC m AS INTEGER '= 88

END MODULE


MODULE verkauf

  DIM m2 AS INTEGER

END MODULE

m = 88
m2 = 234
Print m 
Print m2 
Print einkauf.m 
Print verkauf.m2 

msgbox.kbasic

Dim answer = MsgBox("Hi", kbOKOnly, "Question")

name.kbasic

NAME "old.txt" AS "new.txt"

nz.kbasic

Function test()
  
  Return Null
  
End Function

Print "'" + Nz(test) + "'" ' --> ""

object.kbasic


CLASS rumba


  PRIVATE latein AS INTEGER
  PUBLIC englisch AS STRING
  Dim k 


  'PRIVATE CONST kbAccess = 0

  PUBLIC SUB dance_rumba()
    Print "rumba!!!" 
    'print mySalsa.var
  END SUB

'   CONSTRUCTOR rumba2()
'     PRINT "constructor"
'   END CONSTRUCTOR
' 
'   DESTRUCTOR rumba3()
'     PRINT "destructor"
'   END DESTRUCTOR

END CLASS


'Dim Emp As rumba = New rumba
DIM m AS NEW rumba

m.dance_rumba() 
'Print m.latein 
'Print m.mySalsa.var

object_communicating.kbasic

Class a
  
  Constructor a
    myB = New b     
  End Constructor
  
  Sub send()
    myB.receive()
  End Sub
  
  Sub receive()
    myB.send()    
  End Sub
  
  Private myB As b
 
End Class


Class b 
  
  Constructor b
    myA = New a     
  End Constructor
  
  Sub send()
    myA.receive()
  End Sub
  
  Sub receive()
    myA.send()    
  End Sub
  
  Private myA As a
 
End Class

New a()

oct.kbasic

PRINT OCT$(8)


open.kbasic

Dim TextLine As String, ff As Integer

ff = FreeFile ' next availaible filehandle

Open "test.txt" For Input As #ff ' open test file

Do While Not EOF(ff) ' while end of file has not been reached
   Line Input #ff, TextLine ' store next line in string
   print TextLine 
Loop

Close #ff ' Datei schließen

paramarray.kbasic

Function monique(ByRef i As Integer, ByVal h As Double, ParamArray b() As Variant) As Integer
 return i
END FUNCTION

DIM m = 1 AS INTEGER

PRINT monique( h:=12.2, i:=m )
PRINT monique( m, 12.2 )

'PRINT monique(1)

pos.kbasic

OPTION OLDBASIC
PRINT POS(0)

INPUT s$

PRINT CSRLIN

PRINT s$

print.kbasic

PRINT USING "##.###  "; 12.12345

property.kbasic

CLASS snowBerries

Private MonthNum As Integer' = 1  ' Internal storage for property value. 

Property Month2() As Integer 
   Get 
      Return MonthNum 
   End Get 
   Set(Value As Integer) 
      If Value < 1 Or Value > 12 Then 
         ' Error processing for invalid value. 
      Else 
         MonthNum = Value 
      End If 
   End Set 
End Property   ' Month 

END CLASS


DIM m AS NEW snowBerries

m.Month2 = 10
Print m.Month2

put.kbasic

TYPE TestRecord
    Student AS STRING * 20
    Result AS SINGLE
END TYPE

DIM clss AS TestRecord

OPEN "ENDRESULTS.DAT" FOR RANDOM AS #1 LEN = LEN(clss)
clss.Student = "Bernd Noetscher"
clss.Result = 99
PUT #1, 1, clss
CLOSE #1

OPEN "ENDRESULTS.DAT" FOR RANDOM AS #1 LEN = LEN(clss)
GET #1, 1, clss
PRINT "STUDENT:", clss.Student
PRINT "SCORE:", clss.Result
CLOSE #1

KILL "ENDRESULTS.DAT"

redim.kbasic

SUB t
  
  DIM s (100) AS STRING

  s (1) = "You are my angel."
  
  REDIM s (10)
  REDIM s (1000)
  REDIM s (1)
  
  s (1) = "Without your love..."

END SUB

t()

rem.kbasic

rem
'   This is yet another test ' c = 3.14
REM This is another test ' a = 4
print "The end!"  ' another rem here!

'END  : REM definitely the end


DIM n AS INTEGER
DIM s AS STRING

/**

this is a documentation comment
*/


/*
this is mulitline comment
*/

/*
s = "to be or not to be"

n = 200
*/

REM n = 9999

REM n fkdjfalksjfd
'fdnklfsflsgdngndl dflyjvn

REM This is a test of REM ' x = 2

PRINT "Gloria in exelsis deo."

replace.kbasic

DIM s = "Das ist alles was wir brauchen. Fang nochmal von vorne an."

DIM pattern = "vorne"
DIM toReplace = "hinten"

PRINT REPLACE(s, pattern, toReplace)

reset.kbasic

RESET

rgb.kbasic

Dim red
red = RGB(255, 0, 0)

rmdir.kbasic

MKDIR "C:\TEMP\TEST"
CHDIR "C:\TEMP"
FILES
RMDIR "TEST"

rnd.kbasic

OPTION OLDBASIC
RANDOMIZE TIMER
x% = INT(RND * 6) + 1
y% = INT(RND * 6) + 1
PRINT "2 Würfe mit einem Würfel: Wurf 1 ="; x%; "und Wurf 2 ="; y%


END

CLS

FOR i = 1 TO 300
  'PRINT(RND(-7))
  'PRINT TIMER
NEXT

PRINT TIMER

rtrim.kbasic

PRINT RTRIM$("  bedazzeled  ")

sgn.kbasic

PRINT SGN(77)

PRINT SGN(1), SGN(-1), SGN(0)    '  1  -1  0

sin.kbasic

PRINT SIN(44)

sleep.kbasic

PRINT "Pausing 5 seconds..."
SLEEP 5
PRINT "Continue..."

space.kbasic

PRINT SPACE$(4.3 + 2)

PRINT "*" + SPACE(5) + "*"

sqr.kbasic

PRINT SQR(44)

static.kbasic

STATIC SUB myMsgbox(i AS INTEGER)
  DIM s AS STRING

  IF i = 0 THEN s = "Je suis Bernd. Tu't appelles comment?"

  PRINT s
 
END SUB



myMsgbox (0)
myMsgbox (1)


stop.kbasic

STOP

str.kbasic

PRINT STR$(23.546)

strcomp.kbasic

Option OldBasic

Dim Text1, Text2, Vergl

Text1 = "ABCD": Text2 = "abcd" ' 
Verg1 = StrComp(Text1, Text2, 1) ' result:0.
Verg1 = StrComp(Text1, Text2, 0) ' result:-1.
Verg1 = StrComp(Text2, Text1) ' result:1.

string.kbasic

CLS

DIM s = "I really knew it, KBasic will be great!" ' static string
PRINT s

DIM z AS STRING * 80
z = "he"
PRINT z

DIM a = "Langsamer" AS STRING 
DIM b = " Walzer" AS STRING 
DIM c AS STRING

c = "Langsamer" + " Walzer" ' static string + static string
PRINT c

c = a + b ' string + string

PRINT c




DIM uu AS STRING

uu = " ""Help""you"" "
uu = """"" """"""""""Help""you"""""
uu = " """" """"""""""Help""you"""" "
'uu = "Help""""you"

'uu = "111"
'uu = uu + "222"

DIM n="hello" AS STRING * 1000 ' max length of 1000 characters, like "char s[1000]" in C++
 



PRINT n




LOCATE 25, 3
PRINT uu

STOP

string2.kbasic


PRINT STRING$(10, "*")
PRINT STRING$(22, 65)

'PRINT "Welcome to " + STRING$(10, "*")


sub.kbasic


SUB downloadFile()
 DIM tti#
 tti = 99

 ' EXIT SUB
END SUB

downloadFile()

sub_communicating.kbasic

 
Sub location()
  Print "location" 
  fly()
End Sub

Sub fly()  
  Print "fly" 
End Sub

Sub intercepting()
  Print "intercepting"
  location()
End Sub



CLS

intercepting()

switch.kbasic

Dim s As String 
Dim i As Integer 

i = 2

s = Switch ( i = 1 , "Der Menschen Hörigkeit" , i = 2 , "Casanova" ) 

Print s 

system.kbasic

SYSTEM

tan.kbasic

PRINT TAN(333)

test_cache.kbasic



Class a
  Public i As Integer
   
End Class
 

Class b
  
  Sub testing
    Dim aa As New a
    Dim k As Integer
    
    k = aa.i


  End Sub
   
End Class

Dim bb As New b()

bb.testing()



/*
'Option OldBasic
 
Enum dud
  n1
  n2
End Enum

'Class zzz
'End Class

 
Module c
  Public i As Double
  Const h = "hello!!!"
         
End Module
  

Module d
   
  
  Sub testing() Throws zzz
    Dim k As Integer
    Const v = 999
     
    k = c.i
     
  uuu()
  
  Throw New zzz

  End Sub
 

  Sub uuu
    Dim z As Single
    


  End Sub
   
End Module 
      
 

Dim g As dud
g = dud.n1
'   
'Try
'  d.testing()
'Catch (zz As zzz)
'  Dim rz = 12345
'End Catch
*/ 



test_color.kbasic

Color(15, 0) ' default
 
Color(15, 5)
  
Print "hello"
Print Max(30.05, 30)
     
Color(15, 0) ' switch to default

Print "hello"
  

testmem.kbasic

 
 
SUB nadja()

    
  DIM i AS INTEGER
       
  
END SUB

  
k:

   
DIM c[100] AS INTEGER
c[0] = 21
   
'PRINT c
nadja
   
GOTO k
    

trim.kbasic

PRINT TRIM$("  bedazzeled  ")


type.kbasic

TYPE book
  bkname AS STRING * 100
  
  isbn(1000) AS INTEGER
END TYPE

TYPE address
  books(500) AS book
  age AS INTEGER
  NAME AS STRING * 100
  a AS book   
END TYPE

DIM j(5 TO 10) AS address


'PRINT LBOUND(j, 1)


j(5).books(99).isbn[2] = 123
j(5).a.isbn(10) = 1000

j(5).books(99).isbn[2] = 9 
j(5).a.isbn(10) = 11


PRINT j(5).books(99).isbn[2] + j(5).a.isbn(10)

ubound.kbasic

TYPE book
  bkname AS STRING * 100
  isbn(1000) AS INTEGER
END TYPE

TYPE address
 books(50) AS book
 age AS INTEGER
 name AS STRING * 100
END TYPE

DIM j(10) AS book


PRINT UBOUND(j, 1)

$END

j(3).nn(99) = 123
j(1).a.isbn(10) = 1000
j(2).nn(1) = j(3).nn(99) + j(1).a.isbn(10)

ucase.kbasic


PRINT UCASE$("kbasic")

unary.kbasic

DIM i, a = 2, b = 4, c = 8 AS INTEGER

i = -a
i = +a
i = +a + +b + +c
i = -a + -b + -c
i = +a+b
i = -a-b
i = -a+-b
i = +a-+b
i = +a - -b
i = a+ +a
i = a-+a

' normal human brain?


' someone find this beautiful
i = -(-a + -a) - a
i = -(a+a) - a


' incredible
i = -(-(-a + -a)) - a
i = -(-(-(-a + -a))) - a
i = -(a -(-a + -a)) - a



' normal human brain?
i = -1
i = +1
i = +1 + +2 + +3
i = -1 + -2 + -3
i = +1+2
i = -1-2 
i = -1+-2
i = +1-+2
i = +1- -2
i = 1+ +1
i = 1-+1


' someone finds this beautiful
i = -(-1 + -1) - 1
i = -(1+1) - 1


' incredible
i = -(-(-1 + -1)) - 1
i = -(-(-(-1 + -1))) - 1
i = -(1 -(-1 + -1)) - 1

val.kbasic

DIM s AS STRING

PRINT VAL("43.3")

var_const_implicit.kbasic


Option OldBasic


Sub t

  Const kk = 9
  
  Echo kk : Echo "ßß</html>"
  
End Sub


t

variant.kbasic

CLS
DIM c = ARRAY("abc", 22, 33)
PRINT c(0)




DIM i AS INTEGER

DIM a = 1
a(2) = 99

PRINT "a=" + a
PRINT "a(2)=" + a(2)




DIM s'k(33), s(11), ii



DIM b

b = a
PRINT "b=" + b

FOR i = 1 TO 10
  b(i) = a(i)
NEXT

PRINT "b(2)=" + b(2)
' if all field elements should be copied, you have to use a for next loop b(i) = a(i)

'$END

b = c
a = c
PRINT "a(0)=" + a(0)

FOR i = 1 TO 10
  s(i) = i
  PRINT s(i)
  
NEXT
s = a


PRINT ISARRAY(s)


DIM t(10)

FOR i = 1 TO 10
  t(i) = i
  PRINT t(i)
NEXT

with.kbasic

CLASS rumba

  PUBLIC SUB dance_rumba()
    Print "rumba!!!" 
  END SUB

END CLASS


TYPE book
  bkname AS STRING * 100
  isbn(1000) AS INTEGER
End Type 


Type zoo
  e As book
End Type


DIM j(1 TO 10) AS zoo

With j ( 3 ) 

  with .e
  . isbn ( 99 ) = 123 
  end with
End With 

print j[3].e.isbn[99]
'end

DIM m AS NEW rumba

With m 
  .dance_rumba() 
End with

write.kbasic

OPTION OLDBASIC

 CLS
 OPEN "LIST" FOR OUTPUT AS #1
 DO
     INPUT "   NAME:       ", Name$
     INPUT "   AGE:      ", Age$
     WRITE #1, Name$, Age$
     INPUT "More entries?"; R$
 LOOP WHILE UCASE$(R$) = "Y"
 CLOSE #1
 'print file on screen
 OPEN "LIST" FOR INPUT AS #1
 CLS
 PRINT "Entries of file:": PRINT
DO WHILE NOT EOF(1)
    INPUT #1, Rec1$, Rec2$   
    PRINT Rec1$, Rec2$       
LOOP
CLOSE #1
KILL "LIST"

hello.kbasic

'
'
'  Dear KBasic user!
'
'
'  Thank you for trying out KBasic. 
' 
'  If you are new to coding, you should read KBasic's Learning Coding 
'  for beginners, a group of small lessons on how to use the KBasic 
'  programming language, located in the 'Help' menu. You might also 
'  like to try 'The KBasic Book': this book contains detailed information 
'  about the programming language.
'
'                                                  ****
'  Enjoy it!                                  *     *     *
'                                            *     ****     *
'                                           *   ***********  *
'                                           *    *********   *
'  Bernd Noetscher                          *     *******   *
'                                            *    *     * **
'                                              *         **
'                                                  ****
'
'
'  Hit the [start/play button] to run your first KBasic program now
'





' program beginning

CLS
Print "Hello World!"

Print
Print                                  
Print "                / `._     .       .      _.' \"
Print "              '.@ = `.     \     /     .' = @.'"
Print "               \ @`.@ `.    \   /    .' @.'@ / "
Print "               \ @`.@ `.    \   /    .' @.'@ / "
Print "                \;`@`.@ `.   \ /   .' @.'@`;/  "
Print "                 \`.@ `.@ `'.(*).'` @.' @.'/   "
Print "                  \ '=._`. @ :=: @ .'_.=' /    "
Print "                   \ @  '.'..'='..'.'  @ /     "
Print "                    \_@_.==.: = :.==._@_/      "
Print "                    /  @ @_.: = :._@ @  \      "
Print "                   /@ _.-'  : = :  '-._ @\     "
Print "                  /`'@ @ .-': = :'-.@ @`'`\    "
Print "                  \.@_.=` .-: = :-. `=._@./    "
Print "                    \._.-'   '.'   '-._./      "
Print
Print "... you just run your first KBasic program!"
  
  
  
' program ending

class.kbasic

'color(0,15)
'CLS(15)

' class example
Class being

  Constructor being()     
    Print "being.Constructor!!!!"
  End Constructor

  Sub cry()     
    Print "being.cry"
  End Sub
 
End Class


Class body Inherits being
  
  Constructor body()     
    Print "body.Constructor!!!!"
  End Constructor
     
  Sub cry()     
    Print "body.cry"
  End Sub
    
End Class


Class face Inherits being      
  
  Constructor face()
    Print "face.Constructor!!!!"     
  End Constructor
  
  Sub cry()     
    Print "face.cry"
  End Sub
  
End Class

'Class t 
'End Class

Dim l[10] As being

l[3] = New being
l[4] = New face
l[5] = New body
'l[6] = New t

' polymorphism
l[3].cry()
l[4].cry()
l[5].cry()

'For i As Integer = 2 To 100
'Line(0, 0) - (111+i, 333), 10
'Next
' 
'Locate 1, 1

const.kbasic

' const example

Const pi = 3.14159265

Print pi

dim.kbasic

' dim example

Dim i As Integer

i = 2

Print i


Dim k As String

k = "Backfischfest in Worms"

Print k

doloopwhile.kbasic

  ' do...loop while example
  
  Dim b As Boolean = True
  Dim i As Integer = 0
  
  Do
    
    Print i
    
    i = i + 1
   
    If i > 12 Then b = False
     
  Loop While b
  

dowhileloop.kbasic

' do while...loop example

Dim b As Boolean = True
Dim i As Integer = 0

Do While b

  If i > 2 Then b = False
  
  Print i
  
  i = i + 1
  
Loop

fornext.kbasic

' for next example

Dim i As Integer



For i = 0 To 11
  
  Print "doing the same thing all time: " + i ' repeated 11times
  
Next

function.kbasic

' function example


Function divide(dividend As Double, divisor As Double) As Double
  
  Return dividend / divisor
  
End Function


Print divide(18, 9)

ifthenelse.kbasic

' if then else example

Dim itsFunny As Boolean = True

If itsFunny Then
  Print "Laughing :-)"
Else
  Print "...boring!"   
End If

print.kbasic

' print example
' show something on the screen

Print "show something on the screen"

selectcase.kbasic

' select case example

Dim age As Integer = 24

Select Case age   
  Case 12
    Print "you are young"    
  Case 24
    Print "nearly quarter a century old"        
  Case 33
    Print "just a little bit older"        
End Select

statement.kbasic

' statement example

Dim i As Integer ' create variable

i = 0 ' set value of variable to 0
i = i + 33 ' increase value of variable 

Print i ' show variable on screen

sub.kbasic

' sub example

Sub theMusic   
  Print "represents cuba"
  Print "your hips make a shift..."
  Print "I'm the one to find you in the mood..."
  Print "CUBA!"
  Print "represents cuba"
  Print "represents cuba"
  
End Sub


theMusic() ' first use of sub 
theMusic() ' 2nd use 
theMusic() ' 3rd use 

type.kbasic

' type example

Type woman
  eyes As String   
  mouth As String
  tongue As String   
  hair As String
  teeth As String
  lips As String
  smile As String
  
End Type


Dim nadja As woman

nadja.eyes = "so impressive"
nadja.mouth = "sweets!"
nadja.tongue = "I should better say nothing ;-)"
nadja.hair = "brown, short style"
nadja.teeth = "nice" 
nadja.lips = "full of love"
nadja.smile = "unbelievable!"

CLS
Print nadja.eyes
Print nadja.mouth
Print nadja.tongue
Print nadja.hair
Print nadja.teeth
Print nadja.lips
Print nadja.smile
 

variable.kbasic

 
Const globalConst = 1
Const globalConst2 As Integer = 2
Dim globalVar As Integer = 4
Dim globalVar2 As test

globalVar2 = test.Entry



' global scope 

Enum test
  Entry = 666
  Entry2
  Security = Entry
  securus
  secura
  securum
End Enum

Type book  
  bkname As String * 100
  
  isbn(1000) As Integer   
End Type

Type address
  books(50) As book   
  age As book   
  Name[9] As Integer   
End Type 


Sub globalSub()
  Dim localVar = 99    
End Sub


' module scope

Module module1 

  Public Type address2    
    age As Integer     
  End Type 

  Public Type module_type    
    element AS integer
  End Type   

  Public Enum module_enum    
     Entry
     Entry2
     Security = Entry
  End Enum 

  Const moduleConst = 7  

  Public publicModuleVar As Integer  
  Private privateModuleVar As Integer  
                 

  Sub moduleExplicit()
    Dim localVar = module1.publicModuleVar  
    Dim localVar2 = module1.moduleConst
    
 '   Dim localVar3 As module1.module_enum '  full type name not allowed after AS
    Dim localVar3 As module_enum
    localVar3 = module1.module_enum.Entry
    'Dim localVar4 As module1.module_type     '  full type name not allowed after AS
  End Sub 

  Sub moduleImplicit()
    dim localVar = publicModuleVar
    dim localVar2 = moduleConst 
    dim localVar3 as module_enum
    localVar3 = module_enum.Entry
    dim localVar4 as module_type
  End Sub 

  Sub moduleSubWithDefaultArgument(ko as integer = 6)
    dim localVar = ko
  End Sub 

  Sub moduleSubWithOptionalArgument(Optional ko As Integer)
    If Not IsMissing(ko) Then
      dim localVar = ko      
    End If
  End Sub
  
  Sub moduleSub()
    Const localConst = 6 
    dim n = localConst
  End Sub 

  Sub moduleSubWithArgument(i as integer)
    dim localVar = i
  End Sub 

  Sub moduleSubWithArgumentShadowing(i2 as integer)
    Dim localVar = i2
    Dim i2 = localVar + 99
    dim i3 = i2
  End Sub 
    
  Sub subOverloading ( )
    print "sub1"
  End Sub 
  
  Sub subOverloading ( i as integer = 1)
    print "sub2"    
  End Sub

  Function moduleFunction() As String
    
    subOverloading()
    subOverloading(88)
    
    return "hello"
  End function 

  function moduleFunctionRecursive(byref i as integer) as integer
    if i > 6 then return 1''i

    ''i = i + 1
    return moduleFunctionRecursive(1)''i)
  End function 

End Module


' class scope

Class Walzer

  Public var As integer 
End Class


Class Salsa inherits Walzer

  public Enum class_enum
     Entry
     Entry2
     Security = Entry
  End Enum 

  public type class_type
    element AS integer
  End Type 

  const classConst = 4

  public publicInstanceVar as integer
  Private privateInstanceVar As Integer 
  'Protected protectedInstanceVar As Integer 

  Static Public publicClassVar As Integer' = 8 
  'dim publicModuleType as module1.module_type
  dim publicModuleType2 as module_type

  ' parent constructor call inside constructor

  Sub meExplicit()
    dim localVar = Me.publicInstanceVar '  it is the same with Parent
    dim localVar2 = Me.publicClassVar  
    dim localVar3 = Salsa.publicClassVar 
    dim localVar4 = Salsa.classConst 
    Dim localVar5 = classConst 
    'Dim localVar5b = Me.classConst 
'    
    Dim localVar6 As class_enum 
    localVar6 = Salsa.class_enum.Entry 
'    Dim localVar7 As Me.class_enum   '  full type name not allowed after AS
    dim localVar8 as class_type 
  End Sub 

  Sub meImplicit()
    dim localVar = publicInstanceVar
    dim localVar2 = publicClassVar 
    dim localVar3 = classConst 
    Dim localVar4 As class_enum 
    dim localVar5 as class_type

  End Sub 
  
  Sub classSub()
    const localConst = 6
    dim n = localConst
  End Sub 

  Sub classSubWithArgument(i as integer)
    dim localVar = i
  End Sub 
  
  function classFunction() as string
    return "hello"
  End Function 

  
'  Static Public Sub test() Throws Walzer     
'    Throw New Walzer     
'  End Sub 
  
 
'  Private pvtFname As String 
'  
'  Public Property Nickname As String 
'
'    Get
'      print "Hi"
'    End Get 
'
'    Set ( ByVal Value As String ) 
'      print "Hi"
'    End Set 
'
'  End Property 
  
End Class



CLASS rumba

  Public latein AS INTEGER
  'Public mySalsa As New Salsa 
  'Public mySalsa2[10] As Salsa 
 ' Public mySalsa3[] As Salsa  


  PUBLIC SUB dance_rumba()
    Print "rumba!!!" 
    'print mySalsa.var
  End Sub 

  ' default constructor 

  Constructor rumba ()
    print "constructor"
  End Constructor

  Constructor rumba ( _latein as integer)
    Print "constructor2" 
    latein = _latein
  End Constructor

  Destructor rumba ( ) 
    print "destructor"
  End Destructor
  
  Static Sub myMsgBox(ByRef m As Double)  
   '' m = m + 1  
  End Sub 
 
  Static Sub myMsgbox2(Optional m As Integer)
    If IsMissing(m) Then
     '' m = m + 1  
    Else
      Print "do nothing"       
    End If
  End Sub 

  Static Function monique(ByRef i As Integer, ByVal h As Double, ParamArray b() As Variant) As Integer  

    For i = LBound(b) To UBound(b)
      Print b(i)     
    Next i  
  
    Return i
    
  End Function  


  static SUB structByReference(byref m AS address)
    ''m.name[2] = 71  
  End Sub 

'  static SUB structByValue(byval m AS address) ' struct passed byval not allowed
'    m.name[2] = 71  
'  End Sub 

'  Static Function returnStructByVal() as address ' struct returned not allowed
'    dim m AS address
'    ''m.Name[2] = 71 
'    return m
'  End Sub 

'   static SUB arrayByRef(byref m[] AS address) ' array arguement not allowed
'     m[8].name[2] = 71  
'   End Sub  

'    Sub test(ByRef t(8) As Long)    ' fixed size array arguement not allowed
'    End Sub

'    Sub test2(ByVal t(8) As Long)    ' fixed size array arguement not allowed
'    End Sub

'   Static Function returnArrayByRef() as adress[] ' open array returned not allowed
'     dim m[8] AS address
'     m[1].Name[2] = 71 
'     return m
'   End Sub 

'   static SUB arrayByRef(byref m[][] AS address)
'     m[8][9].name[2] = 71  
'   End Sub 
' 
'   Static Function returnArrayByRef() as adress[][] ' open array returned not allowed
'     dim m[8][6] AS address
'     m[1][4].Name[2] = 71 
'     return m
'   End Sub 

END CLASS


DIM j(5 TO 10) AS address



''j(3).namer(6) = 123
''j(1).age.isbn(10) = 1000
''j[2].namer[1] = j(3).namer(6) + j(1).age.isbn(10)



'Dim Emp As rumba = New rumba
DIM r AS NEW rumba

r.dance_rumba()

'With r
'  .dance_rumba()
'End With

'Print r.latein 
'Print r.mySalsa.var

Print globalVar ' accessable from everywhere 
Print globalVar2 ' accessable from everywhere 
Print globalConst ' accessable from everywhere 
publicModuleVar = 99
Print publicModuleVar
Salsa.publicClassVar = 111
Print Salsa.publicClassVar
print moduleConst 

DIM m = 1 AS INTEGER

'PRINT rumba.monique( h:=12.2, i:=m )
''Print rumba.monique(m, 12.2, 5, 8, 7)


' TRY
'   Salsa.test()
' CATCH (b AS Walzer)
'   PRINT "got you!"
' End Catch 
' 

abstract.kbasic

' Create variable:
DIM variablename AS VARIANT

CLASS ABSTRACT rumba
  
  PUBLIC ABSTRACT SUB dance_rumba()

  PRIVATE latein AS INTEGER
  PUBLIC englisch AS STRING
  PRIVATE CONST kbAccess = 0

  CONSTRUCTOR rumba()     
    DIM p = 77777777
  END CONSTRUCTOR

  DESTRUCTOR rumba()     
    DIM a = 3333
  END DESTRUCTOR
  
END CLASS


CLASS jive INHERITS rumba

  CONSTRUCTOR jive()
    DIM b = 99
  END CONSTRUCTOR

  DESTRUCTOR jive()
    DIM a = 888
  END DESTRUCTOR
 
  PUBLIC SUB dance_rumba()
    PRINT "rumba!!!"
  END SUB

END CLASS


'DIM k AS NEW rumba
DIM m AS NEW jive


m.dance_rumba()

addressof.kbasic

Type a
  k As Integer
  m As Double
  
End Type

Dim b As a

Dim i As Integer
Dim k As Integer

CLS

i = AddressOf(k)

Print "&H" + Hex(i)

i = AddressOf(b)
Print "&H" + Hex(i)

as.kbasic

Dim i As Integer

i = 99

Print i

byref.kbasic


Sub ferrari(ByRef pace As Integer)
  pace = pace + 10
End Sub

Dim i As Integer = 50
 
ferrari(i)

Print i

ferrari(i)

Print i


 

byval.kbasic


Sub ferrari(ByVal pace As Integer)
  pace = pace + 10 ' won't have effect on global var i
End Sub

Dim i As Integer = 50
 
ferrari(i)

Print i

ferrari(i)

Print i

case.kbasic


Dim k As Double
k = 12.12

Select Case k
  Case 12.12
    Print "it's the same value"         
End Select

catch.kbasic

CLASS rumba
  
  SUB dance
    PRINT "rumba.dance"     
  END SUB
  
END CLASS

PUBLIC SUB test() THROWS rumba
  THROW NEW rumba
End Sub 


TRY
  test()
CATCH (b AS rumba)
  PRINT "got you!"
END CATCH

choose.kbasic

DIM s AS STRING

s = CHOOSE(1, "un", "deux", "troi")

PRINT s

class.kbasic


Class Salsa 

  Static    
    Print "Static part of class" 
  End Static 

  Public Sub test()    
    Print "test!!!" 
  End Sub 
/*
  Private pvtFname As String 
  
  Public Property Nickname As String 

    Get
'      return pvtFname  
      print "Hi"
    End Get 

    Set ( ByVal Value As String ) 
      print "Hi"
      'pvtFname = Value
    End Set 

  End Property 

  Public Property Set MyNumber(ByVal strValue As String)
     print "Hi"
'     pvtFname = Val(strValue)
  End Property 

  Public Property Get MyNumber() As String
     print "Hi"
'     MyNumber = pvtFname 
  End Property
  */
End Class



Class rumba

  Private latein As Integer  
  Public englisch As String
  Dim k 
  'Public mySalsa As New Salsa 

  Public Sub dance_rumba()    
    Print "rumba!!!" 
    'print mySalsa.var
  END SUB

'   CONSTRUCTOR rumba2()
'     PRINT "constructor"
'   END CONSTRUCTOR
' 
'   DESTRUCTOR rumba3()
'     PRINT "destructor"
'   END DESTRUCTOR

END CLASS


'DIM m AS New rumba
DIM m AS rumba = New rumba

m.dance_rumba() 
'Print m.latein 
'Print m.mySalsa.var





const.kbasic

Sub Namer (  ) 
  Const pi = 3.14 
  Print pi 

End Sub
  


CONST a = 123.88 * 2, bb = 6
Const k As Integer = 2 

DIM i AS DOUBLE

i = bb

'a = i ' would cause a parser error

Namer()

constructor.kbasic

CLASS rumba


  PRIVATE latein AS INTEGER
  PUBLIC englisch AS STRING
  Dim k 

  'PRIVATE CONST kbAccess = 0

  PUBLIC SUB dance_rumba()
    Print "rumba!!!" 
    'print mySalsa.var
  END SUB

   CONSTRUCTOR rumba()
     PRINT "constructor"
   END CONSTRUCTOR
 
   DESTRUCTOR rumba()
     PRINT "destructor"
   END DESTRUCTOR

END CLASS



DIM r AS NEW rumba

destructor.kbasic

CLASS rumba


  PRIVATE latein AS INTEGER
  PUBLIC englisch AS STRING
  Dim k 

  'PRIVATE CONST kbAccess = 0

  PUBLIC SUB dance_rumba()
    Print "rumba!!!" 
    'print mySalsa.var
  END SUB

   CONSTRUCTOR rumba()
     PRINT "constructor"
   END CONSTRUCTOR
 
   DESTRUCTOR rumba()
     PRINT "destructor"
   END DESTRUCTOR

END CLASS



DIM r AS NEW rumba
r = NULL

dim.kbasic

DIM x AS INTEGER
x = 1 * x + 10 / 47323

DIM n = 999 AS INTEGER
DIM i AS INTEGER

i = 3
i = 333333

do.kbasic

Dim b As Boolean = True

Do While b
 b = false  
Loop

b = True

' another do loop
Do
 b = false  
Loop While b

else.kbasic

Dim b As Boolean = false

If b Then   
  Print "b is true"
Else
  Print "b is false"  
EndIf

elseif.kbasic

Dim b As Boolean = false 
 
If b Then
  Print "true"   
ElseIf b = False Then   
  Print "false"   
Else
  Print "tr+alse ??"   
EndIf

end.kbasic

Print "statement1"

End

Print "statement2" ' will never be executed, because 'End' is in the line above

endif.kbasic

Dim b As Boolean = true

If b Then   
  Print "b is true"
Else
  Print "b is false"  
EndIf

enum.kbasic

Enum Level
   Mo= -1
   Di = 0
   Fr = 1
   Sa = 1 + Fr AND 2
End Enum

Enum test
   Entry
   Entry2
   Security = Entry
End Enum

Dim i As test

i = test.Entry
Print i

'Debug.
Print 3 + Level.Mo
Print test.Entry
Print test.Security

exit.kbasic

Sub doingSomething
  
  Print "did something"   
  
  Exit Sub
  
  Print "end of sub"
  
End Sub


Function doingSomething2() As Variant
      
  Print "did something"   
  
  Exit Function
  
  Print "end of function"
  
End Function


For i As Integer = 1 To 11   
  Exit For
  Print "xyz"   
Next


doingSomething()
doingSomething2()

finally.kbasic

CLASS rumba
  
  SUB dance
    PRINT "rumba.dance"     
  END SUB
  
END CLASS

PUBLIC SUB test() THROWS rumba
  THROW NEW rumba
End Sub 


TRY
  test()
CATCH (b AS rumba)
  PRINT "got you!"
FINALLY
  PRINT "will be always executed, whatever happend"   
END CATCH

for.kbasic

' example - counting in French

Dim i As Integer

For i = 1 To 10 
  
  If i = 1 Then Print "un"
  If i = 2 Then Print "deux"
  If i = 3 Then Print "trois"
  If i = 4 Then Print "quatre"
  If i = 5 Then Print "cinq"
  If i = 6 Then Print "six"
  If i = 7 Then Print "sept"
  If i = 8 Then Print "huit"
  If i = 9 Then Print "neuf"
  If i = 10 Then Print "dix"
  
  If i = 5 Then Iterate For
  
  Print " next step "   
   
Next

for_each.kbasic

  
Dim c As New Collection
Dim f As New Form
Dim k As Form
'Dim a As Collection = c
            
k = Null
c.Add(f, "Form1")
c.Add(f, "Form2")
    
'Print c.Len()
'Print a.Len()
 
f = f
'k = c("Form1")
k = c(0)
'c.Remove(0)
k = f

   
'k.Width= 100
'k.Height = 100
'k.Open
     

For Each k In c
  'k = k
  print "z"
Next

     

function.kbasic

Function returnSomethingReallyImportMaybeItsAPassword() As String
  return "login:bernd, passw:245tg"
End Function

Print returnSomethingReallyImportMaybeItsAPassword()

goto.kbasic

DIM b AS INTEGER
DIM n AS INTEGER

b = 45
GOTO bernd
b = 99999
bernd:

n = 0
ok:
n = n + 1
IF n < 5 THEN GOTO ok

if.kbasic

DIM j AS INTEGER = 6
DIM i = 4 AS INTEGER
DIM n AS INTEGER

IF i = 5 THEN n = 66: n = 55
IF i = 4 THEN n = 77: n = 99
'IF i = 4 THEN : n = 4: n = 10

IF i = 4 THEN n = 22 ELSE n = 55
IF i = 5 THEN n = 33 ELSE IF i = 6 THEN n = 33 ELSE n = 99   

IF i <> 1 THEN n = 11111 ELSE n = 33333

'$END

IF i <> 1 THEN:  n = 11111: ENDIF

IF i <> 1 THEN
  n = 11111 : n = 9
ELSEIF i = 2 * 10 THEN
  n = 22222
ELSE
  n = 33333
ENDIF

IF i <> 1 THEN
  n = 11111
END IF



$END

DIM nReturn AS INTEGER
nReturn = (-.5) + (-1) + 99
nReturn = (-(+5 - -1) * -2) * 4 / -4

END


DIM x,y AS INTEGER


' must be MSC_ID_INTEGER
DIM integer__%
' must be MSC_ID_DOUBLE
DIM double__#
' must be MSC_ID_SINGLE
DIM single__!
' must be MSC_ID_STRING
DIM string__$
' must be MSC_ID_LONG
DIM long__&

long__& = 12

double__& = 10 / 3
double__& = 10 \ 3 ' integer division!

'single__! = 10.10!
double__# = 22.22#
string__$ = "kbasic"
integer__% = 123434%
'long__& = 2134&

END



x=1
y=1
y = x AND y

END


DIM b AS BOOLEAN
DIM t AS SINGLE
DIM ll AS LONG
DIM aa AS LONG

DIM b1=1, b2=0 AS BOOLEAN

ll = 234
aa = 99
t = 2.8

IF b1 OR b2 AND ll THEN
'IF ll = 234 AND t = 2.8 THEN
 aa = 123456
ENDIF

b = false

END

DIM n AS INTEGER
DIM i AS INTEGER
DIM x AS INTEGER

i = &O4

IF i <> 1 THEN n = 11111  ELSE n = 33333

print i

IF i = 1 THEN
n = 11111
ELSEIF i = 2 THEN
n = 22222
ELSEIF i = 3 THEN
n = 33333
ELSEIF i = 4 THEN
n = 44444
ELSE
n = 55555
ENDIF


END

i = 20


i = 20

IF i <> 1 THEN
  n = 11111
ELSEIF i = 2 * 10 THEN
  n = 22222
ELSE
  n = 33333
ENDIF

'FOR i = 1 TO 10
'   n = 123
'NEXT


DIM bRet AS BOOLEAN
DIM b AS BOOLEAN
DIM nReturn AS INTEGER
'GOTO ok
bRet = TRUE
'ok:
b = 45




'nReturn = 5 - 1 * (2 * 4) * 7 / 8
nReturn = ((+5 - -1) * -2) * 4 / -4 + 9 * 88 - 88
'nReturn = (-.5) + (-1) + 6
'nReturn = 4 + 5 * 6
4000 n = +10 * +8
8000 n = TRUE
9000 nReturn = 4 + 5 MOD 2
' IF i = 10 THEN
'   PRINT i
' ENDIF

iif.kbasic

DIM s AS STRING
DIM i AS INTEGER
i = 1
s = IIF (i = 1, "Der Menschen Hörigkeit", "Casanova")

PRINT s

inherits.kbasic

Class generation1
  Public gen1 
End Class

Class generation2 Inherits generation1 
  Static Public gen2  
End Class 

Class generation3 Inherits generation2
  Public gen3 
End Class

Class generation4 Inherits generation3
  Public gen4  
End Class

Class generation5 Inherits generation4
  Public gen5 
End Class

CLS

Dim g As New generation5

g.gen1 = 1
generation5.gen2 = 2
g.gen3 = 3
g.gen4 = 4
g.gen5 = 5

Print g.gen1
Print g.gen2
Print g.gen3
Print g.gen4
Print g.gen5
 

is.kbasic

' 1st use of is
 
DIM m AS CommandButton
 
IF TYPEOF m IS CommandButton THEN
  PRINT "CommandButton"
ENDIF



 
' 2nd use of is
DIM k AS NEW OBJECT

DIM a
DIM b

a = k
b = k

 
PRINT a = b
  
PRINT a IS b
  

iterate.kbasic

CLS

DIM n = 0 AS INTEGER
DIM b = FALSE AS BOOLEAN

/*
DO

  n = n + 1
  PRINT "1"   
  IF n = 4 THEN b = TRUE ELSE ITERATE DO

  PRINT "something"

LOOP UNTIL b = TRUE
*/
/*
DO WHILE b = FALSE

  n = n + 1
  PRINT "1"   
  IF n = 4 THEN b = TRUE ELSE ITERATE DO

  PRINT "something"

LOOP
*/
/*
DO UNTIL b = TRUE

  n = n + 1
  PRINT "1"   
  IF n = 4 THEN b = TRUE ELSE ITERATE DO

  PRINT "something"

LOOP
*/

DO

  n = n + 1
  PRINT "1"   
  IF n = 4 THEN b = TRUE ELSE ITERATE DO

  PRINT "something"

LOOP WHILE b = FALSE

$END

CLS

DIM n AS INTEGER
DIM i# ' test something
DIM y#

FOR i# = 1 TO 2 STEP 1

  FOR y# = 1 TO 4
    n = 99
    PRINT "y = " + y
    IF y# = 2 THEN ITERATE FOR     
    PRINT "n = " + n
    IF y# = 5 THEN EXIT FOR
    
  NEXT

NEXT

n = 100

kbasic.kbasic

Option KBasic 

Print "kbasic syntax and keywords activated"

lbound.kbasic

TYPE book
  bkname AS STRING * 100
  isbn(1000) AS INTEGER
END TYPE

TYPE address
  books(50) AS book
  age AS INTEGER
  NAME2 AS STRING * 100
END TYPE

DIM j(5 TO 10) AS book


PRINT LBOUND(j, 1)

$END

j(3).nn(99) = 123
j(1).a.isbn(10) = 1000
j(2).nn(1) = j(3).nn(99) + j(1).a.isbn(10)

loop.kbasic

' do...loop while example

Dim b As Boolean = True
Dim i As Integer = 0

Do
  
  If i > 12 Then b = False
  
  Print i
  
  i = i + 1
  
Loop While b


' do while...loop example

b = True 
i = 0

Do While b

  If i > 12 Then b = False
  
  Print i
  
  i = i + 1
  
Loop

me.kbasic

Class economy
  
  Sub transfer()
    Print "economy: transfer"       
  End Sub
  
End Class

Class money Inherits economy
  
  Sub transfer()
    parent.transfer()
  End Sub
  
  Sub stopTransfer()
    Print "stopTransfer"
  End Sub  
  
End Class


Class bill Inherits economy
  
  Dim m As money     
  
  Sub transfer()
    Print "bill: transfer"         
  End Sub
  
  Sub payBill()
    Me.transfer()
    m = New money     
    m.transfer()
  End Sub
  
  Sub ignoreBill()
    Print "ignoreBill"
  End Sub 

End Class


Dim b As New bill

'b.transfer()
b.payBill()


mid.kbasic



DIM txt AS STRING, replacement AS STRING, originaltxt AS STRING

txt = "The dog bites the cat"
MID(txt, 5)  = "cat"
PRINT txt



MID(txt, 19) = "dog"
PRINT txt

MID(txt, 5) = "text is too long for the string"
PRINT txt

$END

replacement = "The power of KBasic"
originaltxt = "*********************"
FOR i = 1 to LEN(replacement)
         MID(originaltxt, 2, i) = replacement
         PRINT originaltxt
NEXT i

module.kbasic

MODULE einkauf

  PUBLIC m AS INTEGER

END MODULE


MODULE verkauf

  DIM m2 AS INTEGER

END MODULE

m = 123
m2 = 555

Print m 
Print m2 
Print einkauf.m 
Print verkauf.m2 

new.kbasic

Dim o As New Object
o = Null

next.kbasic

' for next example

Dim i As Integer


For i = 0 To 11
  
  Print "doing the same thing all time: " + i
  
Next

null.kbasic

Class test
  
  Dim m As Integer
  
End Class


Dim t As test
t = New test()
t.m = 333

t = Nothing ' it is the same like null
t = Null ' it is the same like nothing

option.kbasic

' There are several OPTION expressions defined in KBasic (option range, option base, option explicit, option compare...)
OPTION OLDBASIC
OPTION EXPLICIT OFF ' turn off

'OPTION BASE 0 ' 1  standard 1
i$ = "Heyoi"

' turn runtime over/underflow check on
'OPTION RANGE ON

' let's do an overflow!

DIM a AS INTEGER ' 32-bit integer
a = 2147483647  ' the maximum positive signed integer
a = a + 1  ' this is overflow...  a is now -2147483648

parent.kbasic

Class economy
  
  Sub transfer()
    Print "economy.transfer"       
  End Sub
  
End Class

Class money Inherits economy
  
  Sub transfer()
    parent.transfer()
  End Sub
  
  Sub stopTransfer()
    Print "money.stopTransfer"
  End Sub  
  
End Class


Class bill Inherits economy
  
  Dim m As money     
  
  Sub transfer()
    Print "bill.transfer"         
  End Sub
  
  Sub payBill()
    Me.transfer()
    m = New money  
    m.transfer()
  End Sub
  
  Sub ignoreBill()
    Print "bill.ignoreBill"
  End Sub 

End Class


Dim b As New bill

b.payBill()

preserve.kbasic

Sub te
    
  Dim i[10] As Integer
  
  i[0] = 99
  i[1] = 88
  i[2] = 77
  i[3] = 66
  i[4] = 55
  i[5] = 44
  
  
  ReDim Preserve i[20]
  
  Print i[0]
  
End Sub
  
  
te()

private.kbasic

Class movies
  
  Private sMovieName As String
  
  Sub printName     
    print sMovieName
  End Sub
  
  Constructor movies(s As String)
    sMovieName = s
  End Constructor
  
End Class


Dim m As New movies("final fantasy")

m.printName()

' Print m.sMovieName ' NOT accessable, because it is private

property.kbasic

CLASS snowBerries

Private MonthNum As Integer 

Property Month2() As Integer 
  GET
      CONST j = TRUE
     
      Return MonthNum 
  END GET
  
  SET(Value AS INTEGER)
    CONST k = TRUE
    
      If Value < 1 Or Value > 12 Then 
         ' Error processing for invalid value. 
      Else 
         MonthNum = Value 
      End If 
   End Set 
End Property   ' Month 

END CLASS


DIM m AS NEW snowBerries

m.Month2 = 10
PRINT m.Month2

protected.kbasic


Class movies
  
  Protected sMovieName As String   
  /*
  Constructor movies(ByRef s As String)

  End Constructor*/
  
  Sub printName     
    print sMovieName
  End Sub
  
End Class


Class movies2 Inherits movies

  Constructor movies2(ByRef s As String)
   ' Parent.movies()
    
    sMovieName = s 
  End Constructor
    
End Class

Dim k As Integer = 9

Dim m As New movies2("final fantasy")

m.printName()

' Print m.sMovieName ' would cause an error


public.kbasic

Class movies
  
  Public sMovieName As String   
  
  Sub printName     
    print sMovieName
  End Sub
  
  Constructor movies(s As String)
    sMovieName = s
  End Constructor
  
End Class


Dim m As New movies("final fantasy")

m.printName()

Print m.sMovieName ' accessable, because it is public



redim.kbasic

SUB t()
  DIM s (100) AS STRING
  
  s (15) = "You are my angels."
  
  REDIM PRESERVE s(15) 
  REDIM PRESERVE s(100) 
  'REDIM s (1000)
  'REDIM s(1)
  
  PRINT s(15)
  
  's (1) = "Without your love..."
  
END SUB


CLS

CALL t()

rem.kbasic



Rem 
'   This is yet another test ' c = 3.14

Rem This is another test ' a = 4

Print "The end!" ' another rem here!



End Rem definitely the end





  Dim n As Integer  
  Dim s As String


  /**  
  this Is a documentation comment
  */ Print "Hi"
  

Print "Hi"


/*
this Is mulitline comment
*/ Print "Hi"

Print "Hi again"


/*
s = "to be or not to be"

n = 200
*/


REM n = 9999

REM n fkdjfalksjfd
'fdnklfsflsgdngndl dflyjvn

REM This is a test of REM ' x = 2

PRINT "Gloria in exelsis deo."

return.kbasic



' New style for return: Used for returning the function value.

OPTION KBASIC

FUNCTION newUsing()
  RETURN 33.33   
END FUNCTION
 
SUB k()
  RETURN
  PRINT "hi"
END SUB
  
PRINT newUsing()
'k
 

$END

OPTION VERYOLDBASIC
' Old style for return: Used for returning to caller (label, lineno, gosub)

FOR i% = 1 TO 2
   ON i% GOSUB Eins, Zwei
NEXT i%
END

Eins: PRINT "Eins"
RETURN
Zwei: PRINT "Zwei"
RETURN

$END

select.kbasic



Dim k As Integer

k = 6

Select Case k
  Case 6
    Print "it's the same value"
End Select
   
 

signal.kbasic

' take a look in the qt examples in /examples/qt

slot.kbasic

' take a look in the qt examples in /examples/qt

static.kbasic

' make all local vars implicitly static
SUB myMsgbox(i AS INTEGER)   
'STATIC SUB myMsgbox(i AS INTEGER)   
   'DIM s AS STRING
   STATIC s AS STRING

  PRINT "s??? " + s
  
  IF i = 0 THEN s = "Je suis Bernd. Tu't appelles comment?"


 
END SUB

CLS

myMsgbox (0)
myMsgbox (1)

step.kbasic

Dim i As Integer

For i = 1 To 10 Step 2
  
  If i = 1 Then Print "un"
  If i = 2 Then Print "deux"
  If i = 3 Then Print "trois"
  If i = 4 Then Print "quatre"
  If i = 5 Then Print "cinq"
  If i = 6 Then Print "six"
  If i = 7 Then Print "sept"
  If i = 8 Then Print "huit"
  If i = 9 Then Print "neuf"
  If i = 10 Then Print "dix"
   
Next

stop.kbasic

STOP

sub.kbasic

Option OldBasic

CLS

Sub nadja(ByRef h As Double)
    
  Print "h = " + (h + 99)
  
End Sub


Dim m = 1 As Integer

nadja(m)

Print "m = " + m


switch.kbasic

Dim s As String 
Dim i As Integer 

i = 1 

s = Switch ( i = 1 , "Der Menschen Hörigkeit" , i = 2 , "Casanova" ) 

Print s 

then.kbasic

Dim b As Boolean = true

If b Then   
  Print "b is true"
Else
  Print "b is false"  
EndIf

throw.kbasic

CLASS rumba
  
  SUB dance
    PRINT "rumba.dance"     
  END SUB
  
END CLASS

PUBLIC SUB test() THROWS rumba
  THROW NEW rumba
End Sub 


TRY
  test()
CATCH (b AS rumba)
  PRINT "got you!"
FINALLY
  PRINT "will be always executed, whatever happend"   
END CATCH

throws.kbasic

CLASS rumba
  
  SUB dance
    PRINT "rumba.dance"     
  END SUB
  
END CLASS

PUBLIC SUB test() THROWS rumba
  THROW NEW rumba
End Sub 


TRY
  test()
CATCH (b AS rumba)
  PRINT "got you!"
FINALLY
  PRINT "will be always executed, whatever happend"   
END CATCH

to.kbasic

' for next example

Dim i As Integer


For i = 0 To 11
  
  Print "doing the same thing all time: " + i
  
Next

try.kbasic

CLASS rumba
  
  SUB dance
    PRINT "rumba.dance"     
  END SUB
  
END CLASS

PUBLIC SUB test() THROWS rumba
  THROW NEW rumba
  PRINT "hello" 
End Sub 


TRY
  test()
CATCH (b AS rumba)
  PRINT "got you!"
END CATCH

type.kbasic

TYPE book
  bkname AS STRING * 100
  
  isbn(1000) AS INTEGER
END TYPE

TYPE address
  a(50) AS book
  age AS INTEGER
  name AS STRING * 100
  nn(100) AS INTEGER   
END TYPE

DIM j(10) AS address


j(6).nn(99) = 123
j(6).a.isbn(10) = 1000
j(0).nn(0) = j(6).nn(99) + j(6).a.isbn(10)

PRINT j(0).nn(0)

typeof.kbasic

DIM m AS QWidget

IF TYPEOF m IS QWidget THEN
  PRINT "QWidget"
ENDIF


DIM f AS Form

IF TYPEOF f IS Form THEN
  PRINT "Form"
ENDIF

ubound.kbasic

TYPE book
  bkname AS STRING * 100 
  isbn(1000) AS INTEGER
END TYPE

TYPE address
 books(50) AS book
 age AS INTEGER
 name AS STRING * 100  
END TYPE

DIM j(10, 5) AS book


PRINT UBOUND(j, 2)

until.kbasic

' do...loop until example

Dim b As Boolean = True
Dim i As Integer = 0

Do
  
  If i > 12 Then b = False
  
  Print i
  
  i = i + 1
  
Loop Until b = False

$dynamic.kbasic

OPTION VERYOLDBASIC

' $DYNAMIC
REM $DYNAMIC


DIM i(800)

$end.kbasic

Print "Hi"

$End

Print "How do you do?"

$static.kbasic

OPTION VERYOLDBASIC

' $STATIC
REM $STATIC

DIM i(800)

base.kbasic

Option OldBasic
Option Base 1 ' set array start index to 1
Option Explicit Off 

  
Dim m(10) As Double

For i As Integer = 1 To 9   
  m(i) = 100 + i   
Next


For x = 1 To 9   
  Print m(x)   
Next

' Print m(0) ' index out of bounds

call.kbasic

Sub callMe
  Print "you called me"   
End Sub

Call callMe()
callMe() ' call is not needed to call a sub or function, just write it without call

class_initialize.kbasic

CLASS rumba


  PRIVATE latein AS INTEGER
  PUBLIC englisch AS STRING

  PUBLIC SUB dance_rumba()
    Print "rumba!!!" 
  END SUB

  PRIVATE SUB CLASS_INITIALIZE() ' constructor, old style name   
    PRINT "constructor"
  END SUB
 
  PRIVATE SUB CLASS_TERMINATE() ' destructor, old style name   
    PRINT "destructor"
  END SUB

END CLASS


DIM r AS NEW rumba
r.dance_rumba()
r = NULL

class_terminate.kbasic

CLASS rumba


  PRIVATE latein AS INTEGER
  PUBLIC englisch AS STRING

  PUBLIC SUB dance_rumba()
    Print "rumba!!!" 
  END SUB

  PRIVATE SUB CLASS_INITIALIZE() ' constructor, old style name   
    PRINT "constructor"
  END SUB
 
  PRIVATE SUB CLASS_TERMINATE() ' destructor, old style name   
    PRINT "destructor"
  END SUB

END CLASS


DIM r AS NEW rumba
r.dance_rumba()
r = NULL

common.kbasic

OPTION VERYOLDBASIC

COMMON SHARED i AS INTEGER ' common and shared is totally outdated and obsolete

compare.kbasic



 
Option OldBasic
Option Compare Text ' used for STRCOMP, default is 'Binary', other is 'Text'

Dim n As Integer

CLS

n = StrComp("Hi", "HI")
Print n ' --> binary false

n = StrComp("Hi", "Hi")
Print n ' --> binary true


   

declare.kbasic

DECLARE SUB testSub()


SUB testSub()
  
  PRINT "testSub"
  
END SUB


testSub()

defbool.kbasic

OPTION OLDBASIC


DEFBOOL a - b
DEFINT c - M
DEFLNG B, m, k
DEFSNG C
DEFDBL D
DEFSTR z
DEFOBJ o
DEFVAR v

aSimpleTest = true

defbyte.kbasic

OPTION OLDBASIC


DEFBYTE a - b 
DEFINT c - M
DEFLNG B, m, k
DEFSNG C
DEFDBL D
DEFSTR z
DEFOBJ o
DEFVAR v

aSimpleTest = 2

defdbl.kbasic

OPTION OLDBASIC


DEFBOOL a - b
DEFINT c - M
DEFLNG B, m, k
DEFSNG C
DEFDBL D
DEFSTR z
DEFOBJ o
DEFVAR v

aSimpleTest = true

defint.kbasic

OPTION OLDBASIC


DEFBOOL a - b
DEFINT c - M
DEFLNG B, m, k
DEFSNG C
DEFDBL D
DEFSTR z
DEFOBJ o
DEFVAR v

aSimpleTest = true

deflng.kbasic

OPTION OLDBASIC


DEFBOOL a - b
DEFINT c - M
DEFLNG B, m, k
DEFSNG C
DEFDBL D
DEFSTR z
DEFOBJ o
DEFVAR v

aSimpleTest = true

defobj.kbasic

OPTION OLDBASIC


DEFBOOL a - b
DEFINT c - M
DEFLNG B, m, k
DEFSNG C
DEFDBL D
DEFSTR z
DEFOBJ o
DEFVAR v

aSimpleTest = true

defsng.kbasic

OPTION OLDBASIC


DEFBOOL a - b
DEFINT c - M
DEFLNG B, m, k
DEFSNG C
DEFDBL D
DEFSTR z
DEFOBJ o
DEFVAR v

aSimpleTest = true

defstr.kbasic

OPTION OLDBASIC


DEFBOOL a - b
DEFINT c - M
DEFLNG B, m, k
DEFSNG C
DEFDBL D
DEFSTR z
DEFOBJ o
DEFVAR v

aSimpleTest = true

empty.kbasic

Dim v As Variant

v = Empty

Print 1 + 2 '"variable is empty?" +  IsEmpty(v)


erase.kbasic

 
SUB tester()
   
'  DIM b(1000) AS DOUBLE
  DIM b(1000) AS STRING

  
  b[33] = "33"
  PRINT b[33]
    
 
  ERASE b
     
       
 ' PRINT b[33]
     
      
       
END SUB

 
CLS

  

'TYPE o
'  s AS STRING * 100
'END TYPE
'
'DIM oo AS o
'
'oo.s = "33"
'
'ERASE oo
'
'PRINT LEN(oo.s)
' 
'END
'
'
'tester
'END
'

'DIM a(1000) AS DOUBLE
DIM a(1000) AS VARIANT
    
a[33] = "33"
  
PRINT a[33]

ERASE a
    
PRINT ISEMPTY(a[33])
 
    
tester
 

explicit.kbasic

Option OldBasic
Option Explicit Off ' variables are now created on demand without 'dim'

v = 12
i = "GOOOOOOOOOOOOAAAAAAAAAAAAAALLLLLL!!!!!"
k = 122.34
b = True

global.kbasic

Option OldBasic

Global a As Integer ' global is obsolete, use 'Public' instead

a = 12



gosub.kbasic

OPTION VERYOLDBASIC

FOR i% = 1 TO 20
    GOSUB square
NEXT i%
END

square:
PRINT i% * i%

RETURN

isarray.kbasic

Dim array1(1 To 5) As Integer, array2, Test1
array2 = Array(1, 2, 3)

Test1 = IsArray(array1) ' returns True.
Print Test1

Test1 = IsArray(array2) ' returns True.
Print Test1

isempty.kbasic

DIM v AS VARIANT
PRINT ISEMPTY(v)

iserror.kbasic

Function Benutzerfunktion()
   
  'Return 0
  Return CVERR(23)
  
End Function
 
Dim result, Test1
result = Benutzerfunktion()
Test1 = IsError(result)	' return true.

ismissing.kbasic

Option OldBasic

Dim result

result = doubleit() ' returns 0.
result = doubleit(2) ' returns 4.

Function doubleit(Optional ByVal A)   
 If IsMissing(A) Then
  ' if no argument, then return 0
  doubleit = 0
 Else
  ' if argument, then return double value
  doubleit = A * 2
 End If
End Function

isnull.kbasic

DIM v AS VARIANT

v = NULL
'v = 99


PRINT ISNULL(v)

isnumeric.kbasic

PRINT ISNUMERIC(67)

isobject.kbasic

DIM m AS OBJECT
PRINT ISOBJECT(m)

let.kbasic

Option OldBasic

Dim i As Integer

Let i = 12 ' let is obsolete
i = 12 ' leave out let it is just the same

like.kbasic

CLS

DIM i
 
'i = "aab" LIKE "aab"
' 
'PRINT i
'END
   
 
    
'PRINT "abcdfgcdefg" LIKE "" ' False
'PRINT "abcg" LIKE "a*g" ' True
'PRINT "abcdefcdefg" LIKE "a*cde*g" ' True
'Print "abcdefgcdefg" Like "a*cd*cd*g" ' True
'Print "abcdefgcdefg" Like "a*cd*cd*g" ' True
'Print "00aa" Like "####" ' False
'Print "00aa" Like "????" ' True
'PRINT "00aa" LIKE "##??" ' True
'PRINT "00aa" LIKE "*##*" ' True
'PRINT "hk" LIKE "hk*" ' True
'PRINT "00aa" LIKE "*[1-9]*" ' True
'PRINT "*?x]" LIKE "[*?a-z]]"
   
'PRINT "l0" LIKE "[!0-9a-z]" ' True

'PRINT "" LIKE "[]"


PRINT "-*?0x-" LIKE "[-*?0-9a-z-]"

  
   
   
            

lset.kbasic

OPTION OLDBASIC

PRINT 1
LSET test$ = "kkkk"

nothing.kbasic

Class test
  
  Dim m As Integer
  
End Class


Dim t As test
t = New test()
t = Nothing ' it is the same like null
t = Null ' it is the same like nothing
 

off.kbasic

Option OldBasic
Option Explicit Off

v = "variant"
i = 12

oldbasic.kbasic

Option OldBasic

Print "oldbasic syntax and keywords activated"

on.kbasic

OPTION VERYOLDBASIC

CLS

DIM i%

i% = 1
i% = 2

ON i% GOTO one, two

myEnd:
PRINT "myEnd"

END


one:
PRINT "one"
GOTO myEnd

two:
PRINT "two"
GOTO myEnd

optional.kbasic

Sub jump(meter As Integer, Optional high As Integer)
     
  If Not IsMissing(high) Then
    Print "high jump"       
  Else
    print "normal jump"
  End If
  
End Sub


jump(12)
jump(12, 33)

paramarray.kbasic

Function monique(ByRef i As Integer, ByVal h As Double, ParamArray a() As Variant) As Integer   
   
  For i = LBound(a) To UBound(a)
    Print a(i)     
  Next i  

  return i

End Function

CLS

Dim m = 1 As Integer

Print monique(m, 12.2, 1, 2, 3)
Print "---"
 
Print monique(h := 12.2, i := m)
Print "---"

Print monique(m, 12.2)
Print "---"

Print monique(1, 9)
Print "---"




range.kbasic

' WARNING! OPTION RANGE IS NOT SUPPORTED. Overflow check is always disabled.
/*
' turn runtime over/underflow check on
'OPTION RANGE ON

' let's do an overflow!

DIM a AS INTEGER ' 32-bit integer
a = 2147483647  ' the maximum positive signed integer
a = a + 1  ' this is overflow...  a is now -2147483648
*/

read.kbasic

OPTION VERYOLDBASIC

DATA "Salsa"

READ a$


DATA 22

READ t%

'$END


DATA 66, 77

READ t%, txt

RESTORE
'$END

READ a$, txt

DATA 55, 99

READ t%, txt
READ t%, txt

restore.kbasic

OPTION VERYOLDBASIC

DATA "Salsa"

READ a$


DATA 22

READ t%

'$END


DATA 66, 77

READ t%, txt

RESTORE
'$END

READ a$, txt

DATA 55, 99

READ t%, txt
READ t%, txt

resume.kbasic


SUB myTest ()

ON ERROR GOTO err1

DIM g = 0
DIM k = 1 / g

g = 99

EXIT SUB

err1:
IF ERROR = 11 THEN
  g = 1
'  PRINT ERL
'  PRINT ERR
  
  RESUME NEXT
  
 ' g = 88
  
ENDIF

'PRINT "error"

END SUB



myTest ()

rset.kbasic

OPTION VERYOLDBASIC

TYPE j
  k AS STRING * 40
END TYPE
    
CLS
DIM jj AS j
   
RSET jj.k = "abcd"
    
PRINT jj.k
PRINT "123456789 123456789 123456789 123456789 123456789 123456789 123456789 "
    

set.kbasic

Dim i As Object
 
Set i = Nothing ' set is obsolete, just leave it out
i = nothing

shared.kbasic

OPTION VERYOLDBASIC

COMMON SHARED i AS INTEGER ' common and shared is totally outdated and obsolete

system.kbasic

SYSTEM

timer.kbasic


    
OPTION VERYOLDBASIC
 
 ON TIMER(1) GOSUB Update
 TIMER ON
 CLS
 PRINT "Time: "; TIME$
 t = TIMER
 WHILE k < 10
     k = TIMER - t
 WEND
 END

 Update:
     LOCATE 1, 8: PRINT TIME$
     RETURN    

veryoldbasic.kbasic

Option VeryOldBasic 

Print "veryoldbasic syntax and keywords activated"

wend.kbasic

Dim b As Boolean = True

While b
  Print "looping endlessly?"
  b = false
Wend

while.kbasic

Dim b As Boolean = True

While b
  Print "looping endlessly?"
  b = false
End While

with.kbasic

TYPE book
  bkname AS STRING * 100  
  isbn(1000) AS INTEGER
END TYPE


TYPE zoo  
  e AS book 
END TYPE
 

DIM j(1 TO 10) AS zoo



WITH j(3)
  
  .e.bkname = "Frankfurter Zoo"
  
  WITH .e
    . isbn ( 99 ) = 333  
  END WITH
  
END WITH

PRINT j(3).e.bkname
PRINT j(3).e.isbn(99)

  
  
END



CLASS rumba

  PUBLIC SUB dance_rumba()
    PRINT "rumba!!!"
    
    WITH ME
      .test()
    END WITH
    
  END SUB
  
  PRIVATE SUB test()
    PRINT "test"     
  END SUB  

END CLASS


DIM m AS NEW rumba


WITH m
     .dance_rumba() 
 /*jjj*/  '   .dance_rumba() 
'      .dance_rumba() :.dance_rumba()       
END WITH



application.kbasic

Application.OpenModule("")

bytearray.kbasic

Dim k As New Bytearray

   
k.Add("jul", 33)
k.Set("hello", 2)
    
Dim n As String
   
    
n = k.Get(2)

  
Print n

collection.kbasic

               
 
'Class myCollection Inherits Collection
'  
'  Function Len() As Integer ' override the original method
'    Print "len"
'      
'    Return Parent.Len
'    
'  End Function
'End Class
       
         
Dim c As Collection
Dim k As New Form
  
'Dim j As New myCollection
'j.Add(k, "Test")
'Print j.Len
 
  
Application.Name = "Hi"
Print Application.Name
 

c = Application.Forms
c.Add(k, "test")
c.Add(k, "test2")
      
k = c("test")
k = Application.Forms("test")
 
 
For Each k In Application.Forms
  Print "z"
Next

              
     /*     


For Each k In c
  Print "z"
Next
  */
  
  
$End

Dim c As New Collection
Dim f As New Form
Dim k As Form
'Dim a As Collection = c
            
k = Null
c.Add(f, "Form1")
c.Add(f, "Form2")
    
'Print c.Len()
'Print a.Len()
 
f = f
'k = c("Form1")
k = c(0)
'c.Remove(0)
k = f

   
'k.Width= 100
'k.Height = 100
'k.Open
      

For Each k In c
  'k = k
  print "z"
Next

   

kbasic.math.kbasic

Print Math.Abs(-1)

kbasic.string.kbasic


CLS

Dim k As String = "What a nice day!"
Print k.Len()
Print Abs(4)

Dim s$ = "Bernd Noetscher's KBasic" 
Print s$.InStr(1, "KBasic")

Dim d = "43.8".Val() 
Print d

Print "Bernd".Asc()
 
Dim src As String
src = "What a nice day"
Print src.Left$(4) 

Print "I'm living in Germany".RIGHT$(7)
 
Print "KBASIC".LCase()

Print "kbasic".UCase()

Print "  bedazzeled  ".Trim$()

Print RTrim("  bedazzeled  "), "]"

Print "  bedazzeled  ".LTrim$()
 
Dim text$ = "The dog bites the cat"
text$ = text$.MID$(10, 1)
PRINT text$

Dim Text1 = "ABCD" : Dim Text2 = "abcd" 
Print Text1.StrComp(Text2, 1) ' result:0.

Dim x As String, y As String
x = "This is a string"
y = "s"
Print x.InStRev(y)
'
Dim g = "Das ist alles was wir brauchen. Fang nochmal von vorne an." As String
Dim pattern As String = "vorne"
Dim replaceBy As String = "hinten"
Print g.Replace(pattern, replaceBy)
 
Dim o = "Mondscheinsonate von Beethoven" As String 
Print o.StrReverse() ' --> nevohteeB nov etanosniehcsdnoM




 

operator.kbasic

  Dim b As Boolean 
  Dim i As Integer 
  
  b = True AndAlso True
  
  If True AndAlso True Then
    Print "AndAlso: then" 
  Else   
    Print "AndAlso: else"
  EndIf
  
  If False OrElse False Then
    Print "OrElse: then" 
  Else   
    Print "OrElse: else"
  EndIf
  
  
  'i = 1 Shl 4
  'i = 1 Shr 4
  'Inc(i)
  'Dec(i)
  'i += 5
  'i -= 7
  'i /= 8
  'i *= 7
  'i |= 7
  'i &= 8
  'i = 1 BITAND 5
  'i = 1 BITOR 5
  'i = 1 BITXOR 5
  'i = 1 BITNOT 5
  i = i + 1
  i = i - 1
  i = i * 1
  i = i / 1
  i = i Mod 1
  
  i = i = 1
  i = i <> 1
  i = i <= 5
  i = i > 5
  i = i < 5
  i = i And 5
  
  i = 1 Or 2
  
  i = Not True 
  
  i = 2 ^ 8
  Print "i: " & i
  
  i = 1 Xor 4
  
  i = 9 \ 6
  i = i Eqv 2
  
  i = i Imp 5
  
  
  
  

sub.kbasic

ENUM dddddddddd
  dd
END ENUM

TYPE ddfddf
  
  d AS BYTE   
END TYPE

PRIVATE SUB t()
  
END SUB

FUNCTION lg
  
END FUNCTION

SUB myMsgbox(BYREF m AS DOUBLE)
'SUB myMsgbox(OPTIONAL m AS INTEGER)
'SUB myMsgbox(a AS STRING, m AS INTEGER)
 m = m + 1
 'DIM w AS INTEGER
 'w = m
 'IF m < 102 THEN myMsgbox(m)

 EXIT SUB

 'DIM s AS STRING
 's = a
End Sub 

Sub test ()
  Dim j As Byte 
  Dim i As Integer 
  i = 12 

'  Catch ( Exception ) 
'    print "catched"
'  Finally
'   print "done"
End Sub 


SUB openWindow()
 DIM i AS INTEGER
 i = 10
END SUB

'sName = "Follow the white rabbit! Neo."

'openWindow()

DIM b AS DOUBLE
b = 100

CONST test = 23

myMsgbox (b)

'msgbox (sName, 1)

PRINT b
'sName = "Ende"

'msgbox ("Lummerland")

sub2.kbasic

Sub test ()
  Dim i As Integer 
  i = 12
  Print "i = " + i
  
End Sub 


test()

sub_2ndcall_array.kbasic

CLS

Sub nadja(b As Variant)
 
  
  Dim i As Integer
     
  For i = LBound(b) To UBound(b)
    Print "b(" + i + ") = " + b(i)     
  Next i
  
  b[7] = 7

End Sub


Dim k(10) As Variant


k[1] = 1

nadja(k)


Print k[7]

sub_2ndcall_byval_byref.kbasic

CLS

Sub nadja(ByRef z As Integer, ByVal h As Double, Optional j As Integer, ParamArray b() As Variant)
     
  Print "z = " + z
  Print "h = " + h
  If Not IsMissing(j) Then
    Print "j = " + j    
  End If
  
  Dim i As Integer
     
  For i = LBound(b) To UBound(b)
    Print "b(" + i + ") = " + b(i)     
  Next i  

End Sub

Dim m = 1 As Integer


'nadja(j := 888, h := 12.2, z := m)
'nadja(m, 12.2)
nadja(m, 12.2, 1, 2, 3, 4, 5, 6)

sub_array.kbasic

CLS

Sub nadja(b() As Variant)

  
  Dim i As Integer
     
  For i = LBound(b) To UBound(b)
    Print "b(" + i + ") = " + b(i)     
  Next i
  
  b[7] = 7

End Sub


Dim k(22)

k[1] = 1

nadja(k)


Print k[7]

sub_byref_array.kbasic

  
CLS
  
Dim n(8) As Long

' fixed size array arguement not allowed
Sub test(byref t() As Long)   
  
  Print t(8)
  t(8) = 88
  
End Sub


Print "--"

n(8) = 99
test(n)
Print "-- end --"

Print n(8)

sub_byref_const.kbasic

CLS
  
Const n = 99 

Sub test(ByRef t As Long)
  
'  Dim i As Integer 
'  i = t
'  Print i
      
  Dim o As Long
  
   
  o = t
    
  Print t
  t = 8
  
End Sub

'Print n

Print "--"
'test(9)
test(n)
Print "-- end --"

Print n

sub_byref_default.kbasic

Type type1
  e1 As Integer   
  e2[80] As String * 50
  
End Type

CLS

Dim n = 8 As Long

Sub test(ByRef t As Long = 99)
    
  Print "t = " + t
  
End Sub

'Print n

Print "--"
test()
test(n)
'test(n + 1)

Print "-- end --"

sub_byref_scalar.kbasic

CLS
  
Dim n = 99 As Long

Sub test(ByRef t As Long)
  
'  Dim i As Integer 
'  i = t
'  Print i
      
  Dim o As Long
  
   
  o = t
    
  Print t
  t = 8
  
End Sub

'Print n

Print "--"
'test(9)
test(n)
Print "-- end --"

Print n

sub_byref_scalar_recursive.kbasic

  
CLS
  
Dim n = 0 As Long

Sub test(ByRef t As Long)
        
  Print t
  
  If t < 4 Then
    t = t + 1
    test(t)
  End If
  
End Sub

'Print n

Print "--"
test(n + 1)
Print "-- end --"

Print n

sub_byref_scalar_recursive2.kbasic



  
CLS
  
Dim n = 1 As Integer

Sub test(ByRef t As Integer)
        
  Print t
  
  If t < 4 Then
    t = t + 1
    test(t)
  End If
  
End Sub

'Print n

Print "--"
test(n)
Print "-- end --"

Print n

sub_byref_scalar_recursive3.kbasic

  
CLS
  
Dim n = 1 As Long

Sub test(ByRef t As Integer) ' different type
          
  Print t
  
  If t < 4 Then
    t = t + 1
    test(t)
  End If
  
End Sub

'Print n

Print "--"
test(n)
Print "-- end --"

Print n

sub_byref_scalar_recursive_shadowing.kbasic

  
CLS
  
Dim n = 0 As Long

Sub test(ByRef t As Long)
        
  Print t
  
  Dim t = 4 ' shadows arguement t
    
  If t < 4 Then
    t = t + 1
    test(t)
  End If
  
End Sub

'Print n

Print "--"
test(n + 1)
Print "-- end --"

Print n

sub_byref_type.kbasic

Type type1
  e1 As Integer   
  e2[80] As String * 100
  
End Type
  
CLS
  
'Dim n = 99 As Long

Sub test(ByRef t As type1)        

'  Dim i As Integer 
'  i = t
'  Print i
      
  Dim o As type1   
  
   
  o.e1 = 111
  
  'o.e1 = t 
  o.e2[0] = t.e2[0] '"don't let me be misunderstood"

  Print "?" + o.e2[0]
 
  
  'Print o.e2[0]
  't = 8
'  t.e2[0] = "rrr"
  o.e2[0] = "rrr"
  t = o
   
  
  'Print t
  
End Sub

Dim k As type1
  
k.e2[0] = "hello"
  
'Print n
'test(9)
Print "--"

test(k)
Print "-- end --"
Print "!" + k.e2[0]
Print "(" + k.e1

'Print n

sub_byref_type2.kbasic

Type t
  i As Integer
  m As Double
End Type

Sub kk()
  
  Dim l As t
  
  l.i = 9
  l.m = 12
  hh (l.m)
  Print l.m
  
End Sub

Sub hh(ByRef d As Double)
  d = 99
End Sub


kk

sub_byref_typeelement.kbasic

Type type1
  e1 As Integer   
  e2[80] As String * 100
  e3[20] As Double
  
End Type
  
CLS
  
Sub test(ByRef t As String)
  
   t = "99999"
  
End Sub

'Sub test2(ByRef t As Double)
'    
'   t = 99999
'  
'End Sub

Dim k As type1
  

k.e2[0] = "hello"
'k.e3[0] = 1111


Print "--"

Print k.e2[0]
'Print k.e3[0]


test(k.e2[0])
'test2(k.e3[0])

Print "-- end --"

Print k.e2[0]
'Print k.e3[0]

sub_byval_default.kbasic



CLS 
  
Dim n = 8 As Long

Sub test(ByVal t As Long = 99)         
  
  Print "t = " + t
  
End Sub

'Print n

Print "--"
test()
test(n)
'test(n + 1)

Print "-- end --"

sub_byval_scalar.kbasic

  
CLS
  
Dim n = 99 As Long

Sub test(ByVal t As Long)
  
'  Dim i As Integer 
'  i = t
'  Print i
      
  Dim o As Long
  
   
  o = t
    
  Print t
  t = 8
  
End Sub

'Print n

Print "--"
'test(9)
test(n)
Print "-- end --"

Print n

sub_byval_scalar_recursive.kbasic

  
CLS
  
Dim n = 0 As Long

Sub test(ByVal t As Long)
      
  Print t
  
  If t < 4 Then
    test(t + 1)
  End If
  
End Sub

'Print n

Print "--"
test(n + 1)
Print "-- end --"

Print n

sub_object_passing.kbasic

Class tester
  Dim i
End Class

Sub tt(z As tester)
    
  Dim a As tester
  
  a = z
  
  Print a.i
  
End Sub



Dim r As tester
Dim b As tester
 
r = New tester()

r.i = 99

b = r

tt(b)

sub_2ndcall_optional_ismissing.kbasic

CLS

Sub nadja(ByRef z As Integer, ByVal h As Double, Optional j As Integer, ParamArray b() As Variant)
     
  Print "z = " + z
  Print "h = " + h
  If Not IsMissing(j) Then
    Print "j = " + j    
  End If
  
  Dim i As Integer
     
  For i = LBound(b) To UBound(b)
    Print "b(" + i + ") = " + b(i)     
  Next i  

End Sub

Dim m = 1 As Integer


'nadja(j := 888, h := 12.2, z := m)

nadja(m, 12.2)
'nadja(m, 12.2, 1, 2, 3, 4, 5, 6)

sub_2ndcall_paramarray.kbasic

CLS

Sub nadja(ByRef z As Integer, ByVal h As Double, Optional j As Integer, ParamArray b() As Variant)
     
  Print "z = " + z
  Print "h = " + h
  If Not IsMissing(j) Then
    Print "j = " + j    
  End If
  
  Dim i As Integer
     
  For i = LBound(b) To UBound(b)
    Print "b(" + i + ") = " + b(i)     
  Next i  

End Sub

Dim m = 1 As Integer


nadja(j := 33, h := 12.2, z := m, b[12] := "12 hello", b[5] := 555, b[7] := "7 ho")

'nadja(m, 12.2, 1, 2, 3, 4, 5, 6)
'nadja(m, 12.2)

'nadja(m, 12.2, /*1, 2, 3,*/ 4, 5, 6)

sub_optional_ismissing.kbasic

Type type1
  e1 As Integer   
  e2[80] As String * 100
  
End Type

CLS 
  
Dim n = 5 As Long

Sub test(Optional ByVal t As Long)
                   
  If Not IsMissing(t) Then
    Print "t = " + t
  Else
    Print "t is missing"     
  End If
  
  'Print "t? = " + t  ' produce ismissing error
  
End Sub

Print "--"
test()
test(n)
'test(n + 1)

Print "-- end --"

sub_paramarray.kbasic

CLS

Sub nadja(ParamArray b() As Variant)  
  
  Dim i As Integer
     
  For i = LBound(b) To UBound(b)
    Print "b(" + i + ") = " + b(i)     
  Next i  

End Sub

nadja(1, 2, 3, 4, 5, 6)
'nadja()

boolean.kbasic

Dim b As Boolean

b = True
Print b

b = False
Print b

byte.kbasic

Dim b As Byte

b = 1
b = 99
b = 36

Print b

double.kbasic

Dim b As Double

b = 12.23
b = 66.66

Print b

integer.kbasic

Dim b As Integer

b = 1
b = 99
b = 36

Print b

long.kbasic

Dim b As Long

b = 1
b = 99
b = 36

Print b

object.kbasic

 

CLASS rumba

  DIM k
  
  PUBLIC SUB dance_rumba()
    Print "rumba!!!" 
  END SUB

END CLASS


DIM m AS NEW rumba

m.dance_rumba() 

short.kbasic

Dim b As Short

b = 1
b = 99
b = 36

Print b

single.kbasic

Dim b As Single

b = 1
b = 99
b = 36

Print b

string.kbasic

Dim s As String

s = "This is the longest name of a village in the world somewhere in Wales: Llanfairpwllgwyngyllgogerychwyrndrobwllllantysiliogogogoch"

Print s

currency.kbasic

Dim i As Currency

'i = 23.57@ + 78.8989
'i = 40.13103
'i = 2 * i

'i = 11.11@
'i = 111 / i

'i = 4
'i = 1 Or i
 
 
'i = 4
'Print 4 = i
 
'i = 4.5@
'Print 4 ^ i
'Print 4 ^ 4

'Dim k = "price " + 24.95@
'Print k

i = 45.67@
Print i
 

date.kbasic

Dim m As Date
m = #2006-12-12 4:4:44#
Print m
 
  
  
         

variant.kbasic

Dim b As Variant

b = 1
Print b

b = "Slow down you creazy child...When will you realize Vienna waits for you?"
Print b

b = 36.657
Print b

bernd1.kbasic

' IMPORTANT! select 'View/Browser' after running this example

ECHO "<HTML>"
ECHO "<HEAD>"
ECHO "<TITLE>Web pages on the fly</TITLE>"
ECHO "</HEAD>"
ECHO "<BODY>"
ECHO "<TABLE WIDTH=100% BORDER=1>"
ECHO "<TR>"
ECHO "<TD>"
ECHO "Hello World! Dynamically created HTML files...<hr><br>"

FOR i AS INTEGER = 1 TO 50
  
  ECHO "<h" + i + ">"
  /*
  SELECT CASE i
    CASE 10
    '  ECHO "<b>"
        
    CASE 20
    '  ECHO "<i>"
    CASE 30
     ' ECHO "<u>"

   CASE ELSE
    
  END SELECT*/
  
  
  ECHO "<font color='#" + i * 2 + i + i + "'>"    
  ECHO "i=" + i + "<br>"

/*
  SELECT CASE i
    CASE 10
    '  ECHO "</b>"
        
    CASE 20
    '  ECHO "</i>"
    CASE 30
     ' ECHO "</u>"

   CASE ELSE
    
  END SELECT  */
  
  ECHO "</h" + i + ">"
NEXT

ECHO "</TD>"
ECHO "</TR>"
ECHO "</TABLE>"
ECHO "</BODY>"
ECHO "</HTML>"


/*
ECHO "_
<HTML>_
"<HEAD>"_
"<TITLE>Web pages on the fly</TITLE>"_
"</HEAD>"_
"<BODY>"_
"<TABLE WIDTH=100% BORDER=0>"_
"<TR>"_
"<TD>"_
"Hello World! Dynamically created HTML files..."_
"</TD>"_
"</TR>"_
"</TABLE>"_
"</BODY>"_
"</HTML>"


*/

bernd2.kbasic

DIM MX AS SINGLE
DIM value[99] AS SINGLE

RANDOMIZE TIMER
 
FOR i AS INTEGER = 0 TO 99
   
  value[i] = RND + 1
   
NEXT

MX = 0.008
 
FOR i = 1 TO 99 : IF MX < value(i) THEN MX = value(i) ELSE MX = MX : NEXT
           

bernd3.kbasic

DIM l AS INTEGER = 3147483647
END

DIM lVar AS INTEGER     'Long
Dim sVar As String

Dim dVar As Single 'Double
DIM dVar1 AS SINGLE          'Double

   
lVar = 123456789
dVar1 = lVar * 1.0
PRINT dVar1
 
END
 
sVar = .123456789
dVar = VAL(sVar)
  
CLS
Print lVar
Print sVar
Print dVar
PRINT dVar1
Print
Print 123456789 * 1.0
      
      
      


 

forum1.kbasic

Dim a as integer
Dim b as integer

'a = InputBox("text", "text1")
print a
b = a/2
print b

jwwtl1.kbasic



CLS
Color(4, 9)
Dim i%, n%, t$, ans
n = 37
Dim guess_title, guess_text, guess_default, guess_
guess_title = "Made By: jWwtL / xJiX"
guess_text = "Please enter a number between 1 and 100"
guess_default = "1"
t = "%"
For i = 0 To 100 Step 10
Print "Loading [" & i, t, "] Complete"
CLS
Next
MsgBox("Welcome to the guessing game! This is just a simple number guessing game.", , "Guess The # | InfamouS Inc., 2006")

Sub GuessTry
guess_ = InputBox(guess_text, guess_title, guess_default)
ans = Val(guess_)
End Sub

 
Call GuessTry()
Dim b As Boolean = True
  
While b
  
  If ans > n Then
    Print "I am so Sorry, but you need to guess lower."
    'Call GuessTry()
    GuessTry()
  End If
  

  If ans < n Then
    Print "I am Sorry, but you need to guess higher."
    'Call GuessTry()
    GuessTry()
  End If
     
  b = False
    
End While


Print "That is the Correct Answer!"




kaiser1.kbasic

DIM i As Integer
machs:
CLS
PRINT
COLOR 12
PRINT "kb file test"
PRINT
COLOR 7
FOR i = 1 TO 12
PRINT "MAC mit KB ";i
NEXT i
INPUT " weiter mit 1, beenden mit 0 ";i
IF i = 1 THEN machs
END

kaiser2.kbasic

REM math testing

REM Fehler:
REM: weder der richtige Wert a oder b wird bei der Rechnung nicht erkannt
REM a wird als a(12) und b als b(22) genommen, 
REM obwohl a(12), b(22) nicht dimensioniert sind
Rem Division und Potenzierung gehen nicht


/*
1. Problem: DIM a(10), b(10), c, w, r AS INTEGER 

--> Variablendeklaration funktioniert wie in KBasic definiert, siehe pcode

000906: DIM              &H40FD8A0:: r AS INTEGER ( typesize = 4 ) ( allsize = 4 )
000930: DIM              &H40FD8A0:: w AS VARIANT ( typesize = 40 ) ( allsize = 40 )
000954: DIM              &H40FD8A0:: c AS VARIANT ( typesize = 40 ) ( allsize = 40 )
000978: DIM              &H40FD8A0:: b ( 0 TO 10 ) AS VARIANT ( typesize = 40 ) ( allsize = 440 )
001002: Dim &H40FD8A0 : : a(0 To 10) As Variant(typesize = 40)(
*/



Dim a, b(22) As Integer, c, g, w, r As Integer

DIM d(10), e(10), f(10) AS VARIANT
Dim test As String


start:
CLS
PRINT "Math testing 29-03-06 mit a= ";a;
Print " und b= "; b(0) : Print
Input " b(0) = "; b(0)

/*
' 2. Problem:  das hier geht nicht: Input " b = ";b
Rem vorher manuell eingegeben funktioniert es:
--> die Variable b wird als Variant definiert, da kein Typ angegeben wird.Input
kein aber keine Varianttypen aktzeptieren.Hier haben Sie einen kleinen Bug entdeckt,
der jetzt korrigiert wurde.Der Parser wird eine Fehlermeldung ausgeben, wenn versucht wird
Input mit Variant zu kombinieren.Verwenden Sie statt Variant Integer : Dim b As Integer

*/


/*
' 3. Problem:  Warum wird a(12) akzeptiert, obwohl gar nicht dimensioniert und obwohl
--- > Variablen, die ohne Datentyp angegeben werden haben automatisch ein ARRAY der Gr öße 11(0 - 10)

Hier ist ein kritischer Bug aufgetaucht, obwohl der Parser richtig erkennt, das
die Variable ein ARRAY hat, wei ß der Interpreter davon nichts.Habe den Fehler
korrigiert.Sie k önnen den Fehler vorerst umgehen, indem Sie immer den Datentyp
bei einer Variablen deklaration angeben.
z.B. DIM i AS VARIANT statt DIM i

*/




/*
' 4. Problem:  Arrayformation --> funktioniert, war wohl Folgefehler wegen Deklaration der Variablen als Variant
*/
DIM v(40) AS INTEGER

FOR i AS INTEGER = 1 TO 40
  v(i) = 23
  v(i) = 23.4353
  'v(i) = v(i) * i
NEXT

DIM t(40)

FOR i = 1 TO 40
  t(i) = 23

NEXT


DIM s

FOR i = 1 TO 10
  s(i) = 23
  print t(i)
NEXT

Rem: keine Arrayformation akzeptierte irgendeine einfache Rechnung wie
Rem for i=1 To 100 : sum = sum+a(i) : Next i mit natürlich DIM a(101) und
Rem vorhandenen a(1) bis a(100) Daten egal ob Ganzzahlen oder zB 22.5564



/*
' 5. Problem:  Berechnung --> funktioniert, war wohl Folgefehler wegen Deklaration der Variablen als Variant
*/
Dim x=10, y=2.8, z
Print
PRINT "add, mult, (div, sqr, pot) mit x und y zu z "



 Print
z = x + y : PRINT "z=x+y : "; z

Print

INPUT "weiter mit ret, nochmal mit r oder g, Ende  mit / : "; test
IF test = "r" THEN CLS : GOTO start
If test = "g" Then CLS : GOTO start
IF test = "/" THEN END

weiter:
PRINT
CLS
PRINT                   " zu x = ";x; : Print "und y = ";y: Print
z = x + y :       PRINT "         z=x+y : "; z
z = x * y :       PRINT "         z=x*y : "; z
z = x - y :       PRINT "         z=x-y : "; z
z = x*x*x*x-100 : Print " z=x*x*x*x-100 : ";z
z = x / y : PRINT " z=x/y : "; z
z = x \ y : PRINT " z=x\y : "; z
z = x ^ y : PRINT " z=x^y : "; z


Print : Input" return ", test

End

kaiser3.kbasic

DIM i AS INTEGER
DIM x(10) AS INTEGER
DIM w(10) AS long

COLOR(,0)
CLS
SCREEN 12
PRINT "For graph lines changing data..."


'PRINT CINT(12.49), CINT(12.51)


w(1) = 17.3
w(2) = 99.99999
w(3) = 122.0987
w(4) = 600.09876543
w(5) = 12.99876

FOR i = 1 TO 5
  Input" Wert ";w(i)
  PRINT "  Raw data                     ";w(i); i
  NEXT i
  
  
Sleep 2

REM 
PRINT
For i = 1 TO 5
x(i) = CINT(w(i))
NEXT i
FOR i = 1 TO 5
  PRINT " CINT und Ausgangsdaten x(i) & w(i) = "; x(i);"    ";w(i)
  NEXT i
Sleep 3
COLOR(6,7)
PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT
PRINT 
PRINT"             blau   (3): 0,10 bis 0,730 und &HFF00"
PRINT"             rot    (12): 0,0 bis 1010,735"
PRINT"             violett(5): 0,600 bis 1010,600"
PRINT"             grün  (10): 32,605 - 700,605"
LINE(0,602)-(1005,600), 5, , &HFF00 
LINE(0,10) - (0,730), 3, , &HFF00 
LINE(0, 0) - (1010, 735), 12, , &HFF00
LINE (32, 605)-(701, 605), 10, , &HFF00 
LINE(32, 10) - (32, 730), 11, , &HFF00 
LINE(100, 100) - (980, 730), 13, , &HFF00
SLEEP 1
Print"             parallele Farblinien (return) "
FOR i = 2 TO 16  
  LINE(50, 50 + 10 * i) - (600, 50 + 10 * i), i, , &HFF00
NEXT i  
LINE(32, 10) - (32, 730), 3, , &HFF00
PRINT "Zusatzlinie weiss :"
LINE(107, 2002) - (1010, 20), 7, , &HFF00
PRINT : PRINT " jetzt mit CINT..."
Sleep 2
FOR i = 1 TO 5
  LINE(300, 10) - (CINT(w(i)), 500), 5, , &HFF00
  Next i
END

kaiser4.kbasic


DIM i AS INTEGER
DIM H AS STRING

DIM SU AS VARIANT
DIM PRO AS VARIANT
DIM w(10) As VARIANT

start:
CLS
LOCATE 10, 20
Print "Mini-Rechnen mit KBasic; hier Prozentwerte"
LOCATE 13, 4
Print "eingegebene Werte : "
Print
w(1) = 10.09876
w(2) = 23.99876
w(3) = 18.7654
w(4) = w(1) + w(2) + w(3)
w(5) = 100 * w(1) / w(4)
w(6) = 100 * w(2) / w(4)
w(7) = 100 * w(3) / w(4)
w(8) = w(5) + w(6) + w(7)

Print "   Wert 1 ="; w(1); "   2 ="; w(2); "   3 ="; w(3)

Print
REM Prozentrechnung
SU = 0
For i = 1 TO 3
SU = SU + w(i)
Next i
w(4) = SU
Print: Print
Print "   Summe Wert 1 bis 3 = "; SU
Print
For i = 1 TO 3
  PRO = 100 * w(i) / SU
  Print ;"   ";i;". Prozentwert =  "; PRO
Next i
SU = 0
For i = 5 TO 7
  SU = SU + w(i)
Next i
Print
Print "    Prozentsumme =  "; SU
Print
Input"    weiter mit ret, stop mit (/)";H
IF H = "" THEN GOTO start
End

maxminhand_auto.kbasic

REM dim dependant trouble with minimum maximum claculation (REK -> BN)

DIM i AS INTEGER
DIM W(20) AS DOUBLE 'results look different
'DIM W(20) AS SINGLE
DIM MXS AS SINGLE
DIM MNS AS SINGLE
DIM MXD AS DOUBLE
DIM MND AS DOUBLE
DIM MAHD AS DOUBLE
DIM MAHS AS SINGLE
DIM MNHD AS SINGLE

werte:
CLS 
W(1) = 11
W(2) = 4
W(3) = 5
W(4) = 0.1
W(5) = 12.0988
 
MXD = MAX(W(1), W(5))
MXS = MAX(W(1), W(5))
MND = MIN(W(1), W(5))
MNS = MIN(W(1), W(5))

MAHD = 0


FOR i = 1 TO 5
  IF W(i) > MAHD THEN MAHD = W(i)
NEXT i

MAHS = 0
FOR i = 1 TO 5
  IF W(i) > MAHS THEN MAHS = W(i)
NEXT i

MNHD = 1000
FOR i = 1 TO 5
  IF W(i) < MNHD THEN MNHD = W(i)
NEXT i
  
  FOR i = 1 TO 5
    PRINT "data used : "; W(i)
    NEXT i
    PRINT
  PRINT"-----------" 
  PRINT "max double by MAX       = "; MXD
  PRINT "max single by MAX       = "; MXS
  PRINT
  PRINT "max double by FORIFNEXT = "; MAHD
  PRINT "max single by FORIFNEXT = "; MAHS
  
  PRINT
  PRINT "min double by MIN       = "; MND
  PRINT "min single by FORIFNEXT = "; MNHD
  
  END

multiarray.kbasic

CLS
 
DIM Dots(64, 64) AS INTEGER
   
DIM Repeats AS INTEGER
DIM RowIndex AS INTEGER
DIM ColIndex AS INTEGER
DIM AddressValue AS INTEGER
DIM k AS INTEGER
    
   
 
 
FOR Repeats = 1 TO 7
   
  FOR RowIndex = 1 TO 4
       
    FOR ColIndex = 1 TO 4
      
'    ColIndex = ColIndex
'    
'    ITERATE FOR
    
    AddressValue = Dots(RowIndex, ColIndex)
     
    PRINT " " + RowIndex + ")" + ColIndex;
'    IF AddressValue > 0 THEN
'      PRINT "" + RowIndex + "~" + ColIndex
'    END IF
    
   ' Dots(RowIndex, ColIndex) = AddressValue + 1
             
   
'    IF AddressValue = 0 THEN
'        
'    END IF
 
    
    'AddressValue = 5
   

    SELECT CASE AddressValue
         
      CASE IS < 8

      Dots(RowIndex, ColIndex) = AddressValue + 1
 '     k = ColIndex
'      Dots(RowIndex, ColIndex) = Dots(RowIndex, ColIndex) + 1

           
'      CASE ELSE
'        Dots(RowIndex, ColIndex) = 0
 
        
    END SELECT
    AddressValue = 99
    AddressValue = AddressValue
      
    NEXT 'ColIndex
     
  NEXT' RowIndex
  
NEXT ' Repeats
   
 
 
FOR RowIndex = 1 TO 4
   
  FOR ColIndex = 1 TO 4
     
  PRINT "" + RowIndex + "/" + ColIndex + "=" + Dots(RowIndex, ColIndex)
  
  NEXT ColIndex
  
NEXT RowIndex

NO1.EXP

 43 
 212 
 0 
 841130 
 2.74536E+07 
 0 
 243.6 
 0 
 16706 
 507726 
 0 
 311.1 
 0 
 466534.7 
 2.570066E+07 
 0 
 411.2 
 0 
 63846.21 
 5870879 
 0 
 449.5 
 0 
 192.8027 
 33925.13 
 0 
 488.4 
 0 
 76526.43 
 6452184 
 0 
 521.7 
 0 
 1357.741 
 172868 
 0 
 696.8 
 0 
 16718.12 
 1727171 
 0 
 773.8 
 0 
 15381.76 
 1316250 
 0 
 897.2 
 0 
 356 
 38063 
 0 
 995.8 
 0 
 3408.5 
 304003.5 
 0 
 1015.5 
 0 
 896 
 70460 
 0 
 1048.3 
 0 
 1518 
 137371 
 0 
 1093.9 
 0 
 3961.5 
 298391.5 
 0 
 1221 
 0 
 1945.5 
 155990.5 
 0 
 1344.2 
 0 
 1395 
 81320 
 0 
 1399.5 
 0 
 1128 
 68100 
 0 
 1533 
 0 
 2212.5 
 165886.5 
 0 
 1548.8 
 0 
 69.5 
 659 
 0 
 1579.7 
 0 
 79.5 
 1016.5 
 0 
 1586.8 
 0 
 146.5 
 7149.5 
 0 
 1650.6 
 0 
 642.5 
 40644.5 
 0 
 1678.7 
 0 
 251 
 3510 
 0 
 1753.6 
 0 
 84 
 994 
 0 
 1765 
 0 
 90 
 1141 
 0 
 1792.9 
 0 
 984 
 59755 
 0 
 1846.1 
 0 
 175 
 3745 
 0 
 1875.1 
 0 
 222.5 
 2449 
 0 
 1910.2 
 0 
 149.5 
 1049.5 
 0 
 1949.3 
 0 
 236.5 
 884.5 
 0 
 1952.1 
 0 
 72 
 568 
 0 
 1995.3 
 0 
 219.5 
 1846 
 0 
 2019 
 0 
 346.5 
 9107.5 
 0 
 2143.9 
 0 
 338.5 
 5376.5 
 0 
 2164.1 
 0 
 150.5 
 1466 
 0 
 2185.6 
 0 
 542 
 6034 
 0 
 2223.2 
 0 
 1043 
 20348 
 0 
 2232.8 
 0 
 110 
 536 
 0 
 2261.5 
 0 
 317.5 
 3702.5 
 0 
 2287.3 
 0 
 482.5 
 7418 
 0 
 2337.8 
 0 
 82.5 
 1468.5 
 0 
 2352.9 
 0 
 102.5 
 1032 
 0 
 2362 
 0 
 40.5 
 650.5 
 0 
;rek-rc;;IfC;;(Channel 1);G-methanol2;EGTm2.DAT;00053424.EXP;rek-rc;;;;

NO2.EXP

 76 
 213.1 
 0 
 1301339 
 9.98069E+07 
 0 
 245.1 
 0 
 1301027 
 8.1088E+07 
 0 
 310.2 
 0 
 1212224 
 6.639252E+07 
 0 
 410.3 
 0 
 135295.5 
 1.237894E+07 
 0 
 433.9  
;gekuerzt;10_05_06;rek-rc;08/30/00;IfC;meoh3;(Channel 1);G-methanol2;C:\CHROM-CARD FOR TRACE\DATA\NATURALGAS\NLM3.DAT;08/30/00.EXP;rek-rc;;

serge1.kbasic

CLS

Dim s As String
Dim count As Integer

s = ""

Do
  s = Inkey$
  count = count + 1 
Loop While s = ""
Print count; Asc(s)

End

count = 0

Do
  s = "0"
  count = count + 1 
Loop While Inkey$ = ""
Print count; Asc(s)

End

serge2.kbasic

Function test3() As Integer
  Dim i As Integer
  i = 1234
  Return i 
End Function

CLS

Print test3()
End

unden1.kbasic

rem Option OldBasic
REM Option VeryOldBasic
CLS
DIM dt AS SINGLE
dt = 1.0 / 1000.0
PRINT dt
DIM dx AS SINGLE
dx = 180.0 / 1000.0
PRINT dx
DIM dy AS SINGLE
dy = 1.0 / 100000.0
PRINT dy
DIM da AS SINGLE
da = 1.0 / 10.0
PRINT da
DIM db AS SINGLE
db = 3.0 / 4.0
PRINT db
DIM dz AS SINGLE
dz = dt + dx + dy + da + db
PRINT dz

val_problem.kbasic

REM val_problem.kbasic
REM to Bernd: note, this is only the read-in-part of a larger piece of code
REM which changes one ASCII data portion into a line graphics.#
REM but these parts are cutted off as they are not necessary to show the
REM VAL() problem.
REM two data sets are to be used:  YES1.EXP; YES2.EXP   and   NO1.EXP: NO2.EXP
REM I have hundreds other ones and those copied and treated many ways, but
REM probably not the correct way to make the data VAL changeable.
 
DIM w(900) AS DOUBLE : REM Rohwerte des ASCII EXPORT files ausser TEXT
DIM W AS STRING : REM Daten-Einlesewert
DIM t(800) AS DOUBLE, b(800) AS DOUBLE, h(800) AS DOUBLE, a(800) AS DOUBLE
REM t=Zeit, b=Breite, h=Höhe, a=Fläche  
DIM x(800) AS DOUBLE : REM x = Index
REM from on here other DIMS are used and necessary for the larger code part
DIM SA AS DOUBLE
DIM pt(100) AS DOUBLE : REM pt = Prozent Fläche
 
 
DIM MX AS SINGLE
REM max Fläche
DIM MXB AS SINGLE
REM max and min of Breite

DIM MIB AS DOUBLE
REM Korr Faktor X-Achse (t-Werte)
DIM FX AS DOUBLE
REM Korr Faktor Y-Achse (a-Werte)
DIM FY AS DOUBLE
DIM i AS INTEGER
DIM DZ AS INTEGER : REM Datenzahl Gesamt
DIM z AS INTEGER
DIM Q AS INTEGER
DIM L AS INTEGER
DIM X1 AS INTEGER
DIM Y1 AS SINGLE
DIM Y0 AS INTEGER
DIM Y2 AS INTEGER
DIM Y3 AS INTEGER
DIM TXT1 AS STRING : REM Info-Text im file
DIM FN AS STRING : REM file Name

start: 
COLOR(, 0)
CLS 
LOCATE 5, 10

PRINT "data input from an EXPORT file"
i = 0
LOCATE 30, 10
INPUT "Enter file name. End of program with (/) "; FN
IF FN = "/" THEN END
REM IF RIGHT(FN, 4) <> ".EXP" THEN FN = FN + ".EXP" ### NOT USED here
  
'OPEN FN FOR INPUT AS #1
OPEN "c:\kbasic14/examples/kbasic/user/YES1.exp" FOR INPUT AS #1
DO WHILE NOT EOF(1)
  i = i + 1
  LINE INPUT #1, W
  w(i) = VAL(TRIM(W))
  L = LEN(W)
 
  
  IF L >= 20 THEN TXT1 = W
   
  
  IF i MOD 20 = 0 THEN SLEEP

  'IF w(i) = 0 THEN
    PRINT i, ". Wert eingelesen= "; W; "VAL() umgewandelt = ", w(i)
  'ENDIF

  PRINT ".",
LOOP
CLOSE #1
PRINT : PRINT "------------------------------------------"
PRINT "file name used = "; FN
INPUT " one data part represents time values; see them: (RET) ", W
CLS
 
REM Ende einlesen 
DZ = i 
PRINT
PRINT "Datenzahl = "; DZ
z = 0
  FOR i = 2 TO DZ STEP 5
    z = z + 1
    t(z) = w(i)
    PRINT "w(", i, "), tms(", z, ") "; w(i), " time = ", t(z)
NEXT i
PRINT "-----------------------------"
INPUT " restarting program (R) or stop (/) "; W
IF (W = "R" OR W = "r") THEN GOTO start
END
 

1mal1.kbasic

OPTION VERYOLDBASIC

' gibt das 1 mal 1 aus

FOR i% = 1 TO 9

  FOR x% = 1 TO 9

    n% = i% * x%
    PRINT ""+ x% + " * " + i% + "=" + n%
    
  NEXT

NEXT

3d.kbasic

  Type Point3D
      Coord(1 To 4) As Single ' Original coordinates.
      Trans(1 To 4) As Single ' Translated coordinates.
  End Type
  
  
  Const Xmin = 0
  Const Xmax = 1
  Const Ymin = 0
  Const Ymax = 3
  
  Dim Points(Xmin To Xmax, Ymin To Ymax) As Point3D
  
  
  
  Dim T(1 To 4, 1 To 4) As Single
  Dim T1(1 To 4, 1 To 4) As Single
  Dim T2(1 To 4, 1 To 4) As Single
  
  
  Dim EyeX As Single
  Dim EyeY As Single
  Dim EyeZ As Single
  
  Dim Axes(1 To 3) As Point3D
  
  
  ' ********************************************************
  ' Perform vector-matrix multiplication. Set Rpt = Ppt * A.
  ' ********************************************************
  Sub VectorMatrixMult1(x As Integer, y As Integer)
    
  Dim i As Integer
  Dim j As Integer
  Dim value As Single
     
      For i = 1 To 4
          value = 0
          For j = 1 To 4
              value = value + Points(x, y).Coord( j ) * T(j, i)                            
          Next j
          Points(x, y).Trans(i) = value
      Next i
      
  
      ' Renormalize the point.
      ' Note that value still holds Rpt(4).
      Points(x, y).Trans(1) = Points(x, y).Trans(1) / value
      Points(x, y).Trans(2) = Points(x, y).Trans(2) / value
      Points(x, y).Trans(3) = Points(x, y).Trans(3) / value
      Points(x, y).Trans(4) = 1
  End Sub
  
  
  ' ********************************************************
  ' Return the angle with tangent y / x.
  ' ********************************************************
  Function Atan(x As Single, y As Single)
  Const PI = 3.14159
  
  Dim angle As Single
  
      If x = 0 Then
          angle = 0
      Else
          angle = Atn(y / x)
          If x < 0 Then angle = PI + angle
      End If
      
      Return angle
      
  End Function
  
  ' ********************************************************
  ' Make M an identity matrix.
  ' ********************************************************
  Sub MakeIdentity1()
  Dim i As Integer
  Dim j As Integer
  
      For i = 1 To 4
          For j = 1 To 4
              If i = j Then
                  T1(i, j) = 1
              Else
                  T1(i, j) = 0
              End If
          Next j
      Next i
  End Sub
  
  Sub MakeIdentity2()
  Dim i As Integer
  Dim j As Integer
  
      For i = 1 To 4
          For j = 1 To 4
              If i = j Then
                  T2(i, j) = 1
              Else
                  T2(i, j) = 0
              End If
          Next j
      Next i
  End Sub
  
  ' ********************************************************
  ' Perform matrix-matrix multiplication. Set R = A * B.
  ' ********************************************************
  Sub MatrixMatrixMult()
  Dim i As Integer
  Dim j As Integer
  Dim k As Integer
  Dim value As Single
  
      For i = 1 To 4
          For j = 1 To 4
              value = 0
              For k = 1 To 4
                  value = value + T1(i, k) * T2(k, j)
              Next k
              T(i, j) = value
          Next j
      Next i
  End Sub
  
  
  
  ' ********************************************************
  ' Calculate the transformation matrix.
  ' ********************************************************
  Private Sub CalculateTransformation()
  
  Dim r1 As Single
  Dim r2 As Single
  Dim ctheta As Single
  Dim stheta As Single
  Dim cphi As Single
  Dim sphi As Single
  
      ' Rotate around the Z axis so the
      ' eye lies in the Y-Z plane.
      r1 = Sqr(EyeX * EyeX + EyeY * EyeY)
      stheta = EyeX / r1
      ctheta = EyeY / r1
      MakeIdentity1
      T1(1, 1) = ctheta
      T1(1, 2) = stheta
      T1(2, 1) = -stheta
      T1(2, 2) = ctheta
  
      ' Rotate around the X axis so the
      ' eye lies in the Z axis.
      r2 = Sqr(EyeX * EyeX + EyeY * EyeY + EyeZ * EyeZ)
      sphi = -r1 / r2
      cphi = -EyeZ / r2
      MakeIdentity2
      T2(2, 2) = cphi
      T2(2, 3) = sphi
      T2(3, 2) = -sphi
      T2(3, 3) = cphi
  
      ' Project along the Z axis. (Actually we do nothing
      ' here. We just ignore the Z coordinate when drawing.)
  
      ' Combine the transformations.
      MatrixMatrixMult
  End Sub
  
  ' ********************************************************
  ' Draw the surface.
  ' ********************************************************
  Private Sub DrawSurface()
  Dim x As Integer
  Dim y As Integer
  
      
  
      ' Calculate the transformation matrix.
      CalculateTransformation
      
  
     ' Transform the axes.
      For x = 1 To 3
          VectorMatrixMult2 x
      Next x
      
      
      ' Apply the transformation matrix to the points.
      For x = Xmin To Xmax
          
          For y = Ymin To Ymax
              VectorMatrixMult1 x, y
          Next y
      Next x
  
      Dim CurrentX As Integer, CurrentY As Integer
      
      CLS
      Print "Rotate with a, d, w or x     ESC = exit"
  
      ' draw the axes.
      For x = 1 To 3
          Line(512, 384) - (512 + Axes(x).Trans(1) * 30, 384 + Axes(x).Trans(2) * 30), 4        
      Next x
      
  
      Line(512 + Points(0, 0).Trans(1) * 20, 384 + Points(0, 0).Trans(2) * 20) - (512 + Points(0, 1).Trans(1) * 20, 384 + Points(0, 1).Trans(2) * 20), 15
      Line(512 + Points(0, 1).Trans(1) * 20, 384 + Points(0, 1).Trans(2) * 20) - (512 + Points(0, 2).Trans(1) * 20, 384 + Points(0, 2).Trans(2) * 20), 15
      Line(512 + Points(0, 2).Trans(1) * 20, 384 + Points(0, 2).Trans(2) * 20) - (512 + Points(0, 3).Trans(1) * 20, 384 + Points(0, 3).Trans(2) * 20), 15
      Line(512 + Points(0, 3).Trans(1) * 20, 384 + Points(0, 3).Trans(2) * 20) - (512 + Points(0, 0).Trans(1) * 20, 384 + Points(0, 0).Trans(2) * 20), 15
  
      Line(512 + Points(1, 0).Trans(1) * 20, 384 + Points(1, 0).Trans(2) * 20) - (512 + Points(1, 1).Trans(1) * 20, 384 + Points(1, 1).Trans(2) * 20), 10
      Line(512 + Points(1, 1).Trans(1) * 20, 384 + Points(1, 1).Trans(2) * 20) - (512 + Points(1, 2).Trans(1) * 20, 384 + Points(1, 2).Trans(2) * 20), 10
      Line(512 + Points(1, 2).Trans(1) * 20, 384 + Points(1, 2).Trans(2) * 20) - (512 + Points(1, 3).Trans(1) * 20, 384 + Points(1, 3).Trans(2) * 20), 10
      Line(512 + Points(1, 3).Trans(1) * 20, 384 + Points(1, 3).Trans(2) * 20) - (512 + Points(1, 0).Trans(1) * 20, 384 + Points(1, 0).Trans(2) * 20), 10
    
      Line(512 + Points(0, 0).Trans(1) * 20, 384 + Points(0, 0).Trans(2) * 20) - (512 + Points(1, 0).Trans(1) * 20, 384 + Points(1, 0).Trans(2) * 20), 15
      Line(512 + Points(0, 1).Trans(1) * 20, 384 + Points(0, 1).Trans(2) * 20) - (512 + Points(1, 1).Trans(1) * 20, 384 + Points(1, 1).Trans(2) * 20), 15
      Line(512 + Points(0, 3).Trans(1) * 20, 384 + Points(0, 3).Trans(2) * 20) - (512 + Points(1, 3).Trans(1) * 20, 384 + Points(1, 3).Trans(2) * 20), 15
      Line(512 + Points(0, 2).Trans(1) * 20, 384 + Points(0, 2).Trans(2) * 20) - (512 + Points(1, 2).Trans(1) * 20, 384 + Points(1, 2).Trans(2) * 20), 15
    
    
      /*
      ' Draw lines parallel to the X axis.
      'ForeColor = RGB(0, 0, 0)
      For x = Xmin To Xmax
          CurrentX = Points(x, Ymin).Trans(1)
          CurrentY = Points(x, Ymin).Trans(2)
          For y = Ymin + 1 To Ymax
             
              Line(512 + CurrentX * 20, 384 + CurrentY * 20) - (512 + Points(x, y).Trans(1) * 20, 384 + Points(x, y).Trans(2) * 20), 7
              
          Next y
      Next x
  
      ' Draw lines parallel to the Y axis.
      For y = Ymin To Ymax
          CurrentX = Points(Xmin, y).Trans(1)
          CurrentY = Points(Xmin, y).Trans(2)
          For x = Xmin + 1 To Xmax
              Line(512 + CurrentX * 20, 384 + CurrentY * 20) - (512 + Points(x, y).Trans(1) * 20, 384 + Points(x, y).Trans(2) * 20), 15
              
          Next x
      Next y
  */
  
  End Sub
  
  
  Private Sub getkey()
  Const PI = 3.14159
  Const PI2 = -3.14159
  Const Dtheta = PI / 16
  Const Dphi = PI / 8
  
  Dim theta As Single
  Dim phi As Single
  Dim r1 As Single
  Dim r2 As Single
  Dim i$
  
  re:
  Do
    i$ = inkey
  Loop While i$ = ""
  
  
      theta = Atan(EyeX, EyeY)
      r1 = Sqr(EyeX * EyeX + EyeY * EyeY)
      r2 = Sqr(EyeX * EyeX + EyeY * EyeY + EyeZ * EyeZ)
      phi = Atan(r1, EyeZ)
  
  
      Select Case i$
          Case "a" 
              theta = theta - Dtheta
          
          Case "w" 
              phi = phi + Dphi
              If phi > PI / 2 Then phi = PI / 2
  
          Case "d" 
              theta = theta + Dtheta
  
          Case "x" 
              phi = phi - Dphi
              If phi < PI2 / 2 Then phi = PI2 / 2
          Case Else
              End
              
      End Select
      
      EyeX = r1 * Cos(theta)
      EyeY = r1 * Sin(theta)
      EyeZ = r2 * Sin(phi)
      DrawSurface
      goto re
  End Sub
  
  
  Sub VectorMatrixMult2(x As Integer)
  Dim i As Integer
  Dim j As Integer
  Dim value As Single
  
  
      For i = 1 To 4
          value = 0
          For j = 1 To 4
              value = value + Axes(x).Coord(j) * T(j, i)
          Next j
          Axes(x).Trans(i) = value
      Next i
      
      ' Renormalize the point.
      ' Note that value still holds Rpt(4).
      Axes(x).Trans(1) = Axes(x).Trans(1) / value
      Axes(x).Trans(2) = Axes(x).Trans(2) / value
      Axes(x).Trans(3) = Axes(x).Trans(3) / value
      Axes(x).Trans(4) = 1
  End Sub
  
  Private Sub Main()
    
  Dim x As Integer
  Dim y As Integer
  Dim R As Single
  
      ' Initialize the viewing location.
      EyeX = 40
      EyeY = 20
      EyeZ = 20
  
  
      
      Points(0, 0).Coord(1) = 0   ' X coordinate.
      Points(0, 0).Coord(2) = 0   ' Y coordinate.
      Points(0, 0).Coord(3) = 1   ' Z  
      Points(0, 0).Coord(4) = 1   ' Scale factor.  
  
      Points(0, 1).Coord(1) = 10   ' X coordinate.
      Points(0, 1).Coord(2) = 0   ' Y coordinate.
      Points(0, 1).Coord(3) = 1   ' Z 
      Points(0, 1).Coord(4) = 1   ' Scale factor.  
  
      Points(0, 2).Coord(1) = 10   ' X coordinate.
      Points(0, 2).Coord(2) = 10   ' Y coordinate.
      Points(0, 2).Coord(3) = 1   ' Z 
      Points(0, 2).Coord(4) = 1   ' Scale factor.  
  
      Points(0, 3).Coord(1) = 0   ' X coordinate.
      Points(0, 3).Coord(2) = 10   ' Y coordinate.
      Points(0, 3).Coord(3) = 1   ' Z
      Points(0, 3).Coord(4) = 1   ' Scale factor.  
  
  
  
      Points(1, 0).Coord(1) = 0   ' X coordinate.
      Points(1, 0).Coord(2) = 0   ' Y coordinate.
      Points(1, 0).Coord(3) = 10   ' Z  
      Points(1, 0).Coord(4) = 1   ' Scale factor.  
  
      Points(1, 1).Coord(1) = 10   ' X coordinate.
      Points(1, 1).Coord(2) = 0   ' Y coordinate.
      Points(1, 1).Coord(3) = 10   ' Z 
      Points(1, 1).Coord(4) = 1   ' Scale factor.  
  
      Points(1, 2).Coord(1) = 10   ' X coordinate.
      Points(1, 2).Coord(2) = 10   ' Y coordinate.
      Points(1, 2).Coord(3) = 10   ' Z 
      Points(1, 2).Coord(4) = 1   ' Scale factor.  
  
      Points(1, 3).Coord(1) = 0   ' X coordinate.
      Points(1, 3).Coord(2) = 10   ' Y coordinate.
      Points(1, 3).Coord(3) = 10   ' Z
      Points(1, 3).Coord(4) = 1   ' Scale factor.  
  
  /*
      ' Initialize the data points.
      For x = Xmin To Xmax
          For y = Ymin To Ymax
              Points(x, y).Coord(1) = x   ' X coordinate.
              Points(x, y).Coord(2) = y   ' Y coordinate.
              Points(x, y).Coord(4) = 1   ' Scale factor.
          
              ' Z coordinate.
              R = Sqr(x * x + y * y)
              Points(x, y).Coord(3) = Cos(R)
          Next y
      Next x
  */
      ' Initialize the axes.
      Axes(1).Coord(1) = 10   ' X axis.
      Axes(1).Coord(4) = 1
      Axes(2).Coord(2) = 10   ' Y axis.
      Axes(2).Coord(4) = 1
      Axes(3).Coord(3) = 10   ' Z axis.
      Axes(3).Coord(4) = 1
      
      
      DrawSurface
      getkey()
  End Sub
  
  Main()
  
  

bresnham.kbasic


'-----------------------------------------------
'** Demo der Bresenham-Algorithmen für den Kreis
'** Autor:      Roland Heer
'** Sprache:    QBasic
'** Stand:      20.10.96
'** Public Domain
'-----------------------------------------------


   
CLS
DIM md = 5

DIM t! = TIMER

FOR r AS INTEGER = 1 TO 230
  
    Kreis(320, 240, r, 15, md)
NEXT
PRINT USING " needed time: ###.##"; TIMER - t!;
PRINT " sec";


END


SUB Kreis (x0, y0, r, Farbe, md)
    STATIC n AS INTEGER
    
    DIM d = 3 - 2 * r
    DIM Farbe
    
    DIM x = 0 : DIM y = r 'Anfang bei -90ø
    
    DO
    
    n = n + 1
    IF (n MOD md) = 0 THEN Farbe = (Farbe + 1) MOD 16
      
        
        LINE(x0 + x, y0 + y) - (x0 + x, y0 + y), Farbe
        LINE(x0 - x, y0 + y) - (x0 - x, y0 + y), Farbe
        LINE(x0 + x, y0 - y) - (x0 + x, y0 - y), Farbe
        LINE(x0 - x, y0 - y) - (x0 - x, y0 - y), Farbe
        LINE(x0 + y, y0 + x) - (x0 + y, y0 + x), Farbe
        LINE(x0 - y, y0 + x) - (x0 - y, y0 + x), Farbe
        LINE(x0 + y, y0 - x) - (x0 + y, y0 - x), Farbe
        LINE(x0 - y, y0 - x) - (x0 - y, y0 - x), Farbe

        IF d >= 0 THEN
            d = d + 4 * (x - y) + 10
            y = y - 1
        ELSE
            d = d + 4 * x + 6
        END IF
        x = x + 1
    LOOP UNTIL x > y


END SUB

demo1.kbasic


RANDOMIZE TIMER

DIM Ff = 0
DIM V = 0
DIM X = 0
DIM Y = 0
DIM C = 0

CLS

DO
  Ff = Ff + 1
  
  IF Ff > 20000 THEN
    V = V + 1
  
    IF V > 1 THEN V = 0  
    Ff = 0
  END IF
  
  X = INT(RND * 919)
  Y = INT(RND * 699)
  
  IF V = 0 THEN C = INT(RND * 63)
  IF V = 1 THEN C = 0
  
  LINE(X, Y) - (X, Y), C

LOOP UNTIL INKEY$ = CHR(27)

demo2.kbasic




RANDOMIZE TIMER

DIM Xx1 = 0
DIM Xx2 = 0
DIM Yy1 = 0
DIM Yy2 = 0

DO
  Xx1 = Xx1 + INT(RND * 9) - 4
  IF Xx1 < 0 THEN Xx1 = 0
  IF Xx1 > 640 THEN Xx1 = 640
  Xx2 = Xx2 + INT(RND * 9) - 4
  
  IF Xx2 < 0 THEN Xx2 = 0
  IF Xx2 > 640 THEN Xx2 = 640
  Yy1 = Yy1 + INT(RND * 9) - 4
  IF Yy1 < 0 THEN Yy1 = 0
  IF Yy1 > 480 THEN Yy1 = 480
  
  Yy2 = Yy2 + INT(RND * 9) - 4
  IF Yy2 < 0 THEN Yy2 = 0
  IF Yy2 > 480 THEN Yy2 = 480
  
  LINE(Xx1, Yy1) - (Yy1, Yy2), INT(RND * 15)
  
LOOP UNTIL INKEY$ = CHR(27)

fishmast.kbasic

OPTION VERYOLDBASIC
3 CLS
COLOR 15
PRINT "    F  I  S  H  M  A  S  T  E  R  S"
SLEEP 1
PRINT ""
PRINT ""
PRINT ""
PRINT ""
PRINT ""
PRINT ""
PRINT ""
PRINT ""
PRINT ""
PRINT "         V E R S I O N  1.0"
PRINT ""
PRINT ""
PRINT ""
PRINT ""
PRINT ""
PRINT ""
SLEEP 1
PRINT " What are 'ya waitin' for? Christmas?   Press 1 and start fishin'!"
INPUT NUM
IF NUM = 1 GOTO 1
IF NUM = 2 GOTO 2
1 CLS
PRINT "              M E N U"
PRINT ""
PRINT "1. GO FISHIN'"
PRINT ""
PRINT "2. EXIT"
INPUT NUM
IF NUM = 1 GOTO 6
IF NUM = 2 GOTO 5
2 CLS
PRINT ""
PRINT ""
PRINT ""
PRINT ""
PRINT ""
PRINT "You hit th' wrong key, Bozo!"
SLEEP 2
GOTO 3
5 END
6 CLS
COLOR 15
PRINT "What's ur name, feller?"; sn$; ""
INPUT sn$
PRINT sn$; ", huh? Well let's go fishin'!"
SLEEP 2
CLS
PRINT "What kindda lure do ya wanna use?"
PRINT ""
PRINT ""
PRINT ""
PRINT ""
PRINT ""
PRINT "1. Spoon"
PRINT "2. Spinnerbait"
PRINT "3. Crankbait"
PRINT "4. Plastic Worm"
PRINT "5. Jig and Pig"
PRINT "6. Buzzbait"
PRINT "7. Minnows"
PRINT ""
PRINT ""
PRINT ""
PRINT "Chose one fast, so I can get fishin'!"
INPUT NUM
IF NUM = 1 GOTO 10
IF NUM = 2 GOTO 10
IF NUM = 3 GOTO 10
IF NUM = 4 GOTO 10
IF NUM = 5 GOTO 10
IF NUM = 6 GOTO 10
IF NUM = 7 GOTO 10
10 CLS
COLOR 15
PRINT "Good choice! Now I can get th' boat     ready so we can go fishin'"
SLEEP 2
CLS
COLOR 15
PRINT "Well,"; sn$; ", I guess we can start castin'"
SLEEP 2
CLS
PRINT "INSTRUCTIONS: PRESS 1,2, AND 3 TO CAST IN DIFFERENT PLACES"
PRINT "YOU CAN PRESS 1 WHEN YOU'RE TIRED READING THIS"
INPUT NUM
IF NUM = 1 GOTO 11
11 CLS
PRINT ""
PRINT ""
PRINT ""
PRINT "Well, where do ya wanna fish at?"
PRINT ""
PRINT "1. Near The Rock Bank"
PRINT "2. Under The Bridge"
PRINT "3. Off A Point"
PRINT "4. Around The Dock"
PRINT "5. In A Cove"
INPUT NUM
IF NUM = 1 GOTO 12
IF NUM = 2 GOTO 12
IF NUM = 3 GOTO 12
IF NUM = 4 GOTO 12
IF NUM = 5 GOTO 12
12 CLS
SLEEP 2
PRINT "This looks like a good ol' spot"
SLEEP 1
CLS
PRINT "PRESS 1,2, AND 3 TO CAST IN DIFFERENT PLACES"
INPUT NUM
IF NUM = 1 GOTO 13
13 CLS
PRINT "Aww! Ain't that a shame?"
PRINT "Ya cought one, but he got off!"
PRINT ""
PRINT "PRESS 1 TO CAST AGAIN"
INPUT NUM
IF NUM = 1 GOTO 14
14 CLS
PRINT "Got em'! Lets see if he passes the length"
SLEEP 2
GOTO 16
15 PRINT "OL' CARP, YUCK!"
PRINT "1 TO CAST AGAIN"
INPUT NUM
IF NUM = 1 GOTO 14
16 CLS
PRINT "1 2 3 4 5 6 7 8 9 10 11 12"
PRINT "| | | | | | | | | |  |  |"
PRINT "-----------0"
PRINT ""
PRINT ""
PRINT "Its in the limits! Its a keeper!"
PRINT ""
PRINT "6 and 1/2 inches!"
SLEEP 4
PRINT "Nice fish!"
CLS
PRINT "PRESS 1,2, OR 3 TO CAST AGAIN"
INPUT NUM
IF NUM = 1 GOTO 17
IF NUM = 2 GOTO 18
IF NUM = 3 GOTO 19
17 CLS
PRINT "Nothin'"
PRINT "PRESS 1,2, OR 3 TO CAST AGAIN"
INPUT NUM
IF NUM = 1 GOTO 19
IF NUM = 2 GOTO 18
IF NUM = 3 GOTO 20
18 CLS
PRINT "Wow! Nice fish! Lets measure it"
SLEEP 1
PRINT "1 2 3 4 5 6 7 8 9 10 11 12"
PRINT "| | | | | | | | | |  |  |"
PRINT "-------------------------0"
PRINT ""
PRINT ""
PRINT "A keeper!"
19 CLS
PRINT "Nothin'. Lets go somewhere else, ok?"
PRINT "PRESS 1 TO KEEP FISHIN' HERE"
PRINT "PRESS 2 TO EXIT THE GAME"
PRINT "PRESS 3 TO GOTO ANOTHER SPOT"
INPUT NUM
IF NUM = 1 GOTO 21
IF NUM = 2 GOTO 5
IF NUM = 3 GOTO 22
21 CLS
PRINT "Ok, one more cast, then we leave!"
SLEEP 2
CLS
PRINT "See, nothin'"
SLEEP 2
22 CLS
PRINT "1. EXIT"
PRINT "2. BRIDGE"
PRINT "3. AROUND THE DOCK"
INPUT NUM
IF NUM = 1 GOTO 5
IF NUM = 2 GOTO 12
IF NUM = 3 GOTO 12
20 GOTO 12





screensaver1.kbasic

OPTION VERYOLDBASIC
'The Psychotic Glow-worm
'By Aaron Sutherlin

'If this runs too quickly, increase the value "100" in line 18.

CLS

DIM x(0 TO 15000) AS INTEGER
DIM y(0 TO 15000) AS INTEGER

1 DO UNTIL INKEY$ = "q"
  IF arg = 15000 THEN CLS
  
  IF arg = 15000 THEN arg = 0
  arg = arg + 1
  'IF arg > 900 THEN PSET (x(arg - 900), y(arg - 900)), 0
  a = INT(RND(1) * 3) - 1
  b = INT(RND(1) * 3) - 1
  x(arg) = x(arg - 1) + a
  IF x(arg) < 10 THEN x(arg) = 300
  IF x(arg) > 300 THEN x(arg) = 10
  y(arg) = y(arg - 1) + b
  IF y(arg) < 10 THEN y(arg) = 390
  IF y(arg) > 390 THEN y(arg) = 10
  LINE(x(arg), y(arg)) - (x(arg)+1, y(arg)+1),(arg MOD 14 + 1)
  
  'PSET (x(arg), y(arg)), (arg MOD 14 + 1)
  'FOR z = 1 TO 200
  'NEXT
LOOP

snoopy.kbasic

Option VeryOldBasic

1 REM
2 REM ORIGINALLY FOR THE PDP-11
3 REM CONVERTED TO TRS-80 BASIC 4/02 BY ANTHONY WOOD
4 REM
6 CLS:PRINT "SNOOPY FOR YOU"
10 print
20 print
30 print
40 print"                      XXXX"
50 print"                     X    XX"
60 print"                    X  ***  X                XXXXX"
70 print"                   X  *****  X            XXX     XX"
80 print"                XXXX ******* XXX      XXXX          XX"
90 print"              XX   X ******  XXXXXXXXX                XX XXX"
100 print"            XX      X ****  X                           X** X"
110 print"           X        XX    XX     X                      X***X"
120 print"          X         //XXXX       X                      XXXX"
130 print"         X         //   X                             XX"
140 print"        X         //    X          XXXXXXXXXXXXXXXXXX/"
150 print"        X     XXX//    X          X"
160 print"        X    X   X     X         X"
170 print"        X    X    X    X        X"
180 print"         X   X    X    X        X                    XX"
190 print"         X    X   X    X        X                 XXX  XX"
200 print"          X    XXX      X        X               X  X X  X"
210 print"          X             X         X              XX X  XXXX"
220 print"           X             X         XXXXXXXX\     XX   XX  X"
230 print"            XX            XX              X     X    X  XX"
240 print"              XX            XXXX   XXXXXX/     X     XXXX"
250 print"                XXX             XX***         X     X"
260 print"                   XXXXXXXXXXXXX *   *       X     X"
270 print"                                *---* X     X     X"
280 print"                               *-* *   XXX X     X"
290 print"                               *- *       XXX   X"
300 print"                              *- *X          XXX"
310 print"                              *- *X  X          XXX"
320 print"                             *- *X    X            XX"
Sleep 3
330 print"                             *- *XX    X             X"
340 print"                            *  *X* X    X             X"
350 print"                            *  *X * X    X             X"
360 print "                           *  * X**  X   XXXX          X"
370 print"                           *  * X**  XX     X          X"
380 print"                          *  ** X** X     XX          X"
390 print"                          *  **  X*  XXX   X         X"
400 print"                         *  **    XX   XXXX       XXX"
410 print"                        *  * *      XXXX      X     X"
420 print"                       *   * *          X     X     X"
430 print"         =======*******   * *           X     X      XXXXXXXX\"
440 print"                *         * *      /XXXXX      XXXXXXXX\      )"
450 print"           =====**********  *     X                     )  \  )"
460 print"             ====*         *     X               \  \   )XXXXX"
470 print"        =========**********       XXXXXXXXXXXXXXXXXXXXXX"
480 print
490 print
520 END
                                                         

space.kbasic

'
'*********************************************************************
'
' SPACE - A Space Game For KBasic
'
' (C) Copyright KBasic Software 2006.
'
' This small game demonstrates some programming techniques.
'
'*********************************************************************
     


Sub intro()
    Color(10, 0)
    
    CLS
    Locate 5, 1
    
    Locate, 10 : Print "             SPACE               "
    Locate, 10 : Print "_________________________________"
    Locate, 10 : Print "It is about a ship flying around the"
    Locate, 10 : Print "space. You can fly the ship,"
    Locate, 10 : Print "trade goods between planets..."
    Sleep 2
    Locate, 10 : Print ""
    Locate, 10 : Print "Try to keep alive, when pirates"
    Locate, 10 : Print "are trying to blast you."
    Locate, 10 : Print "Good luck!"
    Locate, 10 : Print ""
    Locate, 10 : Print ""
    Locate, 10 : Print "Use the following keys:"
    Locate, 10 : Print ""
    Locate, 10 : Print "Left         A"
    Locate, 10 : Print "Right        D"
    Locate, 10 : Print "Top          W"
    Locate, 10 : Print "Down         X"
    Locate, 10 : Print ""
    Locate, 10 : Print "Fire         G"
    Locate, 10 : Print ""
    Locate, 10 : Print ""
     
    Sleep 2
    Locate, 10 : Print "Press ANY key to start the game..."
    Sleep
    
End Sub

Sub bye()

    Color(1, 15)
    
    CLS
    Locate 15, 1      
    
    Locate, 30 : Print "  Goodbye.              "
    
    Sleep 1
    
End Sub


' *** global vars & inits

Type planet
  myName As String * 100
  x As Integer
  y As Integer
  cargo As Integer   
  price As Integer   
End Type
  

Dim shield As Integer = 100

Dim cargo As Integer = 0
Dim money As Integer = 100
Dim ship As String = "~*~**~*"
'Dim galaxy(24, 5, 3) As Integer

' *** planets
Dim planets(5) As planet

Randomize Timer

For i As Integer = 1 To 5  
  planets[i].x = Int(RND * 12) + 1
  planets[i].y = Int(RND * 5) + 1
  planets[i].cargo = Int(RND * 125) + 1
  planets[i].price = Int(RND * 15) + 10
Next

planets[1].myName = "Earth"
planets[2].myName = "Tauris"
planets[3].myName = "Ceta"
planets[4].myName = "Orion"
planets[5].myName = "Mardoa"
  
planets[1].x = 2
planets[1].y = 2
  
' ***



Dim myX As Integer = 1
Dim myY As Integer = 1

Dim poX As Integer = +1
Dim poY As Integer = +1


Dim enemy As Integer = 0


' ***

Sub header()


    CLS
    Locate 10, 1
      
    Color(15, 0)
    
    Locate, 10 : Print "             SPACE               "
    Locate, 10 : Print "_________________________________" 
End Sub

sub footer
    Locate, 10 : Print "_________________________________" 
    Locate, 10 : Print "" 
    Locate, 10 : Print "Shield " + shield     
    Locate, 10 : Print "---------------------------------"
    Locate, 10 : Print "Cargo #" + cargo + "  Money $" + money

    location()
    navigation()
    'kkk()
    'print "****************************************"
    
    
End Sub

Sub fly()
  
  For i As Integer = 1 To 10

    header()
    'Print "i=" + i
     
    Locate, 10 : Print Right(".              .          .          .     .            . ", 35 - i)   
    Locate, 10 : Print Right(".         .       .            .     .            .        .   "  , 35 - i)  
    Locate, 10 : Print Right(".               .            .     .            .  .           .", 35 - i)
    Locate, 10 : Print Mid("                          |-###->   ", 34 - i)   
    Locate, 10 : Print Right(".         .          .            .     .            . ", 35 - i) 
    Locate, 10 : Print Right(".         .           .            .     .            .        .   "  , 35 - i)  
    Locate, 10 : Print Right(".               .                .     .            .  .           .", 35 - i)
    
    footer()

    
    'Sleep 1    
  
  Next
  
End Sub

Sub intercepting()

    header()
    Locate, 10 : Print "" 
    Locate, 10 : Print "" 
    Locate, 10 : Print "" 
    Locate, 10 : Print "         Intercepting...         "
    Locate, 10 : Print "" 
    Locate, 10 : Print "" 
    Locate, 10 : Print "" 


    footer()
    
    Sleep 2
    
    ' ***
    enemy = 10
    ' ***
  
  
    header()

 
    Locate, 10 : Print ".              .          .    . "   
    Locate, 10 : Print ".         .       .          .   "
    Locate, 10 : Print ".               .               ."
    Locate, 10 : Print " |-###->       " + ship     
    Locate, 10 : Print ".         .       .            . "
    Locate, 10 : Print ".      .            .        .   "
    Locate, 10 : Print ".                .  .           ."
    
    footer()
       
End Sub

Sub visiting(i As Integer)
  
    header()
    Locate, 10 : Print "" 
    Locate, 10 : Print "" 
    Locate, 10 : Print "" 
    Locate, 10 : Print "      Approaching " + planets[i].myName
    Locate, 10 : Print "" 
    Locate, 10 : Print "" 
    Locate, 10 : Print "" 


    Sleep 2
    
  
  bb:
    header()

 
    Locate, 10 : Print ""
    Locate, 10 : Print "Welcome to " + planets[i].myName    
    Locate, 10 : Print ""
    Locate, 10 : Print "I hope you have had a nice stay in space."
    Locate, 10 : Print "How can I help you?"
    Locate, 10 : Print "Would you like to buy or sell cargo?"
    Locate, 10 : Print ""
    Locate, 10 : Print "Press [s] to sell for $" + planets[i].price    
    Locate, 10 : Print "Press [b] to buy for $" + planets[i].price
    Locate, 10 : Print ""
    Locate, 10 : Print "Press [x] to leave this planet"
    Locate, 10 : Print ""
    Locate, 10 : Print "You have got $" + money
    Locate, 10 : Print "Your Cargo #" + cargo
    
    Dim k As String
    Dim d As Integer
    
    Do While True
      k = Inkey
      
      Select Case k
        Case "s"
          Locate 27, 10 : Input "How much to sell"; d
          If d > cargo Then d = cargo           
          money = money + d * planets[i].price
          cargo = cargo - d
          Locate 28, 10 : Print "You are welome."           
          Sleep 1           
          GoTo bb           
        Case "b"
          Locate 27, 10 : Input "How much to buy"; d
          If d * planets[i].price > money Then d = money / planets[i].price         
          money = money - d * planets[i].price
          cargo = cargo + d
          Locate 28, 10 : Print "Nice to meet you."
          Sleep 1           
          GoTo bb           
        Case "x"
          myX = myX + 1
          Exit Sub           
      End Select
      
    Loop

       
End Sub

Sub location()
    Locate 10, 1     
    
    Locate, 50 : Print "         Galaxy         "
    Locate, 50 : Print "_ _ _ _ _ _ _ _ _ _ _ _ " 
    Locate, 50 : Print "                        " 
    Locate, 50 : Print "                        " 
    Locate, 50 : Print "                        " 
    Locate, 50 : Print "                        " 
    Locate, 50 : Print "                        " 
    Locate, 50 : Print "_ _ _ _ _ _ _ _ _ _ _ _ "
    
    Static b As Boolean
     
    For i As Integer = 1 To 5
      Locate 11 + planets[i].y, 49 + planets[i].x : Print "*" 
    Next     
   
    b = Not b
    
    If b Then Color(15, 0) Else Color(0, 15)
    
    Locate 11 + myY, 49 + myX : Print "x"
    
    Color(15, 0)
  
End Sub

Sub visit 
    For i As Integer = 1 To 5
      If myX = planets[i].x And myY = planets[i].y Then
        visiting(i)
      End If
    Next       
End Sub

Sub navigation()
    Locate 20, 1     
    
    Locate, 50 : Print "      Navigation        "
    Locate, 50 : Print "" 

    Locate, 50 : Print "          .             " 
    Locate, 50 : Print "                        " 
    Locate, 50 : Print "      .   .   .         " 
    Locate, 50 : Print "                        " 
    Locate, 50 : Print "          .             "

   ' Print "poX=" & poX : Print "poY=" & poY
     
    If poX = 1 And poY = 1 Then Locate 25, 62
    Else If poX = 1 And poY = 0 Then Locate 24, 62
    Else If poX = 1 And poY = -1 Then Locate 23, 62 
    Else If poX = 0 And poY = -1 Then Locate 23, 60 
    Else If poX = -1 And poY = -1 Then Locate 23, 58
    Else If poX = -1 And poY = 0 Then Locate 24, 58
    Else If poX = 0 And poY = 0 Then Locate 24, 60
    Else If poX = 0 And poY = 1 Then Locate 25, 60
    Else If poX = -1 And poY = 1 Then Locate 25, 58

       
    Print "#"
  
End Sub

Sub move()
  moveX(poX)
  moveY(poY)
End Sub


Sub moveX(x As Integer)
  myX = myX + x
  if myX > 12 myX = 1
End Sub
 
Sub moveY(y As Integer)
  myY = myY + y
  if myY > 5 myY = 1
End Sub
 
Sub hit()
  enemy = enemy - 1
End Sub

Sub fire()

    Select Case Int(RND * 5) + 1     
      Case 1
        hit()
      Case Else
    End Select     
End Sub

Sub kkk()

  Static k As String
  Static t As Integer
  
  t = Timer
  Do While True 
    
    k = Inkey
    
    Select Case k
      Case "a"
        poX = poX - 1 : If poX < -1 Then poX = -1
        Exit Sub
      Case "d"
        poX = poX + 1 : If poX > 1 Then poX = 1
        Exit Sub
      Case "x"
        poY = poY + 1 : If poY > 1 Then poY = 1
        Exit Sub
      Case "w"
        poY = poY - 1 : If poY < -1 Then poY = -1
        Exit Sub
      Case "g"
        fire()
        Exit Sub
      Case Else
        If t + 1 < Timer Then Exit Sub         
    End Select
  
  Loop
  
End Sub



Sub main()
  ' main event loop
  Randomize Timer
  
  fly()      
    
    
  Do While True
     
    Select Case Int(RND * 5) + 1     
      Case 1
        intercepting()
      Case 2 
        For i As Integer = 1 To 5  
          planets[i].cargo = planets[i].cargo + Int(RND * 15) + 1
          planets[i].price = planets[i].price + Int(RND * (100 - planets[i].cargo))
          If planets[i].price < 0 Then planets[i].price = planets[i].price * -1           
        Next        
      Case Else
        fly()
    End Select   
  
    ' ***
    move()
    visit()
    ' *** 
    Sleep 1
     
    
  
  Loop
End Sub
  


'visiting(1)
'intro()

main()
'bye()

spock.kbasic

Option VeryOldBasic

1 REM
2 REM CLASSIC ASCII SPOCK
3 REM CONVERTED TO TRS-80 BASIC ON 4/02 BY ANTHONY WOOD
4 REM
CLS

10 DATA";;-;;-;---;-;;;-;---B-BB??O8@@@@@@@@@@@@@@@@@@@@@@@8IB-;:;':'''''';-/+==?/BB-B-"
20 DATA"''''''''''''''''.;-/*O@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@8XB;'::::::'';B/???/B--;--"
30 DATA"'''::''''''':':':;/I@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@O=-;::':''';;-;---;;;;--"
40 DATA"'''''''''''''''''O@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@#I?''''''';;-B;;;;;;;;"
50 DATA"''''''''''''''-/N@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@8OB;;;;;;;;;;;;;;;--"
60 DATA":'''''''''''BI@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@8+B;;;;;;;;;-----"
70 DATA"'''''''''''BO@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@O*B;;';;;;;-----"
80 DATA"''''''''''-O@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@#O?B;;----BBBB"
90 DATA"''''''''-=@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@S/B-//??/BBB"
100 DATA";'''''''$@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@S=/????/B--"
110 DATA";'''''-I@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@NX+???/BB--"
120 DATA"'''''-X@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@#X=??//BBB"
130 DATA"'''''?N@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@UI??/BBBB"
140 DATA"''''/S@@@@@$*IIO8#ON@@@@@@@@@@@@@@@@@@@@@@@@@@@@@$N@@@@@@@@@@@@@@@@@@@@S?B-----"
150 DATA"''''/$@@@@#S*I$$88OON@@@@@@@@@@@@@@@@@@@@@@@@@@@NON@@@@@@@@@@@@@@@@@@@@$=B-----"
160 DATA"::::/#@@NOZ@@@@@@$N8SOSN#@@@@@@@@@@@@@@@##N@@@@@NN@@@@@@@@@@@@@@@@@@@@@@@**B;--"
170 DATA"::::B$@@S*#@@@@@@@@@8OOSSN$@@@###@@@@##@$O$NNN@@@@@@@@@@@@@@@@@@@@@@@@@@@@*B;--"
180 DATA"::::/#@@OS@@@@@@@@@@@@@8OO=IOON$$8N@N$#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@S?'';"
190 DATA"::::=@@@8$@@@@@@@@@@@@@@@N$8$S###$8@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@NI;''"
200 DATA"::::O@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*;''"
210 DATA":::-N@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@O-''"
220 DATA"::'+@@@@@@#O/=8@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@8/;'"
230 DATA"::'*@@@@@@NO/;-*?O==BOX@#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@#@@@@@@@@@@@@@@N+;;"
240 DATA":::S@@@@@@NOB'...::..:::.:.../;==8I$I=/OINO@*X=N8@N@####N#####@@@@@@@@@@@@@@S?B"
250 DATA"::BO@@@@@@N*-'..........:....:.:.;'''::'';'BB;;-BB+/OXNN#N#####@@@@@@@@@@@@@8?-"
260 DATA":-8@@@@@@@8?:;ISI':.....:...............'..'';-B-;BB/=O8N@@@@##@@@@@@@@@@@@@XB;"
270 Data ":-$@##@@@@S-:'BS$*I;;:'.........:.:...':::';;-';--/?*X$#@@@@@#N@@@@@@@@@@@@@O=-"
280 DATA"::O@N$@@@#?..'-B-OO@N$NSS?/......'...::':'':--=IO$@@@@@@@@@#$###@@@@@@@@@@@@@@O"
290 DATA"::I@@N@@@$-:;---BB==$@@@$8O//;B....''.::'':=**NN@@@@@@@@@@##8N##@@@@@@@@@@@@@@$"
300 DATA"::'IN##@@X:.;?+?/++OSN#@@@@@@@S-:..'..-?OSNN@@@@@@@@@@@@@@@@NO$##@@@@@@@@@@@@@N"
310 DATA";'...BS@N?.:;-?SN@@@@@@@@@@SS.... ..:-O@@#@@@@@@@@@@@@@@@@@#NS8#@@@@@@@@@@@@@#*"
320 DATA"      I@$B..';+#@@O+@@@@@@@SB .... . B8@@@@@@@@@@@@@@@@@@@@@#8S$@@@@@@@@@@@@@$?"
330 DATA":::/S@#@#I..-/=+I$$@@@@@@@@@@$=.....''?ON##@@@@@@@@@@@@@#@@@#8O##@@@@@@@@@@@@@$"
340 DATA"-+/ -'?N8; .:;+;::?==XX*+;; ....  ..:B$@@@@@@@@@O?I@8ON@@@@#N$OX$@@@@@@@@@@@$-"
350 DATA":;B+=B/8X  ..''...''B;/'BB;          BO@@@@@@@S*?IOOOON@@@@@#NS*O@@@@@@@@@@#I.."
360 DATA"..;;'?I$? ......  ..'; --    .......'/O@@@@@@@?';-B/=**SO$SS8##$OX$@@@@@@@#B::'"
370 DATA"..';::?N+  .....  ..'';-;  ........::+$@@@@@@@I:'-B/=**SO$SS8##$OX$@@@@@@@#B::'"
380 DATA"..'-'+$*   .  .  ..';B-;  ......  :/S######@@@='.'-B-B?+IIO8N#8OO8@@@@NN8=;::''"
390 DATA"..'-';-*S   .  .    ';-'   ....    '+8#NN####@@OB.:--B/??IIS$N#8OO$@@@@8$O?-'''"
400 Data "..';::-'I?... .....'''    ....     :?8@##NNNN@@NX-;;;;;-+*OO8NN@@@@@@@N8S+/B-''"
410 DATA" .;;:BI;++::: ....'.::    ....     :BS@@#N$N#@@#S/;''';B+*S8$N$@@@@@@@@#NOB?/-;"
420 DATA" .'; 'B-'B;''' :......  ......     .-O#@@NN8N@@@8+;;-'/X8888$N$@@@@@@@@#O?;;'''"
430 DATA" .'' .:;.';'.'':......  .....      .;XN@@@#N#@@@$IB--B*888$8$N$@@@@@@@@#O-::'::"
440 DATA" .:' .   ::'':::'......  ... /='. .:=8@####N@@@@@8*?++*XO$N$N$$@@@@@@@@N*: .:.."
450 DATA" .::'...;:'':::'......  ... *@@=;'?BS#@@@#N@@@@@@#O*I*S8$NNNNNN@@@@@@@@N?...:::"
460 DATA".. :;'...;-':::.......... . .-/?;*#@@@@@@@@@@@@@@@@N$8#NN@#NNNN@@@@@@@@I..:::::"
470 DATA".. :'-.:+S=':::....... .. . .::':'/@@@@@@@@@@@@@@@@@@$N#N#N#NNN@@@@@@@X; .:::::"
480 DATA"     :'+';-;'':...  ..           ..:-=O@@@@@#N#@@@#N$$$$8$8$$$$$ON##OB   ......"
490 DATA"          ';'::..... :;:       ...:'B/+SO@@@##N#@@NN$$$$888$$N$8S8$N?  ..  ./X8"
500 DATA"            '::......':   . .::::';--;?XOO*OONNN#@#$$$88888$$N$8B/.       .+NN#"
510 DATA"           ;'::......:.   :..:::::';;-+XOOOXXS8$N@#N$$8$$$88$$$$O'       .*8##8"
520 DATA"    ..    :;'::......:....:. .   ... :BIOSOO88N$NNN$$$$$$$N$$$$*       :X8NN@@@"
530 DATA"  .....   .';'::::...:..::. . ;'/.. .'*IOSSO$$NNNN#8$$$N$$$$N$$=   .. '=$###@@@"
540 DATA"  ...       ';':::...:-/X+SO@#@@@##$@@@@@8$88NNNNN#N$$$$$N$$$$8?     'O$O8$$#@@"
550 DATA"   .        :;':::. .'/II*BOB+-?SX@N@@@@@@@#$NN#NN#N$$$$$$$N$88?     -SOS8NN@@@"
560 DATA"   .          '::::::'--::''''...:'''/?OO$$@@@@@@@@$$$$$$$$$8$$?    BISOO8#@@@@"
570 DATA"             .  ':::''-;:::;/+X?*/+-??**O8NN#N#@@@@$$$$$$$88NN$?   :S88S8N@@@@@"
580 DATA".. ... .        ;':::';;;;;-/?IOO#N@@@@@@@@#####@@8$N$N$$$8N##$=   +@@#$#@@@@@@"
590 DATA"........... ...;-''''''';;B/??+*IX+XX$#@@@@#@##@@@$$NNNN$$N#@@NI.  *@@@#@@@@@@@"
600 DATA"::::'''::::::::';--;';;;';;;;;;--//??*X8N@@@@@@@@@@@##NNN#@@@@#O;  $#S=N@@@@@@@"
610 DATA":::::''''::::::';---;;';'''';':':;;-;B/**O8@N@#@@@@@##NN#@@@@@@8B:=#$=;I#@@@@@@"
620 DATA" . .. ......... ..;----;'::::::::';;';B/+II=+//O8NNN$@@@@@@@@@$**NSXB. .++@@@@@"
630 DATA" ................';;;BB;':::'''';;--;;/??IX**IXON##N##@@@@@@@@#NXI#NSB. ./@@@@@"
640 DATA" .  . ...........'-;---/+BB-BB/B////?+***XOOSON#N@@@@@@@@@@@@@#N8S@@@?  .;8@N#N"
650 DATA".............. ..';;;;;B?++/++I===I=XXOXXXSO$$#NN@@@@@@@@@@@@@##@#@@@8B .:I@$OO"
660 DATA"      ..         '?;''''''+8N8#$#N#N@N#$NN###N#@@@@@@@@@###@@@@@@@@@@@@O=''+XOO"
670 DATA"    . .        . -O/'::':';+S@@@@@@@@@@@@@###@@@@@@@@@@#N#@@@@@@@@@@@@@@#O*-+OX"
680 DATA"              ...?#SB.:''';-?/8#8@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@$IIO"
690 DATA"  .           .. BN@S;.:'';-B=++/*8@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@OXO"
700 DATA"  .         .....-O@@#8/':'-BBB;;-B*O@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@N8$N$"
710 DATA"  .       ..  ...B8@@@@O*;;-B?B---?=O#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@N$N##"
720 DATA"  ..  .  .    ....=@@@@@@@@N@N@#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@#@"
730 DATA"  . ..    .  ....=#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@#@"
790 DATA"END"


5 CLS : Print, "Printing Classic Spock"

6 Read L$ : If L$ = "END" Then Print : End

k = k + 1

If k = 35 Then Sleep 2

9 Print L$ : GoTo 6


winter.kbasic

OPTION OLDBASIC

CLS
'PAINT (0, 0), 8
LINE (0, 0)-(639, 200), 0, BF
FOR n = 1 TO 200: x = RND * 630: y = RND * 198: LINE (x, y)-(x, y), 15
NEXT
FOR n = 1 TO 17000: x = RND * 639: y = RND * 190 + 200: LINE (x, y)-(x, y), 15
NEXT

gr = 100: x = 300: y = 250: col = 15: schleife
gr = 70: x = 300: y = 170: schleife
gr = 40: x = 300: y = 110: schleife
gr = 15: x = 225: y = 150: schleife
gr = 15: x = 375: y = 150: schleife
gr = 5: x = 285: y = 100: col = 0: schleife
gr = 5: x = 315: y = 100: schleife
gr = 5: x = 300: y = 110: col = 4: schleife
gr = 5: x = 300: y = 150: col = 0: schleife
gr = 5: y = 160: schleife
gr = 5: y = 170: schleife
LINE (255, 65)-(345, 85), 8, BF
LINE (280, 65)-(320, 30), 8, BF
END

SUB schleife
  
FOR n = 1 TO gr STEP .05
  LINE (x, y)-(x, y), col
'CIRCLE (x, y), n, col
NEXT
END SUB

dll.kbasic

' DLL USING (new style)
' Warning! If you use predeclared DECLARE statements of VB6, be aware
' that the size of the datatypes differs between VB6 and KBasic,
' namely Long in VB6 must be Integer in KBasic! You have to change it.

     
    
' zunächst die benötigten API-Deklarationen

Class comdlg32 Alias Lib "comdlg32.dll"
   
  Static Function ChooseColor_Dlg Alias "ChooseColorA"_
  (lpcc As CHOOSECOLOR_TYPE) As Integer
    
  Type CHOOSECOLOR_TYPE
    lStructSize As Integer
    hwndOwner As Integer
    hInstance As Integer
    rgbResult As Integer
    lpCustColors As Integer
    flags As Integer
    lCustData As Integer
    lpfnHook As Integer
    lpTemplateName As String
  End Type
      
  ' Anwender kann alle Farben wählen
  Const CC_ANYCOLOR = &H100
  ' Nachrichten können "abgefangen" werden
  Const CC_ENABLEHOOK = &H10
  ' Dialogbox Template
  Const CC_ENABLETEMPLATE = &H20
  ' Benutzt Template, ignoriert aber den Template-Namen
  Const CC_ENABLETEMPLATEHANDLE = &H40
  ' Vollauswahl aller Farben anzeigen
  Const CC_FULLOPEN = &H2
  ' Deaktiviert den Button zum Öffnen der Dialogbox-Erweiterung
  Const CC_PREVENTFULLOPEN = &H4
  ' Vorgabe einer Standard-Farbe
  Const CC_RGBINIT = &H1
  ' Hilfe-Button anzeigen
  Const CC_SHOWHELP = &H8
  ' nur Grundfarben auswählbar
  Const CC_SOLIDCOLOR = &H80
        

End Class



 
Class kernel32 Alias Lib "kernel32.dll"
           
            
     
  Public Static Function CloseHandle(ByVal hObject As Integer) As Integer
    
        
  Public Static Function OpenProcess (ByVal dwDesiredAccess As Integer,_
    ByVal bInheritHandle As Integer,_
    ByVal dwProcessId As Integer) As Integer
  
  
  Public Static Function WaitFor Alias "WaitForSingleObject"(ByVal hHandle As Integer,_
    ByVal dwMilliseconds As Integer) As Integer
    
    
  Public Const INFINITE = &HFFFF
  Public Const SYNCHRONIZE = &H100000
 
End Class
 
 
 
'Warten bis Anwendung beendet
Public Sub AppStartAndWait(ByVal sFile As String)

  'Parameterbeschreibung
  'sFile:  Anwendung, die gestartet werden soll
 
  Dim lHandle As Integer
  Dim lRet As Integer
  Dim lRetVal As Integer

  
    
  lRetVal = Shell(sFile)
  
 
 
  lHandle = kernel32.OpenProcess(kernel32.SYNCHRONIZE, 0, lRetVal)
  If lHandle <> 0 Then
    
    
    lRet = kernel32.WaitFor(lHandle, kernel32.INFINITE)
    
    
    kernel32.CloseHandle(lHandle)
  End If
  
End Sub
  
  
  
Dim CC_T As comdlg32.CHOOSECOLOR_TYPE, Retval As Integer
Dim BDF(16) As Integer

'Dim k As String
'CC_T.lpTemplateName = AddressOf(k)

'CC_T.lpTemplateName = "fdgfg"
'Print CC_T.lpTemplateName
 
'Einige Farben vordefinieren (Benutzerdefinierte Farben)
BDF(0) = RGB(255, 255, 255)
BDF(1) = RGB(125, 125, 125)
BDF(2) = RGB(90, 90, 90)
  
'Print Len(CC_T) 'Strukturgröße
With CC_T
  .lStructSize = Len(CC_T) 'Strukturgröße
  .hInstance = 0'App.hInstance    'Anwendungs-Instanz
  .hwndOwner = 0 'Me.hWnd 'Fenster-Handle
  .flags = comdlg32.CC_RGBINIT Or comdlg32.CC_ANYCOLOR Or comdlg32.CC_FULLOPEN Or comdlg32.CC_PREVENTFULLOPEN 'Flags
  .rgbResult = RGB(0, 255, 0)      'Farbe voreinstellen
  .lpCustColors = AddressOf(BDF(0)) 'Benutzerdefinierte Farben zuweisen
End With

Retval = comdlg32.ChooseColor_Dlg(CC_T) 'Dialog anzeigen
   
  
 
If Retval <> 0 Then
  MsgBox Hex$(CC_T.rgbResult) 'gewählte Farbe als Hintergrund setzen
Else
  MsgBox "Das Auswählen einer Farbe ist fehlgeschlagen," & _
  "oder Sie haben Abbrechen gedrückt", kbCritical, "Fehler"
End If



'AppStartAndWait("edit")
   


midi.kbasic

' DLL USING (old style)
' Warning! If you use predeclared DECLARE statements of VB6, be aware
' that the size of the datatypes differs between VB6 and KBasic,
' namely Long in VB6 must be Integer in KBasic! You have to change it.


' Play midi file using the windows api. Not portable!
' Be sure that the midi files are correctly named to the install path of KBasic
' in this example!

Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA"_
  (ByVal lpszCommand As String, ByVal lpszReturnString As String, _
  ByVal cchReturnLength As Integer, ByVal hwndCallback As Integer) As Integer
  
  
  
Dim s As String
Dim k As String
Dim r As Integer
 
k = Space(1024)
  
r = mciSendString("close all", k, Len(k), 0)

Randomize Timer

Select Case Int(RND * 4) + 1
  Case 1
    s = "Open c:\kbasic15\examples\test\mond_1.mid Type sequencer Alias MUSIC"
  Case 2
    s = "Open c:\kbasic15\examples\test\mond_3.mid Type sequencer Alias MUSIC"
  Case 3
    s = "Open c:\kbasic15\examples\test\pathetique_1.mid Type sequencer Alias MUSIC"
  Case 4
    s = "Open c:\kbasic15\examples\test\pathetique_2.mid Type sequencer Alias MUSIC"
     
End Select
 
r = mciSendString(s, k, Len(k), 0)

If r = 0 Then
  r = mciSendString("play MUSIC from 0", k, Len(k), 0)      
End If



  

wav.kbasic

' DLL USING (old style)
' Warning! If you use predeclared DECLARE statements of VB6, be aware
' that the size of the datatypes differs between VB6 and KBasic,
' namely Long in VB6 must be Integer in KBasic! You have to change it.


' Play wav file using the windows api. Not portable!
' Be sure that the wav files are correctly named to the install path of KBasic
' in this example!

Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA"_
  (lpszName As String, ByVal hModule As Integer, ByVal dwFlags As Integer) As Integer




   
 
  
Dim s As String

Randomize Timer

Select Case Int(RND * 2) + 1
  Case 1
    s = "c:\kbasic14\ide\gong.wav"

  Case 2
    s = "c:\kbasic14\ide\neon_light.wav"
 
End Select
  
Dim r = PlaySound(s, 0, 0)




  
examples.txt · Last modified: 2013/04/10 20:37 by 80.116.94.231