 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
UEZ
Anmeldungsdatum: 24.06.2016
Beiträge: 147
Wohnort: Opel Stadt
|
 Verfasst am: 24.06.2016, 20:16 Titel: Threading für eine GDI+ Funktion |
 |
|
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 |
|
 |
Elor
Anmeldungsdatum: 12.07.2013
Beiträge: 205
Wohnort: Konstanz
|
| Verfasst am: 25.06.2016, 12:35 Titel: |
|
|
| 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 |
|
|
UEZ
Anmeldungsdatum: 24.06.2016
Beiträge: 147
Wohnort: Opel Stadt
|
| Verfasst am: 25.06.2016, 16:15 Titel: |
|
|
Vielen Dank Elor.
Ich werde mir die Tutorials "reinziehen".
_________________
Gruß
UEZ |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 25.06.2016, 17:10 Titel: |
|
|
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 |
|
|
UEZ
Anmeldungsdatum: 24.06.2016
Beiträge: 147
Wohnort: Opel Stadt
|
| Verfasst am: 25.06.2016, 20:39 Titel: |
|
|
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. 
_________________
Gruß
UEZ |
|
| Nach oben |
|
|
UEZ
Anmeldungsdatum: 24.06.2016
Beiträge: 147
Wohnort: Opel Stadt
|
| Verfasst am: 06.07.2016, 14:18 Titel: |
|
|
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 |
|
|
|
|
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.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
