7m…ôcUÄ+\cdá«rem Toolbar app using z:\System\Opl\Toolbar.opoINCLUDE "system.oxh"INCLUDE "const.oph"INCLUDE "toolbar.oph"rem !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!rem !!! IMPORTANT W A R N I N G !!!rem !!! The following UID has been reserved for the Skeleton app !!!rem !!! Don't use it for your own app - it will cause serious problems !!!rem !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!rem The UID and name defined here must be changed to your own official UIDrem before use in your own application.rem Not changing it will result in incorrect identification of your applicationrem and of its documents by the System screen and by other system components.rem Each application requires its own unique identifier (UID) - contact Psionrem to reserve a set of UIDs for use in your applications.rem Official UIDs have values greater than &10000000rem !!! Change this UID and this nameconst KUidOplSkeletonApp&=&100002C4const KAppName$="SkelOpl"APP SkelOpl,KUidOplSkeletonApp& ICON "z:\System\Opl\SkelOpl.mbm" CAPTION KAppName$,KLangEnglish% FLAGS 1ENDAconst KNoBorderTbarButton%=1const KBorderTbarButton%=2proc main: rem app specific variables global ScrWid% rem pixel width initially global ScrHght% rem pixel height initially global MenuPos% rem last menu position if KUidOplSkeletonApp&=&100002C4 if KAppName$<>"SkelOpl" alert("The UID &"+hex$(KUidOplSkeletonApp&)+" has been reserved", "You need to reserve your own through Psion") rem The UID defined above must be changed. Not changing it will result in incorrect identification of your application rem and of its documents by the System screen and by other system components. stop endif endif rem must be done before TBarInit: ScrWid%=gWidth ScrHght%=gHeight loadm "z:\system\opl\Toolbar" TBarLink:("AppCont1") rem 'links' toolbar globals and then calls AppCont1 rem TBarLink: calls AppCont1: rem Control does not return to hereendpproc AppCont1: rem Continue from toolbar link TBarLink: global wIdMain% rem main window global HasBord% rem -1 if has border local justEntered% rem next drawing not relative to prev point rem For portability with Sibo global HotKMod% rem modifier for hot-key rem Psion-key on sibo rem Control-key on era global ExitHK% rem Hot-key for exit command rem Event data global event&(16),evType& appInit: rem also initialises TBar + draws it do rem main loop nextEv%: evType&=event&(KEvaType%) gUse wIdMain% if event&(KEvAPtrOplWindowId%)=widMain% if (evType&=KEvPtrEnter&) justEntered%=KTrue% rem next drawing is not relative to prev point continue endif endif if evType&=KEvPtr& if event&(KEvAPtrType%)=KEvPtrDrag& if justEntered% gAt event&(KEvAPtrScreenPosX%),event&(KEvAPtrScreenPosY%) justEntered%=KFalse% endif gLineTo event&(KEvAPtrScreenPosX%),event&(KEvAPtrScreenPosY%)  elseif event&(KEvAPtrType%)=KEvPtrButton1Down& justEntered%=KFalse% gAt event&(KEvAPtrScreenPosX%),event&(KEvAPtrScreenPosY%) gLineBy 0,0 endif else if event&(KEvaType%) and &400 if (evType&<>KEvKeyUp&) and (evType&<>KEvKeyDown&) print "Ev(&"+hex$(event&(KEvaType%));")", endif elseif (event&(KEvaType%)<32 or event&(KEvaType%)>255) print "<";event&(KEvaType%);">"; else print chr$(event&(KEvaType%)); endif endif until 0endpproc appInit: rem set up globals wIdMain%=1 rem Just use console for now HasBord%=-1 gUpdate off gSetPenWidth 2  HotKMod%=4 rem Control-key ExitHK%=%e rem e on Series 5 rem Exit hot-key must be set up before toolbar initTBar: rem create toolbar and show it startScreen: getEvent32 event&() gcls ProcessCmdLine: Border: at 1,1endpproc startScreen: rem set up your main window gUse wIdMain%rem cursor wIdMain%,10,2,12 gTMode 3 rem Replace textrem screen 80,18,2,2 gfont 11 gAt 4,16 gPrint "This sample Opl program shows how to develop OPL32 applications that support a" gAt 4,gY+16 gPrint "menu, a toolbar and pen events. As with all other OPL sample releases, it has been" gAt 4,gY+16 gPrint "written for use by potential OPL32 developers who already know OPL16 or who have" gAt 4,gY+16 gPrint "access to an OPL16 programming manual. The source code has been provided so" gAt 4,gY+16 gPrint "that you can find out how to implement new or changed OPL features. This program" gAt 4,gY+16 gPrint "uses the module TOOLBAR.OPO which provides all the procedures required for" gAt 4,gY+16 gPrint "toolbar support on Series 5. Run TOOLBAR.OPO itself for some help on usage." gAt 4,gY+32 gPrint "This program also provides a typical OPL event loop, using GETEVENT32 to get pen" gAt 4,gY+16 gPrint "and other events which are either used by the toolbar, for a menu command or" gAt 4,gY+16 gPrint "passed to the application for its specific use." gAt 4, gY+32 gPrint "For further details on porting to OPL32, see the manual." gAt 0,0 gBox gWidth, gHeight gSetPenWidth 2 endpproc initTBar: TBarInit:("TBAR",ScrWid%,ScrHght%) TBarButt:("n",KNoBorderTbarButton%,"No"+chr$(10)+"border",0,&0,&0,KTbFlgLatchStart%) TBarButt:("b",KBorderTbarButton%,"Border",0,&0,&0,KTbFlgLatchEnd% or KTbFlgLatched%) TBarButt:("s",3,"Save"+chr$(10)+"file",0,&0,&0,KTbFlgCmdOnPtrDown%) TBarButt:(chr$(ExitHK%),4,"Close",0,&0,&0,0) TBarShow:endpproc nextEv%: rem Handles menu and toolbar events local evType&,command$(255),cmdLetter$(1) while 1 GetEvent32 event&() evType&=event&(KEvaType%) if evType&=KEvCommand& command$=getcmd$ cmdLetter$=left$(command$,1) command$=right$(command$,len(command$)-1) if cmdLetter$="X" cmdE%: elseif cmdLetter$="O" openFile:(command$) elseif cmdLetter$="C" createFile:(command$) endif elseif evType&=KEvPtr& if not TBarOffer%:(event&(KEvAPtrOplWindowId%),event&(KEvAPtrType%),event&(KEvAPtrPositionX%),event&(KEvAPtrPositionY%)) rem Handles tbar events break endif elseif evType&=KEvPtrEnter& and (event&(KEvAPtrOplWindowId%)=wIdMain%) break elseif evType&=0 rem Null event continue elseif (evType&=KKeySidebarMenu%) or ((evType& and $400)=0) if (evType&<>KKeySidebarMenu%) and (evType&<>KKeyMenu%) and ((event&(KEvAKMod%) and HotKMod%)=0) break endif if not offrCmd%:(event&(KEvaType%),event&(KEvAKMod%)) rem ret -1 if command, else 0 break endif endif endwhendpproc cmdTbDownS%: local pop%  rem popup next to button with point specifying the top right corner of the popup pop%=mPopup(ScrWid%-TbWidth%,97,KMPopupPosTopRight%,"Save",%s,"Save as"+chr$(KScreenEllipsis%),%S) if pop% if pop%=%s cmdS%: else cmdsS%: endif endifendpproc processCmdLine: local file$(255),command$(1) command$=cmd$(3) if command$="R" file$=GetLastUsedFile$:(KUidOplSkeletonApp&) if file$<>"" and exist(file$) openFile:(file$) return endif if exist(cmd$(2)) command$="O" else command$="C" endif endif file$=cmd$(2) if command$="O" openFile:(file$) elseif command$="C" createFile:(file$) endifendpproc openFile:(file$) local b%,w%,h% setdoc file$ b%=gloadbit(file$,0,0) w%=gWidth h%=gHeight gUse wIdMain% gCopy b%,0,0,w%,h%,3  gClose b% UpdateTBarTitle:endpproc createFile:(file$) trap delete file$ setdoc file$ UpdateTBarTitle:endpproc UpdateTBarTitle: local off%(6),file$(255) file$=getdoc$ file$=parse$(file$,"",off%()) TBarSetTitle:(right$(file$,len(file$)-off%(4)+1))endp proc border: gSetPenWidth 1 gBorder 0 gSetPenWidth 2endp proc cmdS%: gSaveBit getDoc$endpproc cmdsS%: local f$(255),offset%(6) f$=getDoc$ f$=parse$(f$,"",offset%()) f$=left$(f$,offset%(4)-1) rem Just the drive and path f$=SaveAsFileDialog$:(f$,#0) if len(f$)>0 setDoc f$ gSaveBit f$ UpdateTBarTitle: endif endpproc cmdC%: local x%,y% gUse wIdMain% x%=gX y%=gY gcls cls if HasBord% border: endif gAt x%,y%endpproc cmdN%: gUse wIdMain% if HasBord% TBarLatch:(KNoBorderTbarButton%) HasBord%=0 gGMode 2 rem invert border: gGMode 0 rem set endifendpproc cmdB%: gUse wIdMain% if HasBord%=0 TBarLatch:(KBorderTbarButton%) HasBord%=-1 border: endifendpproc cmdT%: if TbVis% TBarHide: else TBarShow: endifrem if autoSz%rem doMnSz%:rem endifendpproc cmdX%: if ExitHK%=%x stop endif rem If %x on S5 defined, do it here raise -99 rem procedure not foundendpproc cmdE%: rem Always saves cmdS%: SetLastUsedFile%:(getdoc$,KUidOplSkeletonApp&) if ExitHK%=%e stop endif rem If %e on sibo defined, do it here raise -99 rem procedure not foundendpproc offrCmd%:(key&,modif&) rem Returns -1 if command (menu or hot-key) rem also -1 if menu-key and cancelled local isMenuK% local m%,k%,cmdRoot$(4) local mod% local hotK% mod%=modif& k%=key& if (k%=KKeyMenu%) or (k%=KKeySidebarMenu%) isMenuK%=-1 mInit mCard "File","Save",%s,"Save as"+chr$(KScreenEllipsis%),%S,"Close",ExitHK% mCard "View","Show toolbar",%t or TbMenuSym%,"Clear screen",-%c,"Border",%b,"No border",%n m%=menu(MenuPos%) if m% hotK%=m% mod%=HotKMod% rem convert to accelerator if hotK%<=%Z mod%=mod% or 2 rem Shift endif else return -1 endif else rem not menu key hotK%=k%-1+%a rem Control+a/A -> 1 endif if mod% and HotKMod% rem Hotkey modif, so maybe accelerator cmdRoot$="cmd" if mod% and 2 cmdRoot$="cmds" endif rem print "call ";cmdRoot$+chr$(hotK%),hotK% onerr eNotCmd @%(cmdRoot$+chr$(hotK%)): return -1 endifeNotCmd:: if isMenuK% or err<>-99 giprint "Bug: Proc "+cmdRoot$+chr$(hotK%)+"%:,"+err$(err) return -1 endif return 0endpproc OpenIniFile%:(AppUid&) local IniFile$(255),IniExt$(4),offset%(6) local handle%,ret%,uidType$(16) IniExt$=".ini" IniFile$=parse$(IniExt$,Cmd$(1),offset%()) if exist(IniFile$) ret%=ioopen(handle%,IniFile$,$0300) if ret% if ret%=-39 rem Access denied return ret% else goto replace:: endif endif ret%=ioread(handle%,addr(uidType$)+1,16) if ret%<>16 :goto replace:: :endif pokeb addr(uidType$),16 if (uidType$<>CheckUid$:(0,0,AppUid&)) goto replace:: endif return handle%replace:: ioclose(handle%) endif ret%=ioopen(handle%,IniFile$,$0302) if ret% :return ret% :endif uidType$=CheckUid$:(0,0,AppUid&) ret%=iowrite(handle%,addr(uidType$)+1,16) if ret% ioclose(handle%) return ret% endif return handle%endpproc SetLastUsedFile%:(FileName$,AppUid&) local f$(255),handle%,ret% f$=FileName$ handle%=OpenIniFile%:(AppUid&) if handle%<0 return handle% endif ret%=iowrite(handle%,addr(f$),256) ioclose(handle%) return ret%endp proc GetLastUsedFile$:(AppUid&) local f$(255),handle%,ret% handle%=OpenIniFile%:(AppUid&) if handle%<0 return "" endif ret%=ioread(handle%,addr(f$),256) ioclose(handle%) if ret%<>256 return "" endif return f$endpÐР   \c+efd\c&+efdý‚.ÆA…*TEXTED.app….+‰µ+