toolbar.tpl

在手机操作系统symbina上使用的一个脚本扩展语言的代码实现,可以参考用于自己的开发

proc TBarLatch:(comp%)
	external TbBtFlags%(),TbCrCmp%
  local f%,fCur%,c%
  local found%

  fCur%=TbBtFlags%(comp%) and KTbFlgLatchMask%
  rem free others in set
  c%=comp%-1
  while c%>0
    f%=TbBtFlags%(c%) and KTbFlgLatchMask%
    rem KTbFlgLatchStart%<KTbFlgLatchMiddle%<KTbFlgLatchEnd%
    if (f%=0) or (f%>fCur%)
      break     rem reached start of set
    endif
    if f% and KTbFlgLatched%
      found%=-1
      break
    endif
    c%=c%-1
  endwh
  if not found%
    c%=comp%+1
    while c%<KTbNumButtons%
      f%=TbBtFlags%(c%) and KTbFlgLatchMask%
      rem KTbFlgLatchStart%<KTbFlgLatchMiddle%<KTbFlgLatchEnd%
      if (f%=0) or (f%<fCur%)
        break     rem reached end of set
      endif
      if f% and KTbFlgLatched%
        found%=-1
        break
      endif
      c%=c%+1
    endwh
  endif
  if found%
	  rem Unlatch currently latched one
	  TbCrCmp%=c%     rem TbBtChng: only changes current button
	  TbBtFlags%(c%)=TbBtFlags%(c%) and not KTbFlgLatched%
	  TbBtChng:(c%,0)
  endif
  rem and latch new one
  TbBtFlags%(comp%)=TbBtFlags%(comp%) or KTbFlgLatched%
  TbCrCmp%=comp%
  TBarRel:
  TbCrCmp%=0
endp

proc TBarBtDown:(comp%)
	external TbCrCmp%,TbBtFlags%(),TbPtrCapture%

	TbCrCmp%=comp%
	TbBtChng:(comp%,1)
	if TbBtFlags%(comp%) and KTbFlgCmdOnPtrDown%
		TBarDoCmd%:(comp%,"CmdTbDown")
		TbPtrCapture%=0
	endif
endp

proc TBarLink:(AppLink$)
	rem 'Links' toolbar globals into app.
	rem appLink$ is the name of the continuation
	rem procedure in the main app.

	rem Toolbar state variables
	global TbScrW%				rem fullscreen width: gWidth at startup
	global TbWinId%			rem toolbar win
	global TbVis%				rem true if visible
	global TbMenuSym%		rem check box symbol for show toolbar item
	global TbCrCmp%			rem current component
	global TbBtH%				rem button height
	global TbShortcut$(KTbNumButtons%,1)	rem associated shortcut-key
	global TbBtTxt$(KTbNumButtons%,20)		rem 20 enough?
	global TbBtBit&(KTbNumButtons%)
	global TbBtMsk&(KTbNumButtons%)
	global TbState%(KTbNumComps%)	rem pressed/released
	global TbBtFlags%(KTbNumButtons%)
	global TbHght%
	global TbWidth%
	global TbPtrCapture%	rem true when pointer captured by toolbar, only when toolbar has a pen down event
	global TbDefIcon%			rem default icon for buttons
	global TbWindowMode%		rem Window mode.
	global TbColor&(kTbNumColorItems%)	rem Toolbar item colors.
	
	TBarSetDefaultColor: rem For backwards compatibility.
	@(AppLink$):	rem link back to main app
endp

