oplsamp.tpl

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

		gOrder gIdentity,1 rem random to front
rem		orgK%=key
rem		if orgK%
rem			if orgK%=27
rem				break
rem			endif
rem			pause%=doPause%:(orgK%,pause%)
rem			if pause%
rem				busy "Pause count="+num$(pause%,5)
rem			else
rem				busy "No pause"
rem			endif
rem		endif
rem		if pause%
rem			pause pause%
rem		endif
		if ((gOriginX+gWidth)>scrW%) or ((gOriginY+gHeight)>scrH%)
			gUse 1
			gCls
			print "Window",curWid%,"won"
			print "Press a key to continue..."
			busy off
			get		
			break
		endif
		gInvert gWidth-6,gHeight-6
		gat 0,0
	endwh
	i%=0
	while i%<cnt%
		i%=i%+1
		gclose wId%(i%)
	endwh	
	gcls
	busy off
	gUpdate on
endp


proc nyi:
	giprint "Not yet implemented"
endp

proc cmdr%:
	rem random number generation test
	local seed&
	local margX%,margY%
	local loops&,i&
	local min%,max%,minBox%,maxBox%
	local boxes&,box(1000),ix%,avgCnt&,boxW%
	boxes&=460
	avgCnt&=10 rem average in each box

	gUpdate off
	margX%=10
	margY%=10
	dInit "Enter seed for random numbers"
		dLong seed&,"Seed",0,&7fffffff
		dLong boxes&,"Number of boxes",2,gWidth-2*margX%
		dLong avgCnt&,"Average number per box",1,110
	if dialog=0
		return
	endif
	loops&=boxes&*avgCnt&
	boxW%=(gWidth-2*margX%)/boxes&
	if boxW%<=0
		boxW%=1
	endif
	gAt margX%,gHeight-margY%
	gLineBy gWidth,0
	gMove -gWidth,0
	gLineBy 0,-gHeight
	while i&<loops&
		i&=i&+1
		ix%=rnd*boxes&+1
		box(ix%)=box(ix%)+1
		gAt (ix%-1)*boxW%+margX%,gHeight-margY%-box(ix%)
		gLineBy boxW%,0
		if boxW%>2
			if box(ix%)<>1
				gMove -1,1
				gGMode 1
				gLineBy -boxW%+2,0
				gGMode 0
			endif
		endif
		if key=27
			break
		endif
	endwh
	gUpdate on
	rem beep 3,500
	giprint "Finished"
	gAt margX%+5,15
	min%=min(box(),boxes&)
	max%=max(box(),boxes&)
	ix%=0
	minBox%=0
	maxBox%=0
	while ix%<boxes& and (minBox%=0 or maxBox%=0)
		ix%=ix%+1
		if box(ix%)=min%
			minBox%=ix%
		elseif box(ix%)=max%
			maxBox%=ix%
		endif		
	endwh
	gPrint "Max=";max%;" (box";maxBox%;"), "
	gPrint "Min=";min%;" (box";minBox%;"), "
	gPrint "Std=";fix$(std(box(),boxes&),2,10)
	gat margX%+boxW%*(maxBox%-1),gHeight-margY%+2
	glineby boxW%,0
	gat margX%+boxW%*(minBox%-1),gHeight-margY%+2
	glineby boxW%,0
	get
endp

proc init:
	onOpl1993%=exist("rom::sys$prgo.img")

	rem Initialise globals for shell command
	rem to create new cmd(2) - defaults

	if not onOpl1993%
		Col1$="Name"
		Col2$="Address"
		Col3$="ID"
		Tab$="Table1"
	endif
	screenInfo scrInfo%() rem save for restoring
	scrW%=gWidth
	scrH%=gHeight
endp

proc doCmd:
	rem Show  and handle the command line
	local cnt%,i%

	cnt%=5	
	if not OnOpl1993%
		rem only 3 command components on S5
		cnt%=3
	endif
	
	while i%<cnt%
		at 10,7+i%
		i%=i%+1
		print "cmd$(";i%;")=";cmd$(i%)
	endwh
	Db$=cmd$(2)
	if cmd$(3)="O"
		sqlO$=Db$
		if not OnOpl1993%
			rem full DBMS SQL query of any kind allowed on ER1
			sqlO$=sqlO$+" SELECT "+Col1$+","+Col2$+","+Col3$+" FROM "+Tab$
		endif
		trap open sqlO$,a,name$,address$,id%
	elseif cmd$(3)="C"
		sqlC$=Db$
		Tab$="Table1"
		doCreate:(-1)	rem Create from cmdLine
	endif
endp

