[futurebasic] Scroll Bar again

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : September 2004 : Group Archive : Group : All Groups

From: Brian Heibert <bheibert@...>
Date: Sat, 25 Sep 2004 20:04:01 -0500
I don't know what I  did but my scroll bar no longer works:


'~'A
'                             Runtime : Rntm FBII.Incl
'                            Debugger : Off
'                                 CPU : Carbon
'                          CALL Req'd : Off
'                    No Re-DIM'd Vars : Off
'                     DIM'd Vars Only : Off
'                      MacsBug Labels : On
'                           QB Labels : On
'                       Optimize STR# : Off
'                 Ary Bounds Checking : On
'                       Show Warnings : Off
'                       Register Vars : On
'               Make Line Start Table : On
'~'B
/*

Notes to Al
   File Open & File Save don't work
   Run doesn't work yet how do I get it to interpert each line of code
   from the edit field and do something with it
   I know how to put the edit field's text into a string$
   mystring$ = EDIT$(1) down below I am using this container$ = EDIT$(1)
   why container I don't know? I just picked that word hehee

Also there are certain things you may need to comment out
to get this program to run on your Mac like monitor size code, system
version
code, etc.
Here's a example:
sysHeight = SYSTEM(_scrnHeight)
sysWidth = SYSTEM(_scrnWidth)
IF sysHeight = 768 and sysWidth = 1024 then fn sc1
IF sysHeight = 720 and sysWidth = 1152 then fn sc2
as seen below

   Thanks,

    Brian
*/
"main"
RESOURCES "TBASIC.rsrc","APPLtbX~"
OUTPUT FILE "TBASIC.app"
OVERRIDE RUNTIME FBStop(where&)
// FBStopinResourceFork
END FN

LOCAL FN loadSTR$(ID)
txt$ = ""
rHndl& = FN GETRESOURCE(_"STR ",ID)
LONG IF rHndl&
txt$ = PSTR$([rHndl&])
END IF
END FN=txt$

helloworld$ = FN loadSTR$(141)
windemo$ = FN loadSTR$(142)
prinp$ = FN loadSTR$(143)
gui$ = FN loadSTR$(144)
graphics$ = FN loadSTR$(145)

LOCAL FN donothing
BEEP
END FN

EDIT MENU 2 ' this puts in a standard edit menu
edselall$ = FN loadSTR$(132)
prefx$ = FN loadStr$(149)
linem$ = FN loadStr$(150)
menu 2,7,1, edselall$ ' this adds Select All to the edit menu.
menu 2,8,1, "-"
menu 2,9,1, "/;Preferences..."

CURSOR 128

_tbsplsh          = 1                 'TBASIC_Splash window
_picFld1class1    = 1
Dim err,container$,menuid,itemid,runcode
Dim RUNCODE$,EVNT,ID
Dim right,bottom
DEF Fn SaveDoc
DEF Fn OpenDoc
wndtitl1$ = FN loadSTR$(137)
dim gMyFileSpec as fsSpec
LOCAL FN buildTbsplsh
  WINDOW _tbsplsh,wndtitl1$,( 433, 225)-(1147, 630), 1028
  PICTURE FIELD _picFld1class1,%4000,(   0,   0)-( 739, 423), 7,_cropPict
END FN

LOCAL FN updateTbsplsh
  ' If you're not using PG, add...
  DIM gObjT,gObjL,gObjB,gObjR
END FN

LOCAL FN sc1
ish$ = FN loadSTR$(147)
BEEP
Call ParamText (ish$,"","","")
i = Fn StopAlert(130,0)
End
END  FN

LOCAL FN sc2
ish$ = FN loadSTR$(147)
BEEP
Call ParamText (ish$,"","","")
i = Fn StopAlert(130,0)
End
END FN


sysHeight = SYSTEM(_scrnHeight)
sysWidth = SYSTEM(_scrnWidth)
long IF sysHeight = 768 and sysWidth = 1024
fn sc1
end if
long if sysHeight = 720 and sysWidth = 1152
fn sc2
end if

RESOURCES "TBASIC.rsrc"
FN buildTbSplsh
FN updateTbsplsh

 
Local Mode
Local Fn KillSpinningCursor
Dim evnt as EventRecord
End Fn =  Fn EventAvail(  0,  evnt )
include "Tlbx SpeechSynthesis.Incl"
clear local
#if ndef _gestaltSpeechMgrPresent
_gestaltSpeechMgrPresent = 0
#endif
local fn hasSpeechMgr' returns non-zero if Speech Mgr present
dim @ speechAttr as long
end fn = fn Gestalt(_"ttsc",speechAttr) = _noErr and (speechAttr and
_gestaltSpeechMgrPresent%)
syszx$ = FN loadSTR$(140)
do
If System(_sysVers) => 1000 Then Fn KillSpinningCursor
until mouse(_down)
sysz1$ = FN loadSTR$(131)
local fn sysvdlg
BEEP
Call ParamText (sysz1$,"","","")
i = Fn StopAlert(131,0)
End
end fn

