could you share your code for the exposure calculation and the blending?
sure, here you are:
exposure calculation:
Function CalcularExpRelativas() As Integer
Const rUmbralMin As Double = 65536 / (2 ^ 6) ' Ponemos el mínimo 6 diafragmas más abajo para asegurar 2 diafragmas completos de intersección
' entre tomas con sobreexposiciones de hasta +4EV
Const rUmbralMax As Double = 65536 * 0.9 ' Nos quitamos de encima la zona de comportamiento no lineal, 20% superior del rango dinámico
Dim i As Integer, j As Integer, N As Integer
Dim lX As Long, lY As Long
Dim Color0 As GFL_COLOR, Color1 As GFL_COLOR
Dim rSum0 As Double, rSum1 As Double
On Error GoTo CalcularExpRelativas_Error
CalcularExpRelativas = 0
N = UBound(GflBitmap)
SetStatus "Calculating relative exposure..."
' Cálculo de exposiciones
ReDim rFactor(N)
i = 1
rFactor(i) = 1# ' La primera imagen es la toma menos expuesta, la referencia final de exposición
SetStatus EliminaRuta(sFileTIFF(iPos(i))) & ": " & _
Round(1 / rFactor(i) * 100) / 100 & _
" (+" & Round(Log(1 / rFactor(i)) / Log(2) * 100) / 100 & " EV)", ADD
For i = 2 To N
rSum0 = 0#
rSum1 = 0#
For lX = 0 To lWidth - 1
For lY = 0 To lHeight - 1
gflGetColorAt GflBitmap(i - 1), lX, lY, Color0
gflGetColorAt GflBitmap(i), lX, lY, Color1
If Gfl2Long(Color0.Red) >= rUmbralMin And Gfl2Long(Color0.Red) <= rUmbralMax And _
Gfl2Long(Color1.Red) >= rUmbralMin And Gfl2Long(Color1.Red) <= rUmbralMax Then
rSum0 = rSum0 + Gfl2Long(Color0.Red)
rSum1 = rSum1 + Gfl2Long(Color1.Red)
End If
If Gfl2Long(Color0.Green) >= rUmbralMin And Gfl2Long(Color0.Green) <= rUmbralMax And _
Gfl2Long(Color1.Green) >= rUmbralMin And Gfl2Long(Color1.Green) <= rUmbralMax Then
rSum0 = rSum0 + Gfl2Long(Color0.Green)
rSum1 = rSum1 + Gfl2Long(Color1.Green)
End If
If Gfl2Long(Color0.Blue) >= rUmbralMin And Gfl2Long(Color0.Blue) <= rUmbralMax And _
Gfl2Long(Color1.Blue) >= rUmbralMin And Gfl2Long(Color1.Blue) <= rUmbralMax Then
rSum0 = rSum0 + Gfl2Long(Color0.Blue)
rSum1 = rSum1 + Gfl2Long(Color1.Blue)
End If
Next lY
Next lX
If rSum1 = 0# Then
SetStatus "Too wide exposure gap", ADD
SetStatus "DONE", ADD
CalcularExpRelativas = -1
AvisoError ("Too wide exposure gap between " & _
EliminaRuta(sFileTIFF(iPos(i - 1))) & " and " & EliminaRuta(sFileTIFF(iPos(i))))
Exit Function
ElseIf rSum0 > rSum1 Then
SetStatus "Too narrow exposure gap", ADD
SetStatus "DONE", ADD
CalcularExpRelativas = -1
AvisoError ("Too narrow exposure gap between " & _
EliminaRuta(sFileTIFF(iPos(i - 1))) & " and " & EliminaRuta(sFileTIFF(iPos(i))))
Exit Function
Else
rFactor(i) = rSum0 / rSum1 * rFactor(i - 1) ' Acumulamos factores y lo mostramos en pantalla
SetStatus EliminaRuta(sFileTIFF(iPos(i))) & ": " & _
Round(1 / rFactor(i) * 100) / 100 & _
" (+" & Round(Log(1 / rFactor(i)) / Log(2) * 100) / 100 & " EV)", ADD
End If
Next i
SetStatus "DONE", ADD
CalcularExpRelativas_Resume:
DoEvents
Exit Function
CalcularExpRelativas_Error:
MostrarError ("CalcularExpRelativas")
CalcularExpRelativas = -1
Resume CalcularExpRelativas_Resume
End Function
blending:
Sub FusionarImagenes(sRuta As String)
Const MAXINT65535 As Long = 65535
Dim sResult As String
Dim i As Integer, N As Integer
Dim lX As Long, lY As Long
Dim Color As GFL_COLOR
Dim lTH As Long
Dim rIGamma As Single
On Error GoTo FusionarImagenes_Error
N = UBound(GflBitmap)
SetStatus vbCrLf & "Blending into a noise free image...", ADD
' REPLICAMOS CÓDIGO SEGÚN GAMMA SEA 1.0 Y OTRA PARA GANAR VELOCIDAD
rIGamma = 1 / (frmMain.hscGamma.Value / 10) ' 1/Gamma
' Tomamos el color del píxel de la toma más expuesta que cumpla las condiciones
lTH = Round(MAXINT65535 * frmMain.hscTH / 100) ' Umbral de fusión
If rIGamma = 1# Then
For lX = 0 To lWidth - 1
For lY = 0 To lHeight - 1
i = N
gflGetColorAt GflBitmap(i), lX, lY, Color
' Bucle para elegir la imagen que prevalecerá
Do While i > 1 And _
(Gfl2Long(Color.Red) > lTH Or Gfl2Long(Color.Green) > lTH Or Gfl2Long(Color.Blue) > lTH)
i = i - 1
gflGetColorAt GflBitmap(i), lX, lY, Color
Loop
' Solo corregimos valor si no hemos recurrido a la toma menos expuesta
If i > 1 Then
Color.Red = Long2Gfl(Round(Gfl2Long(Color.Red) * rFactor(i)))
Color.Green = Long2Gfl(Round(Gfl2Long(Color.Green) * rFactor(i)))
Color.Blue = Long2Gfl(Round(Gfl2Long(Color.Blue) * rFactor(i)))
gflSetColorAt GflBitmap(1), lX, lY, Color
End If
Next lY
Next lX
Else
For lX = 0 To lWidth - 1
For lY = 0 To lHeight - 1
i = N
gflGetColorAt GflBitmap(i), lX, lY, Color
Do While i > 1 And _
(Gfl2Long(Color.Red) > lTH Or Gfl2Long(Color.Green) > lTH Or Gfl2Long(Color.Blue) > lTH)
i = i - 1
gflGetColorAt GflBitmap(i), lX, lY, Color
Loop
'If i > 1 Then ' Solo corregimos exposición si i > 1
Color.Red = Long2Gfl(Round(MAXINT65535 * (Gfl2Long(Color.Red) * rFactor(i) / MAXINT65535) ^ rIGamma))
Color.Green = Long2Gfl(Round(MAXINT65535 * (Gfl2Long(Color.Green) * rFactor(i) / MAXINT65535) ^ rIGamma))
Color.Blue = Long2Gfl(Round(MAXINT65535 * (Gfl2Long(Color.Blue) * rFactor(i) / MAXINT65535) ^ rIGamma))
gflSetColorAt GflBitmap(1), lX, lY, Color
'End If
Next lY
Next lX
End If
' Guardamos imagen final generada
sResult = "ZN_" & Format(Time, "hhmmss") & "_" & _
Sust(frmMain.cmbProfile, " ", "") & "_G" & Sust(1 / rIGamma, ",", ".") & ".tif"
SetStatus "Saving result as " & sResult & "...", ADD
GuardarGflBitmap GflBitmap(1), DimeRuta(sRuta) & sResult
' Liberamos las imágenes cargadas
For i = 1 To N
CerrarGflBitmap GflBitmap(i)
Next i
SetStatus "DONE", ADD
Beep
FusionarImagenes_Resume:
DoEvents
Exit Sub
FusionarImagenes_Error:
MostrarError ("FusionarImagenes")
Resume FusionarImagenes_Resume
End Sub
