Berechnen einer Umrisskontur um einen grafischen Bereich

[alter Mann]

zum Probieren und Weiterverwerten / Verbessern

Edit: nach Hinweis von Stargate jetzt der Code hier :

Code: Alles auswählen

;++++++++++++++++++++++++++++++++++++++
;+Umriss eines Bildbereiches berechnen+
;++++++++++++++++++++++++++++++++++++++
; - mit der linken Maustaste wird das Zeichnen eingeschaltet und auch wieder ausgeschaltet
;   (die Maustaste muss nicht gehalten werden)
; - die Zeichenfarbe ist grün
; - der berechnete Bereich wird rot umrandet
; - die Umrissfunktion ist nicht optimiert
; 
; Autor : alter Mann
; Datum : 11.11.08
;
;================
; Konstanten
#Image1   = 1
#Window   = 2
#ImageGad = 3
#Button1  = 4
#Text2    = 5
#Text1    = 7
#Button2  = 8
#Spin     = 9
#MaxX     = 800
#MaxY     = 600
#MaxAnz   = 1000
#Timer    = 111

#Time     = 20

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

;==============================================================
; Prototyp für Pixeltest - Funktion, ob Pixel zum Gebiet gehört 
Prototype.i fPixelTest(wPosX.w,wPosY.w,wAnzX.w,wAnzY.w,*lBild.l)
;==============================================================

;===========
; Strukturen
;===========
Structure STRECKE  ; Umrissstrecke
  wX1.w
  wY1.w
  wX2.w
  wY2.w
  wK.w
EndStructure

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

Structure PIXELIDX ; Pixelindex
  wX.w
  wY.w
EndStructure

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

Structure PIXELBEREICH ; alle Umrisskonturen
  wAnz.w
  List sKontur.PIXELKONTUR()
EndStructure

Global sBereich.PIXELBEREICH

;==========================
; Integer-Absolutwert
;==========================
Procedure.i iAbs (iWert.i)
  If iWert < 0
    ProcedureReturn -iWert
  EndIf
  ProcedureReturn iWert
EndProcedure

; ===================================================
; Linie mit Liniendicke zeichnen mit Hilfe von Circle
; ===================================================
Procedure DrawLine(lX1.l,lY1.l,lX2.l,lY2.l,lR.l,lF.l)
  ; ----------------------------------
  ; Eingabe
  ; lX1,lY1    : Startpunkt
  ; lX2,lY2    : Endpunkt
  ; lR         : halbe Linienstärke
  ; lF         : Farbe
  ; ----------------------------------
  Protected lX.l, lY.l, lH.l, lT.l, lA.l, lD.l
  Circle(lX1,lY1,lR,lF)   ; Kreis um Startpunkt
  If lX1=lX2 And lY1=lY2  
    ProcedureReturn      ; Anfangspunkt = Endpunkt
  EndIf
  If iAbs(lX1-lX2) > iAbs(lY1-lY2) ; X-Differenz > Y-Differenz
    lD = lX2-lX1
    If lX1>lX2
      For lX=lX1-1 To lX2 Step -1 ; für jedes Pixel
        lH = (lX-lX1)*(lY2-lY1)
        lT = (lH % lD) << 1
        If lT<lD                   ; Y-Wert ausrechnen
          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                          ; Y-Differenz <= X-Differenz
    lD = lY2-lY1
    If lY1>lY2
      For lY=lY1-1 To lY2 Step -1 ; für jedes Pixel
        lH = (lY-lY1)*(lX2-lX1)
        lT = (lH % lD) << 1
        If lT<lD                   ; X-Wert ausrechnen
          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