WINDOW CLOSE #_tbsplsh
sysv = SYSTEM(_sysvers)
IF sysv < 1030 then fn sysvdlg
long if fn hasSpeechMgr
welcome$ = FN loadSTR$(133)
err = fn SpeakString (welcome$)
while fn SpeechBusy
wend

xelse
BEEP
spch1$ = FN loadSTR$(134)
Call ParamText (spch1$,"","","")
i = Fn StopAlert(128,0)
End
DO
UNTIL MOUSE(_down)
WINDOW CLOSE #855
end if

_tbeditor         = 2                 'TBASIC window
_EF1WClass2       = 1

LOCAL FN buildTbeditor
wndtitl2$ = FN loadSTR$(138)
WINDOW _tbeditor,wndtitl2$,(  24,  80)-(1023, 806), _docNoGrow
TEXT _Times,11,0
//LONG COLOR 60675,61087,48266
//EDIT FIELD _EF1WClass2,%4000,(1, 1)-(1022, 805), 4,_leftJust
left = 1
top = 1
right = 1500 
bottom = 50
Edit Field #1, "", @FieldRect, _framed
END FN

Local Fn BuildScrollFld (EditID,Left,Top,Wide,NumLines)
left = 1
top = 1
right = 1022
bottom = 1000
'---> Variables
DIM FieldRect AS RECT ' Make it a var of type RECT
FieldRect.top = 0
FieldRect.left  = 0
_scrollWidth = 20
FieldRect.right = WINDOW(_width) - _scrollWidth ' You would have set
//_scrollWidth, probably to 20?
FieldRect.bottom = WINDOW(_height)-1


Edit Field -1, "", @FieldRect, _Framed
FieldRect.left   = FieldRect.right + 1
FieldRect.right  = FieldRect.left + 16
Call InsetRect (FieldRect,0,-2)
Scroll Button -1, 1, 1, 1, 1, @FieldRect, _scrollOther
End Fn

LOCAL FN updateTbeditor
  DIM gObjT,gObjL,gObjB,gObjR
END FN

FN buildTbeditor
FN updateTbeditor

EDIT FIELD #8001, container2$


//Fn BuildScrollFld(8001,20,20,180,10)
Fn BuildScrollFld(8001,20,20,180,10)

container$ = EDIT$(8001)
//GET FIELD ZTXThandle&, 1

local fn PrintEditField( whichEF as long )
def PrintEditField( whichEF )
end fn


/*
local fn ParseEFLines( efID as long )
beep 
dim as handle efH 
dim as long i, numLines
dim as str255 lineStr

efH = TeHandle( efID )
numLines = efH..teNLines%

for i = 1 to numLines
lineStr = edit$( efID, i )
// Do your stuff with each line here

LONG IF UCASE$(LEFT$(lineStr,5)) = "FONT "
fnum = VAL(mid$(lineStr,6))
CALL TEXTFONT(fnum)
END IF

LONG IF left$(lineStr,6) = "PRINT "
' If window exists place in window otherwise create default window
//TEXT fnum doesn't work
PRINT MID$(lineStr,7)
END IF

LONG IF LEFT$(lineStr,10 ) = "LAUNCHURL "
URL$ = MID$(lineStr, 11)
FN LaunchURL (URL$)
END IF

LONG IF UCASE$(LEFT$(lineStr,6)) = "ALERT "
alertText$ = MID$(lineStr,7)
CALL PARAMTEXT (alertText$, "", "", "")
butnPressed = FN ALERT(129,0)
END IF

LONG IF UCASE$(LEFT$(lineStr,13)) = "CAUTIONALERT "
alertText1$ = MID$(lineStr,14)
CALL PARAMTEXT (alertText1$, "","","")
butnPressed = FN CAUTIONALERT (129,0)
END IF

LONG IF UCASE$(LEFT$(lineStr,10)) = "STOPALERT "
alertText2$ = MID$(lineStr,11)
CALL PARAMTEXT (alertText2$,"","","")
butnPressed = FN STOPALERT (129,0)
END IF


LONG IF UCASE$(LEFT$(lineStr,4)) = "SUB "  // doesn't work
//lst = STR(lineStr)

LOCAL FN lst
END FN

END IF

LONG IF UCASE$(LEFT$(lineStr,7)) = "LPRINT "  '// doesn't work
/*
printout$ = MID$(lineStr,8)
ROUTE _toPrinter
  PRINT printout$
ROUTE _toScreen
CLEAR LPRINT: CLOSE LPRINT

END IF

LONG IF UCASE$(LEFT$(lineStr,6 )) = "SPEAK " '// doesn't work
sp$ = MID$(lineStr, 7)
Include "Tlbx SpeechSynthesis.Incl"
err = fn SpeakString (sp$)
END IF

LONG IF UCASE$(LEFT$(lineStr,7 )) = "WINNUM "
wnum = MID$(lineStr, 7)
WINDOW #wnum
END IF

LONG IF UCASE$(LEFT$(lineStr,9)) = "WINTITLE "
wtitle$ = MID$(lineStr,9)
WINDOW #wnum, wtitle$
END IF 

LONG IF UCASE$(LEFT$(lineStr,13)) = "WINCOORDWIDTH "
width1 = MID$(lineStr,13)


END IF
LONG IF UCASE$(LEFT$(lineStr,14 )) = "WINCOORDHEIGHT "
height1 = MID$(lineStr, 14)
END IF
LONG IF UCASE$(LEFT$(lineStr,11)) = "WINCOORDTOP "
top1 = MID$(lineStr,11)
END IF
LONG IF UCASE$(LEFT$(lineStr,13 )) = "WINCOORDBOTTOM "
bottom = MID$(lineStr,13)
END IF
LONG IF UCASE$(left$(lineStr, 10 )) = "SETWINDOW "
WINDOW #wnum, wtitle$, (width1,height1) - (top1,bottom)
END IF


NEXT i
end fn = numLines 
*/


