Ok, I got it now, I hope.
I didn't use the right parameter for Make(...), and Y in that function should be 0, not 1.
Here is the full code now:
Code:Public Sub MakeSemiTransparentFullyOpaqueBlack(Srf As cCairoSurface, ByVal uShadowAlpha As Byte, Optional ByVal UpperAlpha As Byte = 128) Dim X As Long, y As Long, b() As Byte Srf.BindToArray b For y = 0 To UBound(b, 2): For X = 0 To UBound(b, 1) Step 4 If b(X + 3, y) > 0 And b(X + 3, y) > UpperAlpha Then 'when semi-transparent (in a certain range)... b(X + 0, y) = 0 b(X + 1, y) = 0 b(X + 2, y) = 0 b(X + 3, y) = uShadowAlpha '255 = completely black/opaque 0=completely transparent, 124=halftransparent End If Next X, y Srf.ReleaseArray b End Sub Public Function CreateDropShadow(ByRef uSurf As cCairoSurface, ByVal uRadius As Long, ByVal uColor As Long, ByVal uAlpha As Double) As cCairoSurface Dim btAlpha As Byte btAlpha = pConvertAlpha(uAlpha) Dim nCopyOrigS As cCairoSurface Set nCopyOrigS = uSurf.CreateSimilar(CAIRO_CONTENT_COLOR_ALPHA, , , True) MakeSemiTransparentFullyOpaqueBlack nCopyOrigS, btAlpha, 0 'debugging: 'nCopyOrigS.WriteContentToPngFile "d:\weg\bla2.png" Dim nCopyOrigC As cCairoContext Set nCopyOrigC = nCopyOrigS.CreateContext Dim lRetRadius& lRetRadius = uRadius Set nCopyOrigS = nCopyOrigS.GaussianBlur(lRetRadius / 2, lRetRadius, False) Dim lWidthOrig& lWidthOrig = uSurf.Width Dim lWidthShadow& lWidthShadow = nCopyOrigS.Width Dim lAdd& lAdd = (lWidthShadow - lWidthOrig) ' Me.Caption = "Input radius: " & uRadius & ", ret radius: " & lRetRadius & ", diff: " & lAdd Set CreateDropShadow = nCopyOrigS End Function




Reply With Quote
