[futurebasic] vertProgBar

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

From: SVANVOORST@...
Date: Wed, 14 Aug 2002 22:12:22 EDT
For those interested the following code creates a vertical progress bar with 
its origin at the bottom.  Little arrows have been reversed so that up arrow 
gives ascending values and down arrow descending.

' --------- Start of Code --------
'--- OS 9.2  compiled PPC/Appearance Compliant
_Arrw = 30'ArrowID
_pBarL = 45'ProgressBar Left
_pBarT = 70'ProgressBar Top
_pBarW = 12'ProgressBar Width
_pBarH = 110'ProgressBar Height
_init = 20'ProgressBar initial
_min = 0'ProgressBar minimum
_max = 100'ProgressBar maximum

dim gArrwVal

dim gFactor!'Ratio of bar height to max value
dim gProgBar as rect
dim gProgBarFrame as rect
end globals

local
dim btnType%
dim r as rect
LOCAL FN buildWnd
WINDOW#-1,"vProgBar",(0,0)-(100,_pBarT+_pBarH+40),_docNoGrow
setrect(r,50,35,75,50)
edit field#1,,@r,_statFramed,_centerJust'--- Display EF ---
def setwindowbackground(_kThemeActiveDialogBackgroundBrush,_zTrue)
btnType% = _kControlLittleArrowsProc'--- Little Arrows ---
setrect(r,30,30,45,55)
appearance Button#_Arrw,_activeBtn,_max+_min-_init,_min,_max,,@r,btnType%
edit$(1) = str$(_init)'Display initial value
window#1'--- Progress Bar ---
gFactor! = _pBarH/_max'Ratio of bar height to max value
setrect(gProgBar,_pBarL,_pBarT,(_pBarL+_pBarW),(_pBarT+_pBarH))
setrect(gProgBarFrame,_pBarL-1,_pBarT-1,(_pBarL+_pBarW)+1,(_pBarT+_pBarH)+1)
gProgBar.top% = (_pBarT+_pBarH)-gFactor!*_init'Sets to init value
color _zRed'Color of bar
paintrect(gProgBar)
END FN

local
dim evnt%
dim id%
dim err
dim msPt as point
dim @outPart'Up or down arrow
dim btnH as handle
LOCAL FN doDialog
evnt% = DIALOG(0)
id% = DIALOG(evnt)
SELECT evnt%
case _wndRefresh
err = fn drawthemeedittextframe(#[tehandle(1)],_true)
err = fn drawthemegenericwell(gProgBarFrame,_true,_false)
'---- Refresh Progress Bar ----
gProgBar.top% = (_pBarT+_pBarH) - (gFactor!*gArrwVal)
gProgBar.bottom% = _pBarT+_pBarH
paintrect(gProgBar)
case _btnClick
select id%
case _Arrw
gArrwVal = button(id%,_FBGetCtlMaximum) + button(id%,_FBGetCtlMinimum) - 
button(id%)
edit$(1) = str$(gArrwVal)
fn getmouse(msPt)
btnH = fn findcontrolundermouse(msPt,window(_wndPointer),outPart)
long if outPart = _kControlDownButtonPart'--- Decreasing Arrow values ---
long if gArrwVal = _min'Reset at bottom
gProgBar.bottom% = _pBarT+_pBarH
xelse
gProgBar.bottom% = (_pBarT+_pBarH) - (gFactor!*gArrwVal)
end if
eraserect(gProgBar)'Erase receding edge
xelse'--- Increasing Arrow values ---
long if gArrwVal = _max'Reset at top
gProgBar.top% = _pBarT
xelse
gProgBar.top% = (_pBarT+_pBarH) - (gFactor!*gArrwVal)
end if
paintrect(gProgBar)'Paint advancing edge
end if
end select
CASE _wndClose
END
END SELECT
END FN

gArrwVal = _init'Start with initial value
FN buildWnd
ON DIALOG FN doDialog
DO
HANDLEEVENTS
UNTIL 0

'------- End of Code -------

Steve Van Voorst