Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

Threading für eine GDI+ Funktion

 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC.
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 129
Wohnort: Opel Stadt

BeitragVerfasst am: 24.06.2016, 20:16    Titel: Threading für eine GDI+ Funktion Antworten mit Zitat

Wie kann ich z.B. diese Funktion per Threading beschleunigen?

Code:
Function _GDIPlus_BitmapCreateGreyscale(hImage As Any Ptr) As Any Ptr
   Dim As Single iW, iH
   Dim As Any Ptr hBitmap_Greyscale
   Dim As BitmapData tBitmapData, tBitmapData_Greyscale
   Dim As Long iX, iY, iRowOffset, iColor, c, iR, iG, iB
   
   GdipGetImageDimension(hImage, @iW, @iH)
   
   Dim As Rect tRect = Type(0, 0, iW - 1, iH - 1)
   
   GdipCreateBitmapFromScan0(iW, iH, 0, PixelFormat32bppARGB, 0, @hBitmap_Greyscale)
   GdipBitmapLockBits(hBitmap_Greyscale, Cast(Any Ptr, @tRect), ImageLockModeWrite, PixelFormat32bppARGB, @tBitmapData_Greyscale)
   GdipBitmapLockBits(hImage, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppARGB, @tBitmapData)
   
   For iY = 0 To iH - 1
      iRowOffset = iY * iW
      For iX = 0 To iW - 1
         iColor = Cast(Integer Ptr, tBitmapData.Scan0)[iRowOffset + iX]
         iR = (iColor Shr 16) And &hFF
         iG = (iColor Shr 8) And &hFF
         iB = iColor And &hFF
         c = Clng((iR * 0.299 + iG * 0.587 + iB * 0.114))
         Cast(Integer Ptr, tBitmapData_Greyscale.Scan0)[iRowOffset + iX] = &hFF000000 + (c Shl 16) + (c Shl 8) + c
      Next
   Next
   
   GdipBitmapUnlockBits(hBitmap_Greyscale, @tBitmapData_Greyscale)
   GdipBitmapUnlockBits(hImage, @tBitmapData)
   Return hBitmap_Greyscale   
End Function


Danke.
_________________
Gruß,
UEZ


Zuletzt bearbeitet von UEZ am 25.06.2016, 16:11, insgesamt einmal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Elor



Anmeldungsdatum: 12.07.2013
Beiträge: 205
Wohnort: Konstanz

BeitragVerfasst am: 25.06.2016, 12:35    Titel: Antworten mit Zitat

Hast du das https://www.freebasic-portal.de/tutorials/ schon gesehen? Ganz unten bei „FreeBASIC für Fortgeschrittene“ gibts Threading Tutorials, vielleicht hilft dir das erst mal weiter?
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 129
Wohnort: Opel Stadt

BeitragVerfasst am: 25.06.2016, 16:15    Titel: Antworten mit Zitat

Vielen Dank Elor.

Ich werde mir die Tutorials "reinziehen".

lächeln
_________________
Gruß,
UEZ
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Jojo
alter Rang


Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte

BeitragVerfasst am: 25.06.2016, 17:10    Titel: Antworten mit Zitat

Es sei an dieser Stelle angemerkt, dass es sich wohl kaum lohnen wird, diese Funktion in Threads aufzuteilen wenn du nicht grade supergroße Bilder in Graustufen umwandeln möchtest. Threading erzeugt Synchronisations-Overhead, der bei relativen kurz laufenen Funktionen oft höher sein kann als der eigentliche Gewinn.

Wenn du viele Bilder verarbeiten möchtest, wäre es sinnvoller mehrere Worker-Threads zu erzeugen (maximal soviele wie CPU-Kerne vorhanden sind) und die Bilder auf diese Worker-Threads zu verteilen, wo sie dann nacheinander abgearbeitet werden. Also nicht die Funktion selbst umschreiben, sondern das Drumherum.
In Pseudocode:
Code:

Erstelle Dateiliste
Ermittle Anzahl Prozessorkerne = n
Teile Liste in n Teillisten auf
Erzeuge n Threads, jeder davon arbeitet eine Teilliste ab durch Aufruf von _GDIPlus_BitmapCreateGreyscale.

Das lässt sich natürlich noch beliebig erweitern, z.B. nicht nur stupide n Listen erzeugen, sondern bereits vorher die Größe der einzelnen Bilder ermitteln und dann dafür sorgen, dass jeder Thread ungefähr gleich ausgelastet wird, also ungefähr gleich viele Pixel verarbeiten muss.
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 129
Wohnort: Opel Stadt