local fn ParseEFLines( efID as long )
dim as handle efH
dim as long i, numLines
dim as str255 lineStr

efH = TeHandle( efID )
if efH = 0 then shutdown "No handle for edit field no." + str$(efID)
numLines = efH..teNLines%
if numLines < 1 then shutdown "No text found in edit field no." + str$(efID)
for i = 1 to numLines
lineStr = edit$( efID, i )
print lineStr'Just to test
// Do your stuff with each line here
select
case UCASE$(LEFT$(lineStr,6)) = "FONT "
fnum = VAL(mid$(lineStr,7))
CALL TEXTFONT(fnum)

case left$(lineStr,6) = "PRINT "
' If window exists place in window otherwise create default window
//TEXT fnum doesn't work
PRINT MID$(lineStr,7)

case LEFT$(lineStr,10 ) = "LAUNCHURL "
URL$ = MID$(lineStr, 11)
FN LaunchURL (URL$)

case UCASE$(LEFT$(lineStr,6)) = "ALERT "
alertText$ = MID$(lineStr,7)
CALL PARAMTEXT (alertText$, "", "", "")
butnPressed = FN ALERT(129,0)

case UCASE$(LEFT$(lineStr,13)) = "CAUTIONALERT "
alertText1$ = MID$(lineStr,14)
CALL PARAMTEXT (alertText1$, "","","")
butnPressed = FN CAUTIONALERT (129,0)

case UCASE$(LEFT$(lineStr,10)) = "STOPALERT "
alertText2$ = MID$(lineStr,11)
CALL PARAMTEXT (alertText2$,"","","")
butnPressed = FN STOPALERT (129,0)

case UCASE$(LEFT$(lineStr,4)) = "SUB "  // doesn't work
//lst = STR(lineStr)
/*
LOCAL FN lst
END FN
*/

case UCASE$(LEFT$(lineStr,7)) = "LPRINT "  '// doesn't work
/*
printout$ = MID$(lineStr,8)
ROUTE _toPrinter
   PRINT printout$
ROUTE _toScreen
CLEAR LPRINT: CLOSE LPRINT
*/

case UCASE$(LEFT$(lineStr,6 )) = "SPEAK " '// doesn't work
sp$ = MID$(lineStr, 7)
Include "Tlbx SpeechSynthesis.Incl"
err = fn SpeakString (sp$)

case else
print "Unable to interpret that command."

end select
NEXT i
end fn = numLines


LOCAL FN doMenus
menuid = Menu(_menuID)
itemid = Menu(_itemID)
//PRINT menuID
//PRINT itemID
Menu

'adds SELECT ALL to EDIT menu
CURSOR 128
Select MenuID
case 127
Select itemID
case 2
urls1$ = FN loadSTR$(128)
Fn LaunchURL (urls1$)
case 3
url1x$ = FN loadSTR$(148)
Fn LaunchURL (url1x$)
case 5

