[RESOLVED] Custom drop shadow

[Jim Davis]

Hello!

I'm look after a solution to draw some drop shadow to my drawn objects to make the gui more entertaining. The way i found is that i use getpixel/setpixel to blend the edges to make the shadow like effect. Well if you look at the attached img it looks almost ok, but the problems is that this way is pretty much slow I also want to implement some bluring to make the edges less sharp, but i just dont get any examples about how to compute. That may also give some more performance drops.

Is there any way to attaching, or just force the system to render multiple drop shadow effect instances inside a picturebox, wherever i want it? I think about the shadow beneath the popup menus for example.

[Jim Davis]

Ok i got a way to blur some shape.

Private Sub Form_Load()
  Dim X As Long, Y As Long ' x,y coords
  Dim xMax As Long, yMax As Long 'white area width height
  Dim pPoint As Long 'position index in 4 byte (32bit) array

  Dim BlackX As Long, BlackY As Long 'black area left/right align, and height

  Dim BlurLevel As Long, Blur As Long
    
    Me.ScaleMode = vbPixels: Me.AutoRedraw = True: Me.Show: DoEvents: Me.BackColor = vbWhite
    
    BlurLevel = 10
    
    BlackX = 25: BlackY = 140
    
    xMax = Me.ScaleWidth: yMax = Me.ScaleHeight
    ReDim pxArray((xMax * yMax * 4) + 4) As Byte
    
    'lets prepare a white area
    For Y = 1 To yMax
        For X = 3 To xMax
            pPoint = ((xMax * (Y - 1)) + X) * 4
            
            'pxArray(pPoint) = 255 'A
            pxArray(pPoint + 1) = 255 'R
            pxArray(pPoint + 2) = 255 'G
            pxArray(pPoint + 3) = 255 'B
        Next X
    Next Y: Debug.Print "White done."
    
    'lets create the solid black area
    For Y = 1 To BlackY
        'If Y Mod 10 = 0 Then Y = Y + 1 'skip a pixel to create a grid thingie
        
        For X = BlackX To xMax - BlackX
            'If X Mod 10 = 0 Then X = X + 1 'skip a pixel to create a grid thingie
            
            pPoint = ((xMax * (Y - 1)) + X) * 4
            
            'pxArray(pPoint) = 255
            pxArray(pPoint + 1) = 0 'R
            pxArray(pPoint + 2) = 0 'G
            pxArray(pPoint + 3) = 0 'B
        Next X
    Next Y: Debug.Print "Black done."
    
    'blur the black area
    For Blur = 1 To BlurLevel
        For Y = BlackY / 2 - (BlurLevel / 2) To BlackY + (BlurLevel / 2) 'just blur the bottom half of it
            For X = BlackX - (BlurLevel / 2) To xMax - BlackX + (BlurLevel / 2)
                pPoint = ((xMax * (Y - 1)) + X) * 4
                '(up + down + left + right) / 4
                pxArray(pPoint + 1) = CByte(CLng((pxArray(pPoint + 1 - (xMax * 4))) + CLng(pxArray(pPoint + 1 + (xMax * 4))) + CLng(pxArray(pPoint + 1 - 4)) + CLng(pxArray(pPoint + 1 + 4))) / 4) 'R
                pxArray(pPoint + 2) = CByte(CLng((pxArray(pPoint + 2 - (xMax * 4))) + CLng(pxArray(pPoint + 2 + (xMax * 4))) + CLng(pxArray(pPoint + 2 - 4)) + CLng(pxArray(pPoint + 2 + 4))) / 4) 'G
                pxArray(pPoint + 3) = CByte(CLng((pxArray(pPoint + 3 - (xMax * 4))) + CLng(pxArray(pPoint + 3 + (xMax * 4))) + CLng(pxArray(pPoint + 3 - 4)) + CLng(pxArray(pPoint + 3 + 4))) / 4) 'B
            Next X
        Next Y
    Next: Debug.Print "Blur done, lets draw"
    
    'display the result
    For Y = 1 To yMax
        For X = 3 To xMax
            pPoint = ((xMax * (Y - 1)) + X) * 4
            'set the True value to False to display only the blured area
            If pxArray(pPoint + 1) <> 0 And pxArray(pPoint + 1) <> 255 Or True Then
                Me.PSet (X, Y), RGB(pxArray(pPoint + 1), pxArray(pPoint + 2), pxArray(pPoint + 3))
            End If
        Next X
    Next Y

End Sub

I also prepared a pxArray() that is just look like a 32bit array from a DIB, but i still dont know what is a DIB actually, and how can i use effectively. Im just wanna COPY the areas of the workspace there is a shadow occurs, to speed up the calculations.