BeitragVerfasst am: 25.06.2016, 20:39    Titel: Antworten mit Zitat

Ich schreibe gerade eine DLL für Bildbearbeitungseffekte und wollte noch Threading implementieren, um langsame Filter wie z.B. "Symmetric Nearest Neighbour" zu beschleunigen.

Um Threading zu erlernen, habe ich eine einfache Funktion als Beispiel genommen. zwinkern
_________________
Gruß,
UEZ
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 129
Wohnort: Opel Stadt

BeitragVerfasst am: 06.07.2016, 14:18    Titel: Antworten mit Zitat

Ich habe mal diese Funktion als Beispiel genommen:
Code:
Function _GDIPlus_BitmapApplyFilter_Median(ByVal hImage As Any Ptr, fRadius As Single, bGDI As Bool) As Any Ptr Export
   Dim As Single iW, iH
   Dim As Any Ptr hBitmap_Median, hGDIBitmap
   Dim As BitmapData tBitmapData, tBitmapData_Median
   Dim As Integer iX, iY, iRowOffset, iColor, iXX, iYY, iColors, iSize, iOff, iMid, iMedianR, iMedianG, iMedianB, iSizeArray
   Dim As Integer iStatus

   iStatus = GdipGetImageDimension(hImage, @iW, @iH)
   If iStatus <> 0 Then Return 0
   
   Dim As Rect tRect = Type(0, 0, iW - 1, iH - 1)
   
   GdipCreateBitmapFromScan0(iW, iH, 0, PixelFormat32bppARGB, 0, @hBitmap_Median)
   GdipBitmapLockBits(hBitmap_Median, Cast(Any Ptr, @tRect), ImageLockModeWrite, PixelFormat32bppARGB, @tBitmapData_Median)
   GdipBitmapLockBits(hImage, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppARGB, @tBitmapData)
   
   fRadius = Int(IIf(fRadius < 1, 1, IIF(fRadius > 25, 25, fRadius)))
   
   iSizeArray = (2 * fRadius + 1) * (2 * fRadius + 1)
   ReDim aColorsR(0 To iSizeArray) As Integer
   ReDim aColorsG(0 To iSizeArray) As Integer
   ReDim aColorsB(0 To iSizeArray) As Integer
   
   iSize = iW * iH - 1
   
   For iY = 0 To iH - 1
      iRowOffset = iY * iW
      For iX = 0 To iW - 1
         
         'calculate median Values
         iColors = 0
         For iXX = iX - fRadius To iX + fRadius
            For iYY = iY - fRadius To iY + fRadius
               iOff = iYY * iW + iXX
               iColor = Cast(Integer Ptr, tBitmapData.Scan0)[IIf(iOff < 0, 0, IIf(iOff > iSize, iSize, iOff))]
               aColorsR(iColors) = (iColor Shr 16) And &hFF
               aColorsG(iColors) = (iColor Shr 8) And &hFF
               aColorsB(iColors) = iColor And &hFF
               iColors += 1
            Next
         Next 
               
         'sort array
         qsort @aColorsR(0), iColors, SizeOf(Integer), @QCompare
         qsort @aColorsG(0), iColors, SizeOf(Integer), @QCompare
         qsort @aColorsB(0), iColors, SizeOf(Integer), @QCompare

         iMid = Int(iColors / 2)
          
         If (iColors And 1) Then
            iMedianR = Int(aColorsR(iMid + 1))
            iMedianG = Int(aColorsG(iMid + 1))
            iMedianB = Int(aColorsB(iMid + 1))
         Else
            iMedianR = Int((aColorsR(iMid) + aColorsR(iMid + 1)) / 2)      
            iMedianG = Int((aColorsG(iMid) + aColorsG(iMid + 1)) / 2)      
            iMedianB = Int((aColorsB(iMid) + aColorsB(iMid + 1)) / 2)                     
         EndIf
         
         'write median color values to bitmap
         Cast(Integer Ptr, tBitmapData_Median.Scan0)[iRowOffset + iX] = &hFF000000 + iMedianR Shl 16 + iMedianG Shl 8 + iMedianB
      Next
   Next
   
   GdipBitmapUnlockBits(hBitmap_Median,@tBitmapData_Median)
   GdipBitmapUnlockBits(hImage,@tBitmapData)
   If bGDI Then
      GdipCreateHBITMAPFromBitmap(hBitmap_Median, @hGDIBitmap, &hFF000000)
      GdipDisposeImage(hBitmap_Median)
      Return hGDIBitmap
   EndIf
   Return hBitmap_Median   