proc __doTbarInit:(name$,scrW%,scrH%,width%,winMode%)
	external TbWinId%,TbHght%,TbWidth%,TbBtH%
	external TbScrW%,TbScrH%
	external tbWindowMode%

	local orgId%
	
	if TbWinId%
		raise -1 rem Initialised already
	endif
	SetComputeMode:(KComputeModeOff&)
	orgId%=gIdentity
	rem non-consts
	TbScrW%=scrW%
	TbHght%=scrH%
	TbWidth%=width%
	TbBtH%=KTbBtH%
	tBWindowMode%=winMode%
	gUpdate off
	TbWinId%=gCreate(TbScrW%-TbWidth%,0,TbWidth%,TbHght%,0,tbWindowMode%) rem invisible
	TBarSetColorForeground:
	TBarSetColorBackground:
	gcls
	gBox gWidth,gHeight
	TBarSetTitle:(name$)
	gFont KTbFont&
	gstyle KTbStyle%
	gAt KTbClockPosX%,gHeight-KTbClockHeight%
	TBarSetColorBackground:
	gClock on,KTbClockType%
	gUse orgId%
endp

proc TBarInitNonStd:(name$,scrW%,scrH%,width%)
	local winMode%,Info&(48)
	gInfo32 info&()
	winMode%=info&(30)
	__doTBarInit:(name$,scrW%,scrH%,width%,winMode%)
endp

proc TBarInit:(name$,scrW%,scrH%)
	rem Creates invisible Toolbar window
	rem with title and clock. Buttons added later
	rem before window shown.
	rem Turns updating off
	local winMode%,Info&(48)
	gInfo32 info&()
	winMode%=info&(30)
	__doTBarInit:(name$,scrW%,scrH%,KTbWidth%,winMode%)
endp

proc TBarInitC:(name$,scrW%,scrH%,winMode%)
	rem Creates invisible Toolbar window
	rem with title and clock. Buttons added later
	rem before window shown.
	rem Turns updating off
	__doTBarInit:(name$,scrW%,scrH%,KTbWidth%,winMode%)
endp

proc TBarSetTitle:(title$)
	external TbWinId%,TbWidth%
	local align%
	local orgId%

	orgId%=gIdentity
	gUse TbWinId%
	gAt 1,KTbBtTop%-8
	gFont KTbTitleFont&
	gStyle 1
	align%=3	rem Centred by default
	if gTWidth(title$)>TbWidth%-2
		align%=2		rem left aligned if too long
	endif
	TBarSetColorForeground:
	TBarSetColorBackground:
	gPrintB title$,TbWidth%-2,align%,6,6,0
	gUse orgId%
endp

proc TBarButt:(shortCut$,pos%,text$,state%,bit&,mask&,flags%)
  rem Constructs a button at position pos%=1,2,3,4,5,6
  rem Draws button

  external TbWidth%,TbBtBit&(),TbBtMsk&(),TbWinId%,TbBtH%,TbShortcut$(),TbBtTxt$(),TbState%(),TbBtFlags%()
  external TbDefIcon%

  local y%
  local origTb% rem origin of toolbar window
  local fLatch%
  local st%     rem state depends on latching
  local orgWid%

  fLatch%=flags% and KTbFLgLatchMask%
  if fLatch% and KTbFlgLatchable%
    if (fLatch% and KTbFlgLatchPosMask%)=0
      raise -2  rem position must be provided
    endif
  endif
  orgWid%=gIdentity
  st%=state%
  if flags% and KTbFlgLatched%
    st%=st%+1
  endif
	if bit&=0		rem default bitmap
		if TbDefIcon%=0
			TbDefIcon%=gCreateBit(24,24) rem create it once and for all
			gCls
			gBorder 0
		endif
		TbBtBit&(pos%)=TbDefIcon%
		TbBtMsk&(pos%)=TbDefIcon%
	else
		TbBtBit&(pos%)=bit&
		TbBtMsk&(pos%)=mask&
	endif
	gUse TbWinId%
	gFont KTbFont&
	y%=KTbBtTop%+(pos%-1)*TbBtH% rem from top
	gAt KTbMarginX%,y%
	gButton text$,1,TbWidth%-2*KTbMarginX%,TbBtH%+1,st%,TbBtBit&(pos%),TbBtMsk&(pos%),KButtExcessToText%
	TbShortcut$(pos%)=shortCut$
	TbBtTxt$(pos%)=text$
	TbState%(pos%+2)=st%        rem title+clock 1st
	TbBtFlags%(pos%)=flags%
	gUse orgWid%
