Last night i have written a function to create bitmap-based
(outline) masktables. The speed is breath-taking. On my little
Duron 800 it only takes 50-100 msec to mask a 1280x1024 sized
Picture.
Here it is:
(You have to change the Imagepath)
Code: Select all
Procedure WindowCallback(WindowID, Message, lParam, wParam) If Message = #WM_PAINT
StartDrawing(WindowOutput())
DrawImage(UseImage(1), 0, 0)
StopDrawing()
EndIf
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Dim px.l(8):Dim py.l(8)
px(1)=-1:py(1)=-1
px(2)=0:py(2)=-1
px(3)=1:py(3)=-1
px(4)=1:py(4)=0
px(5)=1:py(5)=1
px(6)=0:py(6)=1
px(7)=-1:py(7)=1
px(8)=-1:py(8)=0
Structure pst
pox.l
poy.l
EndStructure
NewList Points.pst()
Procedure CreateMaskTable(image,trans,offx,offy,memo,scanstep)
UseImage(image)
StartDrawing(ImageOutput())
If trans=-1:trans=Point(ImageWidth()-1,0):EndIf
If offy=-1:offy=ImageHeight()/2:EndIf
If Point(offx,offy)=trans
Repeat:offx+1:Until Point(offx,offy)trans
EndIf:angle=2:scan=8
pointx=offx:pointy=offy
Repeat
Repeat
testx=pointx+px(scan):testy=pointy+py(scan)
scan+1:If scan=9:scan=1:EndIf
Until Point(testx,testy)trans
pointx=testx:pointy=testy:angle=scan:scan=scan-2
If scan=0:scan=8:ElseIf scan=-1:scan=7:EndIf
AddElement(Points()):Points()\pox=pointx:Points()\poy=pointy
Until pointx=offx And pointy=offy
StopDrawing():sequences=CountList(Points())
*mem=AllocateMemory(memo,sequences*8/scanstep,0)
ResetList(Points())
Repeat
For i=1 To scanstep:NextElement(Points()):Next i
PokeL(*mem+addoff,Points()\pox):PokeL(*mem+addoff+4,Points()\poy):addoff+8
c+scanstep
Until c>sequences
ClearList(Points())
ProcedureReturn sequences/scanstep
EndProcedure
LoadImage(1,"Geebee2.bmp") ; end
Quit=1
EndSelect
Until Quit=1
DeleteObject_(region)cu,
Mischa