Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > VB6 > Уменьшение картинки

Автор: DenageS 18.10.2006, 12:24

Я так понял что картинку надо пропускать через image (stretch) и picturebox(autosize)? Но почему-то получается совсем не так как надо... Помогите пожалуйста. Чтобы картинка уменьшалась под размер формы.

Автор: ~FoX~ 18.10.2006, 12:36

Ну так растяни свой пикчербокс/имедж на размер формы и все.

Автор: DenageS 18.10.2006, 17:44

Изображение исказиться! Я не могу знать какое разрешение у изображения будет

Автор: ~FoX~ 19.10.2006, 08:15

Ну и кто мешает узнать?

Код


Private Sub Form_Load()
Dim x, y As Integer
Const C = 5
  
  Image1.Stretch = True
  Image1.Picture = LoadPicture("c:\1.bmp")
  
  x = Image1.Picture.Width
  y = Image1.Picture.Height
  
  Form1.Width = x / C
  Form1.Height = y / C
  
  Image1.Width = x / C
  Image1.Height = y / C
  
End Sub

Автор: DenageS 19.10.2006, 17:59

Ого! Спасибо! Но вот только как узнать "C", на которую делится, чтобы уменьшалось до рамера формы, а не форма до размеров..

Автор: BorisVorontsov 19.10.2006, 19:59

Код


'в hCanvas - Form или PictureBox
Public Function CheckPictureSize(ByRef hCanvas As Object, ByVal lMaxWidth As Long, ByVal lMaxHeight As Long) As Boolean
    Dim sngAspectRatio As Single
    Dim lW As Long, lH As Long
    Dim lW2 As Long, lH2 As Long
    Dim hTemp As StdPicture
    lW = hCanvas.ScaleWidth
    lH = hCanvas.ScaleHeight
    If lW > lMaxWidth Or lH > lMaxHeight Then
        If lW > lH Then
            sngAspectRatio = lW / lH
            lW2 = lMaxWidth
            lH2 = lMaxWidth / sngAspectRatio
        Else
            sngAspectRatio = lH / lW
            lW2 = lMaxHeight / sngAspectRatio
            lH2 = lMaxHeight
        End If
        Set hTemp = hCanvas.Picture
        Set hCanvas.Picture = Nothing
        Call SetStretchBltMode(hCanvas.hdc, STRETCH_HALFTONE)
        hCanvas.PaintPicture hTemp, 0, 0, lW2, lH2
        Set hCanvas.Picture = hCanvas.Image
        CheckPictureSize = True
    Else
        CheckPictureSize = False
    End If
End Function

Автор: DenageS 20.10.2006, 09:21

На Call SetStretchBltMode ругается Sub или фуекция не определена. smile

Автор: cardinal 20.10.2006, 19:48

DenageS, а объявить слабо? (см. Api Viewer)