 |
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: 140
Wohnort: Opel Stadt
|
 Verfasst am: 19.07.2025, 17:59 Titel: Threading innerhalb einer DLL |
 |
|
Ich arbeite an einer WebP DLL und ich möchte, dass eine Funktion innerhalb der DLL von externen Aufrufer aufgerufen wird und die aufgerufene Funktion in einem eigenen Thread ausgeführt.
Genauer genommen geht es darum, dass er externe Aufrufe das Handle zur einer GUI u.a. angibt und die interne DLL Funktionen eine WebP Animation in einem eigenen Thread ausführt.
Sobald die externe GUI geschlossen wird, soll auch der Thread beendet werden.
Mir geht es eher um das Konstrukt, wie ich das in der DLL realisieren kann, sodass die GUI vom externen Aufrufer nicht abstürzt.
Hat jemand einen guten Ansatz?
Code Auszug aus meine DLL Funktion.
| Code: |
Type ThreadParam
sFile As ZString Ptr
hWND As HWND
w As ULong
h As ULong
pCallback As Any Ptr
pMutex As Any Ptr
End Type
Dim Shared As ThreadParam Ptr pThread
Dim Shared As Any Ptr pThreadAnimPlayer
Private Sub AnimThreadProc(ByVal pParam As Any Ptr) '...'
Dim As ThreadParam Ptr param = Cast(ThreadParam Ptr, pParam)
Dim As UInteger iSize = FileLen(*param->sFile)
/'If iSize = 0 Then
If param->pCallback Then Cast(AutoItProgressCallback, param->pCallback)(-1, NULL)
Deallocate(param)
Return 0
End If'/
Dim As AnimatedImage image
Dim pMem As UByte Ptr
pMem = Allocate(iSize)
LoadWebPImageBin(*param->sFile, pMem)
Dim As WebPBitstreamFeatures WebPBitstreamFeatures
WebPGetFeaturesInternal(pMem, iSize, @WebPBitstreamFeatures, WEBP_DECODER_ABI_VERSION)
/'If WebPGetFeaturesInternal(pMem, iSize, @WebPBitstreamFeatures, WEBP_DECODER_ABI_VERSION) <> VP8_STATUS_OK Then
If param->pCallback Then Cast(AutoItProgressCallback, param->pCallback)(-2, NULL)
Deallocate(param)
Return 0
End If'/
/'If WebPBitstreamFeatures.has_animation = 0 Then
If param->pCallback Then Cast(AutoItProgressCallback, param->pCallback)(-3, NULL)
Deallocate(param)
Return 0
End If'/
Dim As WebPData webp_data
WebPDataInit(@webp_data)
webp_data.bytes = pMem
webp_data.size = iSize
Dim As UInteger frame_index = 0
Dim As Integer prev_frame_timestamp = 0
Dim As WebPAnimDecoder Ptr dec
Dim As WebPAnimInfo anim_info
dec = WebPAnimDecoderNew(@webp_data, 0)
/'If dec = NULL Then
If param->pCallback Then Cast(AutoItProgressCallback, param->pCallback)(-4, NULL)
Deallocate(param)
Return 0
End If'/
WebPAnimDecoderGetInfo(dec, @anim_info)
/'If WebPAnimDecoderGetInfo(dec, @anim_info) = 0 Then
If param->pCallback Then Cast(AutoItProgressCallback, param->pCallback)(-5, NULL)
Deallocate(param)
Return 0
End If'/
image.canvas_width = anim_info.canvas_width
image.canvas_height = anim_info.canvas_height
image.loop_count = anim_info.loop_count
image.bgcolor = anim_info.bgcolor
image.Format = ANIM_WEBP
AllocateFrames(@image, anim_info.frame_count)
/'If AllocateFrames(@image, anim_info.frame_count) = 0 Then
If param->pCallback Then Cast(AutoItProgressCallback, param->pCallback)(-6, NULL)
Deallocate(param)
Return 0
End If'/
Dim As BITMAPINFO tBITMAP
With tBITMAP.bmiHeader
.biSize = SizeOf(BITMAPINFOHEADER)
.biWidth = anim_info.canvas_width
.biHeight = -anim_info.canvas_height
.biPlanes = 1
.biBitCount = 32
.biCompression = BI_RGB
End With
Dim As ULong Ptr aBitmap
Dim As HDC hDCTarget = GetDC(param->hWND)
Dim As HDC hDCMem = CreateCompatibleDC(hDCTarget)
Dim As Any Ptr hHBitmap = CreateDIBSection(hDCTarget, @tBITMAP, DIB_RGB_COLORS, @aBitmap, NULL, NULL)
Dim As HBITMAP hOld = SelectObject(hDCMem, hHBitmap)
If param->pCallback Then AutoItProgressCB = Cast(AutoItProgressCallback, param->pCallback)
Do
frame_index = 0
prev_frame_timestamp = 0
While WebPAnimDecoderHasMoreFrames(dec)
If AutoItProgressCB <> 0 Then
Dim As Long result = AutoItProgressCB((frame_index + 1) / image.num_frames * 100, 0)
If result = 0 Then Exit Do
End If
Dim As DecodedFrame Ptr pCurr_frame
Dim As UByte Ptr pFrame_rgba
Dim As Integer timestamp
WebPAnimDecoderGetNext(dec, @pFrame_rgba, @timestamp)
/'If WebPAnimDecoderGetNext(dec, @pFrame_rgba, @timestamp) = 0 Then
WebPAnimDecoderDelete(dec)
If param->pCallback Then Cast(AutoItProgressCallback, param->pCallback)(-7, NULL)
Deallocate(param)
Return 0
End If'/
pCurr_frame = @image.frames[frame_index]
pCurr_frame->duration = timestamp - prev_frame_timestamp
pCurr_frame->is_key_frame = 0 ' Unused
For i As UInteger = 0 To image.canvas_width * image.canvas_height - 1
aBitmap[i] = pFrame_rgba[i * 4 + 2] Or ((pFrame_rgba[i * 4 + 1]) Shl 8) Or ((pFrame_rgba[i * 4 + 0]) Shl 16) Or (pFrame_rgba[i * 4 + 3]) Shl 24 'ABGR
Next
If param->w AndAlso param->h Then
StretchBlt(hDCTarget, 0, 0, param->w, param->h, hDCMem, 0, 0, anim_info.canvas_width, anim_info.canvas_height, SRCCOPY)
Else
BitBlt(hDCTarget, 0, 0, image.canvas_width, image.canvas_height, hDCMem, 0, 0, SRCCOPY)
End If
Sleep(pCurr_frame->duration)
frame_index += 1
prev_frame_timestamp = timestamp
If frame_index > image.num_frames - 1 Then Exit While
Wend
'? !"Restarting"
dec = WebPAnimDecoderNew(@webp_data, 0)
Loop Until 0 'AutoItProgressCB <> 0 AndAlso AutoItProgressCB(-1, NULL) = 0
dec = WebPAnimDecoderNew(@webp_data, 0)
Deallocate(pMem)
SelectObject(hDCMem, hOld)
DeleteDC(hDCMem)
ReleaseDC(param->HWND, hDCTarget)
DeleteObject(hHBitmap)
Deallocate(pParam)
'Return 0
End Sub
Function WebP_PlayAnimFile(ByVal sFile As ZString Ptr, ByVal hWND As HWND, ByVal w As ULong = 0, ByVal h As ULong = 0, ByVal pCallback As Any Ptr = 0) As Any Ptr Export
Dim As ThreadParam p
p.sFile = sFile
p.hWND = hWND
p.w = w
p.h = h
p.pCallback = pCallback
'p.pMutex = MutexCreate()
pThread = @p
pThreadAnimPlayer = ThreadCreate(@AnimThreadProc, CPtr(Any Ptr, pThread))
If pThreadAnimPlayer = 0 Then Return 0
Sleep(1000)
Return pThreadAnimPlayer
End Function
|
Sobald die WebP_PlayAnimFile() Funktion beendet wird, gibt es einen Crash im externen Programm.
_________________
Gruß,
UEZ |
|
| Nach oben |
|
 |