End Function


Die MT Variante funktioniert auch soweit, aber ist deutlich langsamer als die 1 Thread Variante.

MT Variante:
Code:
#Include Once "crt\stdlib.bi"
#Include Once "crt\math.bi"
#Include Once "win\gdiplus.bi"
#include once "win\winuser.bi"
Using GDIPLUS


Dim Shared As UByte iMaxThreads = 4
Dim Shared As Any Ptr XMutex

Extern "Windows-MS"

Declare Function QCompare cdecl (ByVal e1 As Any Ptr, ByVal e2 As Any Ptr) As Integer
Declare Function _GDIPlus_BitmapApplyFilter_Median(ByVal hImage As Any Ptr, fRadius As Single, bGDI As Bool) As Any Ptr

Type tThread
   hImage As Any Ptr
   hBitmap_Median As Any Ptr
   fRadius As Single
   iPosY As Long
   iWidth As ULong
   iHeight As ULong
   iH As ULong
End Type


'The qsort function expects three numbers
'from the compare function:
'-1: if e1 is less than e2
'0: if e1 is equal to e2
'1: if e1 is greater than e2
Private Function QCompare cdecl (ByVal e1 As Any Ptr, ByVal e2 As Any Ptr) As Integer
   Dim As Integer el1, el2
   Static cnt As Integer
   
   'Get the call count and items passed
   cnt += 1
   'Get the values, must cast to integer ptr
   el1 = *(CPtr(Integer Ptr, e1))
   el2 = *(CPtr(Integer Ptr, e2))
   'Print "Qsort called";cnt;" time(s) with";el1;" and";el2;"."
   'Compare the Values
   If el1 < el2 Then
      Return -1
   ElseIf el1 > el2 Then
      Return 1
   Else
      Return 0
   End If
End Function


Private Sub _GDIPlus_BitmapApplyFilter_Median_Int(pParam As tThread Ptr)
   Dim As Any Ptr hImage, hBitmap_Median
   Dim As BitmapData tBitmapData, tBitmapData_Median
   Dim As Integer iRowOffset, iColor, iXX, iYY, iColors, iSize, iOff, iMid, iMedianR, iMedianG, iMedianB, iSizeArray
   Dim As Single fRadius
   Dim As Integer iW, iH, iW1, iH1
   Dim As Integer iX, iY, iPosY, y
   Dim fBench As Double
   'fBench = Timer
   
   hImage = pParam->hImage
   hBitmap_Median = pParam->hBitmap_Median
   
   fRadius = pParam->fRadius
   
   iW = pParam->iWidth
   iH = pParam->iH
   
   iW1 = iW
   iH1 = pParam->iHeight
   
   iPosY = pParam->iPosY
   
   Dim As Rect tRect = Type(0, 0, iW, iH), tRect2 = Type(0, 0, iW1, iH1)
   
   fRadius = Int(IIf(fRadius < 1, 1, IIF(fRadius > 25, 25, fRadius)))
   
   
   iSizeArray = (2 * fRadius + 1) * (2 * fRadius + 1)
   ReDim aColorsR(0 To iSizeArray) As Integer
   ReDim aColorsG(0 To iSizeArray) As Integer
   ReDim aColorsB(0 To iSizeArray) As Integer
   
   iSize = iW * iH - 1
   
   'Print iPosY & " To " &  iPosY + iH1 - 1

   GdipBitmapLockBits(hImage, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppARGB, @tBitmapData)
   GdipBitmapLockBits(hBitmap_Median, Cast(Any Ptr, @tRect2), ImageLockModeWrite, PixelFormat32bppARGB, @tBitmapData_Median)
   
   y = 0
   For iY = iPosY To iPosY + iH1 - 1
      iRowOffset = y * iW
      For iX = 0 To iW - 1
         
         'calculate median Values
         iColors = 0
         For iXX = iX - fRadius To iX + fRadius
            For iYY = iY - fRadius To iY + fRadius
               
               iOff = iYY * iW + iXX
               iColor = Cast(Integer Ptr, tBitmapData.Scan0)[IIf(iOff < 0, 0, IIf(iOff > iSize, iSize, iOff))]
               
               aColorsR(iColors) = (iColor Shr 16) And &hFF
               aColorsG(iColors) = (iColor Shr 8) And &hFF
               aColorsB(iColors) = iColor And &hFF
               iColors += 1
            Next
         Next 
               
         'sort array
         qsort @aColorsR(0), iColors, SizeOf(Integer), @QCompare
         qsort @aColorsG(0), iColors, SizeOf(Integer), @QCompare
         qsort @aColorsB(0), iColors, SizeOf(Integer), @QCompare

         iMid = Int(iColors / 2)
          
         If (iColors And 1) Then
            iMedianR = Int(aColorsR(iMid + 1))
            iMedianG = Int(aColorsG(iMid + 1))
            iMedianB = Int(aColorsB(iMid + 1))
         Else
            iMedianR = Int((aColorsR(iMid) + aColorsR(iMid + 1)) / 2)                     
            iMedianG = Int((aColorsG(iMid) + aColorsG(iMid + 1)) / 2)                     
            iMedianB = Int((aColorsB(iMid) + aColorsB(iMid + 1)) / 2)                     
         EndIf
         
         'write median color values to bitmap
         Cast(Integer Ptr, tBitmapData_Median.Scan0)[iRowOffset + iX] = &hFF000000 + iMedianR Shl 16 + iMedianG Shl 8 + iMedianB
      Next
      y += 1
   Next
   
   GdipBitmapUnlockBits(hBitmap_Median, @tBitmapData_Median)
   GdipBitmapUnlockBits(hImage, @tBitmapData)
   'Print iPosY & ": " & Timer - fBench
   
