Модераторы: Akina
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Программное сжатие файла-картинки 
:(
    Опции темы
Electron
Дата 2.11.2005, 13:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 8
Регистрация: 2.11.2005

Репутация: нет
Всего: нет
Буду очень признателен, если кто подскажет или даст ссылку, где это можно прочесть, как программно VB сжать изображение. Есть файл-изображение, условно 2Мб, во весь экран, нужно уменьшить изображение в 10 раз, и записать в файл, соответственно, чтобы объём уменьшился тоже. smile
PM MAIL   Вверх
cardinal
Дата 2.11.2005, 16:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Инженер
****


Профиль
Группа: Экс. модератор
Сообщений: 6003
Регистрация: 26.3.2002
Где: Германия

Репутация: 19
Всего: 99
Сжать в смысле размеры изменить (по горизонтали и вертикали) или в смысле dither(http://www.compuphase.com/riemer.htm)?
Если изменить размеры то
Изменить размер картинки:
http://www.activevb.de/tipps/vb6tipps/tipp0069.html
http://www.activevb.de/tipps/vb6tipps/tipp0072.html
http://www.activevb.de/tipps/vb6tipps/tipp0223.html
по-русски инфо не нашел...


--------------------
Немецкая оппозиция потребовала упростить натурализацию иммигрантов
В моем блоге: Разные истории из жизни в Германии

"Познание бесконечности требует бесконечного времени, а потому работай не работай - все едино".  А. и Б. Стругацкие
PM   Вверх
Electron
Дата 3.11.2005, 14:49 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 8
Регистрация: 2.11.2005

Репутация: нет
Всего: нет
Спасибо большое за ссылки. Мне нужно изменить в смысле dither и затем по размерам(вертикаль - горизонталь). Взял оттуду функцию:
Код

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


Private Sub ZoomSub(ByVal Prozent, PicOut As PictureBox, PicInp As PictureBox)
    Dim dx1&, dy1&, dx2&, dy2&, tx&, ty&, SHdc&, ZHdc&
    
    tx = Screen.TwipsPerPixelX
    ty = Screen.TwipsPerPixelY
    
    dx1 = PicOut.Width / tx
    dy1 = PicOut.Height / ty
    
    dx2 = dx1 * Prozent / 100
    dy2 = dy1 * Prozent / 100
    
    ZHdc = PicInp.hdc
    SHdc = PicOut.hdc
    PicInp.AutoRedraw = False
    Call SetStretchBltMode(ZHdc, DELETESCANS)
    StretchBlt ZHdc, 0, 0, dx2, dy2, SHdc, 0, 0, dx1, dy1, SRCCOPY
    PicInp.Refresh
    PicInp.AutoRedraw = True
End Sub

Возник вопрос, она работает не с содержимым PictureBox, а с экраном, т.е. если на форму с PictureBox наложить другое окно с картинкой, то будет скопирована картинка из другого окна. Как бы избежать этого???

Это сообщение отредактировал(а) cardinal - 3.11.2005, 16:13
PM MAIL   Вверх
cardinal
Дата 3.11.2005, 16:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Инженер
****


Профиль
Группа: Экс. модератор
Сообщений: 6003
Регистрация: 26.3.2002
Где: Германия

Репутация: 19
Всего: 99
Модератор: Используйте теги (см. выше на странице) для подсветки кода!

Мне почему-то показалось, что функция написано нелогично (что касается PicInp и PicOut). Я переписал ее так:
Код

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

Const SRCCOPY = &HCC0020
Const DELETESCANS = 3


Private Sub ZoomSub(ByVal Prozent, PicInp As PictureBox, PicOut As PictureBox)
Dim dx1&, dy1&, dx2&, dy2&, tx&, ty&, SHdc&, ZHdc&

PicOut.AutoRedraw = True

tx = Screen.TwipsPerPixelX
ty = Screen.TwipsPerPixelY

dx1 = PicInp.Width / tx
dy1 = PicInp.Height / ty

dx2 = dx1 * Prozent / 100
dy2 = dy1 * Prozent / 100

ZHdc = PicInp.hdc
SHdc = PicOut.hdc
Call SetStretchBltMode(ZHdc, DELETESCANS)
StretchBlt SHdc, 0, 0, dx2, dy2, ZHdc, 0, 0, dx1, dy1, SRCCOPY
PicOut.Refresh
End Sub

и проверив
Код

Private Sub Command1_Click()
ZoomSub 50, PicInp, PicOut
End Sub

был доволен результатом... smile
Цитата(Electron @ 3.11.2005, 12:49)
Мне нужно изменить в смысле dither

Ну а для этого думаю много чего готового можно найти.
Например:
http://www.activevb.de/tipps/vb6tipps/tipp0663.html


--------------------
Немецкая оппозиция потребовала упростить натурализацию иммигрантов
В моем блоге: Разные истории из жизни в Германии

"Познание бесконечности требует бесконечного времени, а потому работай не работай - все едино".  А. и Б. Стругацкие
PM   Вверх
Electron
Дата 3.11.2005, 17:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 8
Регистрация: 2.11.2005

Репутация: нет
Всего: нет
Результат мне тоже вначале показался замечательным. Но получается, что PicInp в начале свое содержимое выводит на экран, а затем с экрана обрабатывается функцией. Поэтому, если PicInp будет частично отображен(например: у формы изменены размеры, что не полностью показыватся PicInp), то функция возьмет часть картинки из PicInp, а другую часть просто с экрана. Можно как-то сделать, минуя экран? Надеюсь, понятно написал smile
PM MAIL   Вверх
cardinal
Дата 3.11.2005, 18:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Инженер
****


Профиль
Группа: Экс. модератор
Сообщений: 6003
Регистрация: 26.3.2002
Где: Германия

Репутация: 19
Всего: 99
А понял... Ну тогда вот:
http://www.vbarchiv.net/archiv/tipp_1083.html
Но учти что размер файла не уменьшиться если ты например возьмешь файл jpg и запомнишь его (уменьшив перед этим размеры) функцией SavePicture.

p.s. Надеюсь с немецким проблем нет? smile


--------------------
Немецкая оппозиция потребовала упростить натурализацию иммигрантов
В моем блоге: Разные истории из жизни в Германии

"Познание бесконечности требует бесконечного времени, а потому работай не работай - все едино".  А. и Б. Стругацкие
PM   Вверх
Electron
Дата 3.11.2005, 19:00 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 8
Регистрация: 2.11.2005

Репутация: нет
Всего: нет
После твоих ссылок, немецкий буду знать в совершенстве smile Ага, работает, уменьшает саму картинку, а объём файла увеличивает раза в три smile спасибо большое, буду разбираться.
PM MAIL   Вверх
cardinal
Дата 3.11.2005, 19:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Инженер
****


Профиль
Группа: Экс. модератор
Сообщений: 6003
Регистрация: 26.3.2002
Где: Германия

Репутация: 19
Всего: 99
Цитата(Electron @ 3.11.2005, 17:00)
уменьшает саму картинку, а объём файла увеличивает раза в три

SavePicture записывает в формате bmp...


--------------------
Немецкая оппозиция потребовала упростить натурализацию иммигрантов
В моем блоге: Разные истории из жизни в Германии

"Познание бесконечности требует бесконечного времени, а потому работай не работай - все едино".  А. и Б. Стругацкие
PM   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "VB6"
Akina

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по VB обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • Используйте теги [code=vb][/code] для подсветки кода. Используйтe чекбокс "транслит" (возле кнопок кодов) если у Вас нет русских шрифтов.

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Akina.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | VB6 | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0748 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.