Polygon-Maske aus PNG erstellen

Für allgemeine Fragen zur Programmierung mit PureBasic.
Lambda
Beiträge: 526
Registriert: 16.06.2011 14:38

Polygon-Maske aus PNG erstellen

Beitrag von Lambda »

Ich möchte aus einem PNG image eine Polygon-Maske erstellen.

Es soll alle X Schritte prüfen ob der Alpha-Wert des Xten Punkt 0 oder kleiner als der "Schwellwert" (zb 100) ist. Ist eine Kante gefunden wird ein Punkt erstellt.Dabei muss die Umrandung in der richtigen Reihenfolge verlaufen.

Bisher hab ich es so gelöst das er Zeile für Zeile durchläuft, allerdings stimmt die Reihenfolge dann natürlich nicht. Wie geh ich da am besten vor? (für ein Beispielcode wäre ich sehr dankbar :D )

Edit: Es wird nur 1 geschlossenes Polygon erstellt, wenn jetzt aber im Bild etwas getrennt ist wird eine unbedeutend dünne Linie bis dahin gezogen damit es bei 1nem Polygon bleibt, der Weg dazwischen aber nicht sichtbar ist.

Hier eine Skizze.. das grüne soll das Polygon darstellen
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 7028
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Re: Polygon-Maske aus PNG erstellen

Beitrag von STARGÅTE »

PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Benutzeravatar
alter Mann
Beiträge: 201
Registriert: 29.08.2008 09:13
Wohnort: hinterm Mond

Re: Polygon-Maske aus PNG erstellen

Beitrag von alter Mann »

Für getrennte Polygone habe ich mal was gemacht, allerdings unkommentiert und nicht optimiert :

Code: Alles auswählen

; 
; Autor : alter Mann
; Datum : 11.11.08
; 
; Demo zum Erzeugen von Grafikumrissen
;
#Image1   = 1
#Window   = 2
#ImageGad = 3
#Button1  = 4
#Text     = 7
#Button2  = 8
#MaxX     = 800
#MaxY     = 600
#MaxAnz   = 1000
#Timer    = 111

#Time     = 20

#BIT0 = 1
#BIT1 = 2
#BIT2 = 4
#BIT3 = 8

Prototype.i fPixelTest(wPosX.w,wPosY.w,wAnzX.w,wAnzY.w,*lBild.l)

Structure STRECKE
  wX1.w
  wY1.w
  wX2.w
  wY2.w
  wK.w
EndStructure

Structure PIXEL
  bRed.b
  bGreen.b
  bBlue.b
EndStructure

Structure PIXELIDX
  wX.w
  wY.w
EndStructure

Structure PIXELKONTUR
  wAnz.w
  List sPixel.PIXELIDX()
EndStructure

Structure PIXELBEREICH
  wAnz.w
  List sKontur.PIXELKONTUR()
EndStructure

Global sBereich.PIXELBEREICH

Procedure.i iAbs (iWert.i)
  If iWert < 0
    ProcedureReturn -iWert
  EndIf
  ProcedureReturn iWert
EndProcedure

Procedure DrawLine(lX1.l,lY1.l,lX2.l,lY2.l,lR.l,lF.l)
  Protected lX.l, lY.l, lH.l, lT.l, lA.l, lD.l
  Circle(lX1,lY1,lR,lF)
  If lX1=lX2 And lY1=lY2
    ProcedureReturn
  EndIf
  If iAbs(lX1-lX2) > iAbs(lY1-lY2)
    lD = lX2-lX1
    If lX1>lX2
      For lX=lX1-1 To lX2 Step -1
        lH = (lX-lX1)*(lY2-lY1)
        lT = (lH % lD) << 1
        If lT<lD
          lY = lY1 + lH / lD - 1
        Else
          lY = lY1 + lH / lD
        EndIf
        Circle(lX,lY,lR,lF)
      Next lX
    Else
      For lX=lX1+1 To lX2 Step 1
        lH = (lX-lX1)*(lY2-lY1)
        lT = (lH % lD) << 1
        If lT>lD
          lY = lY1 + lH / lD + 1
        Else
          lY = lY1 + lH / lD
        EndIf
        Circle(lX,lY,lR,lF)
      Next lX
    EndIf
  Else
    lD = lY2-lY1
    If lY1>lY2
      For lY=lY1-1 To lY2 Step -1
        lH = (lY-lY1)*(lX2-lX1)
        lT = (lH % lD) << 1
        If lT<lD
          lX = lX1 + lH / lD - 1
        Else
          lX = lX1 + lH / lD
        EndIf
        Circle(lX,lY,lR,lF)
      Next lY
    Else
      For lY=lY1+1 To lY2 Step 1
        lH = (lY-lY1)*(lX2-lX1)
        lT = (lH % lD) << 1
        If lT>lD
          lX = lX1 + lH / lD + 1
        Else
          lX = lX1 + lH / lD
        EndIf
        Circle(lX,lY,lR,lF)
      Next lY
    EndIf
  EndIf
