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