case 1

 FN buildTbsplsh
 FN updateTbsplsh
DO
If System(_sysVers) => 1000 Then Fn KillSpinningCursor
UNTIL MOUSE(_down)
WINDOW CLOSE #_tbsplsh

end select
case 7   
Select itemID
case 1
DEF Fn HelpManager
Fn HelpManager
case 3
url1c$ = FN loadSTR$(129)
Fn LaunchURL(url1c$)
case 4
url2c$ = FN loadSTR$(128)
Fn LaunchURL(url2c$)
case 5
url3c$ = FN loadSTR$(146)
Fn LaunchURL (url3c$)
end select
case 1
Select itemID
case 1 ' New
FN buildTbeditor
FN updateTbeditor

Fn BuildScrollFld(1,20,20,180,10)
case 2
 WINDOW #_tbEditor'Open
FN OpenDoc
case 3 'Close
WINDOW CLOSE #_tbEditor

case 5'Save
Fn SaveDoc
case 6 'Save As...
Fn SaveDoc
case 8'Page Setup...
DEF PAGE
case 9 'Print...
Fn PrintEditField(1)
case else
end
end select

case 2
select itemid
case 7
setselect 0, 32767 ' Select All
case 9
beep
end select
case 5
Select itemID
case 1
DEF Fn HelpManager
Fn HelpManager
case 4
url1$ = FN loadSTR$(128)
Fn LaunchURL(url1$)
case 3        
url2$ = FN loadSTR$(129)
Fn LaunchURL(url2$)
case 5
urls$ = FN loadSTR$(146)
Fn LaunchURL (urls$)
end select
case 3
Select itemID
case 1
runcode$ = EDIT$(1)
long if runcode$ = ""
'This is where the run code goes
ncti$ = FN loadSTR$(130)
Call ParamText (ncti$,"","","")
i = Fn NoteAlert(129,0)
xelse
fn ParseEFLines(1)
end if 

case 2
long if runcode$ = ""

// Al this needs fixed too
// it 

'This is where the compiler code goes
ncti2$ = FN loadSTR$(139)
Call ParamText(ncti2$,"","","")
i = Fn NoteAlert(129,0)
xelse

end if


// program execution goes here
end select
end select
end fn

LOCAL FN SaveDoc
savprompt$ = FN loadSTR$(135)
filnm$ = FN loadSTR$(136)
// File Type: tbd~
fileName$ = FILES$(_fSave,savprompt$,filnm$,refNumVar%)
gFBUseNavServices = _zTrue
if filename$ = "" then filename$ = filnm$
DEF OPEN "tbd~tbX~"
OPEN "O",1,filename$,,refNumVar%
WRITE #1, runcode$
CLOSE #1
END FN

LOCAL FN OpenDoc
dim gFileSpec as fsSpec
gSaveName$=Files$(_fsspecOpen,"tbd~",,gFileSpec)
DEF OPEN "tbd~tbX~"
LONG IF LEN(gSaveName$)
//OPEN "I", 1,gSaveName$,, @gMyFileSpec
//open "I", #1,@gMyFileSpec
//READ #1,runcode$
Edit Field #8001, runcode$
//CLOSE #1
XELSE
BEEP
END IF
END FN

LOCAL FN HelpManager
BEEP
WINDOW #52, "Help Manager"
PRINT "Help Not Installed Yet!"
DO
If System(_sysVers) => 1000 Then Fn KillSpinningCursor
UNTIL MOUSE(_down)
WINDOW CLOSE #52
END FN

Local Fn DeletePrefsMenuItem
Dim As OSStatus  OSStatus
Dim As MenuRef @ OutMenu
Dim As Word    @ OutItem

//  --  Get the default Mac OS X preferences menu
OSStatus = Fn GetIndMenuItemWithCommandID ( _False, _"pref", 1, @OutMenu,
@OutItem ) 

//  --  Did everything go okay?
Long If OSStatus = _False
Long If OutMenu
//  --  Delete it!
DeleteMenuItem ( OutMenu, OutItem )

//  --  We do this again to delete the menu item seperator
//      as well.
DeleteMenuItem ( OutMenu, OutItem )

Button Close 1

End If
End If
End Fn
Fn DeletePrefsMenuItem

LOCAL FN doDialog
evnt = DIALOG(0)
id = DIALOG(evnt)
SELECT CASE (evnt)
CASE _wndClose
WINDOW CLOSE #_tbEditor

END SELECT
END FN

ON DIALOG FN doDialog
ON MENU FN doMenus

Do
HANDLEEVENTS
UNTIL gFBQuit