End Sub

Function _GDIPlus_BitmapApplyFilter_Median(ByVal hImage As Any Ptr, fRadius As Single, bGDI As Bool) As Any Ptr Export
   Dim As Single iW, iH
   Dim As Integer iStatus
   iStatus = GdipGetImageDimension(hImage, @iW, @iH)
   If iStatus <> 0 Then Return 0
   
   Dim As Integer i
   Dim As Any Ptr hBitmap, hBitmap_Clone, hBitmap_Median, hGfx
   Dim fBench As Double
   
   
   Dim mThread(0 To iMaxThreads - 1) As tThread
   Dim aThread(0 To iMaxThreads - 1) As Any Ptr

   For i = 0 To iMaxThreads - 1
      GdipCloneImage(hImage, @hBitmap_Clone)
      mThread(i).hImage = hBitmap_Clone
      mThread(i).iWidth = iW
      mThread(i).iHeight = Int(iH / iMaxThreads)
      mThread(i).iPosY = i * mThread(i).iHeight
      mThread(i).fRadius = fRadius
      GdipCreateBitmapFromScan0(iW, mThread(i).iHeight, 0, PixelFormat32bppARGB, 0, @hBitmap)
      mThread(i).hBitmap_Median = hBitmap
      mThread(i).iH = iH
   Next
   
   For i = 0 To iMaxThreads - 1
      aThread(i) = ThreadCreate(@_GDIPlus_BitmapApplyFilter_Median_Int, @mThread(i))
   Next   
    
    
   For i = 0 To iMaxThreads - 1
      ThreadWait(aThread(i))
   Next
   
   
   
   GdipCreateBitmapFromScan0(iW, iH, 0, PixelFormat32bppARGB, 0, @hBitmap_Median)
   GdipGetImageGraphicsContext(hBitmap_Median, @hGfx)

   
   For i = 0 To iMaxThreads - 1
      GdipDrawImageRectRect(hGfx, mThread(i).hBitmap_Median, 0, mThread(i).iPosY, iW, mThread(i).iHeight, 0, 0, iW, mThread(i).iHeight, 2, 0, 0, 0)
      GdipDisposeImage(mThread(i).hBitmap_Median)
      GdipDisposeImage(mThread(i).hImage)
   Next
   GdipDeleteGraphics(hGfx)
   
   
   If bGDI Then
      Dim As Any Ptr hGDIBitmap
      GdipCreateHBITMAPFromBitmap(hBitmap_Median, @hGDIBitmap, &hFF000000)
      GdipDisposeImage(hBitmap_Median)
      Return hGDIBitmap
   EndIf
   
   Return hBitmap_Median
End Function

End Extern


Aufgerufen wird extern die Funktion _GDIPlus_BitmapApplyFilter_Median.

Habe ich was falsch gemacht?

PS: es wird eine DLL erstellt, die von einer anderem Programm aufgerufen wird.
_________________
Gruß,
UEZ
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC. Alle Zeiten sind GMT + 1 Stunde
Seite 1 von 1

 
Gehe zu:  
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.

 Impressum :: Datenschutz