This program uses a custom font file, that I did not make. Some very brilliant QB programmer with the name Jarek, I believe, made a button routine that uses this custom QB font. I got it from http://qbasicgui.datacomponents.net/79_button2.html you'll need either the Impact.qbf or Jarek.qbf to test this.
The first Sub is a custom mouse routine, the second one opens the font files. And the last one is a custom print routine. You should run the buttons.bas file it in QB first to see what it should look like (I used it in QB 4.5, but I believe plain old QBasid should work as well). Copy the following code and then compile with FreeBasic. I'm doing all of this on Linux Mint, I haven't tried to compile it on Windows but I did compile it in Dosbox and it gives me the same results. Once compile run it and you'll see that all the sub programs work as expected but once you uncomment the the fPrint sub it locks up the entire program. I have to close the Terminal to kill the program.
Please look it over and let me know what it is I'm not seeing. Any help would be greatly appreciated.
Here is the code, call the file test.bas to keep it simple:
Code: Select all
' *****MOUSE RUTIN*****
DECLARE SUB MRun ( sg As Integer )
'if sg is 0 then you can see the mouse coordinates on screen and the status of
'the mouse buttons If you put this in between do and loop it communicate whit the
'mouse.
DECLARE SUB fOpen ( File As String, FileNum As Integer)
DECLARE SUB fprint ( Text As String, Textx As Integer, Texty As Integer, TextColor As Integer, FontNum as Integer, cur As Integer )
'text$ The text you want
'textx% The x positions of the text
'texty% the y positions of the text
'colour% The text color
'file% The file NR See down below (in the fopen)
'cur% My own special effect if its bigger than 0 it will do stripes and make it little bold
Type TMouse
Res As Integer
X As Integer
Y As Integer
Wheel As Integer
Clip As Integer
Union
mButtons As Integer
Type
mLeft:1 As Integer
mRight:1 As Integer
mMiddle:1 As Integer
End Type
End Union
End Type
Common Shared Mouse As TMouse
SUB MRun ( sg As Integer )
' this part just communicates with the mouse SUB
Mouse.Res = GetMouse( Mouse.X, Mouse.Y, Mouse.Wheel, Mouse.Clip )
#ifdef __FB_DOS__
Print "Mouse or mouse driver not available"
#else
Print "Mouse not available or not on window"
#endif
'if sg is 0 then you can see the mouse status on the screen
IF sg = 0 THEN
LOCATE 1, 1: PRINT USING "Resolusion: ###"; Mouse.Res
LOCATE 2, 1: PRINT USING "X:### Y:### wheel: +### clip: ##"; Mouse.X; Mouse.Y; Mouse.Wheel; Mouse.Clip
Locate 3, 1: Print "Buttons:"; Mouse.mButtons
LOCATE 4, 1: PRINT "Button1:"; Mouse.mLeft
LOCATE 5, 1: PRINT "Button2:"; Mouse.mRight
Locate 6, 1: Print "Button3:"; Mouse.mMiddle
END IF
END SUB
SUB fOpen ( File As String, FileNum as Integer )
OPEN File FOR RANDOM AS FileNum LEN = 2
END SUB
SUB fprint ( Text As String, Textx As Integer, Texty As Integer, TextColor As Integer, FontNum As Integer, cur As Integer )
Dim lpi As Integer, fws As Integer, fls As Integer, Count As Integer, M As Integer
Dim a1 As Integer, a2 As Integer, n As Integer, z As Integer, bb As Integer, l As Integer, p As Integer
GET #FontNum, 1, lpi
GET #FontNum, 2, fws
GET #FontNum, 3, fls
FOR Count = 1 TO LEN( Text )
M = ASC(MID$( Text, Count, 1)) - 29
IF M > 3 THEN
GET #FontNum, M, a1
GET #FontNum, M + 1, a2
FOR n = a1 TO a2 - 1 STEP lpi
FOR z = 0 TO lpi - 1
bb = bb + 1
GET #FontNum, n + z, l
LINE (p + Textx, (16 * z) + Texty)-(p + Textx, (16 * z) + 15 + texty), TextColor, , l
NEXT z
p = p + 1 + cur
NEXT n
p = p + fls
ELSE
p = p + fws
END IF
NEXT Count
END SUB
Dim Impact as Integer, Jarek as Integer
Impact = FreeFile
Jarek = FreeFile
fOpen( "Impact.qbf", Impact )
fOpen( "Jarek.qbf", Jarek )
ScreenRes 640, 480, 32
' fPrint ("Hello World", 100, 100, 15, Impact, 0)
Do
MRun (0)
Loop until Inkey$ = chr$(27)
end