Модераторы: Snowy, Alexeis, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Уменьшение веса картинки 
:(
    Опции темы
Dzeu
Дата 5.3.2012, 18:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет



Создал компонент BitMap и на него через BitBlt сохранил снимок рабочего стола (разрешение 1920х1080), картинка весил 7,9 мб. Как уменьшить вес картинки? Желательно с кусочком кода, я еще зеленоват в кодинге
PM MAIL   Вверх
Illusion Dolphin
Дата 5.3.2012, 20:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 13
Всего: 63



Можно попробовать так:

Код

uses
  pngimage;

procedure SaveAsPNG(B: TBitmap; FileName: string);
var
  PNG: TPngImage;
begin
  PNG := TPngImage.Create;
  try
    PNG.Assign(B);
    PNG.SaveToFile(FileName);
  finally
    PNG.Free;
  end;
end;


А ещё есть TJPEGImage smile

Это сообщение отредактировал(а) Illusion Dolphin - 5.3.2012, 20:05


--------------------
В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5
PM MAIL WWW ICQ   Вверх
Dzeu
Дата 5.3.2012, 21:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет



я немного не понял, как оно работает, но попробовал написать. Так оно будет работать?

Код

uses
  pngimage;

procedure SaveAsPNG(height,width:integer; FileName: string);
var
  bmp:tbitmap;
  PNG: TPngImage;
begin
  bmp.height:=height;
  bmp.width:=width;
  PNG := TPngImage.Create;
  try
    PNG.Assign(B);
    PNG.SaveToFile(FileName);
  finally
    PNG.Free;
  end;
end;



Код

procedure Tform1.SaveScreenFile(X,Y,Vysota,Hirina:integer;NameFile:String);
var
  bmp: Tbitmap;
  DeskHw,DeskHdC : Longint;
begin
  bmp:=TBitmap.Create;
  DeskHw:=getdesktopwindow;
  DeskHdc:=getdc(deskHw);
  bmp.Height:=Vysota;
  bmp.Width:=Hirina;
  BitBlt(bmp.Canvas.Handle,0,0,Hirina,
Vysota,DeskHdc,X,Y,SRCCOPY);
  bmp.SaveToFile(NameFile);

вот мой старый код, он равносилен тому, что ты дал?





Это сообщение отредактировал(а) Dzeu - 5.3.2012, 21:24
PM MAIL   Вверх
Illusion Dolphin
Дата 5.3.2012, 21:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 13
Всего: 63



Надо что-то типа:

Код


procedure SaveAsPNG(B: TBitmap; FileName: string);
var
  PNG: TPngImage;
begin
  PNG := TPngImage.Create;
  try
    PNG.Assign(B);
    PNG.SaveToFile(FileName);
  finally
    PNG.Free;
  end;
end;

procedure Tform1.SaveScreenFile(X,Y,Vysota,Hirina:integer;NameFile:String);
var
  bmp: Tbitmap;
  DeskHw,DeskHdC : Longint;
begin
  bmp:=TBitmap.Create;
  try
    DeskHw := getdesktopwindow;
    DeskHdc := getdc(deskHw);
    bmp.Height := Vysota;
    bmp.Width := Hirina;
    BitBlt(bmp.Canvas.Handle, 0, 0, Hirina, Vysota, DeskHdc, X, Y, SRCCOPY);
    SaveAsPNG(bmp, NameFile);
  finally
    bmp.free;
  end;
end;



--------------------
В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5
PM MAIL WWW ICQ   Вверх
Dzeu
Дата 5.3.2012, 22:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет



Понял, спасибо, а можно ссылку на компонент pngimage? Тот, что я скачал, выдает ошибки.
PM MAIL   Вверх
Alexeis
Дата 6.3.2012, 09:37 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459



Компонент называется TPngObject . Начиная с версий 2007 или 2009 он уже поставляется вместе с делфи. На официальном сайте его уже нет. Но можно нагулить по названию. Автор Gustavo Daud . Последняя версия вроде была 1.564 , затем embarcadero его уже допиливал под свои нужды. 


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Dzeu
Дата 6.3.2012, 17:37 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет



Код

procedure SaveAsPNG(B: TBitmap; FileName: string);
var
  PNG: TPngObject;
begin
  PNG := TPngobject.Create;
  try
    PNG.Assign(B);
    PNG.SaveToFile(FileName);
  finally
    PNG.Free;
  end;
end;


пишет [Error] Unit1.pas(3): Undeclared identifier: 'tpngobject'
разве я его не объявил в вар?

Это сообщение отредактировал(а) Dzeu - 6.3.2012, 17:38
PM MAIL   Вверх
MetalFan
Дата 6.3.2012, 18:00 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Аццкий Сотона
****


Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 5
Всего: 128



Код

uses pngimage...
...
  PNGImage: TPngImage;
...



--------------------
There are always someone smarter than you...
PM MAIL   Вверх
Dzeu
Дата 6.3.2012, 18:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет



Цитата(MetalFan @ 6.3.2012,  18:00)
Код

uses pngimage...
...
  PNGImage: TPngImage;
...

я уже говорил, что у меня в pngimage выдает ошибки, а именно в pngzlib

[Error] pngzlib.pas(100): File not found: 'obj\deflate.obj'
[Error] pngzlib.pas(101): File not found: 'obj\trees.obj'
[Error] pngzlib.pas(102): File not found: 'obj\inflate.obj'
[Error] pngzlib.pas(103): File not found: 'obj\inftrees.obj'
[Error] pngzlib.pas(104): File not found: 'obj\adler32.obj'
[Error] pngzlib.pas(105): File not found: 'obj\infblock.obj'
[Error] pngzlib.pas(106): File not found: 'obj\infcodes.obj'
[Error] pngzlib.pas(107): File not found: 'obj\infutil.obj'
[Error] pngzlib.pas(108): File not found: 'obj\inffast.obj'

Добавлено через 12 минут и 56 секунд
Скачал, TJpegImage, поменял png на jpeg uде надо, все работает, картинка весит 400 кб, всем спасибо!
PM MAIL   Вверх
MetalFan
Дата 6.3.2012, 18:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Аццкий Сотона
****


Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 5
Всего: 128



Цитата(Dzeu @  6.3.2012,  18:04 Найти цитируемый пост)
что у меня в pngimage выдает ошибки, а именно в pngzlib

это проблемы не компонента.  пропиши нужные пути в search path.


--------------------
There are always someone smarter than you...
PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Звук, графика и видео"
Girder
Snowy
Alexeis

Запрещено:

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

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

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • По вопросам разработки игр стоит заглянуть сюда

FAQ раздела лежит здесь!


Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Girder, Snowy.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Звук, графика и видео | Следующая тема »


 




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


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

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