endp

proc TBarDoCmd%:(comp%,rootCmd$)
	external TbShortcut$(),TbCrCmp%
  local btShortcut$(1)
  local ret%

  btShortCut$=TbShortcut$(comp%)
	rem print " Button ";comp%,"up, shortcut=",btShortCut$
	if btShortCut$>"Z"
		ret%=@%(rootCmd$+btShortCut$):
	else
		ret%=@%(rootCmd$+"s"+btShortCut$):
	endif
  TBarRel:
	TbCrCmp%=0
	return ret%
endp

proc TBarCmd%:(comp%)
	TbBtChng:(comp%,0)
  return TBarDoCmd%:(comp%,"cmd")
endp

proc TBarShow:
	external TbVis%,TbCrCmp%,TbWinId%,TbMenuSym%
	local orgWId%

	orgWId%=gIdentity
	TbVis%=-1
	gUse TbWinId%
	gOrder gIdentity,1
	gVisible on
	TbCrCmp%=0
	TbMenuSym%=KMenuCheckBox% or KMenuSymbolOn%
	gUse orgWId%
endp

proc TBarHide:
	external TbVis%,TbCrCmp%,TbWinId%,TbMenuSym%
	local orgWId%

	orgWId%=gIdentity
	TbVis%=0
	gUse TbWinId%
	TBarRel:	
	gVisible off
	TbMenuSym%=KMenuCheckBox%
	gUse orgWId%
endp

proc TBarComp%:(x&,y&)
	rem x& is the y-co-ordinate of the event in tbar window
	rem y& is the y-co-ordinate of the event in tbar window
	rem Return the toolbar component
	rem Name->-1,Clock->-2,ButtonN->N (N=1 to KTbNumButtons%)
	rem Not in toolbar->0

	external TbWidth%,TbHght%,TbBtH%
	local comp%

	if x&<0 or x&>=TbWidth% or y&<0 or y&>=TbHght%
		return 0
	endif
	if y&<KTbBtTop%
		comp%=-1
	elseif y&>=TbHght%-KTbClockSize%
		comp%=-2
	else
		comp%=1+(y&-KTbBtTop%)/TbBtH%
		if comp%>KTbNumButtons% rem extra pixels in clock?
			comp%=-2
		endif
	endif
	return comp%
endp

proc TBarSetDefaultColor:
	external TbColor&()
	TbColor&(KTbColorItemForeground%)=KRgbBlack&
	TbColor&(KTbColorItemBackground%)=KRgbWhite&
endp

proc TBarColor:(fgR%,fgG%,fgB%,bgR%,bgG%,bgB%)
	external TbColor&()
	TbColor&(1)=fgR%*kRgbRedPosition&+fgG%*kRgbGreenPosition&+fgB%
	TbColor&(2)=bgR%*kRgbRedPosition&+bgG%*kRgbGreenPosition&+bgB%
endp

proc TBarSetColorForeground:
	external TbColor&()
	local rgb&,red%,green%,blue%
	rgb&=TbColor&(kTbColorItemForeground%)
	red%=rgb&/kRgbRedPosition& AND kRgbColorMask&
	green%=rgb&/kRgbGreenPosition& AND kRgbColorMask&
	blue%=rgb& AND kRgbColorMask&
	gcolor red%,green%,blue%
endp

proc TBarSetColorBackground:
	external TbColor&()
	local rgb&,red%,green%,blue%
	rgb&=TbColor&(KTbColorItemBackground%)
	red%=rgb&/kRgbRedPosition& AND kRgbColorMask&
	green%=rgb&/kRgbGreenPosition& AND kRgbColorMask&
	blue%=rgb& AND kRgbColorMask&
	gcolorbackground red%,green%,blue%
endp


rem End of Toolbar module