Is there a simple way of sending a thumbnail on a LAN 2

[tedsmith]

Is there a way of sending a thumbnail of a BMP over a LAN?
I can create what look like a thumbnail with StretchBlt but it seems to be only the picturebox that gets smaller, not the actual bitmap.
I don't want to view the thumbnail at the sending end but I want to send the smaller BMP in a propertybag like it's bigger brother so bypassing the picturebox step at the sending end entirely would be better.

 

[strongm]

Perhaps you'd better show us what your code is doing so far. StretchBlt does not and cannot change the size of a PictureBox. At all. Ever. So we need to see what you are actually doing rather than what you say you are doing ...

 

[tedsmith]

Also it only stretches the part of the picture showing in the picture box so if the picture is smaller or larger than the first box, you also get the borders or cropping in the thumbnail

'2 picicture boxes, 1 command button. Both pic boxes to Autoredraw=true, Form and Scalemode=Pixels
Option Explicit
Private Declare Function StretchBlt Lib "gdi32" _
  (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 SetStretchBltMode Lib "gdi32" _
  (ByVal hdc As Long, ByVal nStretchMode As Long) _
  As Long
Private Const STRETCH_HALFTONE = 4
Dim t As Single

Private Sub Command1_Click()
Dim PWidth As Long, Pheight As Long
PWidth = 200
Pheight = 150
Picture2.Cls
SetStretchBltMode Picture2.hdc, STRETCH_HALFTONE
StretchBlt Picture2.hdc, 0, 0, PWidth, Pheight, Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, vbSrcCopy

End Sub

Image boxes have no scale values.
Can you use Stetchbit to directly change the pixels in the picture before you present it to an image box?

 

[strongm]

Ted, we've discussed with you in the past the limitations of blitting from a PictureBox - namely that you can only blit what is visible because everything outside the visible area is clipped (VB does this for display performance reasons.

And we've discussed solution, namely using memory DCs as the source and target of the blits.

In outline, create a memory DC for the source and destination. Select your source bitmap into the source DC. Create a compatible (albeit blank) bitmap of the required thumbnail size for the destination, and select it into the destination DC (keeping the returned original bmp handle fro the DC). Now stretchblit from source to destination. Select back in the bmp handle we kept earlier thus allowing us to retrieve the current bmp handle - which is the handle to the thumbnailed bitmap.

Now, since you then want to send this via the property bag trick (I'm guessing) all you've got to do now is get that bitmap into one of the Picture objects (IPicture, IPictureDisp, StdPicture, Picture) and Robert is the brother of one of your parents.

 

[tedsmith]

I suspected it would be something like that. As long a stretchblit will work I'll give it a go.
(By the way, I have a brother named Robert)

 

[strongm]

I've got example code if you want

 

[strongm]

I'll take the lack of response as a 'no' then ...

 

[Swi]

Please share strongm.

Swi

 

[strongm]

Ok. You'll need a form with a picture box (just to display the final thumbnail) and a command button. This particular version also experiments with a lesser known/used feature of an IPicture which reduces the number of API required calls slightly. Nevertheless, you should be able to follow what is going on from the outline explanation I provided above:

[blue]Option Explicit

Private Type PICTDESC
   lSize As Long
   lType As Long
   hImage As Long
   hPal As Long
   lReserved As Long
End Type

Private Type IID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(7) As Byte
End Type

Private Const S_OK = &H0
Private Const SRCCOPY = &HCC0020

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32" (lpPictDesc As PICTDESC, RefIid As IID, ByVal fOwn As Boolean, IPict As IPicture) As Long

Private Declare Function StretchBlt Lib "gdi32" (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 SetStretchBltMode Lib "gdi32" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long

Private Enum StretchMode
    BLACKONWHITE = 1
    WHITEONBLACK = 2
    COLORONCOLOR = 3
    HALFTONE = 4
End Enum


Private Sub Command1_Click()
    Dim myPic As IPicture
    Set myPic = LoadPicture("c:\Sunset.bmp") ' my example picture; you probably want to change this ...
    Set Picture1 = Thumbnail(myPic, 33) ' display the returned thumbnail in a picture
End Sub

Public Function Thumbnail(myPic As IPicture, Optional ScalePercent As Single = 100) As IPicture
    Dim srcDC As Long
    Dim dstDC As Long

    Dim oldsrcBmp As Long
    Dim dstBmp As Long
    Dim olddstBmp As Long
    Dim dstPic As IPicture
    
    Dim srcWidth As Single
    Dim srcHeight As Single
    
    srcDC = CreateCompatibleDC(Form1.hdc)
    dstDC = CreateCompatibleDC(Form1.hdc)
    
    srcWidth = Form1.ScaleX(myPic.Width, vbHimetric, vbPixels) ' IPicture measurements are HiMetric, but we need pixels
    srcHeight = Form1.ScaleX(myPic.Height, vbHimetric, vbPixels)
   
    myPic.SelectPicture srcDC, 0&, 0& ' essentially an OLE version of SelectObject API
    dstBmp = CreateCompatibleBitmap(Form1.hdc, srcWidth * (ScalePercent / 100), srcHeight * (ScalePercent / 100)) ' create a blank, appropriately sized destination bitmap
    olddstBmp = SelectObject(dstDC, dstBmp)
    
    SetStretchBltMode dstDC, COLORONCOLOR
    StretchBlt dstDC, 0, 0, srcWidth * (ScalePercent / 100), srcHeight * (ScalePercent / 100), srcDC, 0, 0, srcWidth, srcHeight, SRCCOPY
    dstBmp = SelectObject(dstDC, olddstBmp) ' recover and free handle to our thumbnailed bitmap from DC

    Set Thumbnail = PictureFromhBmp(dstBmp) ' and return an IPicture
End Function

Public Function PictureFromhBmp(ByVal hBmp As Long) As IPicture
    Dim IPict As IPicture
    Dim lpPictDesc As PICTDESC
    Dim iidIPict As IID
    
    If hBmp Then
    
        ' Minimally initialise PICTDESC structure
        With lpPictDesc
            .lSize = Len(lpPictDesc)
            .lType = vbPicTypeBitmap
            .hImage = hBmp
        End With
        
        'GUID for IUnknown Interface
        '{00000000-0000-0000-C000-000000000046}
        iidIPict.Data4(0) = &HC0
        iidIPict.Data4(7) = &H46
        
        If OleCreatePictureIndirect(lpPictDesc, iidIPict, True, IPict) = S_OK Then
             Set PictureFromhBmp = IPict
        End If
        
    End If
End Function[/blue]

 

[Swi]

Very nice. I will mess around with it when I get a chance. Once again, thank you for sharing.

Swi

 

[tedsmith]

Yes it works very fast - thanks.