[futurebasic] SlideGauge

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : November 2001 : Group Archive : Group : All Groups

From: SVANVOORST@...
Date: Sun, 25 Nov 2001 11:35:27 EST
The following code creates a gauge by utilizing two slider controls:

'---------- Start FB^3 Code --------------
Include "Tlbx Appearance.Incl"

dim wndPtr as pointer
dim leftSliderH as handle
dim rightSliderH as handle
dim sliderValue% as int
dim boxRect as rect
dim sliderRect as rect
dim frame as rect
end globals

local
dim err
LOCAL FN buildWnd
WINDOW#-1,"SlideGauge.demo",(0,0)-(190,350),_docNoGrow
wndPtr = window(_wndPointer)
text _sysFont, 12, 0
edit field#1,,(130,120)-(155,135),_statFramed,_centerJust
err = FN 
SetThemeWindowBackground(wndPtr,_kThemeActiveDialogBackgroundBrush,_true)
setrect(sliderRect,40,31,65,320)
leftSliderH = fn 
newcontrol(wndPtr,sliderRect,"",_true,25,0,24,_kControlSliderProc+2,65536*30)
offsetrect(sliderRect,37,0)
rightSliderH = fn 
newcontrol(wndPtr,sliderRect,"",_true,25,0,24,_kControlSliderProc+6,65536*31)
button#35,_activeBtn,"Quit",(120,310)-(180,330),_shadow
setctlvalue(leftSliderH,sliderValue%)
setctlvalue(rightSliderH,sliderValue%)
edit$(1) = str$(sliderValue%)
window#1
END FN

local
dim factor% as int
local fn fillBox
pen ,,,,0'solid pattern
color _zRed
eraseRect(boxRect)'Erase old range
factor% = (sliderRect.bottom%-sliderRect.top%)/25'slider length/#tick marks
setrect(boxRect,66,sliderRect.bottom%-13-(sliderValue%*factor%),80,sliderRect.

bottom%-11)
paintrect(boxRect)'Draw new range
color _zBlack
setrect(frame,30,21,110,330)
framerect(frame)
end fn

local
dim evnt%
dim id%
dim err
LOCAL FN doDialog
evnt% = DIALOG(0)
id% = DIALOG(evnt)
SELECT evnt%
case _wndRefresh
fn fillBox
err = fn drawthemeedittextframe(#[tehandle(1)],_true)
case _btnClick
select id%
case 30'left Slider btn
sliderValue% = fn getctlvalue(leftSliderH)
fn fillBox
edit$(1) = str$(sliderValue%)
scroll button#31,sliderValue%'reset right Slider
case 31'right Slider btn
sliderValue% = fn getctlvalue(rightSliderH)
fn fillBox
edit$(1) = str$(sliderValue%)
scroll button#30,sliderValue%'reset left Slider
case 35
end
end select
CASE _wndClose
END
END SELECT
END FN

sliderValue% = 15
FN buildWnd
ON DIALOG FN doDialog
DO
HANDLEEVENTS
UNTIL 0

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

Toolboxes require "CALL" should not be checked (Edit/Preferences/Compiler).

Steve Van Voorst