I have 3 different sized rectangles. Each type need an exactly sized shadow effect.

Some preparation:

Dim Z as long
For Z = 1 to Ubound(dbBoxTypes)
   dbBoxTypes(Z).ShadowIndex = InitShadow(dbBoxTypes(Z).Width,dbBoxTypes(Z).Height, 5) '5=blur size
Next Z

That method (initshadow) will prepare 2 DIB's for each element, that is the shadow on the right and at the bottom.

Then, when i render each objects, i render a shadow component also..

  RenderShadow .objPosX, .objPosY, .ShadowIndex

The only problem is that i dont know:
-how to mix up the dibs
-how to get the dibs

A little help here would be nice!

I'm using my small gdi engine thingie http://www.vbforums.com/showthread.php?t=546312

[LaVolpe]

DIBs (Device Independent Bitmap) are memory bitmaps. They have a handle just like any other bitmap. To render one or the other, it first has to be selected into a DC and then unselected when done rendering. DIBs must be destroyed at some point too, otherwise, you get memory/resource leaks.

So, inside your RenderShadow routine, you should have code that calls SelectObject and also some code that calls AlphaBlend, BitBlt or StretchBlt api (or are you using GDI+?).

The jist of it, all variables are long. Shadow1 and Shadow2 are handles to the DIBs

oldBmp = SelectObject(memoryDC, Shadow1)
... draw using BitBlt, StretchBlt or AlphaBlend
SelectObject memoryDC, oldBmp
' then do the same for Shadow2

' When done, destroy both DIBs and the memory DC

If the above sounds alien, here is a great tutorial to help de-mystify DIBs. Jump to the bottom of the page
http://edais.mvps.org/Tutorials/index.html

[Jim Davis]

Great tutorial, that is exactly im looking for! Looks interesting, thanks a lot!

[Jim Davis]

YAY it looks good! Im used the 'hijacking' way (it just brilliant) to access the pixels in a dib that is contains the blt-ed copy of a small partial of the work area. so i just can modify the areas where i need to.

the only problem is that the drop shadow effect is rendered TOP DOWN

I mean, is there any common reason why a dibbed (and/or hijacked) stuff will be topdown? The funny thing is that when i blt back to the work area, the image is flipped again so it looks ok.

Well i cant found any reason why its top down

Function InitShadow(ByVal objW As Long, ByVal objH As Long, lShadowDepth As Long) As Long
'initializes a shadow for an object. so if you got a 40px*80px obj, just pass its size (40,80) and a shadow depth (5 for example), thats all.
Dim X As Long, Y As Long, Blur As Long

  lShadowIdx = lShadowIdx + 1
  
  With dbShadows(lShadowIdx)
    .lW = objW
    .lH = objH
    .lDepth = lShadowDepth
    .bmInfo.bmiHeader.biSize = Len(.bmInfo.bmiHeader)
    .bmInfo.bmiHeader.biPlanes = 1
    .bmInfo.bmiHeader.biBitCount = 32
    .bmInfo.bmiHeader.biCompression = &H0
    .bmInfo.bmiHeader.biWidth = .lW + .lDepth
    .bmInfo.bmiHeader.biHeight = .lH + .lDepth
    .bmInfo.bmiHeader.biSizeImage = ((((.bmInfo.bmiHeader.biWidth * .bmInfo.bmiHeader.biBitCount) + &H1F) And Not &H1F&) \ &H8) * .bmInfo.bmiHeader.biHeight
    .hDIB = CreateDIBSection(hsDC, .bmInfo, &H0, .ptrDIBData, 0, 0)
    
    ReDim .aPixel(.lW + .lDepth, .lH + .lDepth)

    'lets create a line at the right
    For Y = .lDepth To .lH - 1: .aPixel(.lW, Y) = 255: Next
      
    'lets create a line at the bottom
    For X = .lDepth To .lW - 1: .aPixel(X, .lH) = 255: Next
    
    For Blur = 1 To .lDepth
      
      'blur the right part
      For Y = 2 To .lH - 2
        For X = .lW - (.lDepth / 2) To .lW + .lDepth - 1
            .aPixel(X, Y) = (.aPixel(X, Y - 1) + .aPixel(X, Y + 1) + .aPixel(X - 1, Y) + .aPixel(X + 1, Y)) / 4
        Next X
      Next Y

      'blur the bottom part
      For Y = .lH - 2 To .lH + .lDepth - 1
        For X = 2 To .lW + .lDepth - 1
            .aPixel(X, Y) = (.aPixel(X, Y - 1) + .aPixel(X, Y + 1) + .aPixel(X - 1, Y) + .aPixel(X + 1, Y)) / 4
        Next X
      Next Y
    Next
    
  End With
  
  InitShadow = lShadowIdx
