[futurebasic] Re: [FB] List box appearance

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : March 2002 : Group Archive : Group : All Groups

From: Ken Shmidheiser <k.shmidheiser@...>
Date: Mon, 11 Mar 2002 09:56:52 -0500
>Hans van Maanen asked:

>For me, the example of the List Box in the manual, p. 44, is a bit
>too terse. Does someone have a working example of a List Box -- how
>to build one, and how to retrieve in  FN handleDialog  a double-click
>on an item or a click on the Select button?

In response to Hans' request, Robert Purves forwarded a demo which I
have built upon.

The following kills the resource and builds a list on the fly so it
can be run as is right from this list.

I have added a function to return cell data, but surely there are better ways.

Sorry, didn't have time before work to implement double clicks.

Ken

p.s. Apologies to Robert and Alain for adding a global handle for the
list box. They will soon post a better way!

p.p.s. Do you know how scary it is to mess with the masters' code!?!?!?

/*
List Box
by Alain Pastor and Robert P.
rev. 3-11-02 Ken Shmidheiser
This is "work-in-progress", not a complete demo of List Box use.
*/

#if ndef  appearanceRuntime
compile shutdown "Must be compiled as Appearance Compliant"
#endif

begin record ldesRec
dim version       as short
dim rows          as short
dim column        as short
dim cellHeight    as short
dim cellWidth     as short
dim hasVertScroll as boolean
dim reserved1     as byte
dim hasHorzScroll as boolean
dim reserved2     as byte
dim resID         as short
dim hasSizeBox    as boolean
dim reserved3     as byte
end record

BEGIN GLOBALS
dim as handle @ listH
END GLOBALS

_myldesResID = 128 // if there is an ldes resource with this ID, use it.

clear local mode
local fn GetldesResID
dim resH  as ^^ldesRec   
dim resID as short     

'SetResLoad( _false )
'resH = fn GetResource( _"ldes", _myldesResID )
'long if resH
'resID = _myldesResID // ID reserved for resource based list control
'xelse
resH = fn NewHandleClear( sizeof( ldesRec ) )
long if resH
resH..column        = 1
resH..hasVertScroll = 1
resH..cellHeight    = usr FontHeight
do
resID = fn Unique1ID( _"ldes")
until ( resID > _myldesResID )
AddResource( resH, _"ldes", resID, "" )
long if ( fn ResError == _noErr )
ReleaseResource( resH )
xelse
resID = 0
DisposeHandle( resH )
end if
end if
'end if
'SetResLoad( _true )
end fn = resID // 0 if fails


'local mode
local fn PutListInButton( listStr( _maxInt) as str255, btnID as long )
dim as short    i, nItems
dim as point    theCell
dim as long   @ actualSize

nItems = val&( listStr(0) ) // 1st str in array = number of items
if nItems == _nil then exit fn

def GetButtonData( btnID, _kControlListBoxPart, ¬
   _kControlListBoxListHandleTag, sizeof( listH ), listH, actualSize )
long if listH
LSetDrawingMode( _zTrue, listH )
theCell.h% = 0
for i = 1 to nItems
theCell.v% = fn LAddRow( 1, i, listH )
LSetCell( @listStr(i)+1, |@listStr(i)|, theCell, listH )
next
end if

end fn

local fn BuildWnd
dim as rect    r
dim as long    j
dim as short  listResID, nListItems
dim as OSErr  err
dim as str255 stringArray(50)

setrect( r, 0, 0, 290, 238 )
window -1, "List Box", @r, _docNoGrow

def SetWindowBackground( _kThemeActiveDialogBackgroundBrush,_false )
text _sysFont, 12
nListItems = 25
stringArray(0) = str$( nListItems )
for j = 1 to nListItems
stringArray(j) = "Item" + str$( j )
next

listResID = fn GetldesResID

// create with resource  listResID if available
setrect ( r, 13, 34, 172, 193 )
appearance button 1, _activeBtn, listResID, 0, 1, , @r, _kControlListBoxProc

fn PutListInButton( stringArray(0), 1 )

setrect ( r, 13, 209, 172, 227 )
edit field 2, "An edit field", @r, _framedNoCR_noDrawFocus

edit field 0

window 1 // make visible

end fn

local fn GetCellInfo$
dim as boolean    cellFound
dim as point      theCell
dim as str31      cellStr
dim as integer  @ strLen

SETPT( theCell, 0, 0)
cellFound = FN LGETSELECT( _zTrue, theCell, listH)

long if cellFound
strLen = 32
LGETCELL( @cellStr+1, strLen, theCell, listH)
| @cellStr, strLen
xelse
cellStr = ""
end if

end fn = cellStr

local fn DoDialog
dim as long   evnt, id

evnt = dialog( 0 )
id   = dialog( evnt )

select evnt
case _btnClick
SELECT id
CASE 1
EDIT$(2) = FN GetCellInfo$
END SELECT

case _wndClose
gFBQuit = _zTrue
end select

end fn

on dialog fn DoDialog
menu 1, 0, 1, "File"
menu 1, 1, 1, "Quit/Q"
edit menu 2
fn BuildWnd
do
handleevents
until gFBQuit
end