Xojo Conferences
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Picture/Picture Matrix/matrix without plugin
Function:
Required plugins for this example:
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Picture/Picture Matrix/matrix without plugin
This example is the version from Fri, 17th Nov 2016.
Project "matrix without plugin.rbp"
Class main Inherits Window
Control Rectangle1 Inherits Rectangle
ControlInstance Rectangle1 Inherits Rectangle
End Control
Control scr Inherits Canvas
ControlInstance scr Inherits Canvas
EventHandler Sub Paint(g As Graphics, areas() As REALbasic.Rect) img_show End EventHandler
End Control
Control PushButton1 Inherits PushButton
ControlInstance PushButton1 Inherits PushButton
EventHandler Sub Action() quit End EventHandler
End Control
Control PushButton2 Inherits PushButton
ControlInstance PushButton2 Inherits PushButton
EventHandler Sub Action() img_reset '---------- original image load init_pmx '--------- grab numbers img_proc img_show End EventHandler
End Control
Control param Inherits int_only
ControlInstance param(0) Inherits int_only
ControlInstance param(1) Inherits int_only
ControlInstance param(2) Inherits int_only
ControlInstance param(3) Inherits int_only
ControlInstance param(4) Inherits int_only
ControlInstance param(5) Inherits int_only
ControlInstance param(6) Inherits int_only
ControlInstance param(7) Inherits int_only
ControlInstance param(8) Inherits int_only
ControlInstance param(9) Inherits int_only
ControlInstance param(10) Inherits int_only
ControlInstance param(11) Inherits int_only
ControlInstance param(12) Inherits int_only
ControlInstance param(13) Inherits int_only
ControlInstance param(14) Inherits int_only
ControlInstance param(15) Inherits int_only
ControlInstance param(16) Inherits int_only
ControlInstance param(17) Inherits int_only
ControlInstance param(18) Inherits int_only
ControlInstance param(19) Inherits int_only
ControlInstance param(20) Inherits int_only
ControlInstance param(21) Inherits int_only
ControlInstance param(22) Inherits int_only
ControlInstance param(23) Inherits int_only
ControlInstance param(24) Inherits int_only
End Control
Control txt1 Inherits Label
ControlInstance txt1 Inherits Label
End Control
Control txt2 Inherits Label
ControlInstance txt2 Inherits Label
End Control
Control ver Inherits int_only
ControlInstance ver Inherits int_only
End Control
Control ska Inherits num_only
ControlInstance ska Inherits num_only
End Control
Control StaticText1 Inherits Label
ControlInstance StaticText1 Inherits Label
End Control
Control demo_pop Inherits PopupMenu
ControlInstance demo_pop Inherits PopupMenu
EventHandler Sub Change() set_pmx demo_pop.listindex img_reset End EventHandler
End Control
Control info Inherits Label
ControlInstance info Inherits Label
End Control
EventHandler Sub Open() img_src = New Picture(200,200,32) '-------- Quellbild img_dst = New Picture(200,200,32) '-------- Zielbild img_maxx=200 img_maxy=200 rgbs=img_src.rgbsurface rgbd=img_dst.rgbsurface img_reset End EventHandler
Sub img_proc() dim xx,yy,xe as integer 'global image pixel coordinates dim xp,yp as integer 'local image pixel coordinates dim xm,ym as integer 'matrix coordinates dim rsum,gsum,bsum as integer 'summary rgb values dim pm as integer dim pix as color info.text="running ..." time=ticks xe=img_maxx-1 for yy=0 to img_maxy-1 for xx=0 to xe rsum=0 bsum=0 gsum=0 for ym=0 to 4 '--------- Koordinaten yp=yy-2+ym for xm=0 to 4 pm=pmx(xm,ym) if pm<255 then pix=rgbs.pixel(xx-2+xm,yp) rsum=rsum+pix.red*pm gsum=gsum+pix.green*pm bsum=bsum+pix.blue*pm end if next next rgbd.pixel(xx,yy)=rgb((rsum+vx)*sx,(gsum+vx)*sx,(bsum+vx)*sx) next next time=ticks-time img_show info.text=str(time/60)+" sec" End Sub
Sub img_reset() img_src.graphics.drawpicture sharp,0,0 img_dst.graphics.drawpicture sharp,0,0 info.text="??? sec" img_show End Sub
Sub img_show() scr.graphics.drawpicture img_dst,0,0 End Sub
Sub init_pmx() dim x,y,cnt as integer dim txt as string 'read out parameters from editfields cnt=0 for y=0 to 4 for x=0 to 4 txt=trim(param(cnt).text) if txt<>"" then pmx(x,y)=val(txt) 'if not empty, get into parameter matrix else pmx(x,y)=256 'if empty, mark with 256 end if cnt=cnt+1 'next index next next sx=val(ska.text) 'get scale vx=val(ver.text) 'get displacement End Sub
Sub set_pmx(idx as integer) dim x as integer for x=0 to 24 param(x).text="" next ver.text="0" ska.text="1" select case idx case 0 '-----------sharp param(7).text="-1" param(11).text="-1" param(13).text="-1" param(17).text="-1" param(12).text="5" case 1 '------------------ contour param(0).text="-1" param(1).text="-2" param(2).text="-3" param(3).text="-2" param(4).text="-1" param(5).text="-2" param(6).text="2" param(7).text="5" param(8).text="2" param(9).text="-1" param(10).text="-3" param(11).text="5" param(12).text="5" param(13).text="5" param(14).text="-3" param(15).text="-2" param(16).text="2" param(17).text="5" param(18).text="2" param(19).text="-2" param(20).text="-1" param(21).text="-2" param(22).text="-3" param(23).text="-2" param(24).text="-1" case 2 '---------------------- smooth param(6).text="1" param(7).text="2" param(8).text="1" param(11).text="2" param(12).text="0" param(13).text="2" param(16).text="1" param(17).text="2" param(18).text="1" ska.text="0.084" case 3 '----------------------- relieff param(6).text="-5" param(8).text="1" param(11).text="-3" param(12).text="1" param(13).text="3" param(16).text="-1" param(18).text="5" ver.text="900" ska.text="0.1" end select End Sub
Property Protected img_dst As picture
Property Protected img_maxx As integer
Property Protected img_maxy As integer
Property Protected img_src As picture
Property Protected imx(4,4,2) As integer
Property Protected pmx(4,4) As integer
Property Protected rgbd As rgbsurface
Property Protected rgbs As rgbsurface
Property Protected sx As double
Property Protected time As integer
Property Protected vx As integer
End Class
MenuBar Menu
MenuItem UntitledMenu3 = ""
MenuItem UntitledMenu2 = "Ablage"
MenuItem FileQuit = "Beenden"
MenuItem UntitledMenu0 = "Bearbeiten"
MenuItem EditUndo = "Undo"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "Ausschneiden"
MenuItem EditCopy = "Kopieren"
MenuItem EditPaste = "Einfügen"
MenuItem EditClear = "Löschen"
End MenuBar
ExternalFile SHARP
End ExternalFile
Class int_only Inherits TextField
EventHandler Sub TextChange() dim i,e as integer dim s,c,m as string dim use as boolean if not use then use=true sel_pos=me.selstart m=one_minus(me.text) e=len(m) if e>0 then s="" for i=1 to e c=mid(m,i,1) if is_number(c) then s=s+c end if next end if me.text=s me.selstart=sel_pos use=false end if End EventHandler
Protected Function is_number(c as string) As boolean return instr("0123456789-",left(c,1))<>0 End Function
Protected Function one_minus(inp as string) As string dim m as string m=left(inp,1) return m+replaceall( right(inp,len(inp)-1),"-","" ) End Function
Property Protected sel_pos As integer
End Class
Class num_only Inherits TextField
EventHandler Sub Open() me.alignment=3 End EventHandler
EventHandler Sub TextChange() dim i,e as integer dim s,c,m as string dim use as boolean if not use then use=true sel_pos=me.selstart m=only_komma(replaceall(me.text,",",".")) e=len(m) if e>0 then s="" for i=1 to e c=mid(m,i,1) if is_number(c) then s=s+c end if next end if me.text=s me.selstart=sel_pos use=false end if End EventHandler
Protected Function is_number(c as string) As boolean return instr("0123456789.",left(c,1))<>0 End Function
Protected Function only_komma(inp as string) As string dim a,b as string if countfields(inp,".")>1 then a=nthfield(inp,".",1) if a="" then a="0" sel_pos=sel_pos+1 end if b=nthfield(inp,".",2) if b="" then b=nthfield(inp,".",3) sel_pos=sel_pos+len(b) end if return a+"."+b else return inp end if End Function
Property Protected sel_pos As integer
End Class
Class App Inherits Application
End Class
End Project

See also:

Feedback, Comments & Corrections

The items on this page are in the following plugins: MBS Picture Plugin.




Links
MBS FileMaker blog