proc doCreate:(cmdLine%)
	do
		dInit "Create Database table"
			dPosition 0,1
			if cmdLine%
				dText "Database",Db$
			else
				dEdit Db$,"Database",20
			endif
			if not OnOpl1993%
				dEdit Tab$,"Table name",20
			endif
		if (dialog=0) and (tab$="")
			if cmdLine%
				giprint "Table name required"
				pause 20
				stop
			endif
		endif
		sqlC$=Db$
		if not OnOpl1993%
			sqlC$=sqlC$+" FIELDS Name,Address,ID TO "+Tab$
		endif
		trap create sqlC$,a,name$,add$,id%
		if err
			dInit "Error creating table"
				dText "SQL query",SqlC$
				dText "",err$(err)
				dButtons "&Exit app",%e,"&Retry",%r
			if dialog=%e
				stop
			endif
		endif
	until err=0
endp

rem ====================================

proc cmdsD%:
  rem DBMS demo

  local choice%
  local c%,d%,str$(16),n$(3)
  global type$(4,16),typ$(4,1),ty$(4,1)
  global file$(24),table$(24),field1$(16),field1%,field2$(16),field2%
  setdbvar:

  dinit "SQL in OPL32 databases"
  dtext "","A database in OPL32 can contain one or more 'TABLES'. ",2
  dtext"","A table contains records (a collection of fields).",2
  dtext"","This demo will show you how to create a database with 1 table and 2 fields",2
  dtext"","Edit the following boxes as desired.",2
  dedit file$,"File name: "
  dedit table$,"Table name: "
  dButtons "quit",27,"continue",13

  if dialog=0
    return
  endif

  dinit  "Demo of creating a database with 1 table and 2 fields"
  dtext"","A record is a collection of different fields: ",2
  dedit field1$,"Name of 1st  field: "
  dchoice field1%,"Type  of 1st  field: ",type$(1)+","+type$(2)+","+type$(3)+","+type$(4)
  dedit field2$,"Name of 2nd  field: "
  dchoice field2%,"Type of 2nd field: ",type$(1)+","+type$(2)+","+type$(3)+","+type$(4)
  dButtons "quit",27,"continue",13

  if dialog=0
    return
  endif

  dinit  "Demo of creating a database with 1 table and 2 fields"
  dtext"","You have chosen to create a table called '"+table$+"'",2
  dtext"","in a data file called '"+file$+"'.",2
  dtext"","Records in this table will contain 2 fields;",2
  dtext"","'"+field1$+"' of type "+type$(field1%)+" and '"+field2$+"' of type "+type$(field2%)+".",2
  dtext"","To create this in OPL32 the command is:",2
  dtext""," ",2
  dtext"","CREATE """+file$+" FIELDS "+field1$+","+field2$+" TO " +table$+""",A,F1"+typ$(field1%)+",F2"+typ$(field2%),$102

  dButtons "quit",27,"continue",13

  if dialog=0
    return
  endif

  dinit "CREATE """+file$+" FIELDS "+field1$+","+field2$+" TO " +table$+""",A,F1"+typ$(field1%)+",F2"+typ$(field2%)
  dtext"","The string in quotes is the 'SQL query', the letter A is the 'logical view name'",2
  dtext"","F1"+typ$(field1%)+" and F2"+typ$(field2%)+" are the field handles,",2
  dtext"","they refer to '"+field1$+"' and '"+field2$+"' respecively.",2
  dtext"","The symbols "+typ$(field1%)+" and "+typ$(field2%)+" indicate the types of these fields",2
  dtext""," ",2
  dtext"","This will create "+file$+" if does not already exist and add "+table$+" to it",2
  dtext"","The created 'view' will be left opened and the logical view name refers to it.",2
  dButtons "quit",27,"continue",13

  if dialog=0
    return
  endif

  dinit "Compatability with Opl1993 OPL syntax"
  dtext"","If the command given was CREATE """+file$+""",A,F1"+typ$(field1%)+",F2"+typ$(field2%),2
  dtext"","file '"+file$+"' is created if necessary and a table called 'TABLE1' added.",2
  dtext"","The field names are derived from the field handles.",2
  dtext""," The type indicators %, $ and amphresand are changed to i, s and a respectively,",2
  dtext""," in this example: 'TABLE1' will have fields called 'F1"+ty$(field1%)+"' and 'F2"+ty$(field2%)+"'.",2
  dButtons "quit",27,"continue",13

  if dialog=0
    return
  endif

  dinit"Examples of other uses of SQL in OPL32"
    dtext"", "OPEN """+file$+" SELECT "+field1$+","+field2$+" FROM " +table$+""",A,fld1"+typ$(field1%)+",fld"+typ$(field2%),2
    dtext"","opens a view on the '"+table$+"' table with access ",2
    dtext"","to just the fields specified between the words SELECT and FROM.",2
    dtext"","The field handles aren't significant but their type indicators are checked.",2
    dtext""," ",2
    dtext"... SELECT * FROM ...","selects all the fields from the table.",2
    dButtons "quit",27,"last page",13

  if dialog=0
    return
  endif

  dinit "SQL   continued"
  dtext"","SELECT * FROM "+table$+" ORDER BY "+field1$+" ASC"",A,F1"+typ$(field1%),2
  dtext"","Opens an ordered view on the table with access to all the fields",2
  dtext""," in each record. The view is ordered using the '"+field1$+"' field values.",2
  dtext"","The order can be alphanmuerically ASCending or DESCending",2
  dtext""," ",2
  dtext"","To do this an index will need to be created first (on the '"+field1$+"' field first).",2
  dtext"","This is done with the relevant OPX function - see Dbase OPX demo.",2
  dbuttons "FINISH",%F
  dialog

endp

proc cmdi%:
  rem DBASE OPX DBMS index file demo
  local path$(32),choice%,app%,key&(3)
  local c%,d%,str$(16),n$(3)

  path$="c:\opl\"
	trap mkdir path$
  trap delete path$+"dbsmp.dbf"
  create path$+"dbsmp.dbf",a, string$

  close
Again::
  open path$+"dbsmp.dbf",a, string$


  while 1

    dinit "DBMS demonstation"
    if c%=0
      dtext"","An empty database has been created for you.",2
      dtext" "," ",2
      dtext"","Add some records to it ",2
    else
      n$=Num$(count,3)
      dtext "You have "+n$+" records(S)","Add another record ?.",2
    endif
    str$=""
    dedit str$,"Record: "
    dText""," ",2
    dText "","The 'Append' button will add this string field to the database",$202

    dButtons  "Append",9,"Finished",13

    if dialog=13
      break
    else
      a.string$=str$
      append
    endif
    c%=c%+1
  endwh
  if count=0
    close
    return
  endif

rem  close
  if app%=0

    key&(1)=DbNewKey&:
    DbAddFieldTrunc:(key&(1),"strings",0,8)
    DbCreateIndex:("indexa",key&(1),path$+"Dbsmp.dbf","table1")
    key&(2)=DbNewKey&:
    DbAddFieldTrunc:(key&(2),"strings",1,8)
    DbCreateIndex:("indexb",key&(2),path$+"Dbsmp.dbf","table1")

    app%=app%+1
  endif
  while 1
    choice%=1
    dinit "Display Records"
      dtext"","Choose how to order the records that you've just entered",2
      dchoice choice%,"Sort order:","Alphabetically, reverse alphabetically, as entered, reverse as entered"
      dtext""," ",2
      dtext"","An index will be created using 'CreateIndex' OPX function",2
      dtext""," ",2
      dButtons "quit",-27,"append more",9,"display",13
    d%=dialog
    if d%=0
      break
    endif
    if d%=9
      goto Again
    endif
    vector choice%
    	c1,c2,c3,c4
    endv
    while 0
c1::
  	  open path$+"Dbsmp.dbf SELECT strings FROM table1 ORDER BY strings ASC",A,string$
    	break
c2::
    	open path$+"Dbsmp.dbf SELECT strings FROM table1 ORDER BY strings DESC",A,string$
    	break
c3::
c4::
    	open path$+"Dbsmp.dbf",a,string$
    	if choice%=4
	      last
    	endif
    endwh
    cls
    c%=0

    while c%<count
      if c%/17*17=c% and c%<>0
        print"                                     More  :  press any key"
        get
      endif
      print " ", a.string$
      if choice%=4
        back
      else
        next
      endif
      c%=c%+1
    endwh
    print
    print "That was ";count;" records  : Press a key to continue"
    get
    close
    cls
  endwh
endp

proc cmds%:
  rem Stopwatch demo using microsecond timing in DATE.OPX
  local s&,e&,d&,a%(2),micro$(6),k%
  local y&,mo&,day&,h&,mi&,se&,m&

  cls
  print
  print " The Opl32 DateTime OPX gives extended access to E32's time functions"
  print
  print " One of abilities of this OPX is to allow OPL programmers easily to"
  print " achieve microsecond accuracy in their programs. This is"
  print " demonstrated below. "
  print
  print
  print " Press any key to start / 'lap time' the clock  :  Esc to quit"
  get
  s&=DTNOW&:

  while 1

    e&=DTNOW&:

    DTDateTimeDiff:(s&,e&,y&,mo&,day&,h&,mi&,se&,m&)

    at 30,15
    micro$=num$(m&/1000,-3)
    print h&;":";mi&;":";se&;":"; micro$;
    print "                     "

    k%=key
    if k%=27
      break
    endif

    if k%
      at 1,17
      print"LAP TIME      ";y& ;" Year(s), "; mo&;" Month(s) and ";day&;" Day(s)."
      print
      print "  ";h&;" Hour(s), ";mi&;" Minute(s), ";se&;" Seconds and ";m&;" Microseconds."
    endif
  endwh
  cls
endp

proc setdbvar:

  file$="dbase.odb"
  table$="wages"
  field1$="employee"
  field2$="salary"
  field1%=4
  field2%=1

  type$(1)="integer"
  type$(2)="long"
  type$(3)="floating point"
  type$(4)="string"
  typ$(1)="%"
  typ$(2)="@" rem should be & but nmonic probs
  typ$(3)=""
  typ$(4)="$"
  ty$(1)="i"
  ty$(2)="a"
  ty$(3)=""
  ty$(4)="s"
endp