;========================================
; Umriss um einen Grafikbereich berechnen
;========================================
Procedure Umriss(wAnzX.w, wAnzY.w, *lBild.l, *pFunction.fPixelTest)
  ; --------------------------------------------------------------------------------
  ; Eingabe
  ; wAnzX      : Anzahl Pixel in X-Richtung
  ; wAnzY      : Anzahl Pixel in Y-Richtung
  ; *lBild     : Pointer auf Farbwerte des Bildes
  ; *pFunction : Userdefinierte Funktion zur Bestimmung, ob Pixel zum Bereich gehört
  ; --------------------------------------------------------------------------------
  Protected i.w,j.w
  Protected iAnzP.i = 0
  Protected Dim bRand.b(wAnzX,wAnzY) ; Feld für Randkennung
  
  For i=0 To wAnzY-1 Step 1
    For j=0 To wAnzX-1 Step 1
      If *pFunction(j,i,wAnzX,wAnzY,*lBild) = #True  ; Pixel gehört zum Bereich
        bRand(j,i) = (#BIT0|#BIT1|#BIT2|#BIT3)       ; alle Randkennungen setzen
        iAnzP + 1
        If j>0 And (bRand(j-1,i) & #BIT1) = #BIT1    ; je nach Nachbar entsprechende Randkennungen streichen
          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 iMaxS = 1000
  Protected Dim sStr.STRECKE(iMaxS)
  Protected iAnzS.i = 0
  ; je nach Kennung Strecken eintagen  
  For i=0 To wAnzY-1 Step 1
    For j=0 To wAnzX-1 Step 1
      If (bRand(j,i) & #BIT0) = #BIT0
        If iAnzS+1 > iMaxS
          iMaxS + 1000
          ReDim sStr.STRECKE(iMaxS)
        EndIf
        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
        If iAnzS+1 > iMaxS
          iMaxS + 1000
          ReDim sStr.STRECKE(iMaxS)
        EndIf
        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
        If iAnzS+1 > iMaxS
          iMaxS + 1000
          ReDim sStr.STRECKE(iMaxS)
        EndIf
        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
        If iAnzS+1 > iMaxS
          iMaxS + 1000
          ReDim sStr.STRECKE(iMaxS)
        EndIf
        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
  ; Feld sortieren
  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
  
  ; erste Strecke ist Startstrecke
  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)
  ; Strecken sortieren
  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 ; geschlossene Kontur übernehmen
      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 ; neue Startstrecke suchen
      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

;=======================
; Bild in Speicher laden
;=======================
Procedure.i GetPixelFromImage (iImage.i, *lPixel.PIXEL)
  ; ---------------------
  ; Eingabe
  ; iImage     : Imagegadgetnummer
  ; *lPixel    : Speicher für Bild
  ; -------------
  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 ; nur für 24Bit Farbtiefe empfehlenswert (bei 32Bit flackert Imagegadget)
      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(iImage))
  Else
    ProcedureReturn (3)
  EndIf
  ProcedureReturn 0
EndProcedure

;============================
; Benutzerdefinierte Funktion
; hier : grüne Pixel
;============================
Procedure.i TestePixel (wX.w, wY.w, wAX.w, wAY.w, *lPix.PIXEL)
  ; ---------------------------------------
  ; Eingabe
  ; wX,wY       : Pixelindex
  ; wAX         : Anzahl Pixel in X im Bild
  ; wAY         : Anzahl Pixel in Y im Bild
  ; *lPix       : Bildspeicher
  ; ---------------------------------------
  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(#Text1,650,#MaxY+25,100,30,"Zeichnen : aus")
  ButtonGadget(#Button2,180,#MaxY+20,70,25, "Rand")
  SpinGadget(#Spin,350,#MaxY+15,50,20,1,10,#PB_Spin_Numeric)
  SetGadgetState(#Spin,lR)
  TextGadget(#Text2,350,#MaxY+37,100,15,"halbe Liniendicke")
  
  StartDrawing(ImageOutput(#Image1)) ; Hintergrund zeichnen
  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  ; Zeichnen ein-/ausschalten
              iAktion = 1-iAktion
              If iAktion = 1
                AddWindowTimer(#Window,#Timer,#Time)
                iTimer = #Timer
                SetGadgetColor(#Text1,#PB_Gadget_FrontColor,RGB(255,0,0))
                SetGadgetText(#Text1,"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
                SetGadgetColor(#Text1,#PB_Gadget_FrontColor,RGB(0,0,0))
                SetGadgetText(#Text1,"Zeichnen : aus")
                iDraw = #False
              EndIf
            EndIf
          
          Case #Button1     ; Hintergrund neu zeichnen
            If iTimer = #Timer
              RemoveWindowTimer(#Window,#Timer)
              iTimer = -1
              SetGadgetText(#Text1,"Zeichnen : aus")
            EndIf              
            StartDrawing(ImageOutput(#Image1))
            Box(0,0,#MaxX,#MaxY,RGB(50,50,50))
            StopDrawing()
            SetGadgetState(#ImageGad,ImageID(#Image1))               
            iDraw = #False
            
          Case #Button2    ; Umriss berechnen und Zeichnen
            
            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           ; Timer zum Zeichnen
        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
            lR = GetGadgetState(#Spin)
            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)

wer legt eigentlich fest, welcher Code einfach nur cool ist ?

[Nino]

Hallo,

erstmal vielen Dank, das ist interessant!

Unter Windows XP funktioniert der Code hier.
Unter Ubuntu 10.04 (mit PB 4.50) kann ich zwar zeichnen, aber nach Klick auf [Rand] wird leider keine rote Linie gezeichnet.

wer legt eigentlich fest, welcher Code einfach nur cool ist ?

Das ICCC (Internationales Code Coolness Council).

Grüße, Nino

[alter Mann]

Hab leider kein Linux . Und auch keine Ahnung, woran es liegen könnte, da ich nur native PB-Befehle
benutzt habe.

(ist vielleicht mal ein Anlass Linux auf einer VM zu installieren)

[NicTheQuick]

Ja, ich hab den selben Bug wie Nino. Ich werde mal versuchen zu schauen, woran es liegt.

///Edit 1:

Ich hab den Fehler. Ich frage mich nur, wieso du ihn nicht abfängst. 'GetPixelFromImage' gibt 1 zurück, also "nur für 24Bit Farbtiefe empfehlenswert (bei 32Bit flackert Imagegadget)".

Interessanterweise ist die Kontur gespiegelt:


///Edit 2:
Die Lösung des Problems ist übrigens einfach folgende Zeilen in 'GetPixelFromImage' zu entfernen.

Code: Alles auswählen

; 		If iPixelFormat & #PB_PixelFormat_24Bits_RGB ; nur für 24Bit Farbtiefe empfehlenswert (bei 32Bit flackert Imagegadget)
; 			StopDrawing()
; 			ProcedureReturn 1
; 		EndIf

[Nino]

Ich meine noch einen anderen Fehler im Code gefunden zu haben. Den finde ich v.a. deshalb interessant, weil ich mich wundere warum PB den nicht reklamiert.

Der Prototyp muss m.E. so aussehen:

Code: Alles auswählen

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

d.h. der letzte Parameter des Prototyps muss den Typ PIXEL haben, denn die Parametertypen des Prototypes und der entspr. Prozedur müssen zusammenpassen.
Daraus folgt dann, dass der 3. Parameter der Prozedur Umriss() ebenfalls vom Typ PIXEL sein muss, und auch die Variable *lPixel im Hauptcode.

Meine Verwunderung resultiert aus folgendem:

... kann die OpenLibrary() und CallFunction() Sequenz ersetzen, da sie einige Vorteile hat: es erfolgt eine Typen-Überprüfung, die Anzahl an Parametern wird geprüft.

Offensichtlich ist hier aber leider keine Typen-Überprüfung erfolgt.

Grüße, Nino

[NicTheQuick]

Die Typ-Prüfung von PB ist nicht so hart wie die von C. Sobald eine Variable ein Pointer ist, ist die Struktur nur noch wichtig um auf die Strukturelemente zuzugreifen. Der Pointer selbst behält ja die selbe Größe, nämlich 4 oder 8 Byte, je nach Architektur. Also macht es keinen Unterschied.

[Nino]

Interessanterweise ist die Kontur gespiegelt:

Problem jetzt auch gelöst.
So etwa um Zeile 530 müssen 3 Zeilen für Linux anders aussehen. der folgende Code funktioniert bei mir unter Ubuntu und Windows:

Code: Alles auswählen

               While NextElement(sBereich\sKontur())
                If sBereich\sKontur()\wAnz
                  ResetList(sBereich\sKontur()\sPixel())
                  NextElement(sBereich\sKontur()\sPixel())                 
                  lX1 = sBereich\sKontur()\sPixel()\wX
             CompilerIf #PB_Compiler_OS = #PB_OS_Windows
                  lY1 = ImageHeight(#Image1)-sBereich\sKontur()\sPixel()\wY - 1
             CompilerElse
                  lY1 = sBereich\sKontur()\sPixel()\wY
             CompilerEndIf
                  ;Debug lX1
                  ;Debug lY1
                  While NextElement(sBereich\sKontur()\sPixel())
               CompilerIf #PB_Compiler_OS = #PB_OS_Windows
                    LineXY(lX1, lY1, sBereich\sKontur()\sPixel()\wX, ImageHeight(#Image1)-sBereich\sKontur()\sPixel()\wY-1, RGB(255,0,0))
               CompilerElse
                    LineXY(lX1, lY1, sBereich\sKontur()\sPixel()\wX, sBereich\sKontur()\sPixel()\wY, RGB(255,0,0))
               CompilerEndIf
                    lX1 = sBereich\sKontur()\sPixel()\wX
               CompilerIf #PB_Compiler_OS = #PB_OS_Windows
                    lY1 = ImageHeight(#Image1) - sBereich\sKontur()\sPixel()\wY - 1
               CompilerElse
                    lY1 = sBereich\sKontur()\sPixel()\wY
               CompilerEndIf
                  Wend

Beim Zeichnen ist anscheinend Y = 0 bei Windows der untere Rand, und bei Linux der obere Rand -- oder umgekehrt, was weiß ich. Aber hier werden ja keine API-Funktionen benutzt, sondern nur native PB-Funktionen. Sollte das da nicht einheitlich sein?

Die Typ-Prüfung von PB ist nicht so hart wie die von C. Sobald eine Variable ein Pointer ist, ist die Struktur nur noch wichtig um auf die Strukturelemente zuzugreifen. Der Pointer selbst behält ja die selbe Größe, nämlich 4 oder 8 Byte, je nach Architektur. Also macht es keinen Unterschied.

Gut, aber PB könnte doch prüfen, ob die Typen zusammenpassen ... das wäre nützlich, und nach dem von mir zitierten Hilfetext zu urteilen eigentlich auch zu erwarten.

Grüße, Nino

[STARGÅTE]

Will mich ja nicht einmischen, weil ich nciht genau verfolgt habe um was es geht.
Aber gibs für sowas (ob die Zeilen von oben nach unten gehen oder andersrum) die Konstante:
#PB_PixelFormat_ReversedY ?
Welche von DrawingBufferPixelFormat() auch zurückgegeben wird (also als BitOr) ...

Es hängt also nicht unbedingt vom OS ab, sonden nur von dem PixelFormat ... welches einfach richtig "gelesen" werde muss.

[Nino]

Aber gibs für sowas (ob die Zeilen von oben nach unten gehen oder andersrum) die Konstante:
#PB_PixelFormat_ReversedY ?
Welche von DrawingBufferPixelFormat() auch zurückgegeben wird (also als BitOr) ...

Interessant, die Konstante kannte ich nicht ( was nichts heißen muss ). Ja, darauf sollte dann wohl geprüft werden.

Es hängt also nicht unbedingt vom OS ab, sonden nur von dem PixelFormat ... welches einfach richtig "gelesen" werde muss.

Na ja, wenn exakt im selben Programm unter Windows und Linux Y = 0 verschiedene Bedeutungen hat (egal ob man diesem Phänomen das Etikett "Pixelformate" oder ein anderes aufklebt), dann hängt das durchaus vom OS ab, weil dieses hier den einzigen Unterschied darstellt.

Grüße, Nino

[alter Mann]

Ich bin begeistert, ihr ward ja fleißig .

Ich habe versucht, alle Anregungen einzuarbeiten. Dabei habe ich die Malfarbe auf rot und die Randfarbe auf grün geändert, weil noch ein Fehler beim
Pixelformat #PB_PixelFormat_24Bits_BGR zu beheben war. Ich füge mal den neuen Quelltext hier ein, damit man die Postings auch später noch versteht.

Code: Alles auswählen

;++++++++++++++++++++++++++++++++++++++
;+Umriss eines Bildbereiches berechnen+
;++++++++++++++++++++++++++++++++++++++
; - mit der linken Maustaste wird das Zeichnen eingeschaltet und auch wieder ausgeschaltet
;   (die Maustaste muss nicht gehalten werden)
; - die Zeichenfarbe ist rot
; - der berechnete Bereich wird grün umrandet
; - die Umrissfunktion ist nicht optimiert
; 
; Autor : alter Mann
; Datum : 12.11.08
;
;================
; Konstanten
#Image1   = 1
#Window   = 2
#ImageGad = 3
#Button1  = 4
#Text2    = 5
#Text1    = 7
#Button2  = 8
#Spin     = 9
#MaxX     = 800
#MaxY     = 600
#MaxAnz   = 1000
#Timer    = 111

#Time     = 20

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

;===========
; Strukturen
;===========
Structure STRECKE  ; Umrissstrecke
  wX1.w
  wY1.w
  wX2.w
  wY2.w
  wK.w
EndStructure

Structure PIXEL ; Pixel
  bRed.b
  bGreen.b
  bBlue.b
  bAlpha.b
EndStructure

Structure PIXELIDX ; Pixelindex
  wX.w
  wY.w
EndStructure

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

Structure PIXELBEREICH ; alle Umrisskonturen
  wAnz.w
  List sKontur.PIXELKONTUR()
EndStructure

;==============================================================
; Prototyp für Pixeltest - Funktion, ob Pixel zum Gebiet gehört 
Prototype.i fPixelTest(wPosX.w,wPosY.w,wAnzX.w,wAnzY.w,*lBild.PIXEL)
;==============================================================

Global sBereich.PIXELBEREICH

;==========================
; Integer-Absolutwert
;==========================
Procedure.i iAbs (iWert.i)
  If iWert < 0
    ProcedureReturn -iWert
  EndIf
  ProcedureReturn iWert
EndProcedure

; ===================================================
; Linie mit Liniendicke zeichnen mit Hilfe von Circle
; ===================================================
Procedure DrawLine(lX1.l,lY1.l,lX2.l,lY2.l,lR.l,lF.l)
  ; ----------------------------------
  ; Eingabe
  ; lX1,lY1    : Startpunkt
  ; lX2,lY2    : Endpunkt
  ; lR         : halbe Linienstärke
  ; lF         : Farbe
  ; ----------------------------------
  Protected lX.l, lY.l, lH.l, lT.l, lA.l, lD.l
  Circle(lX1,lY1,lR,lF)   ; Kreis um Startpunkt
  If lX1=lX2 And lY1=lY2  
    ProcedureReturn      ; Anfangspunkt = Endpunkt
  EndIf
  If iAbs(lX1-lX2) > iAbs(lY1-lY2) ; X-Differenz > Y-Differenz
    lD = lX2-lX1
    If lX1>lX2
      For lX=lX1-1 To lX2 Step -1 ; für jedes Pixel
        lH = (lX-lX1)*(lY2-lY1)
        lT = (lH % lD) << 1
        If lT<lD                   ; Y-Wert ausrechnen
          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                          ; Y-Differenz <= X-Differenz
    lD = lY2-lY1
    If lY1>lY2
      For lY=lY1-1 To lY2 Step -1 ; für jedes Pixel
        lH = (lY-lY1)*(lX2-lX1)
        lT = (lH % lD) << 1
        If lT<lD                   ; X-Wert ausrechnen
          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

;========================================
; Umriss um einen Grafikbereich berechnen
;========================================
Procedure Umriss(wAnzX.w, wAnzY.w, *lBild.l, *pFunction.fPixelTest)
  ; --------------------------------------------------------------------------------
  ; Eingabe
  ; wAnzX      : Anzahl Pixel in X-Richtung
  ; wAnzY      : Anzahl Pixel in Y-Richtung
  ; *lBild     : Pointer auf Farbwerte des Bildes
  ; *pFunction : Userdefinierte Funktion zur Bestimmung, ob Pixel zum Bereich gehört
  ; --------------------------------------------------------------------------------
  Protected i.w,j.w
  Protected iAnzP.i = 0
  Protected Dim bRand.b(wAnzX,wAnzY) ; Feld für Randkennung
  
  For i=0 To wAnzY-1 Step 1
    For j=0 To wAnzX-1 Step 1
      If *pFunction(j,i,wAnzX,wAnzY,*lBild) = #True  ; Pixel gehört zum Bereich
        bRand(j,i) = (#BIT0|#BIT1|#BIT2|#BIT3)       ; alle Randkennungen setzen
        iAnzP + 1
        If j>0 And (bRand(j-1,i) & #BIT1) = #BIT1    ; je nach Nachbar entsprechende Randkennungen streichen
          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 iMaxS = 1000
  Protected Dim sStr.STRECKE(iMaxS)
  Protected iAnzS.i = 0
  ; je nach Kennung Strecken eintagen  
  For i=0 To wAnzY-1 Step 1
    For j=0 To wAnzX-1 Step 1
      If (bRand(j,i) & #BIT0) = #BIT0
        If iAnzS+1 > iMaxS
          iMaxS + 1000
          ReDim sStr.STRECKE(iMaxS)
        EndIf
        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
        If iAnzS+1 > iMaxS
          iMaxS + 1000
          ReDim sStr.STRECKE(iMaxS)
        EndIf
        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
        If iAnzS+1 > iMaxS
          iMaxS + 1000
          ReDim sStr.STRECKE(iMaxS)
        EndIf
        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
        If iAnzS+1 > iMaxS
          iMaxS + 1000
          ReDim sStr.STRECKE(iMaxS)
        EndIf
        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
  ; Feld sortieren
  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
  
  ; erste Strecke ist Startstrecke
  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)
  ; Strecken sortieren
  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 ; geschlossene Kontur übernehmen
      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 ; neue Startstrecke suchen
      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

;=======================
; Bild in Speicher laden
;=======================
Procedure.i GetPixelFromImage (iImage.i, *sPixel.PIXEL)
  ; ---------------------
  ; Eingabe
  ; iImage     : Imagegadgetnummer
  ; *sPixel    : Speicher für Bild
  ; -------------
  If StartDrawing(ImageOutput(iImage))
    Protected *bBuffer.b = DrawingBuffer()
    Protected iPitch.i = DrawingBufferPitch()
    Protected iPixelFormat.i = DrawingBufferPixelFormat()
    Protected iWidth.i = ImageWidth(iImage)
    Protected iHeight.i = ImageHeight(iImage)
    Protected iByte.i,iRev.i
    Protected *bBuffer2.b, bL.b
    Protected i.i,j.i
    Protected sPixel.PIXEL, *sPixel1.PIXEL = *sPixel
    
    If iPixelFormat & #PB_PixelFormat_24Bits_RGB
      iByte = 3
      iRev  = 1
    ElseIf iPixelFormat & #PB_PixelFormat_24Bits_BGR
      iByte = 3
      iRev  = -1
    ElseIf iPixelFormat & #PB_PixelFormat_32Bits_RGB
      iByte = 4
      iRev  = 1
    ElseIf iPixelFormat & #PB_PixelFormat_32Bits_BGR
      iByte = 4
      iRev  = -1
    Else
      StopDrawing()
      ProcedureReturn 1
    EndIf
    iPitch / iByte
    
    If iPitch < iWidth
      StopDrawing()
      ProcedureReturn 2
    EndIf
    If iByte < SizeOf(PIXEL)                                ; Imagefarbe an PIXEL-Struktur anpassen
      sPixel\bAlpha = 255
      If iPixelFormat & #PB_PixelFormat_ReversedY
        For i=0 To iHeight-1
          For j=0 To iWidth-1
            CopyMemory (*bBuffer,@sPixel,iByte)
            *bBuffer + iByte
            CopyMemory(@sPixel,*sPixel,SizeOf(PIXEL))
            *sPixel + SizeOf(PIXEL)
          Next j
          *bBuffer + iByte*(iPitch-iWidth)
        Next i
      Else      
        For i=iHeight-1 To 0 Step -1
          *bBuffer2 = *bBuffer + iPitch * i * iByte
          For j=0 To iWidth-1
            CopyMemory (*bBuffer2,@sPixel,iByte)
            *bBuffer2 + iByte
            CopyMemory(@sPixel,*sPixel,SizeOf(PIXEL))
            *sPixel + SizeOf(PIXEL)
          Next j
        Next i
      EndIf
    ElseIf iAbs(i) = SizeOf(PIXEL)                           ; selbe Größe
      If iPixelFormat & #PB_PixelFormat_ReversedY
        If iPitch = iWidth
          CopyMemory (*bBuffer,*sPixel,iWidth*iHeight*SizeOf(PIXEL))
        ElseIf iPitch > iWidth
          For i=0 To iHeight-1
            CopyMemory (*bBuffer,*sPixel,iWidth*SizeOf(PIXEL))
            *bBuffer + iPitch*SizeOf(PIXEL)
            *sPixel + iWidth*SizeOf(PIXEL)
          Next i
        EndIf
      Else      
        *bBuffer2 = *bBuffer + iPitch * (iHeight-1) * SizeOf(PIXEL)
        For i=iHeight-1 To 0 Step -1
          CopyMemory (*bBuffer2,*sPixel,iWidth*SizeOf(PIXEL))
          *bBuffer2 - iPitch*SizeOf(PIXEL)
          *sPixel + iWidth*SizeOf(PIXEL)
        Next i
      EndIf
    Else
      ProcedureReturn 2
    EndIf
    StopDrawing()
    SetGadgetState(#ImageGad,ImageID(iImage))
    If iRev = -1                               ; Blau und Rot tauschen
      j = iHeight*iWidth - 1 
      For i=0 To j Step 1
        Swap *sPixel1\bBlue,*sPixel1\bRed
        *sPixel1 + SizeOf(PIXEL)
      Next i
    EndIf
  Else
    ProcedureReturn 3
  EndIf
  ProcedureReturn 0
EndProcedure

;============================
; Benutzerdefinierte Funktion
; hier : rote Pixel
;============================
Procedure.i TestePixel (wX.w, wY.w, wAX.w, wAY.w, *sPix.PIXEL)
  ; ---------------------------------------
  ; Eingabe
  ; wX,wY       : Pixelindex
  ; wAX         : Anzahl Pixel in X im Bild
  ; wAY         : Anzahl Pixel in Y im Bild
  ; *lPix       : Bildspeicher
  ; ---------------------------------------
  Protected lX.l = wX, lY.l = wY, lAX.l = wAX
  *sPix + (lX + lY*lAX) * SizeOf(PIXEL)
  If (*sPix\bGreen & $FF) = 0 And (*sPix\bRed & $FF) = 255 And (*sPix\bBlue & $FF) = 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 = RGBA(255,0,0,255)
Define *sPixel.PIXEL
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(#Text1,650,#MaxY+25,100,30,"Zeichnen : aus")
  ButtonGadget(#Button2,180,#MaxY+20,70,25, "Rand")
  SpinGadget(#Spin,350,#MaxY+15,50,20,1,10,#PB_Spin_Numeric)
  SetGadgetState(#Spin,lR)
  TextGadget(#Text2,350,#MaxY+37,100,15,"halbe Liniendicke")
  
  StartDrawing(ImageOutput(#Image1)) ; Hintergrund zeichnen
  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  ; Zeichnen ein-/ausschalten
              iAktion = 1-iAktion
              If iAktion = 1
                AddWindowTimer(#Window,#Timer,#Time)
                iTimer = #Timer
                SetGadgetColor(#Text1,#PB_Gadget_FrontColor,RGB(255,0,0))
                SetGadgetText(#Text1,"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
                SetGadgetColor(#Text1,#PB_Gadget_FrontColor,RGB(0,0,0))
                SetGadgetText(#Text1,"Zeichnen : aus")
                iDraw = #False
              EndIf
            EndIf
          
          Case #Button1     ; Hintergrund neu zeichnen
            If iTimer = #Timer
              RemoveWindowTimer(#Window,#Timer)
              iTimer = -1
              SetGadgetText(#Text1,"Zeichnen : aus")
            EndIf              
            StartDrawing(ImageOutput(#Image1))
            Box(0,0,#MaxX,#MaxY,RGB(50,50,50))
            StopDrawing()
            SetGadgetState(#ImageGad,ImageID(#Image1))               
            iDraw = #False
            
          Case #Button2    ; Umriss berechnen und Zeichnen
            
            Define *fSuchePixel.fPixelTest = @TestePixel()
            
            lX1 = ImageWidth(#Image1)
            lY1 = ImageHeight(#Image1)
            *sPixel = AllocateMemory(lX1*lY1*SizeOf(PIXEL))
            GetPixelFromImage (#Image1, *sPixel)
            
            Umriss(lX1, lY1, *sPixel, *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(0,255,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(*sPixel)

        EndSelect
      Case #PB_Event_Timer           ; Timer zum Zeichnen
        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
            lR = GetGadgetState(#Spin)
            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)