EndProcedure

Procedure Umriss(wAnzX.w, wAnzY.w, *lBild.l, *pFunction.fPixelTest)
  
  Protected i.w,j.w
  Protected iAnzP.i = 0
  Protected Dim bRand.b(wAnzX,wAnzY)
  
  For i=0 To wAnzY-1 Step 1
    For j=0 To wAnzX-1 Step 1
      If *pFunction(j,i,wAnzX,wAnzY,*lBild) = #True
        bRand(j,i) = (#BIT0|#BIT1|#BIT2|#BIT3)
        iAnzP + 1
        If j>0 And (bRand(j-1,i) & #BIT1) = #BIT1
          bRand(j  ,i) & ~#BIT3
          bRand(j-1,i) & ~#BIT1
        EndIf
        If i>0 And (bRand(j,i-1) & #BIT2) = #BIT2
          bRand(j,i  ) & ~#BIT0
          bRand(j,i-1) & ~#BIT2
        EndIf
      EndIf
    Next j
  Next i
  
  Protected Dim sStr.STRECKE(2*wAnzX*wAnzY+wAnzX+wAnzY)
  Protected iAnzS.i = 0
  
  For i=0 To wAnzY-1 Step 1
    For j=0 To wAnzX-1 Step 1
      If (bRand(j,i) & #BIT0) = #BIT0
        sStr(iAnzS)\wX1 = j
        sStr(iAnzS)\wY1 = i
        sStr(iAnzS)\wX2 = j+1
        sStr(iAnzS)\wY2 = i
        sStr(iAnzS)\wK  = 0
        iAnzS + 1
      EndIf
      If (bRand(j,i) & #BIT1) = #BIT1
        sStr(iAnzS)\wX1 = j+1
        sStr(iAnzS)\wY1 = i
        sStr(iAnzS)\wX2 = j+1
        sStr(iAnzS)\wY2 = i+1      
        sStr(iAnzS)\wK  = 0
        iAnzS + 1
      EndIf
      If (bRand(j,i) & #BIT2) = #BIT2
        sStr(iAnzS)\wX1 = j+1
        sStr(iAnzS)\wY1 = i+1
        sStr(iAnzS)\wX2 = j
        sStr(iAnzS)\wY2 = i+1        
        sStr(iAnzS)\wK  = 0
        iAnzS + 1
      EndIf
      If (bRand(j,i) & #BIT3) = #BIT3
        sStr(iAnzS)\wX1 = j
        sStr(iAnzS)\wY1 = i+1
        sStr(iAnzS)\wX2 = j
        sStr(iAnzS)\wY2 = i        
        sStr(iAnzS)\wK  = 0
        iAnzS + 1
      EndIf
    Next j
  Next i
  
  SortStructuredArray(sStr(),#PB_Sort_Ascending,OffsetOf(STRECKE\wX1),#PB_Sort_Word,0,iAnzS-1)
  
  Protected Dim sStr1.STRECKE(iAnzS)
  Protected k.i,iS.i=-1,iE.i, iAnz.i=1, iFind.i=0, iIdx.i=0
  Protected wX0.w = sStr(0)\wX2
  Protected wDx1.w=sStr(0)\wX2-sStr(0)\wX1,wDy1.w=sStr(0)\wY2-sStr(0)\wY1
  Protected wDx2.w,wDy2.w,wDx3.w,wDy3.w,wW2.w,wW3.w
  
  For k=0 To iAnzS Step 1
    If sStr(k)\wX1 = wX0 And iS = -1
      iS = k
    ElseIf sStr(k)\wX1 > wX0
      iE = k
      Break
    EndIf
  Next k
  sStr(0)\wK = 1
  sStr1(0) = sStr(0)
  While iFind < iAnzS
    If sStr1(iAnz-1)\wX2 > wX0
      iS = iE
      While iE<iAnzS And sStr(iE)\wX1 = sStr1(iAnz-1)\wX2
        iE + 1
      Wend
      wX0 = sStr1(iAnz-1)\wX2
    ElseIf sStr1(iAnz-1)\wX2 < wX0
      iE = iS
      iS - 1
      While iS>=0 And sStr(iS)\wX1 = sStr1(iAnz-1)\wX2
        iS - 1
      Wend
      iS + 1
      wX0 = sStr1(iAnz-1)\wX2
    EndIf
    iIdx = -1
    wW2  =  4
    For k=iS To iE-1
      If sStr(k)\wK = 1
        Continue
      EndIf
      If sStr(k)\wX1 = sStr1(iAnz-1)\wX2 And sStr(k)\wY1 = sStr1(iAnz-1)\wY2
        wDx3 = sStr(k)\wX2 - sStr(k)\wX1
        wDy3 = sStr(k)\wY2 - sStr(k)\wY1
        wW3  = wDx1 * wDy3 - wDy1 * wDx3
        If wW3 < wW2
          iIdx = k
          wW2  = wW3
          wDx2 = wDx3
          wDy2 = wDy3
        EndIf
      EndIf
    Next k
    If iIdx = -1 And sStr1(0)\wX1 = sStr1(iAnz-1)\wX2 And sStr1(0)\wY1 = sStr1(iAnz-1)\wY2
      ; Kontur geschlossen
      sBereich\wAnz + 1
      AddElement(sBereich\sKontur())
      For k=0 To iAnz-1 Step 1
        wDx1 = sStr1(k)\wX2 - sStr1(k)\wX1
        wDy1 = sStr1(k)\wY2 - sStr1(k)\wY1
        If     wDx1 =  1 And wDy1 =  0
          wDx2 = sStr1(k)\wX1
          wDy2 = sStr1(k)\wY1
        ElseIf wDx1 =  0 And wDy1 =  1
          wDx2 = sStr1(k)\wX1-1
          wDy2 = sStr1(k)\wY1
        ElseIf wDx1 = -1 And wDy1 =  0
          wDx2 = sStr1(k)\wX2
          wDy2 = sStr1(k)\wY1-1
        ElseIf wDx1 =  0 And wDy1 = -1
          wDx2 = sStr1(k)\wX2
          wDy2 = sStr1(k)\wY2
        Else
        EndIf
        If sBereich\sKontur()\wAnz > 0 And sBereich\sKontur()\sPixel()\wX = wDx2 And sBereich\sKontur()\sPixel()\wY = wDy2
          Continue
        EndIf
        sBereich\sKontur()\wAnz + 1
        AddElement(sBereich\sKontur()\sPixel())
        sBereich\sKontur()\sPixel()\wX = wDx2
        sBereich\sKontur()\sPixel()\wY = wDy2        
      Next k
      iAnz = 0
      For k=0 To iAnzS-1 Step 1
        If sStr(k)\wK = 0
          sStr1(iAnz) = sStr(k)
          sStr(k)\wK = 1
          wX0 = sStr1(0)\wX2
          iAnz + 1
          iFind + 1
          iS = -1
          For j=0 To iAnzS-1 Step 1
            If sStr(j)\wX1 = wX0 And iS = -1
              iS = j
              iE = iAnzS
            ElseIf sStr(j)\wX1 > wX0
              iE = j
              Break
            EndIf
          Next j
          Break
        EndIf
      Next k
      If iAnz = 0
        Break
      EndIf
      wDx1 = sStr1(0)\wX2 - sStr1(0)\wX1
      wDy1 = sStr1(0)\wY2 - sStr1(0)\wY1
    ElseIf iIdx >-1
      sStr1(iAnz) = sStr(iIdx)
      sStr(iIdx)\wK = 1
      iAnz + 1
      iFind + 1
      wDx1 = wDx2
      wDy1 = wDy2
    Else
      Break ; Fehler
    EndIf
  Wend
  k = 0
EndProcedure

Procedure.i GetPixelFromImage (iImage.i, *lPixel.PIXEL)
  If StartDrawing(ImageOutput(iImage))
    Protected *bBuffer.b = DrawingBuffer()
    Protected iPitch.i = DrawingBufferPitch()/SizeOf(PIXEL)
    Protected iPixelFormat.i = DrawingBufferPixelFormat()
    Protected iWidth.i = ImageWidth(iImage)
    Protected iHeight.i = ImageHeight(iImage)
    Protected *bBuffer2.b,*bBuffer3.b
    Protected i.i      
    If iPixelFormat & #PB_PixelFormat_24Bits_RGB
      StopDrawing()
      ProcedureReturn 1
    EndIf
    If iPitch = iWidth
      CopyMemory (*bBuffer,*lPixel,iWidth*iHeight*SizeOf(PIXEL))
    ElseIf iPitch > iWidth
      For i=0 To iHeight
        CopyMemory (*bBuffer,*lPixel,iWidth*SizeOf(Long))
        *bBuffer + iPitch*SizeOf(Long)
        *lPixel + iWidth*SizeOf(Long)
      Next i
    Else
      ProcedureReturn (2)
    EndIf
    StopDrawing()
    SetGadgetState(#ImageGad,ImageID(1))
  Else
    ProcedureReturn (3)
  EndIf
  ProcedureReturn 0
EndProcedure

Procedure.i TestePixel (wX.w, wY.w, wAX.w, wAY.w, *lPix.PIXEL)
  Protected lX.l = wX, lY.l = wY, lAX.l = wAX
  *lPix + (lX + lY*lAX) * SizeOf(PIXEL)
  If (*lPix\bGreen & $FF) = 255 And *lPix\bRed = 0 And *lPix\bBlue = 0
    ProcedureReturn 1
  EndIf
  ProcedureReturn 0
EndProcedure

InitializeStructure(@sBereich,PIXELBEREICH) 

Define iEvent.i
Define iAktion.i = 0
Define iDraw.i = #False
Define iTimer.i = -1
Define lX.l,lY.l,lX1.l,lY1.l
Define lR.l = 5
Define lF.l = RGB(0,255,0)
Define *lPixel.l
Define i.w,j.w

If CreateImage(#Image1,#MaxX,#MaxY,24) = 0
  MessageRequester("Achtung!","Kann Image nicht erstellen")
  End
EndIf

sBereich\wAnz = 0

If OpenWindow(#Window,0,0,#MaxX+10,#MaxY+55,"Cursor in Kontur",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
  ImageGadget (#ImageGad,  5,10, #MaxX,#MaxY,ImageID(#Image1))
  ButtonGadget(#Button1,5,#MaxY+20,50,25, "Neu")
  TextGadget(#Text,65,#MaxY+25,100,30,"Zeichnen : aus")
  ButtonGadget(#Button2,180,#MaxY+20,70,25, "Rand")
  
  StartDrawing(ImageOutput(#Image1))
  DrawingMode(#PB_2DDrawing_AllChannels)
  Box(0,0,#MaxX,#MaxY,RGB(50,50,50))
  StopDrawing()
  SetGadgetState(#ImageGad,ImageID(#Image1))

  Repeat
    iEvent = WaitWindowEvent()
     
    Select iEvent

      Case #PB_Event_Gadget
        
        Select EventGadget()
          
          Case #ImageGad
            If EventType() = #PB_EventType_LeftClick
              iAktion = 1-iAktion
              If iAktion = 1
                AddWindowTimer(#Window,#Timer,#Time)
                iTimer = #Timer
                SetGadgetText(#Text,"Zeichnen : an")
              Else
                If iDraw = #False
                  lX = WindowMouseX(#Window)
                  lY = WindowMouseY(#Window)
                EndIf
                lX1 = WindowMouseX(#Window)
                lY1 = WindowMouseY(#Window)
                If lX1 > -1 And lY1 > -1
                  StartDrawing(ImageOutput(#Image1))
                  DrawLine(lX,lY,lX1,lY1,lR,lF)
                  StopDrawing()
                  SetGadgetState(#ImageGad,ImageID(#Image1))
                EndIf
                RemoveWindowTimer(#Window,#Timer)
                iTimer = -1
                SetGadgetText(#Text,"Zeichnen : aus")
                iDraw = #False
              EndIf
            EndIf
          
          Case #Button1
            If iTimer = #Timer
              RemoveWindowTimer(#Window,#Timer)
              iTimer = -1
              SetGadgetText(#Text,"Zeichnen : aus")
            EndIf              
            StartDrawing(ImageOutput(#Image1))
            Box(0,0,#MaxX,#MaxY,RGB(50,50,50))
            StopDrawing()
            SetGadgetState(#ImageGad,ImageID(#Image1))               
            iDraw = #False
            
          Case #Button2
            
            Define *fSuchePixel.fPixelTest = @TestePixel()
            
            lX1 = ImageWidth(#Image1)
            lY1 = ImageHeight(#Image1)
            *lPixel = AllocateMemory(lX1*lY1*SizeOf(Long))
            GetPixelFromImage (#Image1, *lPixel)
            
            Umriss(lX1, lY1, *lPixel, *fSuchePixel)
            If sBereich\wAnz>0
              Debug sBereich\wAnz
              StartDrawing(ImageOutput(#Image1))
              ResetList(sBereich\sKontur())
              While NextElement(sBereich\sKontur())
                If sBereich\sKontur()\wAnz
                  ResetList(sBereich\sKontur()\sPixel())
                  NextElement(sBereich\sKontur()\sPixel())                  
                  lX1 = sBereich\sKontur()\sPixel()\wX
                  lY1 = ImageHeight(#Image1)-sBereich\sKontur()\sPixel()\wY-1
                  Debug lX1
                  Debug lY1
                  While NextElement(sBereich\sKontur()\sPixel())
                    LineXY(lX1,lY1,sBereich\sKontur()\sPixel()\wX,ImageHeight(#Image1)-sBereich\sKontur()\sPixel()\wY-1,RGB(255,0,0))
                    lX1 = sBereich\sKontur()\sPixel()\wX
                    lY1 = ImageHeight(#Image1)-sBereich\sKontur()\sPixel()\wY-1
                  Wend
                  Debug lX1
                  Debug lY1
                  ClearList(sBereich\sKontur()\sPixel())
                EndIf
              Wend
              StopDrawing()
              ClearList(sBereich\sKontur())
              sBereich\wAnz = 0
              SetGadgetState(#ImageGad,ImageID(#Image1))               
            EndIf
            FreeMemory(*lPixel)

        EndSelect
      Case #PB_Event_Timer
        If EventTimer() = #Timer
          If iDraw = #False
            lX = WindowMouseX(#Window)
            lY = WindowMouseY(#Window)
          EndIf
          iDraw = #True
          lX1 = WindowMouseX(#Window)
          lY1 = WindowMouseY(#Window)
          If lX1 > -1 And lY1 > -1
            StartDrawing(ImageOutput(#Image1))
            DrawLine(lX,lY,lX1,lY1,lR,lF)
            StopDrawing()
            lX = lX1
            lY = lY1
            SetGadgetState(#ImageGad,ImageID(#Image1))
          EndIf
        EndIf
    EndSelect
  Until iEvent = #PB_Event_CloseWindow
EndIf
CloseWindow(#Window)
Win11 64Bit / PB 6.0
Lambda
Beiträge: 526
Registriert: 16.06.2011 14:38

Re: Polygon-Maske aus PNG erstellen

Beitrag von Lambda »

Das ist doch mal ein genialer Code :allright: . Ich brauche für einen kleinen Bild Editor eine Funktion um Ränder zu glätten/auszublenden. Damit dürfte das kein Problem sein :D . Danke
Antworten