FlexGrid Pictures and Sizing [Resolved (Kinda)]

[Ogmius]

Hello,

I am trying to put a picture in a cell but it is too big and resizing the grid to accomodate the size of the picture is not an option.. What I want to do is resize the picture to fit inside the cell, how can I do that?

thanks!

- Quack!

[bushmobile]

would using a picturebox with .Visible = False and .AutoRedraw = True be an option:

Private Sub Command1_Click()
    With MSFlexGrid1
        .Col = 1
        .Row = 1
        Picture1.PaintPicture LoadPicture("C:\test.jpg"), 0, 0, .CellWidth, .CellHeight
        Picture1.Picture = Picture1.Image
        Set .CellPicture = Picture1.Picture
        Set Picture1.Picture = Nothing
    End With
End Sub

[RhinoBull]

would using a picturebox with .Visible = False and .AutoRedraw = True be an option:

Private Sub Command1_Click()
    With MSFlexGrid1
        .Col = 1
        .Row = 1
        Picture1.PaintPicture LoadPicture("C:\test.jpg"), 0, 0, [B][SIZE=3].CellWidth, .CellHeight[/SIZE][/B]
        Picture1.Picture = Picture1.Image
        Set .CellPicture = Picture1.Picture
        Set Picture1.Picture = Nothing
    End With
End Sub

I wouldn't agree with the highlighted - cell could be as wide as the entire form so can height.
Image size needs to be calculated proportionally (basically scaled down) but based on "highlighted properties" vs original image size.

[Ogmius]

well the cells arent that large, but the pictures are pulled from an imagelist control, so I dont think that would work anyway

[jcis]

well the cells arent that large, but the pictures are pulled from an imagelist control, so I dont think that would work anyway

It will work like this:

'Test this in a new project, Add a Picturebox and the Imagelist loaded with pictures.
Private Sub Form_Load()
    With Picture1
        .Visible = False
        .AutoRedraw = True
        .BorderStyle = flexBorderNone
    End With
End Sub
 
Private Sub Command1_Click()
Dim i As Long
    
    With MSFlexGrid1
        .Rows = 2
        .Cols = Me.Imagelist1.ListImages.Count
        .Row = 1
        For i = 1 To .Cols - 1
            .Col = i
            .CellPictureAlignment = flexAlignCenterCenter
            
            Picture1.Height = .CellHeight
            Picture1.Width = .CellWidth
            
            ResizePicture Picture1, Me.Imagelist1.ListImages.Item(i).Picture
            Set .CellPicture = Picture1.Image
        Next
    End With
End Sub
 
Private Sub ResizePicture(pBox As PictureBox, pPic As Picture)
Dim lWidth      As Single, lHeight    As Single
Dim lnewWidth   As Single, lnewHeight As Single
    
    'Clear the Image  in the Picturebox
    pBox.Cls
    
    'Get the size of the Image, but in the same Scale than the scale used by the PictureBox
    lWidth = pBox.ScaleX(pPic.Width, vbHimetric, pBox.ScaleMode)
    lHeight = pBox.ScaleY(pPic.Height, vbHimetric, pBox.ScaleMode)
    
    'If image Width > pictureBox Width, resize Width
    If lWidth > pBox.ScaleWidth Then
        lnewWidth = pBox.ScaleWidth              'new Width = PB width
        lHeight = lHeight * (lnewWidth / lWidth) 'Risize Height keeping proportions
    Else
        lnewWidth = lWidth                       'If not, keep the original Width value
    End If
    
    'If the image Height > The pictureBox Height, resize Height
    If lHeight > pBox.ScaleHeight Then
        lnewHeight = pBox.ScaleHeight                   'new Height = PB Height
        lnewWidth = lnewWidth * (lnewHeight / lHeight)  'Risize Width keeping proportions
    Else
        lnewHeight = lHeight                            'If not, use the same value
    End If
    
    'add resized and centered to Picturebox
    pBox.PaintPicture pPic, (pBox.ScaleWidth - lnewWidth) / 2, _
                            (pBox.ScaleHeight - lnewHeight) / 2, _
                            lnewWidth, lnewHeight
