PureBasic Forums - English

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)