grindstone
Anmeldungsdatum: 03.10.2010
Beiträge: 1280
Wohnort: Ruhrpott
|
| Verfasst am: 20.07.2025, 14:06 Titel: Re: Threading innerhalb einer DLL |
|
|
| UEZ hat Folgendes geschrieben: | Mir geht es eher um das Konstrukt, wie ich das in der DLL realisieren kann, sodass die GUI vom externen Aufrufer nicht abstürzt.
|
Um dazu etwas sgen zu können, bräuchte ich genauere Informationen.
Aber ganz allgemein kann ich sagen, dass die DLL mit Dylibload eingebunden werden muss. Die gewünschte Funktion wird dann mit ThreadCreate als eigener Thread gestartet.
Ohne mir das jetzt genauer angesehen zu haben: Dein Problem hört sich ganz danach an, als ob der Thread nicht sauber beendet wird.
Gruß
grindstone
_________________
For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen! |
|
| Nach oben |
|
|
UEZ
Anmeldungsdatum: 24.06.2016
Beiträge: 140
Wohnort: Opel Stadt
|
| Verfasst am: 20.07.2025, 18:49 Titel: |
|
|
@grindstone: danke für dein Feedback.
ich habe es so gelöst:
| Code: |
...
Type ThreadParam
sFile As ZString Ptr
hWND As HWND
w As ULong
h As ULong
pCallback As Any Ptr
pThread As Any Ptr
_error As Long
End Type
Dim Shared As Long g_ThreadError = 0
Dim Shared As Long g_bRunning = 0
Dim Shared As Any Ptr pThreadAnimPlayer
Dim Shared As ThreadParam Ptr p
Declare Function NtDelayExecution Lib "ntdll.dll" Alias "NtDelayExecution" (ByVal dwAlertable As Long, ByVal qInterval As LongInt Ptr) As Long
...
Private Sub AnimThreadProc(ByVal pParam As Any Ptr)
Dim As ThreadParam Ptr param = Cast(ThreadParam Ptr, pParam)
Dim As UInteger iSize = FileLen(*param->sFile)
If iSize = 0 Then
Debug("Error filesize = 0", 0)
g_ThreadError = -1
param->_error = -1
If param->pCallback Then Cast(AutoItProgressCallback, param->pCallback)(-1, NULL)
Delete param
Exit Sub
End If
Dim As AnimatedImage image
Dim pMem As UByte Ptr
pMem = Allocate(iSize)
LoadWebPImageBin(*param->sFile, pMem)
Dim As WebPBitstreamFeatures WebPBitstreamFeatures
' WebPGetFeaturesInternal(pMem, iSize, @WebPBitstreamFeatures, WEBP_DECODER_ABI_VERSION)
If WebPGetFeaturesInternal(pMem, iSize, @WebPBitstreamFeatures, WEBP_DECODER_ABI_VERSION) <> VP8_STATUS_OK Then '...'
Debug("Error in WebPGetFeaturesInternal function", 0)
g_ThreadError = -2
param->_error = -2
If param->pCallback Then Cast(AutoItProgressCallback, param->pCallback)(-2, NULL)
Delete param
Exit Sub
End If
If WebPBitstreamFeatures.has_animation = 0 Then '...'
Debug("No animation file!", 0)
g_ThreadError = -3
param->_error = -3
If param->pCallback Then Cast(AutoItProgressCallback, param->pCallback)(-3, NULL)
Delete param
Exit Sub
End If
Dim As WebPData webp_data
WebPDataInit(@webp_data)
webp_data.bytes = pMem
webp_data.size = iSize
Dim As UInteger frame_index = 0
Dim As Integer prev_frame_timestamp = 0
Dim As WebPAnimDecoder Ptr dec
Dim As WebPAnimInfo anim_info
dec = WebPAnimDecoderNew(@webp_data, 0)
If dec = NULL Then
Debug("Error in WebPAnimDecoderNew function", 0)
g_ThreadError = -4
param->_error = -4
If param->pCallback Then Cast(AutoItProgressCallback, param->pCallback)(-4, NULL)
Delete param
Exit Sub
End If
'WebPAnimDecoderGetInfo(dec, @anim_info)
If WebPAnimDecoderGetInfo(dec, @anim_info) = 0 Then
Debug("Error in WebPAnimDecoderGetInfo function", 0)
g_ThreadError = -5
param->_error = -5
If param->pCallback Then Cast(AutoItProgressCallback, param->pCallback)(-5, NULL)
Delete param
Exit Sub
End If
image.canvas_width = anim_info.canvas_width
image.canvas_height = anim_info.canvas_height
image.loop_count = anim_info.loop_count
image.bgcolor = anim_info.bgcolor
image.Format = ANIM_WEBP
'AllocateFrames(@image, anim_info.frame_count)
If AllocateFrames(@image, anim_info.frame_count) = 0 Then
Debug("Error in AllocateFrames", 0)
g_ThreadError = -6
param->_error = -6
If param->pCallback Then Cast(AutoItProgressCallback, param->pCallback)(-6, NULL)
Delete param
Exit Sub
End If
Dim As BITMAPINFO tBITMAP
With tBITMAP.bmiHeader
.biSize = SizeOf(BITMAPINFOHEADER)
.biWidth = anim_info.canvas_width
.biHeight = -anim_info.canvas_height
.biPlanes = 1
.biBitCount = 32
.biCompression = BI_RGB
End With
Dim As ULong Ptr aBitmap
Dim As HDC hDCTarget = GetDC(param->hWND)
Dim As HDC hDCMem = CreateCompatibleDC(hDCTarget)
Dim As Any Ptr hHBitmap = CreateDIBSection(hDCTarget, @tBITMAP, DIB_RGB_COLORS, @aBitmap, NULL, NULL)
Dim As HBITMAP hOld = SelectObject(hDCMem, hHBitmap)
If param->pCallback <> 0 Then AutoItProgressCB = Cast(AutoItProgressCallback, param->pCallback)
Dim As LongInt delay
Dim As Long animStartTime
Do
animStartTime = GetTickCount()
frame_index = 0
prev_frame_timestamp = 0
While WebPAnimDecoderHasMoreFrames(dec) And InterlockedCompareExchange(@g_bRunning, 1, 1)
If param->pCallback <> 0 AndAlso AutoItProgressCB <> 0 Then
Dim As Long result = AutoItProgressCB((frame_index + 1) / image.num_frames * 100, 0)
If result = 0 Then InterlockedCompareExchange(@g_bRunning, 0, 1)
End If
Dim As DecodedFrame Ptr pCurr_frame
Dim As UByte Ptr pFrame_rgba
Dim As Integer timestamp
WebPAnimDecoderGetNext(dec, @pFrame_rgba, @timestamp)
/'If WebPAnimDecoderGetNext(dec, @pFrame_rgba, @timestamp) = 0 Then
WebPAnimDecoderDelete(dec)
If param->pCallback Then Cast(AutoItProgressCallback, param->pCallback)(-7, NULL)
Delete param
Return 0
End If'/
pCurr_frame = @image.frames[frame_index]
pCurr_frame->duration = timestamp - prev_frame_timestamp
pCurr_frame->is_key_frame = 0 ' Unused
For i As UInteger = 0 To image.canvas_width * image.canvas_height - 1
aBitmap[i] = pFrame_rgba[i * 4 + 2] Or ((pFrame_rgba[i * 4 + 1]) Shl 8) Or ((pFrame_rgba[i * 4 + 0]) Shl 16) Or (pFrame_rgba[i * 4 + 3]) Shl 24 'ABGR
Next
If param->w AndAlso param->h Then
StretchBlt(hDCTarget, 0, 0, param->w, param->h, hDCMem, 0, 0, anim_info.canvas_width, anim_info.canvas_height, SRCCOPY)
Else
BitBlt(hDCTarget, 0, 0, image.canvas_width, image.canvas_height, hDCMem, 0, 0, SRCCOPY)
End If
Dim As Long tNow = GetTickCount()
Dim As Long tFrameTarget = animStartTime + timestamp
Dim As Long tSleep = tFrameTarget - tNow
If tSleep > 0 Then
delay = -tSleep * 10000
NtDelayExecution(False, CPtr(LongInt Ptr, @delay))
End If
frame_index += 1
prev_frame_timestamp = timestamp
If frame_index > image.num_frames - 1 Then Exit While
Wend
'? !"Restarting"
If dec Then WebPAnimDecoderDelete(dec)
dec = WebPAnimDecoderNew(@webp_data, 0)
Loop Until InterlockedCompareExchange(@g_bRunning, 1, 1) = 0
If dec Then WebPAnimDecoderDelete(dec)
Deallocate(pMem)
SelectObject(hDCMem, hOld)
DeleteDC(hDCMem)
ReleaseDC(param->hWND, hDCTarget)
DeleteObject(hHBitmap)
End Sub
Function WebP_PlayAnimFile(ByVal sFile As ZString Ptr, ByVal hWND As HWND, ByVal w As ULong = 0, ByVal h As ULong = 0, ByVal pCallback As Any Ptr = 0) As Any Ptr Export
If InterlockedCompareExchange(@g_bRunning, 1, 0) = 1 Then Return 0 'already running
p = New ThreadParam
p->sFile = sFile
p->hWND = hWND
p->w = w
p->h = h
p->pCallback = pCallback
pThreadAnimPlayer = ThreadCreate(@AnimThreadProc, CPtr(Any Ptr, p))
If pThreadAnimPlayer = 0 Then
g_bRunning = 0
Delete p
Return 0
End If
p->pThread = pThreadAnimPlayer
Sleep(250)
'MessageBoxEx(NULL, Hex(pThreadAnimPlayer), "Debug", MB_ICONINFORMATION Or MB_OK Or MB_APPLMODAL Or MB_TOPMOST, 1033)
If g_ThreadError Then
Delete p
Return 0
End If
Return CPtr(Any Ptr, p)
End Function
Function WebP_StopAnimFile(ByVal pThread As Any Ptr) As Long Export
If InterlockedCompareExchange(@g_bRunning, 0, 1) = 0 Then Return -1
Dim As ThreadParam Ptr p = CPtr(ThreadParam Ptr, pThread)
If p = 0 Then Return -2 ' not running
'MessageBoxEx(NULL, Hex(p->pThread), "Debug", MB_ICONINFORMATION Or MB_OK Or MB_APPLMODAL Or MB_TOPMOST, 1033)
ThreadWait(p->pThread)
p->pThread = 0
Delete p
Return 1
End Function
...
|
Den kompletten Code habe ich auf meinen 1Drv hochgeladen: WebP
_________________
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
