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

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

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

Автор: XOXOJI 8.12.2008, 21:16

Надо програмно уменьшить размеры рисунка в picturebox или image, без разницы, но при этом чтоб форма оставалась невидимой... нашел реализацию где необходимо чтоб форма была видима... но это не устраивает (((

Автор: neic 8.12.2008, 22:16

А что тебе мешает, сделать форму при загрузке не видимо?

Код


Form2.Show
Form2.Visible = False

Или сделай код в инициализации формы, после чего форма автоматически будет закрываться.

Автор: XOXOJI 8.12.2008, 22:18

если делаю форму невидимой то StretchBlt копирует кусок ненужного экрана, а если ее потом убивать, то не очень коректно будет, постоянно моргать что-то на экране будет...

Автор: neic 8.12.2008, 22:21

XOXOJI, попробуй тогда минимизировать форму при загрузке.
И если можно, кусок кода. Чтобы хотя бы посмотреть, что можно сделать.

Автор: XOXOJI 8.12.2008, 22:29

Код


Private Sub ImgResize(src As PictureBox, TmpPic As PictureBox, mWidth As Long, mHeight As Long)
src.AutoRedraw = False
TmpPic.AutoRedraw = True
TmpPic.Height = mHeight 'установка размеров невидимого picturebox
TmpPic.Width = mWidth
StretchBlt TmpPic.hdc, 0, 0, mWidth, mHeight, src.hdc, 0, 0, src.Width, src.Height, SRCCOPY
'сохранить временной файл на диске
SavePicture TmpPic.Image, App.Path + "\tempimg.bmp"
'перезагрузить оригинальный picturebox
src.AutoSize = True
src.Picture = LoadPicture(App.Path + "\tempimg.bmp")
'удалить временной файл
Kill App.Path + "\tempimg.bmp"
'очистить невидимый picturebox
TmpPic.Picture = LoadPicture()
'пример для вызова функции
'ImgResize Picture1, Picture2, Picture1.Width / 2, Picture1.Height / 2
End Sub

Автор: neic 8.12.2008, 22:45

Ругается на эту строчку:

Код


StretchBlt TmpPic.hDC, 0, 0, mWidth, mHeight, src.hDC, 0, 0, src.Width, src.Height, SRCCOPY

Автор: XOXOJI 9.12.2008, 04:26

Код


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
Const SRCCOPY = &HCC0020

Автор: XOXOJI 9.12.2008, 05:10

методом научного тыка проблему решил ))) кому интерестно то вот решение

Код


Private Sub Command3_Click()
pic.Picture = LoadPicture("c:\1.jpg")
Picture1.AutoRedraw = True
Picture1.Height = 1000
Picture1.Width = 1000
Picture1.PaintPicture pic, _
    0, 0, 1000, 1000, , , , , vbSrcCopy
SavePicture Image1.Picture, "c:\2.jpg"
End Sub

Автор: mb78 27.12.2008, 03:15

Создаем 2 PictureBox .

Затем

Picture1.Visible=False
Picture2.Visible=False
Picture1.Autoredraw=True
Picture2.Autoredraw=True

Загружаем картинку в Picture2.Picture (внимание :не в Picture1)

Затем Picture1.PaintPicture Picture2.Picture 0 , 0 , желаемый размер по X , желаемый размер по Y , 0 , 0 , Picture2.Width , Picture2.Height

Затем сохраняем Picture1 (если нужно).