TMGWSBR1 ;TMG/kst/OO Scroll Bar ;05/10/07 ;;1.0;TMG-LIB;**1**;05/10/07 ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"------------------------------------------ ;"Object oriented window object setup code below ;"------------------------------------------ Constructor(instanceName) ;"Module MUST have 'Constructor' procedure ;"Purpose -- A constructor for object Window ;"Input: instanceName -- the NAME of the type of the object to be defined. ;" This should be a variable (global or otherwise) of the object. ;"Note: This function should NOT be called directly, but instead is called ;" via new^TMGOOL ;"Result: none <--- REQUIRED TO NOT RETURN A RESULT ;"Here we define the default values for vars and functions. ;"----------------All constructors should copy this format -------------------- new TMGthis set TMGthis=instanceName do inheritFrom^TMGOOL(instanceName,"TMGWGOJ") ;"--------------------------------------------------------- ;"register PROCEDURES/FUNCTIONS do regFn^TMGOOL(TMGthis,"PAINT","Paint^TMGWSBR1()") ;"--------------------------------------------------------- ;"Register Event Handlers do regEvent^TMGOOL(TMGthis,"CLICK","HandleClick^TMGWSBR1(LOC)") ;"override ;"--------------------------------------------------------------------- ;"Register Properties do regProp^TMGOOL(TMGthis,"MAX VALUE",100,"setMax^TMGWSBR1") ;" do regProp^TMGOOL(TMGthis,"MIN VALUE",0,"setMin^TMGWSBR1") ;" do regProp^TMGOOL(TMGthis,"VALUE",50,"setValue^TMGWSBR1") ;" do regProp^TMGOOL(TMGthis,"PERCENT",50,"setPercent^TMGWSBR1") ;" do regProp^TMGOOL(TMGthis,"ORIENTATION","H") ;"[H]ORIZ VS. [V]ERT ;"-------------------------------------------------------------------------------- ;"Optional initialization of some instance-specific variables. ;"-------------------------------------------------------------------------------- ;"Startup code here... quit Destructor(instanceName) ;"Module MUST have 'Destructor' procedure ;"Purpose: A destructor for object Widget ;" any needed clean up code would go here first. ;"Input: instanceName -- the name of the object instance to be deleted. ;" This should be the value returned from defWidget ;"Note: Don't actually delete the object here. Just perform code needed to ;" save the object variables etc. Anything neeed before the object ;" is deleted by delete^TMGOOL ;"----------------- ;" Here I would put code that needs to be called before destruction of the object. ;"----------------- quit ;"------------------------------------------ ;"Object member functions below ;"------------------------------------------ ;"Note: A variable (with global scope) TMGthis is available as a 'this' pointer (this instance) ;"Note: ALL members must have QUIT xx (even if xx is meaningless, as in a procedure) Paint() ;"Purpose: To paint the scroolbar ;"Input: instanceName -- the name/ref of this instance new T,L,B,R,H,W,LOC new scrap set scrap=$$getProp^TMGOOL(TMGthis,"LOC",.LOC) do proc^TMGOOL(TMGthis,"CONVERT TO FRAME",.LOC,"SCREEN") set T=+$get(LOC("TOP")),L=+$get(LOC("LEFT")) set B=+$get(LOC("BOTTOM")),R=+$get(LOC("RIGHT")) set H=+$get(LOC("HEIGHT")),W=+$get(LOC("WIDTH")) new o set o=$$getProp^TMGOOL(TMGthis,"ORIENTATION") new pct set pct=$$getProp^TMGOOL(TMGthis,"PERCENT") new len set len=$select(o="H":(W),1:(H)) set len=len-1 ;"avoid overlap in bottom-right corner. new tempS set tempS=$$getDispS(len,o,pct) if o="H" do SAY^TMGXGF(T,L,tempS) else do VSAY^TMGXGF(T,L,tempS) do setProp^TMGOOL(TMGthis,"NEEDS REPAINT",0) ;"flag as painted. quit 0 ;"------------------------------------------ ;"Property Getters & Setters below ;"------------------------------------------ setMax(TMGthis,PropName,value) ;"Purpose: to set MAX value possible for scroll bar ;"Input: TMGthis -- a this pointer for properter setter. ;" PropName -- the name of the property -- not used here ;" value -- value to set set @TMGthis@("PROP","MAX")=$get(value) do setActualPct quit ;"<-- required not return value for property setter. setMin(TMGthis,PropName,value) ;"Purpose: to set MIN value possible for scroll bar ;"Input: TMGthis -- a this pointer for properter setter. ;" PropName -- the name of the property -- not used here ;" value -- value to set set @TMGthis@("PROP","MIN")=$get(value) do setActualPct quit ;"<-- required not return value for property setter. setValue(TMGthis,PropName,value) ;"Purpose: to set value for scroll bar ;"Input: TMGthis -- a this pointer for properter setter. ;" PropName -- the name of the property -- not used here ;" value -- value to set new max,min set max=$get(@TMGthis@("PROP","MAX")) set min=$get(@TMGthis@("PROP","MIN")) set value=+$get(value) if (value'>max)&(value'100 set pct=100 else if pct<0 set pct=0 new range set range=max-min new value set value=(range*(pct/100))+min set @TMGthis@("PROP","VALUE")=value set @TMGthis@("PROP","PERCENT")=pct quit ;"<-- required not return value for property setter. setOrient(TMGthis,PropName,value) ;"Purpose: to set percent value for scroll bar ;"Input: TMGthis -- a this pointer for properter setter. ;" PropName -- the name of the property -- not used here ;" pct -- value to set: expected input="H" or "V" set value=$$UP^XLFSTR($extract(value,1)) if (value="H")!(value="V") set @TMGthis@("PROP","ORIENTATION")=value quit ;"<-- required not return value for property setter. ;"------------------------------------------ ;"Event handlers below ;"------------------------------------------ HandleClick(LOC) ;"Purpose: do something here with a mouse click. Note: descendents can ;" overwrite this function to customize their control. ;"Input: LOC -- PASS BY REFERNCE. Expected input format: ;" coordinates in LOCAL frame of refeernces. ;" LOC("TOP")= ;" LOC("LEFT")= ;" LOC("HEIGHT")= ;"optional ;" LOC("WIDTH")= ;"optional ;" LOC("BOTTOM")= ;"optional ;" LOC("RIGHT")= ;"optional ;"Note: It has already been determined that the click belongs to this window ;" (and not a child of this window), so it should be handled here.) ;"Click belongs to this window, so handle it. ;"Put default click handler code here... do proc^TMGOOL(TMGthis,"CONVERT TO FRAME",.LOC,TMGthis) ;"ensure coordinates in TMGthis's frame new L set L=$get(LOC("LEFT")) new T set T=$get(LOC("TOP")) new orient set orient=$$getProp^TMGOOL(TMGthis,"ORIENTATION") if orient="H" do . new W set W=$$getProp^TMGOOL(TMGthis,"WIDTH") . if L=0 do scrlMinus(1) . ;"For line below: why W-2? . ;" A: numbering starts at 0, so W seems 1 too long . ;" then subtract another 1 to avoid overlap with Vscroll bar . else if L=(W-2) do scrlPlus(1) . else do . . new pos set pos=$$getMrkPos() . . if Lpos do scrlPRight else if orient="V" do . new H set H=$$getProp^TMGOOL(TMGthis,"HEIGHT") . if T=0 do scrlMinus(1) . ;"For line below: why H-1? . ;" A: numbering starts at 0, so H seems 1 too long . ;" no need to subtract another 1 re overlap, because Vscroller has corner . else if T=(H-2) do scrlPlus(1) . else do . . new pos set pos=$$getMrkPos() . . if Tpos do scrlPDown HCDone quit ;"<-- required: NO return value for event handler ;"------------------------------------------ ;"Private functions below ;"------------------------------------------ getMrkPos() ;"Purpose: to get the graphical position of the marker on ;" the scroll bar. new o set o=$$getProp^TMGOOL(TMGthis,"ORIENTATION") new pct set pct=$$getProp^TMGOOL(TMGthis,"PERCENT") new len set len=$select(o="H":(W),1:(H)) set len=len-1 ;"avoid overlap in bottom-right corner. new tempS set tempS=$$getDispS(len,o,pct) new s set s=$piece(tempS,"*",1) quit $length(s) scrlPLeft ;"Purpose: to handle a request to scroll a page to the left new W set W=$$getProp^TMGOOL(TMGthis,"WIDTH") do scrlMinus(W) quit scrlPRight ;"Purpose: to handle a request to scroll a page to the left new W set W=$$getProp^TMGOOL(TMGthis,"WIDTH") do scrlPlus(W) quit scrlPUp ;"Purpose: to handle a request to scroll a page to the left new H set H=$$getProp^TMGOOL(TMGthis,"HEIGHT") do scrlMinus(H) quit scrlPDown ;"Purpose: to handle a request to scroll a page to the left new H set H=$$getProp^TMGOOL(TMGthis,"HEIGHT") do scrlPlus(H) quit scrlMinus(num) ;"Purpose: to handle a request to scroll to the minus direction (left, or up) new value set value=$$getProp^TMGOOL(TMGthis,"VALUE") set value=value-num do setProp^TMGOOL(TMGthis,"VALUE",value) quit scrlPlus(num) ;"Purpose: to handle a request to scroll to the plus direction (right or down) new value set value=$$getProp^TMGOOL(TMGthis,"VALUE") set value=value+num do setProp^TMGOOL(TMGthis,"VALUE",value) quit setActualPct ;"Purpose: to set the value of PERCENT to match current values new max,min,value set max=$get(@TMGthis@("PROP","MAX")) set min=$get(@TMGthis@("PROP","MIN")) set value=$get(@TMGthis@("PROP","VALUE")) new range set range=max-min new pos set pos=value-min new pct set pct=0 if range'=0 set pct=((pos/range)*100) set @TMGthis@("PROP","PERCENT")=pct quit getDispS(len,o,pct) ;"Purpose: get a string that represents the scroll bar ;" e.g. '<---#------>' ;" or if orientation is vertical: '^||||#|||v' ;"Input: len -- the total length of the string to be returned ;" o -- orientation: 'H' or 'V' ;" pct -- the percent position ;"results: returns string, or "" if length<3 new result set result="" set len=$get(len)-2 ;"shrink for arrows on ends if len'>0 goto gDSDone set o=$get(o,"H") set pct=+$get(pct) ;"if o="H" set len=len-1 ;"avoid overlap with HORIZ bar at the corner new bar ;"if o="V" set $piece(bar,$get(IOVL,"|"),len+2)=" " ;"else set $piece(bar,$get(IOHL,"-"),len+2)=" " if o="V" set $piece(bar,"|",len+2)=" " else set $piece(bar,"-",len+2)=" " new pre,post set pre=(len*pct\100),post=len-pre set result=result_$extract(bar,1,pre-1)_"*"_$extract(bar,1,post) if o="V" set result="^"_result_"v" else set result="<"_result_">" gDSDone quit result