[RESOLVED] picturebox upsidedown-gradient

[LaVolpe]

Here is a working example. The actual blending of the reflection into the background, from your example, is not done the way I did it. It is using a different algorithm. My goal was to get close, replicating it 100% requires more work and, honestly, not my responsibility.

1. Start a new project
2. Add 2 pictureboxes to the form: Picture1 & Picture2
3. Add the attached image to Picture2
4. Copy this code to the form & run the project
5. Play around with different backcolors & different images. Also play with different opacity values for the lBlend variable.

Option Explicit
Private Type TRIVERTEX
   X As Long
   Y As Long
   Red As Integer
   Green As Integer
   Blue As Integer
   Alpha As Integer
End Type

Private Type GRADIENT_RECT
   UpperLeft As Long
   LowerRight As Long
End Type
   
Private Declare Function GradientFill Lib "msimg32" (ByVal hdc As Long, pVertex As Any, ByVal dwNumVertex As Long, pMesh As Any, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Private Declare Function StretchBlt Lib "gdi32.dll" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdcDest As Long, ByVal xDest As Long, ByVal yDest As Long, ByVal WidthDest As Long, ByVal HeightDest As Long, ByVal hdcSrc As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long, ByVal Blendfunc As Long) As Long
Private Declare Function SetStretchBltMode Lib "gdi32.dll" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Private Const STRETCH_HALFTONE As Long = 4

Private Sub Form_Load()
    ' source image goes into picture2
    With Picture2
        .Appearance = 0
        .BorderStyle = 0
        .AutoSize = True
        .AutoRedraw = True
        .Visible = False
    End With
    With Picture1
        .Appearance = 0
        .BorderStyle = 0
        .AutoRedraw = True
        .BackColor = RGB(38, 58, 88)  ' set destination backcolor
    End With
    DoSample
End Sub

Private Sub DoSample()
   
    Dim cx As Long, cy As Long, lBlend As Long, reflectCy As Long
    Dim bdrCx As Long, bdrCy As Long, sMode As Long
    Dim scaleCx As Long, scaleCy As Long, scaleReflect As Long
    
    Const imgScale As Long = 100 ' 100 pct of image, change to < > 100% as needed
    
    ' get actual image size
    cx = ScaleX(Picture2.Picture.Width, vbHimetric, vbPixels)
    cy = ScaleY(Picture2.Picture.Height, vbHimetric, vbPixels)
    
    reflectCy = (cy \ 2)        ' how much of image to reflect; cannot be > cy
    scaleReflect = (reflectCy * imgScale) \ 100
    scaleCx = (cx * imgScale) \ 100
    scaleCy = (cy * imgScale) \ 100
    
    bdrCx = 8: bdrCy = 8    ' borders around image, set to taste
    ' resize destination picbox to imagesize + reflection + borders
    Picture1.Width = ScaleX(bdrCx * 2 + scaleCx, vbPixels, Me.ScaleMode)
    Picture1.Height = ScaleY(bdrCy * 2 + scaleCy + scaleReflect, vbPixels, Me.ScaleMode)
    
    ' gradient fill a rectangle = to reflection size. We will use top portion of destination
    ' since it will be painted over anyway. Prevents needing another DC to hold gradient box
    Call DrawGradientFill(Picture1.hdc, Picture1.BackColor, vbBlack, bdrCx, bdrCy, scaleCx, scaleReflect - 1, True)
    
    ' copy flipped source to destination, offset for borders
    sMode = SetStretchBltMode(Picture1.hdc, STRETCH_HALFTONE) ' makes stretching better quality
    ' flip portion of source to bottom of destination. Bottom edges of normal & flipped images will overlap by 1 pixel
    Call StretchBlt(Picture1.hdc, bdrCx, scaleReflect - 2 + bdrCy + scaleCy, scaleCx, -scaleReflect, Picture2.hdc, 0, cy - reflectCy, cx, reflectCy, vbSrcCopy)
    
    ' blend the gradient box over the flipped portion
    lBlend = (192 * &H10000) ' change 192 to level of opacity of gradient over image. Range 0-255
    AlphaBlend Picture1.hdc, bdrCx, scaleCy + bdrCy, scaleCx, scaleReflect - 1, Picture1.hdc, bdrCx, bdrCy, scaleCx, scaleReflect - 1, lBlend
    
    ' copy source to destination, offset for borders
    StretchBlt Picture1.hdc, bdrCx, bdrCy, scaleCx, scaleCy, Picture2.hdc, 0, 0, cx, cy, vbSrcCopy
    SetStretchBltMode Picture1.hdc, sMode ' reset stretchmode
    
    Picture1.Refresh
    
End Sub

Private Sub DrawGradientFill(ByVal gDC As Long, ByVal dwColour1 As Long, ByVal dwColour2 As Long, _
                            ByVal gLeft As Long, ByVal gTop As Long, _
                            ByVal gWidth As Long, ByVal gHeight As Long, Vertical As Boolean)
    
   Dim vert(0 To 1) As TRIVERTEX
   Dim grRc As GRADIENT_RECT
  
  'Colour at upper-left corner
   With vert(0)
      .X = gLeft
      .Y = gTop
      .Red = LongToSignedShort((dwColour1 And &HFF&) * 256)
      .Green = LongToSignedShort(((dwColour1 And &HFF00&) \ &H100&) * 256)
      .Blue = LongToSignedShort(((dwColour1 And &HFF0000) \ &H10000) * 256)
      .Alpha = 0
   End With

   
  'Colour at bottom-right corner
   With vert(1)
      .X = gWidth + gLeft
      .Y = gHeight + gTop
      .Red = LongToSignedShort((dwColour2 And &HFF&) * 256)
      .Green = LongToSignedShort(((dwColour2 And &HFF00&) \ &H100&) * 256)
      .Blue = LongToSignedShort(((dwColour2 And &HFF0000) \ &H10000) * 256)
      .Alpha = 0
   End With

   With grRc
      .LowerRight = 0
      .UpperLeft = 1
   End With
   
   Call GradientFill(gDC, vert(0), 2, grRc, 1, Abs(Vertical))

End Sub

Private Function LongToSignedShort(dwUnsigned As Long) As Integer
    
  'convert from long to signed short
   If dwUnsigned < 32768 Then
      LongToSignedShort = CInt(dwUnsigned)
   Else
      LongToSignedShort = CInt(dwUnsigned - &H10000)
   End If
    
End Function

Edited: Added scaling functionality so final image can be stretched