End Sub

That code will fit the picture in the cell keeping ratio, but it won't make the picture bigger than its original size when its original size is smaller than the cell. Anyway, if you want to always resize (also in that cases) then this code can be easily modified to do that.

[bushmobile]

I wouldn't agree with the highlighted - cell could be as wide as the entire form so can height.
Image size needs to be calculated proportionally (basically scaled down) but based on "highlighted properties" vs original image size.

true - i just assumed Ogmius wanted to resize it to fill the cell, not resize it proportionally.

[RhinoBull]

well the cells arent that large, but the pictures are pulled from an imagelist control, so I dont think that would work anyway

Well, if you allow column rsizing then you cannot possibly know what it might be. That one thing. Another one is that you wouldn't want your users to see extremly distorted image or out of reasonable proportions, would you?

[Ogmius]

That code looks great, im gonna have to use it next chance I get and let you know.. The cells are going to be a fixed size that cannot be changed, so as long as I can get one th work the rest will be great

Thanks!

[RhinoBull]

OK, good luck.

[Ogmius]

Ok, I did what you said, and the picture control works fine, but when it sets the cellpicture into the flexgrid I end up with no picture in the flexgrid...

Below is the code, and I aslo attached a bmp of what it looks like

flxAgentList.Row = i
        flxAgentList.Col = 0
        flxAgentList.CellPictureAlignment = flexAlignCenterCenter
        If flxAgentList.RowHeight(i) > flxAgentList.ColWidth(0) Then
            Picture1.Height = flxAgentList.RowHeight(i)
            Picture1.Width = flxAgentList.RowHeight(i)
        Else
            Picture1.Height = flxAgentList.ColWidth(0)
            Picture1.Width = flxAgentList.ColWidth(0)
        End If
        
        'Picture1.Picture = imgState.ListImages(Int(Mid(strAgentData, 1, InStr(1, strAgentData, "|", vbTextCompare) - 1))).Picture
        
        ResizePicture Picture1, imgState.ListImages(Int(Mid(strAgentData, 1, InStr(1, strAgentData, "|", vbTextCompare) - 1))).Picture
        
        Set flxAgentList.CellPicture = Picture1.Image
        strAgentData = Mid(strAgentData, InStr(1, strAgentData, "|", vbTextCompare) + 1, Len(strAgentData))
        flxAgentList.TextMatrix(i, 1) = Mid(strAgentData, 1, InStr(1, strAgentData, "|", vbTextCompare) - 1)
        strAgentData = Mid(strAgentData, InStr(1, strAgentData, "|", vbTextCompare) + 1, Len(strAgentData))
        flxAgentList.TextMatrix(i, 2) = Mid(strAgentData, 1, InStr(1, strAgentData, "|", vbTextCompare) - 1)
        strAgentData = Mid(strAgentData, InStr(1, strAgentData, "|", vbTextCompare) + 1, Len(strAgentData))
        
        strAgentData = Mid(strAgentData, InStr(1, strAgentData, vbNewLine, vbTextCompare) + 2, Len(strAgentData))
        i = i + 1
        'flxAgentList.Rows = i + 1
     Loop

[jcis]

That code looks ugly, and it's incomplete. Could you attach a project that demonstrates your problem? (zipped)

[Ogmius]

Attached is the application, I changed the names of the people that im generating this for and removed the parts that add registry entries so that it doesnt put a bunch of crap on your PC...

The modules are from other projects that I found on PlanetSourceCode and even here on VB Forums, I just havent had the chance to reference them in my project yet so if you wrote one of these, I Promise you will be acknowledged!


If you click on the button that says "Agent View Test" it will do what its supposed to do, but it still has the bricks instead of the pictures... suggestions would be appreciated!

Thanks in advance!

[Ogmius]

Bump... anyone?

[Ogmius]

I got it kinda... I decided to embed the proper size images into the application with an image list control instead of resizing them... its not the way I wanted to do it but it works and thats whats important