initial commit
This commit is contained in:
commit
b04d90ff0d
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
|
|
@ -0,0 +1,35 @@
|
|||
#lang "fblite"
|
||||
dim as integer max,a,b,n,i
|
||||
|
||||
print
|
||||
input "Maximum absolute value of the numbers [default: 100]: ";max
|
||||
if max<2 then
|
||||
max=100
|
||||
end if
|
||||
print
|
||||
input "How many examples [default: 25] ";n
|
||||
if n<=0 then
|
||||
n=25
|
||||
end if
|
||||
Print ' output on the printer
|
||||
Print
|
||||
Print
|
||||
Print " ";n;" arithmetical exercises with integral numbers from ";-max;" to";max
|
||||
Print
|
||||
Print
|
||||
|
||||
randomize 'initialize the rnd random-number generator
|
||||
for i=1 to n
|
||||
a=int(rnd*(2*max+1))-max
|
||||
b=int(rnd*(2*max+1))-max
|
||||
Print using " ###) ";i;
|
||||
Print a;
|
||||
if b<=0 then
|
||||
Print " -";abs(b)
|
||||
else
|
||||
Print " +";b
|
||||
end if
|
||||
'Print
|
||||
'Print
|
||||
next i
|
||||
Print Chr(12) ' for output on computer screen use the command "sleep"
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
Dim answer As String
|
||||
Input "Type something, you idiot! ", answer
|
||||
Print "You typed: '";answer;"'"
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
Cls
|
||||
Print "Standard Sixteen Color Test"
|
||||
Sleep 2000
|
||||
For b As Integer = 0 to 15
|
||||
For f As Integer = 0 to 15
|
||||
Cls
|
||||
Locate 10,15
|
||||
Color f,b:Print "Foreground: "; f; " Background: "; b;" ";:Color 7,0:Print
|
||||
Sleep 125
|
||||
Next f
|
||||
Next b
|
||||
Color 7,0
|
||||
Print "Press Any Key...":Sleep
|
||||
|
||||
Cls
|
||||
Print "RGB Color Test: 256 Random RGB Values..."
|
||||
Sleep 2000
|
||||
Randomize 2, 1
|
||||
For i As Integer = 1 to 256
|
||||
dim as Integer last,first
|
||||
last = 254:first = 0
|
||||
dim as Integer r,g,b
|
||||
r = cast(integer, fix(rnd*(last-first))+first)
|
||||
g = cast(integer, fix(rnd*(last-first))+first)
|
||||
b = cast(integer, fix(rnd*(last-first))+first)
|
||||
|
||||
Cls
|
||||
Locate 10,15
|
||||
Color RGB(r,g,b), RGB(b,r,g):Print "Color Count: ";i;" Foreground: (";r;",";g;",";b;")";" Background: (";b;",";g;",";r;")";:Color 7,0:Print
|
||||
Sleep 125
|
||||
Next i
|
||||
Print "Press any key...":Sleep:Cls
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
Dim As Integer clr, ccode
|
||||
Color 15,0
|
||||
clr = Color
|
||||
Print "Current color setting:"
|
||||
Print "Foreground: ";Loword(clr)
|
||||
Print "Background: ";Hiword(clr)
|
||||
Print
|
||||
ccode = Screen(0, 0)
|
||||
Print "Character code at 1,1 is";ccode;" which is ";Chr(ccode);"."
|
||||
clr = Screen(1, 1, 1)
|
||||
Print "Foreground color at 1,1:";clr And 15
|
||||
Print "Background color at 1,1:";clr Shr 4
|
||||
End
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
Dim As Double myDbl
|
||||
Dim As Integer myInt
|
||||
myDbl = 5.56
|
||||
myInt = myDbl
|
||||
print "myInt = "; myInt
|
||||
Sleep
|
||||
End
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
Cls
|
||||
Locate 1, 10
|
||||
'Color 15, 1
|
||||
'Print space( 50 );
|
||||
'Locate 12, 12
|
||||
'print "Hello World";
|
||||
|
||||
'Print Point(1,10)
|
||||
|
||||
Sub DrawTextBox(ByVal x as Integer, ByVal y as Integer, _
|
||||
ByVal TextWidth as Integer, ByVal FieldLen as Integer, _
|
||||
ByVal TabAble as Integer = 0, ByVal Label as String)
|
||||
|
||||
Color 15,1:Locate y,x:Print Label;:Locate y,x+TextWidth:Print "[";
|
||||
Locate y,x+TextWidth+FieldLen-1:Print "]";
|
||||
End Sub
|
||||
|
||||
DrawTextBox 25,5,10,33,1, "Name:"
|
||||
Binary file not shown.
Binary file not shown.
|
|
@ -0,0 +1,47 @@
|
|||
Const depth=8
|
||||
|
||||
#Include Once "gfx.bi"
|
||||
#Include Once "font.bi"
|
||||
|
||||
ScreenRes 640,480,depth
|
||||
|
||||
Dim As TFont SerifRed,SansBlue,MonoGreen,Serif,Sans,Mono,Sans18,Sans30
|
||||
SerifRed.Load("serif.fnt",&hd83f3f)
|
||||
MonoGreen.Load("mono.fnt",&h13c86b)
|
||||
SansBlue.Load("sans.fnt",&h729fcf)
|
||||
Sans.Load("sans.fnt")
|
||||
Serif.Load("serif.fnt")
|
||||
Mono.Load("mono.fnt")
|
||||
Sans18.Load("sans.fnt"):Sans18.ChangeSize(18)
|
||||
Sans30.Load("sans.fnt"):Sans30.ChangeSize(30)
|
||||
|
||||
Line (0,0)-(640,480),GetColor(&h2e3436),BF
|
||||
Serif.DrawString(,"ÄÖÜäöüß éÈáÀóÒúÙíÌć ĄĘñ âêô ¿ €",10,10)
|
||||
SerifRed.DrawString(,"Freeserif",10,30)
|
||||
Serif.DrawString(,"Freeserif Bold",100,30,True)
|
||||
Serif.DrawString(,"Freeserif Italic",220,30,,,True)
|
||||
Serif.DrawString(,"Freeserif Underlined",340,30,,True)
|
||||
|
||||
SansBlue.DrawString(,"Freesans",10,80)
|
||||
Sans.DrawString(,"Freesans Bold",100,80,True)
|
||||
Sans.DrawString(,"Freesans Italic",220,80,,,True)
|
||||
Sans.DrawString(,"Freesans Underlined",340,80,,True)
|
||||
|
||||
MonoGreen.DrawString(,"Freemono",10,130)
|
||||
Mono.DrawString(,"Freemono Bold",100,130,True)
|
||||
Mono.DrawString(,"Freemono Italic",220,130,,,True)
|
||||
Mono.DrawString(,"Freemono Underlined",340,130,,True)
|
||||
|
||||
Serif.DrawString(,"Basic Latin: Good evening FreeBasic - Community and others",10,180)
|
||||
Serif.DrawString(,"German: Hallöchen! Stinkefüße und Äpfel kosten 1000 €uros",10,200)
|
||||
Serif.DrawString(,"Portuguese/Spanish: Olá amigos ¿Cómo estás? Eñe Freebasic é ótimo",10,220)
|
||||
Serif.DrawString(,"Polish: Się granicą filmów Ęsiąząt",10,240)
|
||||
|
||||
Sans.DrawString(,"Freesans 11",10,300)
|
||||
Sans18.DrawString(,"Freesans 18",10,320)
|
||||
Sans30.DrawString(,"Freesans 30",10,350)
|
||||
|
||||
|
||||
Sans.DrawString(,"Bold, Italic and Unterlined!",10,450,True,True,True)
|
||||
Sleep
|
||||
End
|
||||
|
|
@ -0,0 +1,495 @@
|
|||
Type TFont
|
||||
As Any Ptr Char(103),CharItalic(103)
|
||||
As UByte wide(103)
|
||||
As UByte size,origsize
|
||||
As Integer clr
|
||||
Declare Sub Load(file As String, clrc As Integer=&hffffff)
|
||||
Declare Sub DrawString(buffer As Any Ptr=0,text As String,x As Integer,y As Integer,bold As Boolean=False,underline As Boolean=False,italic As Boolean=False)
|
||||
Declare Sub Render(buffer As Any Ptr=0,charid As UByte,x As Integer, y As Integer,bold As Boolean=False,underline As Boolean=False,italic As Boolean=False)
|
||||
Declare Sub CombinedRender(buffer As Any Ptr=0,charid As UByte,charid2 As UByte,x As Integer, y As Integer,bold As Boolean=False,underline As Boolean=False,italic As Boolean=False,down As Boolean=False,plusx As Integer=0,plusy As Integer=0)
|
||||
'Declare Sub ChangeColor(clr As Integer)
|
||||
Declare Sub ChangeSize(newsize As UByte)
|
||||
Declare Function Length(text As WString) As Integer
|
||||
End Type
|
||||
|
||||
Sub TFont.Load(file As String, clrc As Integer=&hffffff)
|
||||
clr=GetColor(clrc)
|
||||
Dim As UByte in
|
||||
Dim As Integer wholewide,start
|
||||
Dim As Any Ptr fntimg
|
||||
Var ff=FreeFile
|
||||
Open file For Binary As #ff
|
||||
Get #ff,0,size
|
||||
origsize=size
|
||||
For i As Integer=1 To 101
|
||||
|
||||
If wide(1)=&hFF Then
|
||||
wide(i)=7
|
||||
Else
|
||||
Get #ff,,wide(i)
|
||||
End If
|
||||
|
||||
Char(i)=ImageCreate(wide(i),size-1)
|
||||
CharItalic(i)=ImageCreate(wide(i)+2,size-1)
|
||||
wholewide+=wide(i)
|
||||
Next
|
||||
Char(102)=ImageCreate(Wide(64),size-1)
|
||||
CharItalic(102)=ImageCreate(Wide(64)+2,size-1)
|
||||
Char(103)=ImageCreate(Wide(31),size-1)
|
||||
CharItalic(103)=ImageCreate(Wide(31)+2,size-1)
|
||||
Wide(103)=Wide(31)
|
||||
If wide(1)=&hFF Then wide(1)=7:start=1
|
||||
fntimg=ImageCreate(wholewide,size)
|
||||
For x As Integer=start To wholewide Step 8
|
||||
For y As Integer=0 To size-1
|
||||
Get #ff,,in
|
||||
For i As Integer=1 To 8
|
||||
If Bit(in,8-i)=True Then
|
||||
Pset fntimg,(x+(i-1),y),clr
|
||||
End If
|
||||
Next
|
||||
Next
|
||||
Next
|
||||
Close #ff
|
||||
wholewide=0
|
||||
|
||||
For i As Integer=1 To 101
|
||||
Get fntimg,(wholewide,0)-(wholewide+wide(i)-1,size-1),Char(i)
|
||||
wholewide+=wide(i)
|
||||
For x As UByte=0 To Wide(i)-1
|
||||
For y As UByte=0 To size-1
|
||||
If depth<=8 Then
|
||||
If Point(x,y,Char(i))=clr Then
|
||||
If y<(size-1)/3 Then
|
||||
Pset CharItalic(i),(x+2,y),clr
|
||||
ElseIf y>((size-2)/3)*2 Then
|
||||
Pset CharItalic(i),(x,y),clr
|
||||
Else
|
||||
Pset CharItalic(i),(x+1,y),clr
|
||||
End If
|
||||
End If
|
||||
ElseIf depth=16 Then
|
||||
If Point(x,y,Char(i))<>&hff00ff Then
|
||||
If y<(size-1)/3 Then
|
||||
Pset CharItalic(i),(x+2,y),clr
|
||||
ElseIf y>((size-2)/3)*2 Then
|
||||
Pset CharItalic(i),(x,y),clr
|
||||
Else
|
||||
Pset CharItalic(i),(x+1,y),clr
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
If Point(x,y,Char(i))<>&hffff00ff Then
|
||||
'If y<(size-1)/2 Then
|
||||
'Pset CharItalic(i),(x+2,y),clr
|
||||
'ElseIf y>((size-2)/3)*2 Then
|
||||
Pset CharItalic(i),(x,y),clr
|
||||
'Else
|
||||
' Pset CharItalic(i),(x+1,y),clr
|
||||
'End If
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
Next
|
||||
Next
|
||||
|
||||
Char(102)=MirrorImage(Char(64),2,clr)
|
||||
CharItalic(102)=MirrorImage(CharItalic(64),2,clr)
|
||||
Char(103)=MirrorImage2(Char(31),-1,clr,-3)
|
||||
CharItalic(103)=MirrorImage2(CharItalic(31),1,clr,-3)
|
||||
|
||||
ImageDestroy fntimg
|
||||
End Sub
|
||||
|
||||
Sub TFont.Render(buffer As Any Ptr=0,charid As UByte,x As Integer, y As Integer,bold As Boolean=False,underline As Boolean=False,italic As Boolean=False)
|
||||
If italic=True Then
|
||||
Put buffer,(x,y),CharItalic(charid),trans
|
||||
If bold=True Then Put buffer,(x+1,y),CharItalic(charid),trans
|
||||
Else
|
||||
Put buffer,(x,y),Char(charid),trans
|
||||
If bold=True Then Put buffer,(x+1,y),Char(charid),trans
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Sub TFont.CombinedRender(buffer As Any Ptr=0,charid As UByte,charid2 As UByte,x As Integer, y As Integer,bold As Boolean=False,underline As Boolean=False,italic As Boolean=False,down As Boolean=False,plusx As Integer=0,plusy As Integer=0)
|
||||
If italic=True Then
|
||||
Put buffer,(x,y),CharItalic(charid),trans
|
||||
If down=True Then
|
||||
Put buffer,(x+plusx,y+size-3-plusy),CharItalic(charid2),trans
|
||||
Else
|
||||
Put buffer,(x+plusx,y-plusy),CharItalic(charid2),trans
|
||||
End If
|
||||
If bold=True Then
|
||||
Put buffer,(x+1,y),CharItalic(charid),Trans
|
||||
If down=True Then
|
||||
Put buffer,(x+1+plusx,y+size-3-plusy),CharItalic(charid2),trans
|
||||
Else
|
||||
Put buffer,(x+1+plusx,y-plusy),CharItalic(charid2),trans
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
Put buffer,(x,y),Char(charid),trans
|
||||
If down=True Then
|
||||
Put buffer,(x+plusx,y+size-3-plusy),Char(charid2),trans
|
||||
Else
|
||||
Put buffer,(x+plusx,y-plusy),Char(charid2),trans
|
||||
End If
|
||||
If bold=True Then
|
||||
Put buffer,(x+1,y),Char(charid),Trans
|
||||
If down=True Then
|
||||
Put buffer,(x+1+plusx,y+size-3-plusy),Char(charid2),trans
|
||||
Else
|
||||
Put buffer,(x+1+plusx,y-plusy),Char(charid2),trans
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Sub TFont.DrawString(buffer As Any Ptr=0,text As String,x As Integer,y As Integer,bold As Boolean=False,underline As Boolean=False,italic As Boolean=False)
|
||||
Dim As UByte charid,charid2
|
||||
Dim As Byte plusx,plusy
|
||||
Dim As Boolean down
|
||||
Dim As UShort textlength
|
||||
For i As Integer=0 To Len(text)
|
||||
charid=text[i]-32
|
||||
charid2=0
|
||||
down=False
|
||||
plusx=0
|
||||
plusy=0
|
||||
If text[i]<33 Then
|
||||
textlength+=3
|
||||
charid=0
|
||||
ElseIf charid=162 Then
|
||||
charid=text[i+1]-32
|
||||
i+=1
|
||||
If charid=159 Then
|
||||
charid=103
|
||||
textlength+=wide(103)
|
||||
End If
|
||||
ElseIf charid=194 Then
|
||||
charid=text[i+1]-32
|
||||
i+=1
|
||||
If charid=98 Then
|
||||
charid=text[i+1]-32
|
||||
i+=1
|
||||
If charid=140 Then
|
||||
charid=101
|
||||
textlength+=wide(101)
|
||||
End If
|
||||
End If
|
||||
Elseif charid=164 Then
|
||||
charid=text[i+1]-32
|
||||
i+=1
|
||||
If charid=100 Then 'Ą
|
||||
charid=33
|
||||
charid2=64
|
||||
textlength+=wide(33)
|
||||
down=True
|
||||
plusx=6
|
||||
Elseif charid=101 Then 'ą
|
||||
charid=65
|
||||
charid2=64
|
||||
textlength+=wide(65)
|
||||
down=True
|
||||
plusx=3
|
||||
ElseIf charid=102 Then
|
||||
charid=35
|
||||
charid2=102
|
||||
textlength+=wide(35)
|
||||
plusy=2
|
||||
plusx=3
|
||||
ElseIf charid=103 Then
|
||||
charid=67
|
||||
charid2=102
|
||||
textlength+=wide(67)
|
||||
ElseIf charid=120 Then 'Ę
|
||||
charid=37
|
||||
charid2=102
|
||||
textlength+=wide(37)
|
||||
plusy=2
|
||||
plusx=2
|
||||
Elseif charid=121 Then
|
||||
charid=69
|
||||
charid2=64
|
||||
textlength+=wide(69)
|
||||
down=True
|
||||
plusx=3
|
||||
End If
|
||||
ElseIf charid=163 Then
|
||||
charid=text[i+1]+32
|
||||
i+=1
|
||||
Select Case charid
|
||||
Case 220 'ü
|
||||
charid=99
|
||||
textlength+=wide(99)
|
||||
Case 196 'ä
|
||||
charid=97
|
||||
textlength+=wide(97)
|
||||
Case 164 'Ä
|
||||
charid=94
|
||||
textlength+=wide(94)
|
||||
Case 214 'ö
|
||||
charid=98
|
||||
textlength+=wide(98)
|
||||
Case 182 'Ö
|
||||
charid=95
|
||||
textlength+=wide(95)
|
||||
Case 188 'Ü
|
||||
charid=96
|
||||
textlength+=wide(96)
|
||||
Case 191 'ß
|
||||
charid=100
|
||||
textlength+=wide(100)
|
||||
'Case 140 '€
|
||||
'charid=101
|
||||
'textlength+=wide(101)
|
||||
|
||||
Case 162 'â
|
||||
charid=33
|
||||
charid2=62
|
||||
textlength+=wide(33)
|
||||
plusy=3
|
||||
Case 170 'ê
|
||||
charid=37
|
||||
charid2=62
|
||||
textlength+=wide(37)
|
||||
plusy=4
|
||||
Case 180 'Ô
|
||||
charid=47
|
||||
charid2=62
|
||||
textlength+=wide(47)
|
||||
plusy=4
|
||||
|
||||
Case 194 'â
|
||||
charid=65
|
||||
charid2=62
|
||||
textlength+=wide(65)
|
||||
plusy=2
|
||||
plusx=-1
|
||||
Case 202 'ê
|
||||
charid=69
|
||||
charid2=62
|
||||
textlength+=wide(69)
|
||||
plusy=2
|
||||
plusx=-1
|
||||
Case 212 'ô
|
||||
charid=79
|
||||
charid2=62
|
||||
textlength+=wide(79)
|
||||
plusy=2
|
||||
plusx=-1
|
||||
|
||||
Case 166 'Æ
|
||||
charid=33
|
||||
charid2=37
|
||||
textlength+=wide(33)+6
|
||||
plusx=6
|
||||
Case 198 'Æ
|
||||
charid=65
|
||||
charid2=69
|
||||
textlength+=wide(65)+5
|
||||
plusx=5
|
||||
|
||||
Case 209 'ñ
|
||||
charid=78
|
||||
charid2=63
|
||||
textlength+=wide(78)
|
||||
plusy=size-2
|
||||
|
||||
Case 160 'À
|
||||
charid=33
|
||||
charid2=64
|
||||
textlength+=wide(33)
|
||||
plusy=2
|
||||
plusx=2
|
||||
Case 161 'À
|
||||
charid=33
|
||||
charid2=102
|
||||
textlength+=wide(33)
|
||||
plusy=2
|
||||
plusx=2
|
||||
Case 168 'É
|
||||
charid=37
|
||||
charid2=64
|
||||
textlength+=wide(37)
|
||||
plusy=2
|
||||
plusx=2
|
||||
Case 169 'É
|
||||
charid=37
|
||||
charid2=102
|
||||
textlength+=wide(37)
|
||||
plusy=2
|
||||
plusx=2
|
||||
Case 172 'Ì
|
||||
charid=41
|
||||
charid2=64
|
||||
textlength+=wide(41)
|
||||
plusy=2
|
||||
Case 173 'Ì
|
||||
charid=41
|
||||
charid2=102
|
||||
textlength+=wide(41)
|
||||
plusy=2
|
||||
Case 178 'Ò
|
||||
charid=47
|
||||
charid2=64
|
||||
textlength+=wide(47)
|
||||
plusy=2
|
||||
plusx=2
|
||||
Case 179 'Ò
|
||||
charid=47
|
||||
charid2=102
|
||||
textlength+=wide(47)
|
||||
plusy=2
|
||||
plusx=2
|
||||
Case 185 'Ù
|
||||
charid=53
|
||||
charid2=64
|
||||
textlength+=wide(53)
|
||||
plusy=2
|
||||
plusx=2
|
||||
Case 186 'Ù
|
||||
charid=53
|
||||
charid2=102
|
||||
textlength+=wide(53)
|
||||
plusy=2
|
||||
plusx=2
|
||||
Case 230 'Ć
|
||||
charid=35
|
||||
charid2=102
|
||||
textlength+=wide(35)
|
||||
plusy=2
|
||||
plusx=3
|
||||
|
||||
Case 192 'à
|
||||
charid=65
|
||||
charid2=64
|
||||
textlength+=wide(65)
|
||||
Case 193 'á
|
||||
charid=65
|
||||
charid2=102
|
||||
textlength+=wide(65)
|
||||
Case 200 'é
|
||||
charid=69
|
||||
charid2=64
|
||||
textlength+=wide(69)
|
||||
Case 201 'é
|
||||
charid=69
|
||||
charid2=102
|
||||
textlength+=wide(69)
|
||||
Case 204 'í
|
||||
charid=73
|
||||
charid2=64
|
||||
textlength+=wide(74)
|
||||
Case 205 'í
|
||||
charid=73
|
||||
charid2=102
|
||||
textlength+=wide(74)
|
||||
Case 210 'ó
|
||||
charid=79
|
||||
charid2=64
|
||||
textlength+=wide(79)
|
||||
Case 211 'ó
|
||||
charid=79
|
||||
charid2=102
|
||||
textlength+=wide(79)
|
||||
Case 217 'ú
|
||||
charid=85
|
||||
charid2=64
|
||||
textlength+=wide(85)
|
||||
Case 218 'ú
|
||||
charid=85
|
||||
charid2=102
|
||||
textlength+=wide(85)
|
||||
Case 228 'Ą
|
||||
charid=33
|
||||
charid2=64
|
||||
textlength+=wide(33)
|
||||
down=True
|
||||
plusx=6
|
||||
Case 229 'ą
|
||||
charid=65
|
||||
charid2=64
|
||||
textlength+=wide(65)
|
||||
down=True
|
||||
plusx=3
|
||||
Case 231 'ć
|
||||
charid=67
|
||||
charid2=102
|
||||
textlength+=wide(67)
|
||||
Case 248 'Ę
|
||||
charid=37
|
||||
charid2=64
|
||||
textlength+=wide(37)
|
||||
down=True
|
||||
plusx=4
|
||||
Case 249 'ę
|
||||
charid=69
|
||||
charid2=64
|
||||
textlength+=wide(69)
|
||||
down=True
|
||||
plusx=3
|
||||
Case Else
|
||||
textlength+=3
|
||||
End Select
|
||||
Else
|
||||
textlength+=wide(charid)
|
||||
End If
|
||||
|
||||
If charid<>0 Then
|
||||
If charid2<>0 Then
|
||||
CombinedRender(buffer,charid,charid2,x+textlength-wide(charid),y,bold,,italic,down,plusx,plusy)
|
||||
Else
|
||||
Render(buffer,charid,x+textlength-wide(charid),y,bold,,italic)
|
||||
End If
|
||||
End If
|
||||
|
||||
'Draw String (10,40+i*20),Str(charid)+"|"+Str(Len(text))
|
||||
If bold=True Then textlength+=1
|
||||
If underline=True Then
|
||||
Line (x,y+size+1)-(x+textlength,y+size+1),clr
|
||||
End If
|
||||
Next
|
||||
End Sub
|
||||
|
||||
'Sub TFont.ChangeColor(clrc As Integer)
|
||||
'Var clr2=GetColor(clrc)
|
||||
'For i As Integer=1 To 102
|
||||
'For y As Integer=0 To size-1
|
||||
'For x As Integer=0 To wide(i)+2
|
||||
'If Point(x,y,char(i))=clr Then
|
||||
'Pset char(i),(x,y),clr2
|
||||
'End If
|
||||
'If Point(x,y,charitalic(i))=clr Then
|
||||
'Pset charitalic(i),(x,y),clr2
|
||||
'End If
|
||||
'Next
|
||||
'Next
|
||||
'Next
|
||||
'clr=clr2
|
||||
'End Sub
|
||||
|
||||
Sub TFont.ChangeSize(newsize As UByte)
|
||||
size=newsize
|
||||
Dim As Integer oldwide
|
||||
For i As Integer=1 To 102
|
||||
oldwide=Wide(i)
|
||||
Wide(i)=Wide(i)+(size-origsize)
|
||||
Char(i)=Resize(Char(i),Wide(i)/oldwide,size/origsize)
|
||||
Next
|
||||
|
||||
End Sub
|
||||
|
||||
Function TFont.Length(text As WString) As Integer
|
||||
Dim As Integer textlength
|
||||
Dim As UByte charid
|
||||
For i As Integer=0 To Len(text)
|
||||
charid=text[i]-32
|
||||
If charid<33 Then
|
||||
textlength+=3
|
||||
Else
|
||||
textlength+=wide(charid)
|
||||
End If
|
||||
Next
|
||||
Return textlength
|
||||
End Function
|
||||
|
|
@ -0,0 +1,121 @@
|
|||
#define RGBA_R(c) (CUInt(c) Shr 16 And 255)
|
||||
#define RGBA_G(c) (CUInt(c) Shr 8 And 255)
|
||||
#define RGBA_B(c) (CUInt(c) And 255)
|
||||
'#define RGBA_A(c) (CUInt(c) Shr 24 )
|
||||
|
||||
Function GetDistanceBetweenColours(a As Integer, b As Integer) As Integer
|
||||
Var ra=RGBA_R(a)
|
||||
Var ga=RGBA_G(a)
|
||||
Var ba=RGBA_B(a)
|
||||
|
||||
Var rb=RGBA_R(b)
|
||||
Var gb=RGBA_G(b)
|
||||
Var bb=RGBA_B(b)
|
||||
|
||||
dim as integer dR = ra - rb
|
||||
dim as integer dG = ga - gb
|
||||
dim as integer dB = ba - bb
|
||||
return dR * dR + dG * dG + dB * dB
|
||||
End Function
|
||||
|
||||
Function GetColor(clr As Integer)As Integer
|
||||
Dim As Integer plt4(15)={&h000000, &h000080, &h008000, &h241200, &h800000, &h800080, &h808000, &hc0c0c0, &h808080, &h0000FF, &h00FF00, &h00FFFF, &hFF0000, &hFF00FF, &hFFFF00, &hFFFFFF}
|
||||
Dim As Integer plt8(255)={&h000080, &h008000, &h241200, &h800000, &h800080, &h808000, &hc0c0c0, &h808080, &h0000FF, &h00FF00, &h00FFFF, &hFF0000, &hFF00FF, &hFFFF00, &hFFFFFF, &h000000, &h141414, &h202020, &h2C2C2C, &h383838, &h444444, &h505050, &h616161, &h717171, &h818181, &h919191, &hA1A1A1, &hB6B6B6, &hCACACA, &hE2E2E2, &hFFFFFF, &h0000FF, &h4000FF, &h7D00FF, &hBE00FF, &h000000, &hFF00BE, &hFF007D, &hFF0040, &hFF0000, &hFF4000, &hFF7D00, &hFFBE00, &hFFFF00, &hBEFF00, &h7DFF00, &h40FF00, &h00FF00, &h00FF40, &h00FF7D, &h00FFBE, &h00FFFF, &h00BEFF, &h007DFF, &h0040FF, &h7D7DFF, &h9D7DFF, &hBE7DFF, &hDE7DFF, &hFF7DFF, &hFF7DDE, &hFF7DBE, &hFF7D9D, &hFF7D7D, &hFF9D7D, &hFFBE7D, &hFFDE7D, &hFFFF7D, &hDEFF7D, &hBEFF7D, &h9DFF7D, &h7DFF7D, &h7DFF9D, &h7DFFBE, &h7DFFDE, &h7DFFFF, &h7DDEFF, &h7DBEFF, &h7D9DFF, &hB6B6FF, &hC6B6FF, &hDAB6FF, &hEAB6FF, &hFFB6FF, &hFFB6EA, &hFFB6DA, &hFFB6C6, &hFFB6B6, &hFFC6B6, &hFFDAB6, &hFFEAB6, &hFFFFB6, &hEAFFB6, &hDAFFB6, &hC6FFB6, &hB6FFB6, &hB6FFC6, &hB6FFDA, &hB6FFEA, &hB6FFFF, &hB6EAFF, &hB6DAFF, &hB6C6FF, &h000071, &h1C0071, &h380071, &h550071, &h710071, &h710055, &h710038, &h71001C, &h710000, &h711C00, &h713800, &h715500, &h717100, &h557100, &h387100, &h1C7100, &h007100, &h00711C, &h007138, &h007155, &h007171, &h005571, &h003871, &h001C71, &h383871, &h443871, &h553871, &h613871, &h713871, &h713861, &h713855, &h713844, &h713838, &h714438, &h715538, &h716138, &h717138, &h617138, &h557138, &h447138, &h387138, &h387144, &h387155, &h387161, &h387171, &h386171, &h385571, &h384471, &h505071, &h595071, &h615071, &h695071, &h715071, &h715069, &h715061, &h715059, &h715050, &h715950, &h716150, &h716950, &h717150, &h697150, &h617150, &h597150, &h507150, &h507159, &h507161, &h507169, &h507171, &h506971, &h506171, &h505971, &h000040, &h100040, &h200040, &h300040, &h400040, &h400030, &h400020, &h400010, &h400000, &h401000, &h402000, &h403000, &h404000, &h304000, &h204000, &h104000, &h004000, &h004010, &h004020, &h004030, &h004040, &h003040, &h002040, &h001040, &h202040, &h282040, &h302040, &h382040, &h402040, &h402038, &h402030, &h402028, &h402020, &h402820, &h403020, &h403820, &h404020, &h384020, &h304020, &h284020, &h204020, &h204028, &h204030, &h204038, &h204040, &h203840, &h203040, &h202840, &h2C2C40, &h302C40, &h342C40, &h3C2C40, &h402C40, &h402C3C, &h402C34, &h402C30, &h402C2C, &h40302C, &h40342C, &h403C2C, &h40402C, &h3C402C, &h34402C, &h30402C, &h2C402C, &h2C4030, &h2C4034, &h2C403C, &h2C4040, &h2C3C40, &h2C3440, &h2C3040, &h000000, &h000000, &h000000, &h000000, &h000000, &h000000, &h000000, &h000000, &hFFFFFF}
|
||||
|
||||
Dim As Integer ret,r,g,b
|
||||
r=RGBA_R(clr)
|
||||
g=RGBA_G(clr)
|
||||
b=RGBA_B(clr)
|
||||
If depth=4 Then
|
||||
Dim As Integer d, c
|
||||
d=&h000000
|
||||
c=&hFFFFFF
|
||||
For i As Integer=0 To 15
|
||||
d=GetDistanceBetweenColours(clr,plt4(i))
|
||||
If d<c Then
|
||||
c=d
|
||||
ret=i
|
||||
End If
|
||||
Next
|
||||
Elseif depth=8 Then
|
||||
Dim As Integer d, c
|
||||
d=&h000000
|
||||
c=&hFFFFFF
|
||||
For i As Integer=0 To 255
|
||||
d=GetDistanceBetweenColours(clr,plt8(i))
|
||||
If d<c Then
|
||||
c=d
|
||||
ret=i+1
|
||||
End If
|
||||
Next
|
||||
Else
|
||||
ret=clr
|
||||
End If
|
||||
Return ret
|
||||
End Function
|
||||
|
||||
Function resize(source As Any Ptr, xScale as Single, yScale As Single)As Any Ptr
|
||||
Dim As Integer sourcewidth, sourceheight,clr,clr2,clr3,clr4,clr5,clr6,clr7,clr8
|
||||
ImageInfo(source,sourcewidth,sourceheight)
|
||||
Var ret=ImageCreate(sourcewidth*xScale,sourceheight*yScale)
|
||||
|
||||
For y As Integer=0 To sourceheight
|
||||
For x As Integer=0 To sourcewidth
|
||||
clr=Point(x,y,source)
|
||||
If clr<>0 Then Pset ret,(x*xScale,y*yScale),clr
|
||||
Next
|
||||
Next
|
||||
|
||||
For y As Integer=0 To sourceheight
|
||||
For x As Integer=0 To sourcewidth
|
||||
clr=Point(x,y,source)
|
||||
clr2=Point(x+1,y,source)
|
||||
clr3=Point(x,y+1,source)
|
||||
clr4=Point(x+1,y+1,source)
|
||||
clr5=Point(x-1,y,source)
|
||||
clr6=Point(x,y-1,source)
|
||||
clr7=Point(x+1,y-1,source)
|
||||
For yi As Integer=0 To yScale
|
||||
For xi As Integer=0 To xScale
|
||||
'If clr+clr2+clr3<>0 Then
|
||||
|
||||
Pset ret,(x*xScale+xi,y*yScale+yi),clr
|
||||
'End If
|
||||
Next
|
||||
Next
|
||||
Next
|
||||
Next
|
||||
|
||||
Return ret
|
||||
End Function
|
||||
|
||||
Function MirrorImage(source As Any Ptr,plusx As Integer=0,clr2 As Integer)As Any Ptr
|
||||
Dim As Integer sourcewidth, sourceheight,clr
|
||||
ImageInfo(source,sourcewidth,sourceheight)
|
||||
Var ret=ImageCreate(sourcewidth+plusx,sourceheight)
|
||||
For y As Integer=0 To sourceheight
|
||||
For x As Integer=0 To sourcewidth-1
|
||||
clr=Point(x,y,source)
|
||||
If clr=clr2 Then
|
||||
Pset ret,(sourcewidth-x+plusx,y),GetColor(&hFFFFFF)
|
||||
End If
|
||||
Next
|
||||
Next
|
||||
Return ret
|
||||
End Function
|
||||
|
||||
Function MirrorImage2(source As Any Ptr,plusx As Integer=0,clr2 As Integer,plusy As Integer=0)As Any Ptr
|
||||
Dim As Integer sourcewidth, sourceheight,clr
|
||||
ImageInfo(source,sourcewidth,sourceheight)
|
||||
Var ret=ImageCreate(sourcewidth+plusx,sourceheight+plusy)
|
||||
For y As Integer=0 To sourceheight
|
||||
For x As Integer=0 To sourcewidth-1
|
||||
clr=Point(x,y,source)
|
||||
If clr=clr2 Then
|
||||
Pset ret,(sourcewidth-x+plusx,sourceheight-y+plusy),GetColor(&hFFFFFF)
|
||||
End If
|
||||
Next
|
||||
Next
|
||||
Return ret
|
||||
End Function
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
|
|
@ -0,0 +1,296 @@
|
|||
''
|
||||
'' FreeBASIC Text Input Box using fbgfx only!
|
||||
''
|
||||
'' Alex Barry
|
||||
'' http://www.mrbarry.com/
|
||||
''
|
||||
'' June 24, 2011
|
||||
''
|
||||
|
||||
|
||||
#define DEBUG 1
|
||||
|
||||
Type InputBox
|
||||
public:
|
||||
Declare Constructor( byref strId as string )
|
||||
Declare Destructor()
|
||||
|
||||
Declare Sub reset( )
|
||||
|
||||
Declare Function getStringId( ) As String
|
||||
|
||||
Declare Sub display( focus as integer )
|
||||
Declare Function getInput( ) As Integer
|
||||
|
||||
Declare Sub setCaret( pos as integer )
|
||||
|
||||
Declare Sub setCaretBlinkRate( nTimesPerSecond as double = 1.0 )
|
||||
|
||||
As Integer x, y
|
||||
As Integer columns
|
||||
As String * 1 passwordChar
|
||||
As Integer isPassword
|
||||
As String text
|
||||
|
||||
As Integer redraw
|
||||
|
||||
As Integer paddingX, paddingY
|
||||
|
||||
As Uinteger background, foreground, border, caretCol
|
||||
private:
|
||||
Declare Sub moveCaretLeft()
|
||||
Declare Sub moveCaretRight()
|
||||
As Integer caret
|
||||
As Integer caretDraw
|
||||
As Integer textStartAt
|
||||
As Double caretInterval
|
||||
As Double caretNextBlink
|
||||
As String stringId
|
||||
End Type
|
||||
|
||||
ScreenRes 800, 600, 16
|
||||
Dim Shared As Integer fontWidth, fontHeight
|
||||
'' Get the default width and height of the font
|
||||
var w = Width()
|
||||
fontWidth = 800 / LoWord( w )
|
||||
fontHeight = 600 / HiWord( w )
|
||||
|
||||
Dim clickLock as Integer = 0
|
||||
|
||||
Dim txt(0 To 1) As InputBox Ptr = { new InputBox( "Left" ), new InputBox( "Right" ) }
|
||||
txt(0)->x = 20
|
||||
txt(0)->y = 20
|
||||
txt(0)->columns = 50
|
||||
txt(0)->paddingY = 5
|
||||
txt(0)->setCaretBlinkRate( 2.5 )
|
||||
|
||||
txt(1)->x = 500
|
||||
txt(1)->y = 20
|
||||
txt(1)->columns = 30
|
||||
txt(1)->paddingY = 5
|
||||
txt(1)->setCaretBlinkRate( 2.5 )
|
||||
txt(1)->isPassword = 1
|
||||
|
||||
locate 10, 1
|
||||
Print "** Press Esc to quit **"
|
||||
Print "Font Size: " & fontWidth & "x" & fontHeight
|
||||
Print
|
||||
Do
|
||||
|
||||
Dim As Integer mx, my, mb
|
||||
GetMouse( mx, my, , mb )
|
||||
If ( mb And 1 ) And ( Not clickLock ) Then
|
||||
For obj As Integer = Lbound( txt ) To Ubound( txt )
|
||||
Dim ibox As InputBox Ptr = txt(obj)
|
||||
If ( mx >= ibox->x ) And ( mx <= ibox->x+(fontWidth*ibox->columns)+(ibox->paddingX*2) ) And ( my >= ibox->y ) And ( my <= ibox->y+(fontHeight)+(ibox->paddingY*2) ) Then
|
||||
If obj > 0 Then
|
||||
Print "Changing focus to " & ibox->getStringId()
|
||||
For r As Integer = obj-1 To Lbound( txt ) Step -1
|
||||
swap txt(r+1), txt(r)
|
||||
Next r
|
||||
End If
|
||||
ibox->redraw = 1
|
||||
If mx < (ibox->x+ibox->paddingX) Then
|
||||
ibox->setCaret(0)
|
||||
Else
|
||||
var caretPos = fix( (mx-(ibox->x+ibox->paddingX))/fontWidth )
|
||||
ibox->setCaret( caretPos )
|
||||
End If
|
||||
End if
|
||||
Next Obj
|
||||
clickLock = 1
|
||||
ElseIf ( ( mb And 1 ) = 0 ) And clickLock Then
|
||||
clickLock = 0
|
||||
End if
|
||||
|
||||
if txt(0)->getInput( ) then
|
||||
print "Input (" & txt(0)->getStringId() & ") : `" & txt(0)->text & "`"
|
||||
txt(0)->reset()
|
||||
end if
|
||||
|
||||
ScreenLock()
|
||||
txt(0)->display(1)
|
||||
For u As Integer = 1 To Ubound( txt )
|
||||
txt(u)->display(0)
|
||||
Next u
|
||||
ScreenUnLock()
|
||||
sleep 1, 1
|
||||
Loop Until Multikey( &h1 )
|
||||
|
||||
For d As Integer = Lbound( txt ) To Ubound( txt )
|
||||
Delete txt(d)
|
||||
Next d
|
||||
|
||||
Constructor InputBox( byref strId as string )
|
||||
this.isPassword = 0
|
||||
this.passwordChar = "*"
|
||||
this.paddingX = 2
|
||||
this.paddingY = 2
|
||||
this.caretInterval = 1.0
|
||||
this.background = rgb(255,255,255)
|
||||
this.foreground = rgb(0,0,0)
|
||||
this.border = rgb( 100,100,100 )
|
||||
this.caretCol = rgb( 10,10,10 )
|
||||
this.stringId = strId
|
||||
this.reset()
|
||||
End Constructor
|
||||
|
||||
Destructor InputBox()
|
||||
this.text = ""
|
||||
this.passwordChar = ""
|
||||
End Destructor
|
||||
|
||||
Sub InputBox.reset()
|
||||
this.text = ""
|
||||
this.caret = 0
|
||||
this.caretDraw = 0
|
||||
this.textStartAt = 1
|
||||
this.redraw = 1
|
||||
End Sub
|
||||
|
||||
Function InputBox.getStringId( ) As String
|
||||
return this.stringId
|
||||
End Function
|
||||
|
||||
Sub InputBox.display( focus as integer )
|
||||
|
||||
If focus Then
|
||||
If (Timer >= this.caretNextBlink) Then
|
||||
this.caretDraw = Not this.caretDraw
|
||||
this.caretNextBlink = Timer + this.caretInterval
|
||||
this.redraw = 1
|
||||
End If
|
||||
Else
|
||||
this.caretDraw = 0
|
||||
End If
|
||||
|
||||
If this.redraw Then
|
||||
Line (this.x, this.y)-step((this.columns*fontWidth)+(this.paddingX*2), fontHeight+(this.paddingY*2)), this.background, bf
|
||||
Line (this.x, this.y)-step((this.columns*fontWidth)+(this.paddingX*2), fontHeight+(this.paddingY*2)), this.border, b
|
||||
|
||||
Dim showChars as string
|
||||
showChars = Mid( this.text, this.textStartAt )
|
||||
If len( showChars ) > this.columns Then showChars = Mid( showChars, 1, this.columns )
|
||||
If this.isPassword = 1 Then
|
||||
showChars = String( len( showChars ), this.passwordChar )
|
||||
End If
|
||||
Draw String ( this.x+this.paddingX, this.y+this.paddingY ), showChars, this.foreground
|
||||
|
||||
If this.caretDraw Then
|
||||
Line ( this.x+this.paddingX + (this.caret*8) - 1, this.y+(this.paddingY/2) )-( this.x+this.paddingX + (this.caret*8), this.y+fontHeight+(this.paddingY) ), this.caretCol, bf
|
||||
Else
|
||||
Line ( this.x+this.paddingX + (this.caret*8) - 1, this.y+(this.paddingY/2) )-( this.x+this.paddingX + (this.caret*8), this.y+fontHeight+(this.paddingY) ), this.background, bf
|
||||
End If
|
||||
|
||||
this.redraw = 0
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Function InputBox.getInput( ) As Integer
|
||||
'' Parse text input
|
||||
Dim a As Integer
|
||||
Dim i As String
|
||||
Dim As String splitA, splitB
|
||||
i = Inkey()
|
||||
a = Asc( i )
|
||||
this.redraw = 1
|
||||
If ( a >= 32 ) And ( a <= 126 ) Then
|
||||
splitA = Mid( this.text, 1, this.textStartAt+this.caret-1 )
|
||||
splitB = Mid( this.text, this.textStartAt+this.caret )
|
||||
this.text = splitA & i & splitB
|
||||
moveCaretRight( )
|
||||
ElseIf ( a = 13 ) Then
|
||||
this.redraw = 0
|
||||
Return 1
|
||||
ElseIf ( a = 8 ) Then
|
||||
If ( len( this.text ) > 0 ) And ( this.textStartAt >= 1 ) Then
|
||||
splitA = Mid( this.text, 1, this.textStartAt+this.caret-2 )
|
||||
splitB = Mid( this.text, this.textStartAt+this.caret + 1 )
|
||||
this.text = splitA & splitB
|
||||
moveCaretLeft( )
|
||||
End If
|
||||
ElseIf ( i = (chr(255)+chr(75)) ) Then '' Left
|
||||
this.moveCaretLeft( )
|
||||
ElseIf ( i = (chr(255)+chr(77)) ) Then '' Right
|
||||
this.moveCaretRight( )
|
||||
ElseIf ( i = (chr(255)+chr(83)) ) Then '' Delete
|
||||
If ( len( this.text ) > 0 ) Then
|
||||
splitA = Mid( this.text, 1, this.textStartAt+this.caret-1 )
|
||||
splitB = Mid( this.text, this.textStartAt+this.caret + 1 )
|
||||
this.text = splitA & splitB
|
||||
End If
|
||||
ElseIf ( i = (chr(255)+chr(71)) ) Then '' Home
|
||||
this.textStartAt = 1
|
||||
this.caret = 0
|
||||
ElseIf ( i = (chr(255)+chr(79)) ) Then '' End
|
||||
Dim max As Integer
|
||||
max = len( this.text ) - this.columns
|
||||
If max < 1 Then
|
||||
this.textStartAt = 1
|
||||
this.setCaret( len( this.text ) )
|
||||
Else
|
||||
this.textStartAt = max
|
||||
this.setCaret( this.columns )
|
||||
End If
|
||||
Else
|
||||
If a > 0 Then
|
||||
#if DEBUG
|
||||
Print "Unhandled key: ";
|
||||
For p As Integer = 1 To Len( i )
|
||||
print asc( Mid( i, p, 1 ) ) & "+";
|
||||
Next
|
||||
Print ""
|
||||
#endif
|
||||
End If
|
||||
this.redraw = 0
|
||||
End If
|
||||
|
||||
Return 0
|
||||
End Function
|
||||
|
||||
Sub InputBox.setCaret( p as integer )
|
||||
If (p < 0) Then
|
||||
this.caret = 0
|
||||
ElseIf pos >= 1 Then
|
||||
If p > this.columns Then p = this.columns
|
||||
Dim maxd As Integer
|
||||
maxd = len( mid( this.text, this.textStartAt, this.columns ) )
|
||||
If p > maxd Then
|
||||
this.caret = maxd
|
||||
Else
|
||||
this.caret = p
|
||||
End If
|
||||
End If
|
||||
this.caretDraw = 0
|
||||
this.caretNextBlink = Timer
|
||||
End Sub
|
||||
|
||||
Sub InputBox.setCaretBlinkRate( nTimesPerSecond as double )
|
||||
this.caretInterval = 1.0/nTimesPerSecond
|
||||
this.caretNextBlink = Timer
|
||||
End Sub
|
||||
|
||||
Sub InputBox.moveCaretLeft()
|
||||
If this.caret = 0 Then
|
||||
this.textStartAt -= 1
|
||||
If this.textStartAt < 1 Then this.textStartAt = 1
|
||||
Else
|
||||
this.caret -= 1
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Sub InputBox.moveCaretRight()
|
||||
If this.caret = this.columns Then
|
||||
this.textStartAt += 1
|
||||
Dim max As Integer
|
||||
max = len( this.text ) - this.columns
|
||||
If max < 1 Then
|
||||
this.textStartAt = 1
|
||||
Else
|
||||
this.textStartAt = max
|
||||
End If
|
||||
Else
|
||||
this.caret += 1
|
||||
End If
|
||||
End sub
|
||||
|
|
@ -0,0 +1,564 @@
|
|||
|
||||
|
||||
#INCLUDE "fbgfx.bi"
|
||||
Using FB
|
||||
Windowtitle "Simple Paint Program"
|
||||
Screenres 640,480,32
|
||||
|
||||
Dim Shared As Integer cmd
|
||||
cmd = 0 'draw mode default
|
||||
Dim Shared As Integer btnID 'id of button pressed
|
||||
Dim Shared As Integer penSize
|
||||
penSize = 3 'pen size default
|
||||
Dim Shared As Integer mirror
|
||||
mirror = 0 'default to no mirror
|
||||
|
||||
'fill in pallete with colors
|
||||
Dim As Ubyte r,g,b
|
||||
Dim Shared As Uinteger colors(48)
|
||||
For i As Integer = 0 To 47
|
||||
Read r,g,b
|
||||
colors(i) = Rgb(r,g,b)
|
||||
Next i
|
||||
|
||||
Dim Shared As Any Ptr canvas1,canvas2 'displayed image
|
||||
canvas1 = Imagecreate(640,480,Rgb(255,255,254)) 'save image while screen is being worked on
|
||||
canvas2 = Imagecreate(640,480,Rgb(255,255,254)) 'saves saved image for UNDO
|
||||
|
||||
Dim Shared As Integer mx,my,ox,oy,sx,sy,dx,dy,mb 'mouse variables
|
||||
Setmouse(0,0,1,1)
|
||||
|
||||
Dim Shared As Integer sColor 'id of selected color in palette
|
||||
sColor = 0 'black pen default palette#0
|
||||
|
||||
Dim Shared As Integer mode1, mode2 'fill rectangle, fill circle
|
||||
|
||||
|
||||
Sub update()
|
||||
Screenlock()
|
||||
'=============
|
||||
'draw buttons
|
||||
'=============
|
||||
For x As Integer = 0 To 15
|
||||
If cmd=x Or (mirror = 1 And x = 7) Then
|
||||
Line (x*40,0)-(x*40+39,20),Rgb(100,100,255),bf
|
||||
Else
|
||||
Line (x*40,0)-(x*40+39,20),Rgb(10,10,255),bf
|
||||
End If
|
||||
Next x
|
||||
Draw String (4,8),"DRAW RECT CIRC LINE FILL RUB CLS HMIR UNDO SAVE LOAD PEN .... .... .... QUIT",Rgb(255,255,254)
|
||||
For i As Integer = 0 To 15
|
||||
Line (i*40,0)-(i*40+39,20),Rgb(200,200,200),b
|
||||
Next i
|
||||
|
||||
|
||||
'==================
|
||||
' draw palette
|
||||
'==================
|
||||
For x As Integer = 0 To 39
|
||||
Line (x*16,464)-(x*16+15,479),colors(x),bf
|
||||
If x = sColor Or (mirror = 1 And x = 7) Then
|
||||
Line (x*16,464)-(x*16+15,479) ,Rgb(255,255,254),b
|
||||
Line (x*16+1,464+1)-(x*16+15-1,479-1) ,Rgb(0,0,0),b
|
||||
Else
|
||||
Line (x*16,464)-(x*16+15,479) ,Rgb(0,0,0),b
|
||||
End If
|
||||
Next x
|
||||
Screenunlock()
|
||||
Sleep 2
|
||||
End Sub
|
||||
|
||||
Sub thickLine(x1 As Integer,y1 As Integer,x2 As Integer,y2 As Integer,size As Integer,c As Uinteger)
|
||||
Dim As Integer x,y
|
||||
If x1 = x2 And y1 = y2 Then
|
||||
Circle (x1, y1), size, c, , , , f
|
||||
Elseif Abs(x2 - x1) >= Abs(y2 - y1) Then
|
||||
Dim K As Single = (y2 - y1) / (x2 - x1)
|
||||
For I As Integer = x1 To x2 Step Sgn(x2 - x1)
|
||||
x = I
|
||||
y = K * (I - x1) + y1
|
||||
Circle (x,y), size, c, , , , f
|
||||
If mirror = 1 Then
|
||||
Circle (640-x,y),size,c,,,,f 'for horizontal mirror
|
||||
End If
|
||||
Next I
|
||||
Else
|
||||
Dim L As Single = (x2 - x1) / (y2 - y1)
|
||||
For J As Integer = y1 To y2 Step Sgn(y2 - y1)
|
||||
x = L * (J - y1) + x1
|
||||
y = J
|
||||
Circle (x,y), size,c,,,,f
|
||||
If mirror = 1 Then
|
||||
Circle (640-x,y),size,c,,,,f 'for horizontal mirror
|
||||
End If
|
||||
Next J
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Sub FloodFill (x As Integer, y As Integer, oldcolour As Integer, newcolour As Integer)
|
||||
Dim As Integer Ptr p = New Integer[16*1024 * 1024]
|
||||
Dim As Integer n = 0
|
||||
Dim As Integer x0, y0
|
||||
|
||||
If oldcolour = newcolour Then Exit Sub
|
||||
p[n] = x
|
||||
p[n+1] = y
|
||||
n = n + 2
|
||||
While n > 0
|
||||
y0 = p[n-1]
|
||||
x0 = p[n-2]
|
||||
n = n - 2
|
||||
If Point(x0, y0) = oldcolour Then
|
||||
Pset (x0, y0), newcolour
|
||||
p[n] = x0
|
||||
p[n+1] = y0-1
|
||||
p[n+2] = x0
|
||||
p[n+3] = y0+1
|
||||
p[n+4] = x0-1
|
||||
p[n+5] = y0
|
||||
p[n+6] = x0+1
|
||||
p[n+7] = y0
|
||||
n = n + 8
|
||||
End If
|
||||
Wend
|
||||
Delete p
|
||||
End Sub
|
||||
|
||||
Sub Fill()
|
||||
FloodFill (mx,my,Point(mx,my),colors(sColor))
|
||||
update()
|
||||
'wait for select button release
|
||||
While mb=1
|
||||
Getmouse mx,my,,mb
|
||||
Wend
|
||||
Put canvas2,(0,0),canvas1,Pset 'canvas2 = canvas1
|
||||
Get (0,0)-(639,479),canvas1 'canvas1 = screen
|
||||
End Sub
|
||||
|
||||
Sub drawRectangle()
|
||||
Dim As Integer r
|
||||
Dim As String s
|
||||
While mb=1
|
||||
Getmouse mx,my,,mb
|
||||
If mx<>ox Or my<>oy Then 'mouse has moved so draw erase old draw new
|
||||
Screenlock()
|
||||
Put (0,0),canvas1,Trans 'restore screen
|
||||
|
||||
'fill rectangle mode?
|
||||
If mode1 = 1 Then
|
||||
For i As Integer = oy To my
|
||||
Line (ox,i)-(mx,i),colors(sColor)
|
||||
Next i
|
||||
End If
|
||||
|
||||
thickLine(ox,oy,mx,oy,penSize,colors(sColor))
|
||||
thickLine(mx,oy,mx,my,penSize,colors(sColor))
|
||||
thickLine(mx,my,ox,my,penSize,colors(sColor))
|
||||
thickLine(ox,my,ox,oy,penSize,colors(sColor))
|
||||
Screenunlock()
|
||||
update()
|
||||
Sleep 1
|
||||
End If
|
||||
Wend
|
||||
Put canvas2,(0,0),canvas1,Pset 'canvas2 = canvas1
|
||||
Get (0,0)-(639,479),canvas1 'canvas1 = screen
|
||||
End Sub
|
||||
|
||||
Sub drawLine()
|
||||
Dim As Integer sx,sy
|
||||
sx = mx
|
||||
sy = my
|
||||
While mb=1
|
||||
Getmouse mx,my,,mb
|
||||
If mx<>ox Or my<>oy Then 'mouse has moved so draw erase old draw new
|
||||
Put (0,0),canvas1,Trans 'restore screen
|
||||
thickLine(sx,sy,mx,my,penSize,colors(sColor)) 'draw line
|
||||
ox = mx
|
||||
oy = my
|
||||
update()
|
||||
End If
|
||||
Wend
|
||||
Put canvas2,(0,0),canvas1,Pset 'canvas2 = canvas1
|
||||
Get (0,0)-(639,479),canvas1 'canvas1 = screen
|
||||
End Sub
|
||||
|
||||
Sub drawPen()
|
||||
While mb=1
|
||||
Getmouse mx,my,,mb
|
||||
If mx<>ox Or my<>oy Then 'mouse has moved so draw erase old draw new
|
||||
thickLine(ox,oy,mx,my,penSize,colors(sColor)) 'drawline onto screenBuffer
|
||||
ox = mx
|
||||
oy = my
|
||||
update()
|
||||
End If
|
||||
Sleep 1
|
||||
Wend
|
||||
Put canvas2,(0,0),canvas1,Pset 'canvas2 = canvas1
|
||||
Get (0,0)-(639,479),canvas1 'canvas1 = screen
|
||||
|
||||
End Sub
|
||||
|
||||
Sub Ellipse(x0 As Integer, Y0 As Integer, X1 As Integer, y1 As Integer, c As Uinteger)
|
||||
'bresenham circle
|
||||
'void bresenham_ellipse( x0 As Integer,y0 As Integer, x1 As integer, y1 As integer )
|
||||
If x0>x1 Then Swap x0,x1
|
||||
If y0>y1 Then Swap y0,y1
|
||||
Dim As Integer x,y,a2,b2, S, T,xb,yb,b
|
||||
b=(y1-y0)/2
|
||||
b2=b*b
|
||||
a2=(x1-x0)^2/4
|
||||
xb=(x0+x1)/2
|
||||
yb=(y0+y1)/2
|
||||
|
||||
x = 0
|
||||
y = b
|
||||
S = a2*(1-2*b) + 2*b2
|
||||
T = b2 - 2*a2*(2*b-1)
|
||||
If mode2 = 1 Then 'fill ellipse
|
||||
Line ((xb-x),(yb+y))-((xb-x),(yb-y)),c
|
||||
Line ((xb+x),(yb+y))-((xb+x),(yb-y)),c
|
||||
End If
|
||||
Circle ((xb+x),(yb+y)),3,c,,,,f
|
||||
Circle ((xb+x),(yb-y)),3,c,,,,f
|
||||
Circle ((xb-x),(yb+y)),3,c,,,,f
|
||||
Circle ((xb-x),(yb-y)),3,c,,,,f
|
||||
|
||||
Do
|
||||
If S<0 Then
|
||||
|
||||
S += 2*b2*(2*x+3)
|
||||
T += 4*b2*(x+1)
|
||||
x+=1
|
||||
Elseif T<0 Then
|
||||
S += 2*b2*(2*x+3) - 4*a2*(y-1)
|
||||
T += 4*b2*(x+1) - 2*a2*(2*y-3)
|
||||
x+=1
|
||||
y-=1
|
||||
Else
|
||||
S -= 4*a2*(y-1)
|
||||
T -= 2*a2*(2*y-3)
|
||||
y-=1
|
||||
End If
|
||||
If mode2 = 1 Then 'fill ellipse
|
||||
Line ((xb-x),(yb+y))-((xb-x),(yb-y)),c
|
||||
Line ((xb+x),(yb+y))-((xb+x),(yb-y)),c
|
||||
End If
|
||||
Circle ((xb+x),(yb+y)),3,c,,,,f
|
||||
Circle ((xb+x),(yb-y)),3,c,,,,f
|
||||
Circle ((xb-x),(yb+y)),3,c,,,,f
|
||||
Circle ((xb-x),(yb-y)),3,c,,,,f
|
||||
Loop While y>0
|
||||
|
||||
End Sub
|
||||
|
||||
Sub drawCircle()
|
||||
Dim As Double r
|
||||
Dim As Integer x,y,cx,cy
|
||||
While mb=1
|
||||
Getmouse mx,my,,mb
|
||||
If mx<>ox Or my<>oy Then 'mouse has moved so draw erase old draw new
|
||||
Screenlock()
|
||||
Put (0,0),canvas1,Trans 'restore screen
|
||||
Ellipse(ox,oy,mx,my,colors(sColor)) 'draw onto screen
|
||||
If mirror = 1 Then
|
||||
Ellipse(640-ox,oy,640-mx,my,colors(sColor))
|
||||
End If
|
||||
Screenunlock()
|
||||
update()
|
||||
End If
|
||||
Wend
|
||||
Put canvas2,(0,0),canvas1,Pset 'canvas2 = canvas1
|
||||
Get (0,0)-(639,479),canvas1 'canvas1 = screen
|
||||
End Sub
|
||||
|
||||
Sub Rubber()
|
||||
Dim As Double r
|
||||
Dim As Integer x,y,cx,cy
|
||||
While mb=1
|
||||
Getmouse mx,my,,mb
|
||||
If mx<>ox Or my<>oy Then 'mouse has moved so draw erase old draw new
|
||||
Line(ox,oy)-(ox+20,oy+20),Rgb(255,255,254),bf 'erase box outline
|
||||
Line(mx,my)-(mx+20,my+20),Rgb(255,255,254),bf
|
||||
Line(mx,my)-(mx+20,my+20),Rgb(0,0,0),b 'draw box outline
|
||||
ox = mx
|
||||
oy = my
|
||||
update()
|
||||
End If
|
||||
Wend
|
||||
Line(ox,oy)-(ox+20,oy+20),Rgb(255,255,254),bf 'erase box outline
|
||||
Put canvas2,(0,0),canvas1,Pset 'canvas2 = canvas1
|
||||
Get (0,0)-(639,479),canvas1 'canvas1 = screen
|
||||
End Sub
|
||||
|
||||
Sub save()
|
||||
Dim fileName As String
|
||||
Locate 20,10
|
||||
Get (0,0)-(639,479),canvas1 'save into canvas1
|
||||
Line (60,140)-(560,172),Rgb(255,255,254),bf
|
||||
Line (60,140)-(560,172),Rgb(1,1,1),b
|
||||
Line Input "Enter picture name:", fileName
|
||||
Locate 26,10
|
||||
Print " ... SAVING"
|
||||
Bsave filename + ".bmp",canvas1
|
||||
Put (0,0),canvas1,Pset 'copy to screen
|
||||
update()
|
||||
End Sub
|
||||
|
||||
Sub load()
|
||||
Dim fileName As String
|
||||
Locate 20,10
|
||||
Line (60,140)-(560,172),Rgb(255,255,254),bf
|
||||
Line (60,140)-(560,172),Rgb(1,1,1),b
|
||||
Line Input "Enter picture name:",fileName
|
||||
Bload filename + ".bmp",canvas1
|
||||
Put (0,0),canvas1,Pset 'copy to screen
|
||||
update()
|
||||
End Sub
|
||||
|
||||
Color Rgb(0,0,0),Rgb(255,255,254) 'black ink, white paper
|
||||
Cls 'executes the color change
|
||||
|
||||
update()
|
||||
|
||||
Dim As String key
|
||||
Do
|
||||
|
||||
Getmouse mx,my,,mb
|
||||
ox = mx
|
||||
oy = my
|
||||
|
||||
|
||||
If mb = 1 Then
|
||||
|
||||
'is it over drawing area?
|
||||
If my>20 And my<480-20 Then
|
||||
If cmd = 0 Then
|
||||
drawPen()
|
||||
End If
|
||||
If cmd = 1 Then
|
||||
drawRectangle()
|
||||
End If
|
||||
If cmd = 2 Then
|
||||
drawCircle()
|
||||
End If
|
||||
If cmd = 3 Then
|
||||
drawLine()
|
||||
End If
|
||||
If cmd = 4 Then
|
||||
Fill()
|
||||
End If
|
||||
If cmd = 5 Then
|
||||
Rubber()
|
||||
End If
|
||||
End If
|
||||
'is it over buttons
|
||||
If my<20 Then
|
||||
|
||||
btnID = mx\40
|
||||
|
||||
If btnID=1 Then 'set rectangle mode
|
||||
|
||||
Get (0,0)-(639,479),canvas1 'save screen into canvas1 to restore
|
||||
Locate 18,2
|
||||
Print "Release mouse button over fill or not fill icon to select mode"
|
||||
update()
|
||||
'drop down rectangle examples
|
||||
For j As Integer = 0 To 1
|
||||
Line (44,j*32+23)-(44+31,j*32+31+23),Rgb(255,255,254),bf
|
||||
Line (44,j*32+23)-(44+31,j*32+31+23),Rgb(1,1,1),b
|
||||
Line (52,31)-(52+16,31+16),Rgb(1,1,1),b
|
||||
Line (52,63)-(52+16,63+16),Rgb(1,1,1),bf
|
||||
Next j
|
||||
While mb=1
|
||||
Getmouse mx,my,,mb
|
||||
Wend
|
||||
'was it released over shape fill mode?
|
||||
If mx>44 And mx<75 And my>25 And my<87 Then
|
||||
mode1 = (Int(my-23)\32)
|
||||
End If
|
||||
Put (0,0),canvas1,Pset 'restore screen
|
||||
update()
|
||||
End If
|
||||
|
||||
If btnID=2 Then 'set rectangle mode
|
||||
|
||||
Get (0,0)-(639,479),canvas1 'save screen into canvas1 to restore
|
||||
Locate 18,2
|
||||
Print "Release mouse button over fill or not fill icon to select mode"
|
||||
update()
|
||||
'drop down ellipse examples
|
||||
For j As Integer = 0 To 1
|
||||
Line (84,j*32+25)-(84+31,j*32+31+25),Rgb(255,255,254),bf
|
||||
Line (84,j*32+25)-(84+31,j*32+31+25),Rgb(1,1,1),b
|
||||
Circle (99,40),10,Rgb(1,1,1)
|
||||
Circle (99,73),10,Rgb(1,1,1),,,,f
|
||||
Next j
|
||||
While mb=1
|
||||
Getmouse mx,my,,mb
|
||||
Wend
|
||||
'was it released over shape fill mode?
|
||||
If mx>84 And mx<115 And my>25 And my<87 Then
|
||||
mode2 = (Int(my-23)\32)
|
||||
End If
|
||||
Put (0,0),canvas1,Pset 'restore screen
|
||||
update()
|
||||
End If
|
||||
|
||||
If btnID<6 Then
|
||||
cmd = btnID
|
||||
End If
|
||||
|
||||
If btnID=6 Then
|
||||
Color Rgb(1,1,1),Rgb(255,255,254) 'black ink, white paper
|
||||
Line canvas1,(0,0)-(639,479),Rgb(255,255,254),bf 'clear canvas1
|
||||
Cls
|
||||
End If
|
||||
|
||||
If btnID=7 Then
|
||||
mirror = mirror+1
|
||||
If mirror=2 Then mirror = 0
|
||||
End If
|
||||
|
||||
If btnID=8 Then
|
||||
Put canvas1,(0,0),canvas2,Pset 'get previous
|
||||
Put (0,0),canvas1,Pset 'copy to screen
|
||||
update()
|
||||
End If
|
||||
|
||||
If btnID = 9 Then
|
||||
save()
|
||||
update()
|
||||
'btnID = mode 'reset button ID
|
||||
End If
|
||||
|
||||
If btnID = 10 Then
|
||||
load()
|
||||
update()
|
||||
'btnID = mode 'reset button ID
|
||||
End If
|
||||
|
||||
If btnID = 11 Then 'pen size
|
||||
Get (0,0)-(639,479),canvas1 'save screen into canvas1 to restore
|
||||
Locate 8,2
|
||||
Print "Release mouse button over desired pen size"
|
||||
update()
|
||||
'drop down pen examples
|
||||
For j As Integer = 0 To 3
|
||||
Line (449,j*23+23)-(449+22,j*23+22+23),Rgb(255,255,254),bf
|
||||
Line (449,j*23+23)-(449+22,j*23+22+23),Rgb(1,1,1),b
|
||||
Circle (449+11,j*23+11+23),j*2+1,Rgb(1,1,1),,,,f
|
||||
Next j
|
||||
While mb=1
|
||||
Getmouse mx,my,,mb
|
||||
Wend
|
||||
'was it released over pen size?
|
||||
If mx>454 And mx<476 And my>23 And my<114 Then
|
||||
penSize = (Int(my-23)\23)*2+1
|
||||
End If
|
||||
Put (0,0),canvas1,Pset 'restore screen
|
||||
update()
|
||||
|
||||
End If
|
||||
|
||||
|
||||
'wait for button release
|
||||
While mb = 1
|
||||
Getmouse mx,my,,mb
|
||||
Wend
|
||||
|
||||
update()
|
||||
|
||||
End If
|
||||
'is it over pallete?
|
||||
If my>464 Then
|
||||
sColor = mx\16
|
||||
While mb = 1
|
||||
Getmouse mx,my,,mb
|
||||
Wend
|
||||
End If
|
||||
update()
|
||||
End If
|
||||
|
||||
Loop Until btnID = 15
|
||||
|
||||
Imagedestroy(canvas1)
|
||||
Imagedestroy(canvas2)
|
||||
|
||||
'Custom colors
|
||||
ColorData:
|
||||
|
||||
' === microsoft PAINT standard colors ===
|
||||
Data 0 ,0 , 0 'BLACK
|
||||
Data 127,127,127 'dark gray
|
||||
Data 195,195,195 'light gray
|
||||
Data 255,255,254 'WHITE
|
||||
Data 136, 0, 21 'red brown
|
||||
Data 185,122, 87 'brown
|
||||
Data 237, 28, 36 'red
|
||||
Data 255,174,201 'pink
|
||||
Data 255,127, 39 'orange
|
||||
Data 255,201, 14 'deep yellow gold
|
||||
Data 255,242, 0 'yellow
|
||||
Data 239,228,176 'light yellow
|
||||
Data 34,177, 76 'green
|
||||
Data 181,230, 29 'lime
|
||||
Data 0,162,232 'turquoise medium blue
|
||||
Data 153,217,234 'light blue
|
||||
Data 63, 72,204 'indigo dark blue
|
||||
Data 112,146,190 'blue gray
|
||||
Data 163, 73,164 'purple
|
||||
Data 200,191,231 'lavenda
|
||||
'=====================================
|
||||
Data 255,128,128
|
||||
Data 255, 0, 0
|
||||
Data 128, 64, 64
|
||||
Data 128, 0, 0
|
||||
|
||||
Data 255,255,128 'yellow
|
||||
Data 255,255, 0
|
||||
Data 255,128, 64 'orange
|
||||
Data 255,128, 0
|
||||
Data 128, 64, 0 'brown
|
||||
Data 128,128, 0
|
||||
|
||||
Data 128,255,128 'green
|
||||
Data 128,255, 0
|
||||
Data 0,255, 0
|
||||
Data 0,128, 0
|
||||
Data 0, 64, 0
|
||||
Data 128,128, 64
|
||||
|
||||
Data 0,255,128
|
||||
Data 0,255, 64
|
||||
Data 0,128,128
|
||||
Data 0,128, 64
|
||||
Data 0, 64, 64
|
||||
Data 128,128,128 'gray
|
||||
|
||||
Data 128,255,255 'blue
|
||||
Data 0,255,255
|
||||
Data 0, 64,128
|
||||
Data 0, 0,255
|
||||
Data 0, 0,128
|
||||
Data 64,128,128
|
||||
|
||||
Data 0,128,255
|
||||
Data 0,128,192
|
||||
Data 128,128,255
|
||||
Data 0, 0,160
|
||||
Data 0, 0, 64
|
||||
Data 192,192,192 'gray
|
||||
|
||||
Data 255,128,192 'red
|
||||
Data 128,128,192
|
||||
Data 128, 0, 64
|
||||
Data 128, 0,128 'purple
|
||||
Data 64, 0, 64
|
||||
Data 64, 0,128 'black
|
||||
|
||||
Data 255,128,255
|
||||
Data 255, 0,255
|
||||
Data 255, 0,128
|
||||
Data 128, 0,255
|
||||
Data 64, 0,128
|
||||
Data 255,255,254 'white
|
||||
|
|
@ -0,0 +1,41 @@
|
|||
locate ,,0
|
||||
dim as integer oldcolor = color
|
||||
dim as integer oldwidth = width
|
||||
|
||||
width 80, 25
|
||||
view print 1 to 8
|
||||
color 0, 7
|
||||
cls
|
||||
sleep 2000
|
||||
|
||||
view print 17 to 25
|
||||
color , 7
|
||||
cls
|
||||
sleep 2000
|
||||
|
||||
locate 25,57
|
||||
print "press any key to exit...";
|
||||
sleep 2000
|
||||
|
||||
view print 9 to 16
|
||||
color 7, 1
|
||||
cls
|
||||
sleep 2000
|
||||
|
||||
locate 13, 40 - (len( "Welcome to FreeBASIC!" ) \ 2)
|
||||
sleep 2000
|
||||
|
||||
print "Welcome to ";
|
||||
color 15
|
||||
print "FreeBASIC";
|
||||
color 7
|
||||
print "!"
|
||||
|
||||
sleep
|
||||
dim as string clearkey = inkey
|
||||
|
||||
width oldwidth and &HFFFF, oldwidth shr 16
|
||||
color oldcolor and &HFFFF, oldcolor shr 16
|
||||
view print 1 to oldwidth shr 16
|
||||
cls
|
||||
locate ,,1
|
||||
|
|
@ -0,0 +1,224 @@
|
|||
'============= START FONT BUSINESS ==========================
|
||||
Function Blur(Byref tim As Uinteger Pointer,rad As Single=2) As Uinteger Pointer
|
||||
Type p2
|
||||
As Integer x,y
|
||||
As Uinteger col
|
||||
End Type
|
||||
#macro ppoint(_x,_y,colour)
|
||||
pixel=row+pitch*(_y)+4*(_x)
|
||||
(colour)=*pixel
|
||||
#endmacro
|
||||
#macro ppset(_x,_y,colour)
|
||||
pixel=row+pitch*(_y)+4*(_x)
|
||||
*pixel=(colour)
|
||||
#endmacro
|
||||
#macro average()
|
||||
ar=0:ag=0:ab=0:inc=0
|
||||
xmin=x:If xmin>rad Then xmin=rad
|
||||
xmax=rad:If x>=(_x-1-rad) Then xmax=_x-1-x
|
||||
ymin=y:If ymin>rad Then ymin=rad
|
||||
ymax=rad:If y>=(_y-1-rad) Then ymax=_y-1-y
|
||||
For y1 As Integer=-ymin To ymax
|
||||
For x1 As Integer=-xmin To xmax
|
||||
inc=inc+1
|
||||
ar=ar+(NewPoints(x+x1,y+y1).col Shr 16 And 255)
|
||||
ag=ag+(NewPoints(x+x1,y+y1).col Shr 8 And 255)
|
||||
ab=ab+(NewPoints(x+x1,y+y1).col And 255)
|
||||
Next x1
|
||||
Next y1
|
||||
averagecolour=Rgb(ar/(inc),ag/(inc),ab/(inc))
|
||||
#endmacro
|
||||
Dim As Integer _x,_y
|
||||
Imageinfo tim,_x,_y
|
||||
Dim As Uinteger Pointer im=Imagecreate(_x,_y)
|
||||
Dim As Integer pitch
|
||||
Dim As Any Pointer row
|
||||
Dim As Uinteger Pointer pixel
|
||||
Dim As Uinteger col
|
||||
Imageinfo tim,,,,pitch,row
|
||||
Dim As p2 NewPoints(_x,_y)
|
||||
For y As Integer=0 To (_y)-1
|
||||
For x As Integer=0 To (_x)-1
|
||||
ppoint(x,y,col)
|
||||
NewPoints(x,y)=type<p2>(x,y,col)
|
||||
Next x
|
||||
Next y
|
||||
Dim As Uinteger averagecolour
|
||||
Dim As Integer ar,ag,ab
|
||||
Dim As Integer xmin,xmax,ymin,ymax,inc
|
||||
For y As Integer=0 To _y-1
|
||||
For x As Integer=0 To _x-1
|
||||
average()
|
||||
NewPoints(x,y).col=averagecolour
|
||||
Next x
|
||||
Next y
|
||||
Imageinfo im,,,,pitch,row
|
||||
For y As Integer=0 To _y
|
||||
For x As Integer=0 To _x
|
||||
ppset((NewPoints(x,y).x),(NewPoints(x,y).y),NewPoints(x,y).col)
|
||||
Next x
|
||||
Next y
|
||||
ImageDestroy tim: tim = 0
|
||||
Function= im
|
||||
End Function
|
||||
Sub drawstring(xpos As Integer,ypos As Integer,text As String,colour As Uinteger,size As Single,im As Any Pointer=0)
|
||||
Type D2
|
||||
As Double x,y
|
||||
As Uinteger col
|
||||
End Type
|
||||
Static As d2 cpt(),XY()
|
||||
Static As Integer runflag
|
||||
If runflag=0 Then
|
||||
Redim XY(64,127)
|
||||
Redim cpt(1 To 64)
|
||||
Screenres 10,10
|
||||
dim as uinteger pointer img
|
||||
Dim count As Integer
|
||||
For ch As Integer=1 To 127
|
||||
img=imagecreate(10,10)
|
||||
Draw String img,(1,1),Chr(ch)
|
||||
For x As Integer=1 To 8
|
||||
For y As Integer=1 To 8
|
||||
If Point(x,y,img)<>0 Then
|
||||
count=count+1
|
||||
XY(count,ch)=Type<D2>(x,y)
|
||||
End If
|
||||
Next y
|
||||
Next x
|
||||
count=0
|
||||
imagedestroy img
|
||||
Next ch
|
||||
runflag=1
|
||||
End If
|
||||
If size=0 Then Exit Sub
|
||||
Dim As D2 np,t
|
||||
#macro Scale(p1,p2,d)
|
||||
np.col=p2.col
|
||||
np.x=d*(p2.x-p1.x)+p1.x
|
||||
np.y=d*(p2.y-p1.y)+p1.y
|
||||
#endmacro
|
||||
|
||||
Dim As D2 c=Type<D2>(xpos,ypos)
|
||||
Dim As Integer dx=xpos,dy=ypos
|
||||
For z6 As Integer=1 To Len(text)
|
||||
Var asci=text[z6-1]
|
||||
For _x1 As Integer=1 To 64
|
||||
t=Type<D2>(XY(_x1,asci).x+dx,XY(_x1,asci).y+dy,colour)
|
||||
Scale(c,t,size)
|
||||
cpt(_x1)=np
|
||||
|
||||
If XY(_x1,asci).x<>0 Then
|
||||
If Abs(size)>1 Then
|
||||
Line im,(cpt(_x1).x-size/2,cpt(_x1).y-size/2)-(cpt(_x1).x+size/2,cpt(_x1).y+size/2),cpt(_x1).col,bf
|
||||
Else
|
||||
Pset im,(cpt(_x1).x,cpt(_x1).y),cpt(_x1).col
|
||||
End If
|
||||
End If
|
||||
Next _x1
|
||||
dx=dx+8
|
||||
Next z6
|
||||
End Sub
|
||||
Sub init Constructor 'automatic loader
|
||||
drawstring(0,0,"",0,0)
|
||||
Screen 0
|
||||
End Sub
|
||||
|
||||
function Colour(im as uinteger pointer,newcol as uinteger,grade as integer) as uinteger pointer
|
||||
#macro ppset2(_x,_y,colour)
|
||||
pixel2=row2+pitch2*(_y)+4*(_x)
|
||||
*pixel2=(colour)
|
||||
#endmacro
|
||||
#macro ppoint(_x,_y,colour)
|
||||
pixel=row+pitch*(_y)+4*(_x)
|
||||
(colour)=*pixel
|
||||
#endmacro
|
||||
dim as integer w,h
|
||||
Dim As Integer pitch,pitch2
|
||||
Dim As Any Pointer row,row2
|
||||
Dim As Uinteger Pointer pixel,pixel2
|
||||
Dim As Uinteger col
|
||||
Imageinfo im,w,h,,pitch,row
|
||||
dim as uinteger pointer temp
|
||||
temp=imagecreate(w,h)
|
||||
Imageinfo temp,,,,pitch2,row2
|
||||
for y as integer=0 to h-1
|
||||
for x as integer=0 to w-1
|
||||
ppoint(x,y,col)
|
||||
Var v=.299*((col Shr 16)And 255)+.587*((col Shr 8)And 255)+.114*(col And 255)
|
||||
if v>grade then
|
||||
ppset2(x,y,newcol)
|
||||
else
|
||||
ppset2(x,y,rgb(255,0,255))
|
||||
end if
|
||||
next x
|
||||
next y
|
||||
return temp
|
||||
end function
|
||||
|
||||
sub FONT(byref myfont as uinteger pointer,fontsize as integer,col as uinteger,grade as integer=190)
|
||||
Const FIRSTCHAR = 32, LASTCHAR = 127
|
||||
Const NUMCHARS = (LASTCHAR - FIRSTCHAR) + 1
|
||||
Dim As ubyte Ptr p
|
||||
dim as uinteger pointer temp
|
||||
Dim As Integer i
|
||||
temp = ImageCreate(NUMCHARS * 8*FontSize, 9*FontSize,rgb(255,0,255))
|
||||
myfont=ImageCreate(NUMCHARS * 8*FontSize, 9*FontSize,rgb(255,0,255))
|
||||
|
||||
For i = FIRSTCHAR To LASTCHAR
|
||||
drawstring ((i - FIRSTCHAR) * 8*FontSize, 1,chr(i),rgb(255,255,255),FontSize,temp)
|
||||
Next i
|
||||
for n as integer=1 to fontsize-1
|
||||
temp=blur(temp,1)
|
||||
next n
|
||||
temp=Colour(temp,col,grade)
|
||||
put myfont,(0,0),temp,trans
|
||||
ImageInfo( myfont,,,,, p )
|
||||
p[0] = 0
|
||||
p[1] = FIRSTCHAR
|
||||
p[2] = LASTCHAR
|
||||
For i = FIRSTCHAR To LASTCHAR
|
||||
p[3 + i - FIRSTCHAR] = 8*FontSize
|
||||
next i
|
||||
imagedestroy(temp)
|
||||
end sub
|
||||
'=================== END FONTS ========================================
|
||||
|
||||
|
||||
'=========== USAGE ========================
|
||||
screen 19,32
|
||||
|
||||
dim as uinteger pointer customfont
|
||||
dim as uinteger pointer customfont2
|
||||
dim as uinteger pointer customfont3
|
||||
|
||||
'font choice,size,colour
|
||||
|
||||
font customfont,3,rgb(0,200,0)
|
||||
|
||||
|
||||
'You can tweak the last parameter a bit.
|
||||
'The default is 190
|
||||
font customfont2,1,rgb(200,200,200),205
|
||||
|
||||
|
||||
font customfont3,4,rgb(0,0,255),210
|
||||
|
||||
|
||||
draw string(50,50),"Custom font",,customfont
|
||||
draw string(50,200),"Custom font2",,customfont2
|
||||
draw string(50,300),"Custom font3",,customfont3
|
||||
draw string(50,400),"Press a key",,customfont
|
||||
|
||||
sleep
|
||||
do
|
||||
screenlock
|
||||
cls
|
||||
draw string(10,200),"Once the fonts are created then",,customfont
|
||||
draw string(10,300),"they display by Draw string.",,customfont
|
||||
draw string(10,400),"<ESC> to end",,customfont3
|
||||
screenunlock
|
||||
sleep 1,1
|
||||
loop until inkey=chr(27)
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
#include once "windows.bi"
|
||||
'
|
||||
dim as integer p,res
|
||||
'
|
||||
dim progpath as zstring * 512
|
||||
res=GetModuleFileName(NULL,progpath,512)
|
||||
'
|
||||
p=instr(progpath,"\")
|
||||
while p>0
|
||||
mid(progpath,p,1)="_"
|
||||
p=instr(progpath,"\")
|
||||
wend
|
||||
'
|
||||
print "REGEDIT4" '"Windows Registry Editor Version 5.00"
|
||||
print
|
||||
print "[HKEY_CURRENT_USER\Console\";progpath;"]"
|
||||
print !"\"FontSize\"=dword:000e0000" '14 pt
|
||||
print !"\"FontFamily\"=dword:00000036"
|
||||
print !"\"FontWeight\"=dword:000002bc" 'bold
|
||||
print !"\"FaceName\"=\"Lucida Console\""
|
||||
'print !"\"QuickEdit\"=dword:00000001"
|
||||
'
|
||||
sleep
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
Const Xmax=640
|
||||
Const Ymax=480
|
||||
|
||||
ScreenRes Xmax,Ymax,32
|
||||
|
||||
#Include Once "fontlib.bi"
|
||||
|
||||
ScreenLock
|
||||
Line (0,0)-(Xmax,Ymax),RGB(30,30,30),BF
|
||||
ColorRGB(86,156,214,3)
|
||||
ColorRGB(86,156,214,4)
|
||||
DrawString("Hello World! :-) VGA-16",30,10,VGA16)
|
||||
DrawString("Hello World! :-) VGA-14",30,30,VGA14)
|
||||
DrawString("Hello World! :-) VGA-8",30,50,VGA8)
|
||||
DrawString("Hello World! :-) PX Sans Nouveaux",30,70,SANS)
|
||||
DrawString("Hello World! :-) Monospace",30,90,MONO)
|
||||
ScreenUnlock
|
||||
Sleep
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 41 KiB |
|
|
@ -0,0 +1,3 @@
|
|||
font1.bmp
|
||||
all=8
|
||||
8
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 47 KiB |
|
|
@ -0,0 +1,3 @@
|
|||
font2.bmp
|
||||
all=8
|
||||
8
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 23 KiB |
|
|
@ -0,0 +1,3 @@
|
|||
font3.bmp
|
||||
all=8
|
||||
8
|
||||
|
|
@ -0,0 +1,97 @@
|
|||
Type TFont
|
||||
As String nam,imgpath
|
||||
As Integer height,charlength(93)
|
||||
As Any Ptr img,char(93)
|
||||
End Type
|
||||
|
||||
Dim Shared As TFont Font(4)
|
||||
Dim Shared As UByte num_fonts
|
||||
|
||||
Sub LoadFont(nam As String, height As UByte, path As String)
|
||||
Dim As String length
|
||||
Dim As Integer count,fontlength
|
||||
|
||||
With Font(num_fonts)
|
||||
.nam=nam
|
||||
.height=height
|
||||
.img=ImageCreate(93*8,height)
|
||||
Var ff=FreeFile
|
||||
Open path For Input As #ff
|
||||
Line Input #ff,.imgpath
|
||||
Line Input #ff,length
|
||||
For i As Integer=1 To 93
|
||||
.charlength(i)=Val(Mid(length,5))
|
||||
Next
|
||||
Do
|
||||
Line Input #ff,Length
|
||||
count+=1
|
||||
.charlength(count)=Val(Length)
|
||||
Loop Until Eof(ff)
|
||||
Close #ff
|
||||
Bload .imgpath,.img
|
||||
For i As Integer=1 To 93
|
||||
.char(i)=ImageCreate(.charlength(i),height)
|
||||
Get .img,(fontlength,0)-(fontlength+.charlength(i)-1,height-1),.char(i)
|
||||
fontlength+=.charlength(i)
|
||||
Next
|
||||
ImageDestroy .img
|
||||
End With
|
||||
num_fonts+=1
|
||||
End Sub
|
||||
|
||||
Const VGA14=0
|
||||
Const VGA16=1
|
||||
Const VGA8=2
|
||||
Const SANS=3
|
||||
Const MONO=4
|
||||
|
||||
LoadFont("VGA_14",14,"font1.fon")
|
||||
LoadFont("VGA_16",16,"font2.fon")
|
||||
LoadFont("VGA_8",8,"font3.fon")
|
||||
LoadFont("Sans Serif 11",11,"sans11.fon")
|
||||
LoadFont("Monospace 14",15,"mono14.fon")
|
||||
|
||||
function replace(byval src as uinteger, byval dest as uinteger, byval p as any ptr) as uinteger
|
||||
dim c as uinteger = *cptr(uinteger ptr, p)
|
||||
if src = RGB(255,255,255) then
|
||||
return c
|
||||
elseif src = 0 then
|
||||
return dest
|
||||
else
|
||||
return src
|
||||
end if
|
||||
end function
|
||||
|
||||
Sub ColorRGB(R As UByte, G As UByte, B As Ubyte, fontid As UByte=0)
|
||||
Dim As ULong C
|
||||
C=RGB(R,G,B)
|
||||
For i As Integer=1 To 93
|
||||
Put Font(fontid).char(i),(0,0),Font(fontid).char(i),Custom,@replace,@c
|
||||
Next
|
||||
End Sub
|
||||
|
||||
Sub DrawString(text As String, x As Short, y As Short, fontid As UByte=0)
|
||||
Dim As Integer fontlength
|
||||
For i As Integer=1 To Len(text)
|
||||
'Put (x+(i-2)*8+(8-Font(fontid).Charlength(Asc(Mid(text,i,1))-32)),y),Font(fontid).Char(Asc(Mid(text,i,1))-32),Trans
|
||||
If Mid(text,i,1)<>" " Then
|
||||
Put (x+fontlength,y),Font(fontid).Char(Asc(Mid(text,i,1))-32),Trans
|
||||
fontlength+=Font(fontid).Charlength(Asc(Mid(text,i,1))-32)
|
||||
Else
|
||||
fontlength+=6
|
||||
End If
|
||||
Next
|
||||
End Sub
|
||||
|
||||
Function FontWidth(text As String, fontid As UByte=0)As Integer
|
||||
Dim As Integer fontlength
|
||||
For i As Integer=1 To Len(text)
|
||||
If Mid(text,i,1)<>" " Then
|
||||
fontlength+=Font(fontid).Charlength(Asc(Mid(text,i,1))-32)
|
||||
Else
|
||||
fontlength+=6
|
||||
End If
|
||||
Next
|
||||
Return fontlength
|
||||
End Function
|
||||
|
||||
Binary file not shown.
Binary file not shown.
|
After Width: | Height: | Size: 1.5 KiB |
|
|
@ -0,0 +1,3 @@
|
|||
mono14.bmp
|
||||
all=8
|
||||
8
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 878 B |
|
|
@ -0,0 +1,95 @@
|
|||
sans11.bmp
|
||||
all=8
|
||||
2
|
||||
4
|
||||
9
|
||||
6
|
||||
11
|
||||
7
|
||||
2
|
||||
4
|
||||
4
|
||||
6
|
||||
6
|
||||
3
|
||||
4
|
||||
2
|
||||
5
|
||||
6
|
||||
4
|
||||
6
|
||||
6
|
||||
6
|
||||
6
|
||||
6
|
||||
6
|
||||
6
|
||||
6
|
||||
2
|
||||
3
|
||||
4
|
||||
6
|
||||
4
|
||||
6
|
||||
10
|
||||
8
|
||||
7
|
||||
7
|
||||
7
|
||||
7
|
||||
7
|
||||
8
|
||||
7
|
||||
2
|
||||
6
|
||||
7
|
||||
7
|
||||
8
|
||||
7
|
||||
8
|
||||
7
|
||||
8
|
||||
7
|
||||
7
|
||||
8
|
||||
8
|
||||
8
|
||||
10
|
||||
8
|
||||
8
|
||||
7
|
||||
3
|
||||
5
|
||||
3
|
||||
6
|
||||
7
|
||||
3
|
||||
6
|
||||
6
|
||||
6
|
||||
6
|
||||
6
|
||||
5
|
||||
6
|
||||
6
|
||||
2
|
||||
3
|
||||
5
|
||||
2
|
||||
8
|
||||
6
|
||||
6
|
||||
6
|
||||
6
|
||||
5
|
||||
6
|
||||
5
|
||||
6
|
||||
6
|
||||
10
|
||||
6
|
||||
6
|
||||
6
|
||||
4
|
||||
2
|
||||
4
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
Cls
|
||||
Print "Hello, World!"
|
||||
|
||||
|
||||
|
||||
Binary file not shown.
|
|
@ -0,0 +1,21 @@
|
|||
Dim As String key, char
|
||||
Dim As Integer i
|
||||
Do
|
||||
'Check keyboard buffer
|
||||
key = Inkey
|
||||
'If key has been pressed
|
||||
If Len(key) > 0 Then
|
||||
'Clear the last message
|
||||
Locate 1, 1
|
||||
Print Space(79);
|
||||
'Reposition cursor
|
||||
locate 1,1
|
||||
'Print current key codes
|
||||
For i = 1 To Len(key)
|
||||
char = Mid(key, i, 1)
|
||||
Print "Character: ";char; " Code: ";Asc(char); " ";
|
||||
Next
|
||||
End If
|
||||
Sleep 10
|
||||
Loop Until key = Chr(27)
|
||||
End
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
#define MAKDWORD(x,y) (cint(x) shl 16 or cint(y))
|
||||
|
||||
Dim myInt As Uinteger
|
||||
Dim As Integer i, cnt
|
||||
myInt = MAKDWORD(5,5)
|
||||
|
||||
Width 80,25
|
||||
cnt = 1
|
||||
For i = 1 to 80
|
||||
If cnt = 10 Then
|
||||
cnt = 0
|
||||
End If
|
||||
Locate 1, i
|
||||
Print Str(cnt)
|
||||
cnt += 1
|
||||
Next
|
||||
cnt = 2
|
||||
For i = 2 To 25
|
||||
If cnt = 10 then
|
||||
cnt = 0
|
||||
End If
|
||||
Locate i,1
|
||||
Print Str(cnt);
|
||||
cnt += 1
|
||||
Next
|
||||
Locate Hiword(myInt), Loword(myInt)
|
||||
Print "We stored the screen location in a single uinteger"
|
||||
End
|
||||
|
|
@ -0,0 +1,48 @@
|
|||
cls
|
||||
i = 20
|
||||
maxchar = 20
|
||||
screen 12
|
||||
|
||||
Do
|
||||
color 7, 0
|
||||
cls
|
||||
locate 2, 1
|
||||
print "Password:"
|
||||
color 4,15
|
||||
|
||||
' if passed the maximum character limit, then take one
|
||||
' letter out of the password to make it not pass the limit
|
||||
if len(pass$) > maxchar then pass$ = mid$(pass$, 1, len(pass$) - 1)
|
||||
|
||||
for s = 1 to maxchar
|
||||
locate 3,s
|
||||
print " ";
|
||||
next s
|
||||
|
||||
if len(pass$) > 0 then
|
||||
for s = 1 to len(pass$)
|
||||
locate 3, s
|
||||
print "*";
|
||||
next s
|
||||
end if
|
||||
|
||||
do
|
||||
a$ = inkey$
|
||||
loop until a$ <> ""
|
||||
if a$ = chr$(13) then
|
||||
cls
|
||||
color 4, 0
|
||||
print "You typed "; pass$
|
||||
sleep
|
||||
end
|
||||
end if
|
||||
|
||||
if a$ = chr$(8) then
|
||||
pass$ = left(pass$, len(pass$) - 1)
|
||||
i=i+1
|
||||
else
|
||||
pass$ = pass$ + a$
|
||||
i=i-1
|
||||
end if
|
||||
loop
|
||||
End
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
Dim As Single total, count, number
|
||||
Dim As String text
|
||||
|
||||
Print "This program will calculate the sum and average for a"
|
||||
Print "list of numbers. Enter an empty value to see the results."
|
||||
Print
|
||||
|
||||
Do
|
||||
Input "Enter a number: ", text
|
||||
If text = "" Then Exit Do
|
||||
count += 1
|
||||
total += Val(text)
|
||||
Loop
|
||||
|
||||
Print
|
||||
Print "You entered: "; count; " number(s)"
|
||||
Print "The sum is: "; total
|
||||
|
||||
If count > 0 Then Print "The average is: "; total / count
|
||||
|
||||
Print
|
||||
Print "Any keypress ends program.";
|
||||
|
||||
Sleep
|
||||
|
|
@ -0,0 +1,568 @@
|
|||
/' ######################### ABSTRACT ##############################
|
||||
|
||||
File: ScreenRes_Width.bas Updated: 2015 Jan 03
|
||||
|
||||
Language: FreeBASIC 1.00.0 ( 32bit Windows ) By: Dean Saurdine
|
||||
|
||||
Purpose: Demonstrate font sizes in console and GfxLib gui screens
|
||||
|
||||
Skillset: beginning Beginner
|
||||
|
||||
Notes: 1) No copyright. Public domain. No warranty. Your risk.
|
||||
2) Coded Courier New 10pt on 72 columns.
|
||||
3) Ensure -s gui compiler switch is NOT set.
|
||||
4) The three main program segments can be three different
|
||||
program files and three different executables, if desired.
|
||||
5) Appendix follows main program and can be read first, if
|
||||
desired. Written for the beginning Beginner.
|
||||
|
||||
##################################################################### '/
|
||||
REM####################### MAIN PROGRAM ############################
|
||||
|
||||
/' ********************************
|
||||
***** FreeBASIC console screen *****
|
||||
********************************
|
||||
'/
|
||||
|
||||
REM setup FreeBASIC console screen
|
||||
Screen , Rem default FreeBASIC screen
|
||||
Width 43,28 Rem columns,rows
|
||||
Color 0,15 Rem black foreground,white background
|
||||
Cls
|
||||
|
||||
REM print box grid at font size
|
||||
Color ,7 Rem light gray background
|
||||
|
||||
For false_loop As Integer = 0 To 0
|
||||
|
||||
Dim As Integer row = 0
|
||||
Dim As Integer column = 0
|
||||
|
||||
Rem odd numbered rows
|
||||
For row = 1 To 27 Step 2
|
||||
For column = 1 To 43 Step 2
|
||||
Locate row,column : Print Space(1) ;
|
||||
Next column
|
||||
Next row
|
||||
|
||||
Rem even numbered rows
|
||||
For row = 2 To 28 Step 2
|
||||
For column = 2 To 42 Step 2
|
||||
Locate row,column : Print Space(1) ;
|
||||
Next column
|
||||
Next row
|
||||
|
||||
Next false_loop
|
||||
|
||||
'Print row Rem try compiling with this line uncommented
|
||||
|
||||
/'
|
||||
Note: the variables false_loop, row and column are visible only while
|
||||
the false loop runs, which is exactly one time. false_loop, row and
|
||||
column are created once. This coding technique is efficient for
|
||||
loop-in-loop with large counters and small steps, a common occurence
|
||||
when creating "graphic" elements. The expense is the creation of
|
||||
false_loop, which is a do-nothing variable. Alternatives to a false
|
||||
loop? Will they obfuscate the code?
|
||||
|
||||
Counting "variable creations" can be considered as a first step in
|
||||
managing the computer's memory space. Programs with well managed memory
|
||||
space run faster and smoother, and the concept becomes increasingly
|
||||
important as programs become larger and more complex. More advanced
|
||||
memory space management methods are beyond this program's purpose.
|
||||
'/
|
||||
|
||||
REM print text
|
||||
Color ,15 Rem back to white background
|
||||
'Color ,7 Rem try this for different visual effect
|
||||
|
||||
Locate 2,2 : Print "FreeBASIC console font size 8x12 pixels" ;
|
||||
Locate 5,2 : Print "console 'Print' is opaque background" ;
|
||||
|
||||
Locate 10,9 : Print "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ;
|
||||
Locate 12,9 : Print "abcdefghijklmnopqrstuvwxyz" ;
|
||||
Locate 14,9 : Print "0 1 2 3 4 5 6 7 8 9 ~_+`-=" ;
|
||||
Locate 16,9 : Print "!@(#)$[%]^{&}*<?>;':""|,\." ;
|
||||
|
||||
Locate 21,9 : Print "press a key to continue..." ; : Sleep
|
||||
Locate 21,9 : Print " " ;
|
||||
|
||||
/' *************************
|
||||
***** GfxLib gui screen *****
|
||||
*************************
|
||||
'/
|
||||
|
||||
REM sub definitions
|
||||
Sub model( ByVal columns As Integer , _ Rem console layer
|
||||
ByVal rows As Integer , _ Rem console layer
|
||||
ByVal w As Integer , _ Rem font width in pixels
|
||||
ByVal h As Integer _ Rem font height in pixels
|
||||
)
|
||||
|
||||
REM set and display the different GfxLib gui screen font sizes
|
||||
|
||||
REM finish setup GfxLib gui screen.
|
||||
'ScreenRes 336,336 Rem graphic layer x,y pixels
|
||||
Width columns,rows Rem console layer for font size w x h
|
||||
Color 0,15 Rem black foreground,white background
|
||||
Cls
|
||||
|
||||
/'
|
||||
Note: window, screen, and layer are different concepts. For now, we can
|
||||
say "layers on a screen, screen in an operating system window." We can
|
||||
also say "everything that can be done on the console screen is now done
|
||||
on the GfxLib gui screen's console layer".
|
||||
|
||||
The first mnemomic will eventually become "viewport in a layer, layer on
|
||||
a page, page on a screen, screen in an operating system window."
|
||||
Viewports and pages are beyond this program's purpose.
|
||||
|
||||
Executing ScreenRes more than once may result in the GfxLib gui screen's
|
||||
operating system window returning to its original position, if it has
|
||||
been moved while the executable is running. Try it by uncommenting
|
||||
ScreenRes in this code block.
|
||||
'/
|
||||
|
||||
REM print text on console layer
|
||||
Locate 2,2 : Print "GfxLib gui font size 8x" + Str(h) + Space(1) + _
|
||||
"pixels" ;
|
||||
|
||||
REM draw text on graphic layer
|
||||
Color 32 Rem bright blue foreground
|
||||
Draw String ( (2-1)*w,(2-1)*h ), "GfxLib gui"
|
||||
|
||||
/'
|
||||
Note: the GfxLib gui screen, as it is set in this program, has an
|
||||
adjustable 256 color palette, with color index numbers from 0 to 255.
|
||||
For now, we can say Color 0 and Color 15 are identical to the console
|
||||
screens. Color 1 through Color 14 may look different. Adjusting the
|
||||
GfxLib gui screen's color palette is beyond this program's purpose.
|
||||
|
||||
The Draw String should precisely overlay the first part of the Print.
|
||||
|
||||
The "math" inside the Draw String's outer braces converts a column,row
|
||||
position to an x,y position, using the following general equations:
|
||||
|
||||
x = ( pseudo column - 1 ) * w
|
||||
y = ( pseudo row - 1 ) * h
|
||||
|
||||
Pseudo because real columns and real rows are on the console layer.
|
||||
|
||||
The 1 is because the layers have different origin coordinate numbers:
|
||||
The console layer's origin coordinate numbers are column,row = 1,1.
|
||||
The graphic layer's origin coordinate numbers are x,y = 0,0.
|
||||
The two origins are at the same place, which is the GfxLib gui screen's
|
||||
upper left corner.
|
||||
|
||||
The w is because one console layer column is w pixels wide, and the h is
|
||||
because one console layer row is h pixels high.
|
||||
|
||||
Pseudo column and pseudo row do not need to be integers in these
|
||||
equations. The calculation results will be reduced to the next lower
|
||||
integer when used for the x and y positions in a drawing command. Try
|
||||
pseudo column = 2.6, pseudo row = 3.3, or some other fractions.
|
||||
'/
|
||||
|
||||
REM draw box grid at font size on graphic layer
|
||||
Color 7 Rem light gray foreground
|
||||
|
||||
Scope
|
||||
|
||||
Dim As Integer y = 0
|
||||
Dim As Integer x = 0
|
||||
|
||||
For y = 0 To (rows-1)*h Step h
|
||||
For x = 0 To (columns-1)*w Step w
|
||||
Line (x-1,y-1)-(x+w-1,y+h-1),,B Rem B = hollow Box
|
||||
Next x
|
||||
Next y
|
||||
|
||||
End Scope
|
||||
|
||||
'Print y Rem try compiling with this line uncommented
|
||||
|
||||
/'
|
||||
Note: the Scope...End Scope code block works the same way as a false
|
||||
loop, and has the advantage of not creating a do-nothing variable.
|
||||
Alternatives to Scope, without obfuscating the code?
|
||||
|
||||
Placement of the grid, for visual effect, depends on the font size
|
||||
and the physical pixel size and shape. Different "screen" manufacturers
|
||||
and/or models may have different physical pixel sizes and shapes.
|
||||
|
||||
code correct... Line (x,y)-(x+w,y+h),,B
|
||||
move box one pixel left... Line (x-1,y)-(x+w-1,y+h),,B
|
||||
then one pixel up... Line (x-1,y-1)-(x+w-1,y+h-1),,B
|
||||
|
||||
Remember: "good visual effect" may not always be "code correct".
|
||||
'/
|
||||
|
||||
REM mixed printing and drawing on their respective layers
|
||||
Color 0 Rem back to black foreground
|
||||
'Color 0,7 Rem try this for different visual effect
|
||||
|
||||
Locate ( 5,2 ) : Print _
|
||||
"console ""Print"" is opaque background" ;
|
||||
|
||||
Draw String ( (2-1)*w,(7-1)*h ), _
|
||||
"graphic ""Draw"" is transparent background"
|
||||
|
||||
Draw String ( (9-1)*w,(10-1)*h ), _
|
||||
"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
||||
|
||||
Draw String ( (9-1)*w,(12-1)*h ), _
|
||||
"abcdefghijklmnopqrstuvwxyz"
|
||||
|
||||
Draw String ( (9-1)*w,(14-1)*h ), _
|
||||
"0 1 2 3 4 5 6 7 8 9 ~_+`-="
|
||||
|
||||
Draw String ( (9-1)*w,(16-1)*h ), _
|
||||
"!@(#)$[%]^{&}*<?>;':""|,\."
|
||||
|
||||
Locate ( 21,9 ) : Print _
|
||||
"press a key to continue..." ;
|
||||
Sleep
|
||||
|
||||
/'
|
||||
Note: this coding style shows the coding similarities and differences
|
||||
between printing text on the console layer and drawing text on the
|
||||
graphic layer. What are they? Does printing and drawing order matter?
|
||||
|
||||
Recall the "math" inside Draw String's outer braces converts column,row
|
||||
position to x,y position. Can you create general equations to convert
|
||||
x,y position to column,row position? Where would they be used?
|
||||
'/
|
||||
|
||||
End Sub
|
||||
REM end of sub definitions
|
||||
|
||||
REM main program
|
||||
REM start setup GfxLib gui screen
|
||||
ScreenRes 336,336 Rem graphic layer x,y pixels
|
||||
'Width columns,rows Rem in the sub definition
|
||||
'Color foreground,background Rem in the sub definition
|
||||
'Cls Rem in the sub definition
|
||||
|
||||
REM set and display the different GfxLib gui screen font sizes
|
||||
model( 42,42 , 8,8 ) Rem console layer columns,rows for font size w,h
|
||||
model( 42,24 , 8,14 ) Rem ditto
|
||||
model( 42,21 , 8,16 ) Rem ditto
|
||||
|
||||
'model( 42,28 , 8,12 ) Rem try this illegal font size, with and
|
||||
Rem without the other models.
|
||||
|
||||
REM end of main program
|
||||
|
||||
/' *****************************
|
||||
***** GfxLib console screen *****
|
||||
*****************************
|
||||
'/
|
||||
|
||||
REM setup GfxLib console screen Rem closes GfxLib gui screen, if open
|
||||
Screen 0 Rem GfxLib console screen
|
||||
Width 80,25 Rem default columns,rows
|
||||
Color 7,0 Rem default foreground,background
|
||||
Cls
|
||||
|
||||
REM print text
|
||||
Locate 2,2 : Print "GfxLib console font size 8x12 pixels" ;
|
||||
Locate 21,2 : Print "press a key to end this executable..." ; : Sleep
|
||||
|
||||
REM end of main program
|
||||
REM#####################################################################
|
||||
REM######################## APPENDIX ###############################
|
||||
|
||||
/'
|
||||
|
||||
----------
|
||||
|
||||
"Graphic screen text is too small" usually means a lack of understanding
|
||||
of how the GfxLib gui screen works. There is a lot to learn and this is,
|
||||
fortunately, one of a very few times that interrelated concepts have to
|
||||
be learned simultaneously.
|
||||
|
||||
This program belongs to the category of "study and play with this, then
|
||||
see me if you have questions". It is written in the FreeBASIC (fb)
|
||||
dialect of the BASIC coding language.
|
||||
|
||||
This appendix and main program's /'Note...'/ are meant to supplement the
|
||||
existing wiki pages, and have evolved with "can you explain..." and "can
|
||||
I see your 3-ring binder...". /'Note...'/ can be considered as footnotes
|
||||
to specific code blocks. My questions and "try this" are meant to
|
||||
stimulate thinking and creativity.
|
||||
|
||||
----------
|
||||
|
||||
Prerequisites, or keywords/keyboard keys "you are supposed to know".
|
||||
Some do not have proper wiki pages as of this appendix's writing.
|
||||
|
||||
colon (statement termination = : = CR)
|
||||
Enter key (statement and line termination = Enter key = CRLF)
|
||||
underscore (statement continuation = _ = suppress CR in CRLF)
|
||||
Rem (human readable comment, in the FreeBASIC variations)
|
||||
|
||||
Screen , (FreeBASIC console screen)
|
||||
Width (screen size)
|
||||
Color (screen Colors)
|
||||
Cls (Clear the screen)
|
||||
|
||||
Locate (position screen cursor)
|
||||
Print (Print something on screen)
|
||||
|
||||
Dim (variable definition)
|
||||
Integer (variable or expression type)
|
||||
String (variable or expression type)
|
||||
|
||||
Str (create String from number)
|
||||
Space (flexible, human readable version of " ")
|
||||
plus (String concatination = +)
|
||||
|
||||
Scope...End Scope (code block, localized new variable visibility)
|
||||
For...Next (code block, looping with built-in counter)
|
||||
Sub...End Sub (code block, branching)
|
||||
|
||||
Sleep (suspend program execution)
|
||||
|
||||
|
||||
New keywords to learn:
|
||||
|
||||
ScreenRes x,y (GfxLib gui screen)
|
||||
Screen 0 (GfxLib console screen)
|
||||
|
||||
Draw String (Draw text as String on graphic layer)
|
||||
Line (draw Line or box on graphic layer)
|
||||
|
||||
----------
|
||||
|
||||
To be consistent with the corresponding compiler switches, which are
|
||||
-s gui and -s console, the word "gui" is used to identify what other
|
||||
coders may call "graphic" screens.
|
||||
|
||||
----------
|
||||
|
||||
"Terminal 8x12" is the intended font style and size for the console
|
||||
screen segments of this program.
|
||||
|
||||
See my Console_Defaults.bas program for discussion of console screen
|
||||
default settings (Windows operating system).
|
||||
|
||||
----------
|
||||
|
||||
Font size can be verified with this program's running executable. There
|
||||
should be, for font size 8x12, four lines for every three lines of font
|
||||
size 8x16. Eight lines for every six lines, sixteen for twelve...
|
||||
|
||||
"Four for three" is calculated from the Least Common Multiple (LCM) of
|
||||
12 and 16. LCM is a concept from mathematics.
|
||||
|
||||
LCM( 12,16 ) = 48. 48 is the smallest common screen height, in pixels.
|
||||
|
||||
Then calculate the corresponding number of available screen rows from:
|
||||
|
||||
available rows = LCM / font height
|
||||
|
||||
8x12 font size: available rows = 48 / 12 = 4
|
||||
8x16 font size: available rows = 48 / 16 = 3
|
||||
|
||||
----------
|
||||
|
||||
GfxLib is one of FreeBASIC's built-in libraries. GfxLib contains the
|
||||
FreeBASIC gui screens and another FreeBASIC console screen. In this
|
||||
appendix, the screens accessed via GfxLib are called GfxLib gui screen
|
||||
and GfxLib console screen, and the default FreeBASIC console screen is
|
||||
called the FreeBASIC console screen.
|
||||
|
||||
The GfxLib console screen can be considered as having the same default
|
||||
screen settings as the FreeBASIC console screen, and these defaults are
|
||||
set in the same way (via cmd.exe).
|
||||
|
||||
Use the FreeBASIC console screen if your program has no gui elements, as
|
||||
GfxLib will bloat the executable. Use the GfxLib console screen if, for
|
||||
any reason, you want to switch from a GfxLib gui screen to a console
|
||||
screen.
|
||||
|
||||
----------
|
||||
|
||||
Initiating a GfxLib gui screen with the "Screen mode" statement is from
|
||||
old BASIC dialects, and should only be used for initial translation of
|
||||
old BASIC programs. The FreeBASIC way to initiate a GfxLib gui screen is
|
||||
through the use of the ScreenRes keyword. ScreenRes can be used in a
|
||||
simple way, as in this program, or ScreenRes can be more capable than
|
||||
the various gui screens created from "Screen mode".
|
||||
|
||||
----------
|
||||
|
||||
The GfxLib gui screen can be considered as having one built-in unnamed
|
||||
fixed-width font, whose style resembles Courier. Most text editors and
|
||||
word processors set font size in points. GfxLib gui screen's font size
|
||||
is set in pixels. This font size is represented by a box w pixels wide
|
||||
and h pixels high. Characters, in the font set, fit into the box.
|
||||
|
||||
GfxLib gui screen's available font sizes are 8x8, 8x14 and 8x16. In
|
||||
words, the available font width is w = 8 pixels and the available font
|
||||
heights are h = 8, 14 and 16 pixels. The default height is h = 8 pixels.
|
||||
|
||||
The size of the GfxLib gui screen's built-in font can be adjusted by the
|
||||
coder through the use of the "ScreenRes x,y" and "Width columns,rows"
|
||||
statement pair. Adjusting the size of GfxLib gui screen's built-in font
|
||||
is a purpose of this program.
|
||||
|
||||
The coder can, through advanced use of the ScreenRes keyword, introduce
|
||||
and use other fonts. The coder can also use other libraries to introduce
|
||||
and use other fonts (and screens). Other fonts and screens are beyond
|
||||
this program's purpose.
|
||||
|
||||
----------
|
||||
|
||||
The following LCM table can be used to "rapid prototype" the GfxLib gui
|
||||
screen, with built-in font size options to try for a common screen size.
|
||||
LCM = Least Common Multiple, a concept from mathematics.
|
||||
|
||||
+--------------------------------+
|
||||
LCM | rows ( for gui font 8 x h ) |
|
||||
+-----------+--------------------------------|
|
||||
| ScreenRes | | | |
|
||||
| y | h = 8 | h = 14 | h = 16 |
|
||||
| pixels | | | |
|
||||
|============================================|
|
||||
| 112 | 14 | 8 | 7 |
|
||||
| 224 | 28 | 16 | 14 |
|
||||
| 336 | 42 | 24 | 21 |
|
||||
| 448 | 56 | 32 | 28 |
|
||||
| 560 | 70 | 40 | 35 |
|
||||
| 672 | 84 | 48 | 42 |
|
||||
| 784 | 98 | 56 | 49 |
|
||||
| 896 | 112 | 64 | 56 |
|
||||
| 1008 | 126 | 72 | 63 |
|
||||
| 1120 | 140 | 80 | 70 |
|
||||
| 1232 | 154 | 88 | 77 |
|
||||
| 1344 | 168 | 96 | 84 |
|
||||
|======================+---------------------+
|
||||
| x | columns |
|
||||
+----------------------+
|
||||
|
||||
Read up for x and columns, for font width w = 8 pixels.
|
||||
Read down for y and rows, for font height h = 8 or 14 or 16 pixels.
|
||||
|
||||
Code as: ScreenRes x,y
|
||||
Width columns,rows
|
||||
|
||||
|
||||
Example: setup GfxLib gui screen smaller than x,y = 800,600 and at font
|
||||
size 8x14, using the LCM table.
|
||||
|
||||
code as: ScreenRes 784,560
|
||||
Width 98,40
|
||||
|
||||
----------
|
||||
|
||||
x,y and columns,rows are calculated from the following equations, which
|
||||
can also be used "fine tune" the GfxLib gui screen after deciding on a
|
||||
particular font size:
|
||||
|
||||
either: columns = x / 8 and rows = y / h
|
||||
|
||||
or: x = columns * 8 and y = rows * h
|
||||
|
||||
where: h = 8 or 14 or 16
|
||||
|
||||
Code as: ScreenRes x,y
|
||||
Width columns,rows
|
||||
|
||||
All equation elements need to be exactly integers (no fractions), or the
|
||||
GfxLib gui screen font size may revert to the default 8x8. The available
|
||||
columns,rows will then become the next lower integers, based on the
|
||||
GfxLib gui screen's default 8x8 font size and the coder's x,y.
|
||||
|
||||
|
||||
Example: setup GfxLib gui screen smaller than x,y = 800,600 and at font
|
||||
size 8x14, using the equations.
|
||||
|
||||
columns = x / 8 = 800 / 8 = 100 ...all are exactly integers
|
||||
|
||||
rows = y / h = 600 / 14 = 42.86 ...fractions! Use rows = 42
|
||||
|
||||
then... y = rows * h = 42 * 14 = 588 ...all are exactly integers
|
||||
|
||||
code as: ScreenRes 800,588
|
||||
Width 100,42
|
||||
|
||||
----------
|
||||
|
||||
Summary of FreeBASIC screen features ( for now... )
|
||||
|
||||
+-----------------------------------------------+
|
||||
FreeBASIC Screens | console | GfxLib gui |
|
||||
| ( Windows ) | |
|
||||
+---------------------+===============================================|
|
||||
| screen initiation | Screen , (FreeBASIC) | ScreenRes x,y |
|
||||
| | Screen 0 (GfxLib) | |
|
||||
|---------------------+-------------------------+---------------------|
|
||||
| screen size | columns,rows | x,y |
|
||||
|---------------------+-------------------------+---------------------|
|
||||
| default screen size | set via cmd.exe | not defined |
|
||||
|---------------------+-------------------------+---------------------|
|
||||
| font style | set via cmd.exe | similar to Courier |
|
||||
|---------------------+-------------------------+---------------------|
|
||||
| font size | set via cmd.exe | adjustable 8x8 |
|
||||
| | | 8x14 |
|
||||
| | | 8x16 |
|
||||
|---------------------+-------------------------+---------------------|
|
||||
| default font size | set via cmd.exe | 8x8 |
|
||||
|---------------------+-------------------------+---------------------|
|
||||
| screen colors | fixed 0 to 15 (cmd.exe) | adjustable 0 to 255 |
|
||||
|---------------------+-------------------------+---------------------|
|
||||
| default Color | 7,0 if Color is used. | 15,0 |
|
||||
| | Set via cmd.exe if | |
|
||||
| | Color is not used. | |
|
||||
|---------------------+-------------------------+---------------------|
|
||||
| layer types | "console" | console |
|
||||
| | | graphic |
|
||||
+---------------------------------------------------------------------+
|
||||
|
||||
Whether or not "console" exists depends on the point of view you are
|
||||
comfortable with. "Console" as shown here is consistent with the "layers
|
||||
on a screen, screen in an operating system window" mnemonic. It is
|
||||
equally correct to say "FreeBASIC console screens do not have layers".
|
||||
|
||||
See my Console_Defaults.bas program for discussion of cmd.exe settings.
|
||||
|
||||
----------
|
||||
|
||||
The following "code" is copy/paste from my template file, named
|
||||
template_FreeBASIC.bas and saved as a "read only" file. The file helps
|
||||
me code in a consistent style, and the file evolves as I learn.
|
||||
|
||||
|
||||
REM setup FreeBASIC console screen
|
||||
Screen , Rem default FreeBASIC screen
|
||||
Width 80,25 Rem default columns,rows
|
||||
Color 7,0 Rem default foreground,background
|
||||
Cls
|
||||
|
||||
REM setup GfxLib gui screen
|
||||
ScreenRes x,y Rem graphic layer pixels
|
||||
Width columns,rows Rem console layer for font size w x h
|
||||
Color 15,0 Rem default foreground,background
|
||||
Cls
|
||||
|
||||
REM setup GfxLib console screen Rem closes GfxLib gui screen, if open
|
||||
Screen 0 Rem GfxLib console screen
|
||||
Width 80,25 Rem default columns,rows
|
||||
Color 7,0 Rem default foreground,background
|
||||
Cls
|
||||
|
||||
|
||||
Comments are free! In my coding style, comments "to the left" describe
|
||||
code blocks, while comments "to the right" are like sticky notes.
|
||||
FreeBASIC code is letter-case insensitive, so I use REM "to the left" to
|
||||
describe a code block and Rem "to the left" to describe a code block
|
||||
within a code block.
|
||||
|
||||
----------
|
||||
|
||||
'/
|
||||
|
||||
REM end of appendix
|
||||
REM#####################################################################
|
||||
REM end of file
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
Screen 13
|
||||
|
||||
'Move to (50,50) without drawing
|
||||
Draw "BM 50,50"
|
||||
|
||||
'Set drawing color to 2 (green)
|
||||
Draw "C2"
|
||||
|
||||
'Draw a box
|
||||
Draw "R50 D30 L50 U30"
|
||||
|
||||
'Move inside the box
|
||||
Draw "BM +1,1"
|
||||
|
||||
'Flood fill with color 1 (blue) up to border color 2
|
||||
Draw "P 1,2"
|
||||
|
||||
Sleep
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
Sub StaticSub()
|
||||
Static cnt As Integer
|
||||
cnt += 1
|
||||
Print "In StaticSub "; cnt; " time(s)."
|
||||
If (cnt = 10) Then
|
||||
Print "That's the end!"
|
||||
End If
|
||||
End Sub
|
||||
|
||||
' *** Versus VB5 ***
|
||||
'Private Sub StaticSub()
|
||||
' Set cnt As Integer
|
||||
' cnt = cnt + 1
|
||||
' Print "In StaticSub" & cnt & " times(s)."
|
||||
' If cnt = 10 Then
|
||||
' Print "That's the end!"
|
||||
' End If
|
||||
'End Sub
|
||||
|
||||
Dim i As Integer
|
||||
For i = 1 to 10
|
||||
'Call StaticSub until the loop completes
|
||||
StaticSub
|
||||
Next
|
||||
|
||||
Sleep
|
||||
End
|
||||
|
|
@ -0,0 +1,55 @@
|
|||
'*** ONLY WORKS ON WINDOWS ***
|
||||
#include "windows.bi"
|
||||
|
||||
Dim As HKEY hKey1, hKey2
|
||||
Dim As DWORD dwDisposition
|
||||
Dim As Integer fontheight,fontwidth
|
||||
Dim As DWORD fontFamily = 54
|
||||
Dim As DWORD fontSize
|
||||
|
||||
'valid font heights for Lucida console are
|
||||
'5, 6, 7, 8, 10, 12, 14, 16, 18, 20, 24, 28, 36, and 72
|
||||
|
||||
fontheight = 72 'change this value for a different font size
|
||||
fontwidth = 0
|
||||
fontsize=(fontheight*2^16)+fontwidth
|
||||
|
||||
Dim As DWORD fontWeight = 700
|
||||
|
||||
Dim As String key2
|
||||
key2 = Command(0)
|
||||
For x As Integer = 1 To Len(key2)
|
||||
If Mid$(key2,x,1) = "\" Then
|
||||
Mid$(key2,x,1)="_"
|
||||
End If
|
||||
Next x
|
||||
|
||||
Dim As String faceName = "Lucida Console"
|
||||
|
||||
|
||||
RegOpenKeyEx( HKEY_CURRENT_USER, "Console", 0, KEY_ALL_ACCESS, @hKey1 )
|
||||
|
||||
|
||||
RegCreateKeyEx( hKey1, Strptr(key2), 0, null, 0, KEY_ALL_ACCESS, _
|
||||
null, @hKey2, @dwDisposition )
|
||||
|
||||
|
||||
RegSetValueEx( hKey2, "FaceName", 0, REG_SZ, _
|
||||
Strptr(faceName), Sizeof(faceName)+2 )
|
||||
|
||||
RegSetValueEx( hKey2, "FontFamily", 0, REG_DWORD, _
|
||||
cast(LPSTR,@fontFamily), Sizeof(DWORD) )
|
||||
|
||||
RegSetValueEx( hKey2, "FontSize", 0, REG_DWORD, _
|
||||
cast(LPSTR,@fontSize), Sizeof(DWORD) )
|
||||
|
||||
Print RegSetValueEx( hKey2, "FontWeight", 0, REG_DWORD, _
|
||||
cast(LPSTR,@fontWeight), Sizeof(DWORD) )
|
||||
|
||||
|
||||
freeconsole()
|
||||
allocconsole()
|
||||
color 12,0
|
||||
width 20,1
|
||||
Print " Big Red Letters!";
|
||||
Sleep
|
||||
|
|
@ -0,0 +1,139 @@
|
|||
'' Text user interface example
|
||||
|
||||
namespace tui
|
||||
|
||||
type window
|
||||
declare constructor _
|
||||
( _
|
||||
new_x as integer = 1, new_y as integer = 1, _
|
||||
new_w as integer = 20, new_h as integer = 5, _
|
||||
new_title as string = "" _
|
||||
)
|
||||
declare destructor( )
|
||||
declare sub show( )
|
||||
|
||||
'' Title property
|
||||
declare property title as string
|
||||
declare property title( new_title as string )
|
||||
|
||||
'' Position properties
|
||||
declare property x as integer
|
||||
declare property x( new_x as integer )
|
||||
declare property y as integer
|
||||
declare property y( new_y as integer )
|
||||
|
||||
private:
|
||||
declare sub redraw( )
|
||||
declare sub remove( )
|
||||
declare sub drawtitle( )
|
||||
|
||||
dim as string mytitle
|
||||
dim as integer posx, posy, sizew, sizeh
|
||||
end type
|
||||
|
||||
constructor window _
|
||||
( _
|
||||
new_x as integer, new_y as integer, _
|
||||
new_w as integer, new_h as integer, _
|
||||
new_title as string _
|
||||
)
|
||||
|
||||
this.posx = new_x
|
||||
this.posy = new_y
|
||||
this.sizew = new_w
|
||||
this.sizeh = new_h
|
||||
this.mytitle = new_title
|
||||
|
||||
if( len( this.mytitle ) = 0 ) then
|
||||
this.mytitle = "untitled"
|
||||
end if
|
||||
|
||||
end constructor
|
||||
|
||||
destructor window( )
|
||||
color 7, 0
|
||||
cls
|
||||
end destructor
|
||||
|
||||
property window.title( ) as string
|
||||
return this.mytitle
|
||||
end property
|
||||
|
||||
property window.title( new_title as string )
|
||||
this.mytitle = new_title
|
||||
this.drawtitle( )
|
||||
end property
|
||||
|
||||
property window.x( ) as integer
|
||||
return this.posx
|
||||
end property
|
||||
|
||||
property window.x( new_x as integer )
|
||||
this.remove( )
|
||||
this.posx = new_x
|
||||
this.redraw( )
|
||||
end property
|
||||
|
||||
property window.y( ) as integer
|
||||
return this.posy
|
||||
end property
|
||||
|
||||
property window.y( new_y as integer )
|
||||
this.remove( )
|
||||
this.posy = new_y
|
||||
this.redraw( )
|
||||
end property
|
||||
|
||||
sub window.show( )
|
||||
this.redraw( )
|
||||
end sub
|
||||
|
||||
sub window.drawtitle( )
|
||||
locate this.posy, this.posx
|
||||
color 15, 1
|
||||
print space( this.sizew );
|
||||
locate this.posy, this.posx + (this.sizew \ 2) - (len( this.mytitle ) \ 2)
|
||||
print this.mytitle;
|
||||
end sub
|
||||
|
||||
sub window.remove( )
|
||||
color 0, 0
|
||||
var spaces = space( this.sizew )
|
||||
for i as integer = this.posy to this.posy + this.sizeh - 1
|
||||
locate i, this.posx
|
||||
print spaces;
|
||||
next
|
||||
end sub
|
||||
|
||||
sub window.redraw( )
|
||||
this.drawtitle( )
|
||||
color 8, 7
|
||||
var spaces = space( this.sizew )
|
||||
for i as integer = this.posy + 1 to this.posy + this.sizeh - 1
|
||||
locate i, this.posx
|
||||
print spaces;
|
||||
next
|
||||
end sub
|
||||
|
||||
end namespace
|
||||
|
||||
dim win as tui.window = tui.window( 3, 5, 50, 15 )
|
||||
|
||||
win.show( )
|
||||
sleep 2000
|
||||
|
||||
win.title = "Window 1"
|
||||
sleep 2000
|
||||
win.x = win.x + 10
|
||||
sleep 2000
|
||||
|
||||
win.title = "Window 2"
|
||||
sleep 2000
|
||||
win.y = win.y - 2
|
||||
sleep 2000
|
||||
|
||||
locate 25, 1
|
||||
color 7, 0
|
||||
print "Press any key...";
|
||||
|
||||
sleep
|
||||
|
|
@ -0,0 +1,123 @@
|
|||
|
||||
namespace tui
|
||||
|
||||
type window
|
||||
declare constructor _
|
||||
( _
|
||||
new_x as integer = 1, new_y as integer = 1, _
|
||||
new_w as integer = 20, new_h as integer = 5, _
|
||||
new_title as string = "" _
|
||||
)
|
||||
declare destructor( )
|
||||
declare sub show( )
|
||||
|
||||
'' Title property
|
||||
declare property title as string
|
||||
declare property title( new_title as string )
|
||||
|
||||
'' Position properties
|
||||
declare property x as integer
|
||||
declare property x( new_x as integer )
|
||||
declare property y as integer
|
||||
declare property y( new_y as integer )
|
||||
|
||||
private:
|
||||
declare sub redraw( )
|
||||
declare sub remove( )
|
||||
declare sub drawtitle( )
|
||||
|
||||
dim as string mytitle
|
||||
dim as integer posx, posy, sizew, sizeh
|
||||
end type
|
||||
|
||||
constructor window _
|
||||
( _
|
||||
new_x as integer, new_y as integer, _
|
||||
new_w as integer, new_h as integer, _
|
||||
new_title as string _
|
||||
)
|
||||
|
||||
this.posx = new_x
|
||||
this.posy = new_y
|
||||
this.sizew = new_w
|
||||
this.sizeh = new_h
|
||||
this.mytitle = new_title
|
||||
|
||||
if( len( this.mytitle ) = 0 ) then
|
||||
this.mytitle = "untitled"
|
||||
end if
|
||||
|
||||
end constructor
|
||||
|
||||
destructor window( )
|
||||
color 7, 0
|
||||
cls
|
||||
end destructor
|
||||
|
||||
property window.title( ) as string
|
||||
return this.mytitle
|
||||
end property
|
||||
|
||||
property window.title( new_title as string )
|
||||
this.mytitle = new_title
|
||||
this.drawtitle( )
|
||||
end property
|
||||
|
||||
property window.x( ) as integer
|
||||
return this.posx
|
||||
end property
|
||||
|
||||
property window.x( new_x as integer )
|
||||
this.remove( )
|
||||
this.posx = new_x
|
||||
this.redraw( )
|
||||
end property
|
||||
|
||||
property window.y( ) as integer
|
||||
return this.posy
|
||||
end property
|
||||
|
||||
property window.y( new_y as integer )
|
||||
this.remove( )
|
||||
this.posy = new_y
|
||||
this.redraw( )
|
||||
end property
|
||||
|
||||
sub window.show( )
|
||||
this.redraw( )
|
||||
end sub
|
||||
|
||||
sub window.drawtitle( )
|
||||
locate this.posy, this.posx
|
||||
color 15, 1
|
||||
print space( this.sizew );
|
||||
locate this.posy, this.posx + (this.sizew \ 2) - (len( this.mytitle ) \ 2)
|
||||
print this.mytitle;
|
||||
end sub
|
||||
|
||||
sub window.remove( )
|
||||
color 0, 0
|
||||
var spaces = space( this.sizew )
|
||||
for i as integer = this.posy to this.posy + this.sizeh - 1
|
||||
locate i, this.posx
|
||||
print spaces;
|
||||
next
|
||||
end sub
|
||||
|
||||
sub window.redraw( )
|
||||
this.drawtitle( )
|
||||
color 8, 7
|
||||
var spaces = space( this.sizew )
|
||||
for i as integer = this.posy + 1 to this.posy + this.sizeh - 1
|
||||
locate i, this.posx
|
||||
print spaces;
|
||||
next
|
||||
end sub
|
||||
|
||||
end namespace
|
||||
|
||||
dim win1 as tui.window = tui.window( 3, 5, 50, 15, "Flashcards" )
|
||||
Cls
|
||||
'win1.title = "Window 1"
|
||||
win1.show( )
|
||||
sleep
|
||||
|
|
@ -0,0 +1,76 @@
|
|||
'From the FreeBASIC.Net tutorial site.
|
||||
#include "fbgfx.bi"
|
||||
Using FB
|
||||
|
||||
'Put all the vars into a custom type
|
||||
Type ObjectType
|
||||
x As Single
|
||||
y As Single
|
||||
r As Single
|
||||
l As Single
|
||||
u As Single
|
||||
d As Single
|
||||
speed As Single
|
||||
End Type
|
||||
|
||||
Dim Shared CircleM As ObjectType
|
||||
|
||||
Screen 13,8,2,0 'A 320x200 graphical window
|
||||
SetMouse 0,0,0 'Hide the mouse cursor
|
||||
|
||||
CircleM.x = 150 'Put the circle in the middle
|
||||
CircleM.y = 90 'Of the window.
|
||||
CircleM.l = 0
|
||||
CircleM.r = 0
|
||||
CircleM.u = 0
|
||||
CircleM.d = 0
|
||||
CircleM.speed = 1
|
||||
|
||||
Do
|
||||
Cls 'Refreshes the window, so the circle doesn't "paint"
|
||||
Circle (CircleM.x,CircleM.y), 10, 15 'Sets new location and shape
|
||||
If CircleM.speed = 0 Then CircleM.speed = 1
|
||||
|
||||
If MultiKey(SC_LEFT) Then CircleM.l = 1:CircleM.r = 0:CircleM.u = 0:CircleM.d = 0
|
||||
If MultiKey(SC_RIGHT) Then CircleM.r = 1:CircleM.l = 0:CircleM.u = 0:CircleM.d = 0
|
||||
If MultiKey(SC_UP) Then CircleM.u = 1:CircleM.d = 0:CircleM.l = 0:CircleM.r = 0
|
||||
If MultiKey(SC_DOWN) Then CircleM.d = 1:CircleM.u = 0:CircleM.l = 0:CircleM.r = 0
|
||||
|
||||
If MultiKey(SC_UP) And MultiKey(SC_LEFT) Then CircleM.u = 1:CircleM.l = 1:CircleM.d = 0:CircleM.r = 0
|
||||
If MultiKey(SC_UP) And MultiKey(SC_RIGHT) Then CircleM.u = 1:CircleM.r = 1:CircleM.d = 0:CircleM.l = 0
|
||||
If MultiKey(SC_DOWN) And MultiKey(SC_LEFT) Then CircleM.d = 1:CircleM.l = 1:CircleM.u = 0:CircleM.r = 0
|
||||
If MultiKey(SC_DOWN) And MultiKey(SC_RIGHT) Then CircleM.d = 1:CircleM.r = 1:CircleM.u = 0:CircleM.l = 0
|
||||
|
||||
'Listens for activity on named keys, and updates the circle
|
||||
'Position accordingly.
|
||||
If CircleM.l = 1 Then
|
||||
CircleM.x = CircleM.x - CircleM.speed
|
||||
If CircleM.x < 0 Then CircleM.x = 320
|
||||
End If
|
||||
|
||||
If CircleM.r = 1 Then
|
||||
CircleM.x = CircleM.x + CircleM.speed
|
||||
If CircleM.x > 320 Then CircleM.x = 0
|
||||
End If
|
||||
|
||||
If CircleM.u = 1 Then
|
||||
CircleM.y = CircleM.y - CircleM.speed
|
||||
If CircleM.y < 0 Then CircleM.y = 200
|
||||
End If
|
||||
|
||||
If CircleM.d = 1 Then
|
||||
CircleM.y = CircleM.y + CircleM.speed
|
||||
If CircleM.y > 200 Then CircleM.y = 0
|
||||
End If
|
||||
|
||||
If MultiKey(SC_TAB) Then CircleM.speed = CircleM.speed + 1
|
||||
If MultiKey(SC_SPACE) Then
|
||||
CircleM.speed = 0
|
||||
CircleM.l = 0
|
||||
CircleM.r = 0
|
||||
CircleM.u = 0
|
||||
CircleM.d = 0
|
||||
End If
|
||||
|
||||
Sleep 10, 1 'No delay makes the movement invisible
|
||||
Loop Until MultiKey(SC_Q) Or MultiKey(SC_ESCAPE) 'Escape or Q to exit
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
Dim As Single lb, kg
|
||||
Input "Enter a weight in pounds:", lb
|
||||
kg = lb * 0.454
|
||||
Print lb; " lb. is equal to ";kg; " kg"
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
|
||||
Dim As Integer consize, rows, cols
|
||||
'Get the current console size
|
||||
consize = Width
|
||||
rows = Hiword(consize)
|
||||
cols = Loword(consize)
|
||||
Print "Current Rows =";rows
|
||||
Print "Current Columns =";cols
|
||||
Print "Press any key..."
|
||||
Sleep
|
||||
Cls
|
||||
'Resize console if necessary
|
||||
If rows > 25 Then
|
||||
Width 80, 25
|
||||
End If
|
||||
'Get the new console size
|
||||
consize = Width
|
||||
rows = Hiword(consize)
|
||||
cols = Loword(consize)
|
||||
Print "New Rows =";rows
|
||||
Print "New Columns =";cols
|
||||
Sleep
|
||||
End
|
||||
Loading…
Reference in New Issue