Как правильно отмасштабировать объект Pictrure в Pictureboxе

[MiGan]

Код: Выделить всё


Private Sub SetPicture(ByVal Path As String, ByRef Img As Image)
    Dim fso As New FileSystemObject
    Dim Proportion As Single
    Dim Picture As StdPicture
    If fso.FileExists(Path) Then
        Set Picture = LoadPicture(Path)
        Proportion = Picture.Height / Picture.Width
        Picture.Height = Me.ScaleY(Img.Height, vbTwips, vbPixels)
        Picture.Width = Picture.Height / Proportion
        Set Img.Picture = Picture
    Else
        Set Img.Picture = Nothing
    End If
End Sub


Такой код не работает, т.к. при записи значения проперту Height объекта Picture возникает: Object does not support this property or method!
Как???
Или подскажите, какие еще есть пути для того, чтобы программно подогнать картинку в picturebox (!!! с соблюдением ее пропорций, т.е. не picturebox.stretch= true!!!)

[Konst_One]

посмотри метод PaintPicture

[MiGan]

Во-первых - paintpicture - м-д PictureBoxа а у меня был Image. Ну ладно. Проблема в том, что мне нужно сжать картинку с соблюдением ее пропорций, т.е. допустим растянуть картинку по высоте контейнера а по ширине в одинаковой пропорции!!!!

[Kovu]

BitBlt рулит ( это тот же Paint Picture )

[Ennor]

Для масштабирования лучше использовать StretchBlt() - она специально для этого предназначена.

[Konst_One]

посмотри вот этот пример:
http://bbs.vbstreets.ru/download.php?id=763
его oxygen выкладавала в свое время

[SHURUP]

Центрирование изображения с сохранением пропорциЙ:
(Нужна Form1, а на ней Picture1)

Код: Выделить всё

Option Explicit
Private Sub SetPicture()
Dim PicProportion As Single, _
    FormProportion As Single, _
_
    newHeiqht As Single, _
    newWidth As Single, _
    newTop As Single, _
    newLeft As Single
   
    PicProportion = Picture1.Height / Picture1.Width
    FormProportion = ScaleHeight / ScaleWidth
    If PicProportion > FormProportion Then
        newHeiqht = Form1.ScaleHeight - 1
        newWidth = newHeiqht / PicProportion
    Else
        newWidth = Form1.ScaleWidth - 1
        newHeiqht = newWidth * PicProportion
    End If
        newTop = (Form1.ScaleHeight - newHeiqht) / 2
        newLeft = (Form1.ScaleWidth - newWidth) / 2
    Cls
    On Error Resume Next
    PaintPicture Picture1.Picture, _
        newLeft, newTop, newWidth, newHeiqht, _
        0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, vbSrcCopy
End Sub

Private Sub Form_Load()
Dim path As String
path = "C:\windows\winnt.bmp"
    AutoRedraw = True
With Picture1
    .AutoRedraw = True
    .AutoSize = True
    .Visible = False
    If FileLen(path) Then .Picture = LoadPicture(path)
End With
End Sub

Private Sub Form_Resize()
    SetPicture
End Sub


теперь можно ресайзить форму

[MiGan]

SHURUP
Спасибо! Твой пример - то что надо

[Kovu]

Ну а если заменить PaintPicture на BitBlt то вместо жирного пикчербокса можно использовать имадж как ты и хотел
З.Ы. Прямой вызов всегда быстрей

[BV]

2 Kovu

Для самых "умных": Image не имеет hDC, которая и нужна для BitBlt!

[tyomitch]

2Kovu

Для самых "умных": BitBlt не позволяет менять масштаб изображения, т.ч. в данном случае она совершенно бесполезна.

[Kovu]

Заели меня бедного

[alibek]

Image не имеет hDC, которая и нужна для BitBlt!

Image1.Picture.Handle не смотрел?

[tyomitch]

Image не имеет hDC, которая и нужна для BitBlt!

Image1.Picture.Handle не смотрел?

Это же hBitmap, а не hDC!

[alibek]

Наверное да, сам не юзал