End Function

Sub RenderShadow(ByVal posX As Long, posY As Long, IDX As Long)
Dim DIBDataPtr As Long, hDIB As Long
Dim BMData() As Long
Dim MDDWADesc As SafeArray2D
Dim ArrDescPtr As Long
Dim X As Long, Y As Long
Dim R As Long, G As Long, B As Long, O As Long, A As Long
  
  hOldBmp = SelectObject(hsDC, dbShadows(IDX).hDIB)
  
  BitBlt hsDC, 0, 0, dbShadows(IDX).bmInfo.bmiHeader.biWidth, dbShadows(IDX).bmInfo.bmiHeader.biHeight, htDC, posX, posY, vbSrcCopy
  
  With MDDWADesc
      .cDims = 2
      .cbElements = 4
      .pvData = dbShadows(IDX).ptrDIBData
      .rgSABounds(0).lLbound = 0
      .rgSABounds(0).cElements = Abs(dbShadows(IDX).bmInfo.bmiHeader.biHeight)
      .rgSABounds(1).lLbound = 0
      .rgSABounds(1).cElements = (dbShadows(IDX).bmInfo.bmiHeader.biSizeImage \ .rgSABounds(0).cElements) \ 4
  End With
  
  ArrDescPtr = VarPtrArray(BMData)
  Call PutDWord(ByVal ArrDescPtr, VarPtr(MDDWADesc))
  
  With dbShadows(IDX)
      '"blend" the right part
      For Y = 2 To .lH - 2 - 1
        For X = .lW To .lW + .lDepth - 1
            O = BMData(X, Y): A = .aPixel(X, Y)
            R = ((O And &HFF&)) - A: If R < 0 Then R = 0
            G = ((O And &HFF00&) / 256) - A: If G < 0 Then G = 0
            B = ((O And &HFF0000) / 65536) - A: If B < 0 Then B = 0
            BMData(X, Y) = RGB(R, G, B)
        Next X
      Next Y

      '"blend" the bottom part
      For Y = .lH - 2 To .lH + .lDepth - 1
        For X = 2 To .lW + .lDepth - 1
            O = BMData(X, Y): A = .aPixel(X, Y)
            R = ((O And &HFF&)) - A: If R < 0 Then R = 0
            G = ((O And &HFF00&) / 256) - A: If G < 0 Then G = 0
            B = ((O And &HFF0000) / 65536) - A: If B < 0 Then B = 0
            BMData(X, Y) = RGB(R, G, B)
        Next X
      Next Y
  End With
  
  Call PutDWord(ByVal ArrDescPtr, 0&)
  
  Call BitBlt(htDC, posX, posY, dbShadows(IDX).bmInfo.bmiHeader.biWidth, _
      dbShadows(IDX).bmInfo.bmiHeader.biHeight, hsDC, 0, 0, vbSrcCopy)
  
  Call SelectObject(hsDC, hOldBmp)
  
End Sub

[Jim Davis]

I forgot to say that i just aligned the brown rectangles for this screenshot, to be 'attached' to the shadow effect, but the rendered shadow is just pretty much top down...

Look at this attachment for the actual projection to make things clear.

[LaVolpe]

Yes, by default, DIBs are stored bottom up, but when rendered via BitBlt, StretchBlt and the others, it is rendered top down as normal. Most of us have adapted to this and loop our hijacked arrays from Height-1 to 0 Step-1. However, if you really want to handle only top down, when you create the DIB in the first place, you must make your .bmiHeader.biHeight = -ActualHeight (negative value). But recommend just adapting like the rest of us because eventually, you'll be messing with DIBs that you didn't create and they will be bottom up 99.9% of the time.

[Jim Davis]

Ah thats crap. Ok ive fixed the whole rendering, so i moved the bottom shadow to the top, so it will be placed to the bottom on the flipped dib.

http://www.vbforums.com/showthread.php?p=3378331

Thanks your help LaVolpe!

[LaVolpe]

You're welcome. That was a great tutorial wasn't it? I studied that thing for weeks when I first started to mess with DIBs and bookmarked it too.

I saw your new project. If you want to check it for memory leaks, check out my tutorial in the FAQ section. If you have XP/2K, you can pretty much confirm/deny leaks within a few minutes.

[Jim Davis]

Ah yes it is! Ok i just read the first 2 sections, that was extactly i'm looking for. Im sorry to say, but its even better than any code i read so far. I also learnd the hijack way (well more or less), that is a brilliant way to direct access some 'previously hidden' memory areas. Maybe (later) i can adopt it into my futher codings as well!

Nice collection of experiments you got in there! Im diggin it!

Thanks, again.