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

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Уменьшение изображений 
:(
    Опции темы
k2s
Дата 28.2.2005, 01:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет
Проблема при уменьшении изображения произвольного размера до размера 95x67. Изображение не уменьшается, а всё его содержимое исчезает (отсканированный текстовый документ), размер увеличивается с 700Kb до 17Mb. Пожалуйста, посмотрите что может быть не так в этом фрагменте исходного текста. Процедуру procedure StretchCoolW(x, y, Width, Height : Integer; Rect : TRect; var S, D : TBitmap); для уменьшения изображения я взял из http://forum.vingrad.ru/index.php?showtopic=33117, и вроде бы она должна работать нормально. Может быть не так использую?
Код

unit IODU4;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
 Buttons, ComCtrls, ExtCtrls, Mask, Dialogs, DBCtrls, ExtDlgs, IBServices,
 DB, IBCustomDataSet, IBTable, JPEG, Math;

type
TRGB=record
r:byte;
g:byte;
b:byte;
end;
ARGB=array [0..1] of TRGB;
PARGB=^ARGB;
PRGB = ^TRGB;

 ...

var
 AddInDocForm: TAddInDocForm;
 bmpb, bmpt: Graphics.TBitmap;

...

procedure TAddInDocForm.StretchCoolW(x, y, Width, Height : Integer; Rect : TRect; var S, D : TBitmap);
var
i,j,k,p,Sheight1:integer;
p1: pargb;
col,r,g,b : integer;
Sh, Sw : Extended;
Xp : array of PARGB;
begin
s.PixelFormat:=pf24bit;
d.PixelFormat:=pf24bit;
if width+x>d.Width then
d.Width:=width+x;
if Height+y>d.Height then
d.Height:=height+y;
Sw:=(Rect.Right-Rect.Left)/width;
Sh:=(Rect.Bottom-Rect.Top)/height;
Sheight1:=(Rect.Bottom-Rect.Top)-1;
SetLength(Xp,S.height);
for i:=0 to S.height-1 do
Xp[i]:=s.ScanLine[i];
for i:=y to height+y-1 do
begin
p1:=d.ScanLine[i];
for j:=0 to width-1 do
begin
 col:=0;
 r:=0;
 g:=0;
 b:=0;
 for k:=Round(Sh*(i-y)) to Min(S.Height-1-Rect.Top,Round(Sh*(i+1-y))-1) do
 begin
  for p:=Round(Sw*j) to Min(Round(Sw*(j+1))-1,S.Width-1-Rect.Left) do
  begin
   inc(col);
   inc(r,Xp[k+Rect.Top,p+Rect.Left].r);
   inc(g,Xp[k+Rect.Top,p+Rect.Left].g);
   inc(b,Xp[k+Rect.Top,p+Rect.Left].b);
  end;
 end;
 if col<>0 then
 begin
  p1[j+x].r:=r div col;
  p1[j+x].g:=g div col;
  p1[j+x].b:=b div col;
 end;
end;
end;
end;

procedure TAddInDocForm.OKBtnClick(Sender: TObject);
var
W, H: Integer;
begin

 ...
     begin
      IODocsDataModule.INDOCSIBTable.fieldbyname('IMAGEFNAME').AsString := AddInImgEdit.Text;
      W:= bmpb.Width;
      H:= bmpb.Height;
      bmpt := Graphics.TBitmap.Create;
      StretchCoolW(0,0,W,H,rect(0,0,95,67),bmpb,bmpt);
      (IODocsDataModule.INDOCSIBTableIMAGE as TBlobField).Assign(bmpt);
     end;
  ...

MainForm.Tag := 1;
IODocsDataModule.INDOCSIBTable.Post;
AddInDocForm.Close;
end;
end;


Это сообщение отредактировал(а) k2s - 28.2.2005, 22:54
PM MAIL   Вверх
Illusion Dolphin
Дата 28.2.2005, 19:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 13
Всего: 63
Всё дело в том, что неправильно передаются параметры в функцию.
x, y, Width, Height - это координаты картинки на получателе, а Rect - это область, которая будет проицироваться из источника в получатель. Т.е. по сути тебе нужно вызывать её так:
Код

StretchCoolW(0,0,95,67,rect(0,0,W,H),bmpb,bmpt);



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


Эксперт
***


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

Репутация: 13
Всего: 63
Да, ещё.. для твоего случая легче юзать вот это:

Код

procedure StretchCool(Width, Height : integer; var S,D : TBitmap);
var
 i, j, k, p : Integer;
 p1 : PARGB;
 col, r, g, b, Sheight1 : integer;
 Sh, Sw : Extended;
 Xp : array of PARGB;
begin
If Width=0 then exit;
If Height=0 then exit;
S.PixelFormat:=pf24bit;
D.PixelFormat:=pf24bit;
D.Width:=Width;
D.Height:=Height;
Sh:=S.height/height;
Sw:=S.width/width;
Sheight1:=S.height-1;
SetLength(Xp,S.height);
for i:=0 to Sheight1 do
Xp[i]:=s.ScanLine[i];
for i:=0 to Height-1 do
begin
 p1:=D.ScanLine[i];
 for j:=0 to Width-1 do
 begin
  col:=0;
  r:=0;
  g:=0;
  b:=0;
  for k:=Round(Sh*i) to Min(Round(Sh*(i+1))-1,Sheight1) do
  begin
   for p:=Round(Sw*j) to Min(Round(Sw*(j+1))-1,S.Width-1) do
   begin
    inc(col);
    inc(r,Xp[k,p].r);
    inc(g,Xp[k,p].g);
    inc(b,Xp[k,p].b);
   end;
  end;
  if col<>0 then
  begin
   p1[j].r:=r div col;
   p1[j].g:=g div col;
   p1[j].b:=b div col;
  end;
 end;
end;
end;

А если хочешь при этом сохранять пропорции, то вот тебе ещё одна функция:
Код

procedure ProportionalSize(aWidth, aHeight: Integer; var aWidthToSize, aHeightToSize: Integer);
begin
If (aWidthToSize<aWidth) and (aHeightToSize<aHeight) then
begin
 Exit;
end;
if (aWidthToSize = 0) or (aHeightToSize = 0) then
begin
 aHeightToSize := 0;
 aWidthToSize  := 0;
end else begin
 if (aHeightToSize/aWidthToSize) < (aHeight/aWidth) then
 begin
  aHeightToSize := Round ( (aWidth/aWidthToSize) * aHeightToSize );
  aWidthToSize  := aWidth;
 end else begin
  aWidthToSize  := Round ( (aHeight/aHeightToSize) * aWidthToSize );
  aHeightToSize := aHeight;
 end;
end;
end;



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


Новичок



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

Репутация: нет
Всего: нет
Illusion Dolphin, скажи пожалуйста как правильно передать параметры в ProportionalSize, а то у меня что-то не получается никак...
PM MAIL   Вверх
Illusion Dolphin
Дата 1.3.2005, 01:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 13
Всего: 63
Например, мы хотим нашу картинку произвольного размера преобразовать до 95х67 (максимальный размер), тогда мы пишем так:

Код

var
ww,hh : integer;
begin
.....
ww:=bmpb.width;
hh:=bmpb.height;
ProportionalSize(95,67,ww,hh);
//StretchCoolW(0,0,ww,hh,rect(0,0,W,H),bmpb,bmpt);


Если будут ещё проблемы - спрашивай.

Это сообщение отредактировал(а) Illusion Dolphin - 1.3.2005, 01:22


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


Новичок



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

Репутация: нет
Всего: нет
А изображение, которое было получено с помощью ProportionalSize сохраняется туда же, откуда и было взято?
PM MAIL   Вверх
Illusion Dolphin
Дата 1.3.2005, 09:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 13
Всего: 63
ProportionalSize ничего с изображением не делает, а только рассчитывает длинну и ширину конечного изображения. Я посто выше показал как юзать ProportionalSize и там же в коментарии дан возможный вариант использования того, что рассчитывает ProportionalSize.


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


Новичок



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

Репутация: нет
Всего: нет
Всё понял. Спасибо тебе, Illusion Dolphin, за помощь. smile

Это сообщение отредактировал(а) k2s - 31.3.2005, 02:35
PM MAIL   Вверх
Limonchik
Дата 21.11.2007, 10:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет
добрый день!!я начинающий программер и пытаюсь написать свой просмотрщик графики.Решил,написать свой алгоритм уменьшения изображений.за основу решил взять приведенный в этой ветке алгоритм.Но у меня возникли трудности с его пониманием.Не могли бы вы помочь начинающему??? smile 
PM MAIL   Вверх
Alexeis
Дата 21.11.2007, 10:59 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 55
Всего: 459
Хороший стреч. можно получить используя GDI+ установив бикубическую интерполяцию


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

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

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


Новичок



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

Репутация: нет
Всего: нет
во,большое спасибо
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Звук, графика и видео"
Girder
Snowy
Alexeis

Запрещено:

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

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

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

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

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

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


 




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


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

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