Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 03.10.2008, 16:07   #1
RamireZ
Студент
Пользователь
 
Аватар для RamireZ
 
Регистрация: 30.05.2008
Сообщений: 61
По умолчанию Размеры изображения

Как можно изменить размеры открытого изображения?
Т.е допустим,прога открывает картинку и сохранить ее необходимо с другими размерами
RamireZ вне форума Ответить с цитированием
Старый 03.10.2008, 16:20   #2
SunKnight
Участник клуба Подтвердите свой е-майл
 
Аватар для SunKnight
 
Регистрация: 14.12.2007
Сообщений: 1,434
По умолчанию

Код:
const
  FThumbSize = 150;

 //Speed up by Renate Schaaf, Armido, Gary Williams... 
procedure MakeThumbNail(src, dest: tBitmap);
 type
   PRGB24 = ^TRGB24;
   TRGB24 = packed record
     B: Byte;
     G: Byte;
     R: Byte;
   end;
 var
   x, y, ix, iy: integer;
   x1, x2, x3: integer;

   xscale, yscale: single;
   iRed, iGrn, iBlu, iRatio: Longword;
   p, c1, c2, c3, c4, c5: tRGB24;
   pt, pt1: pRGB24;
   iSrc, iDst, s1: integer;
   i, j, r, g, b, tmpY: integer;

   RowDest, RowSource, RowSourceStart: integer;
   w, h: integer;
   dxmin, dymin: integer;
   ny1, ny2, ny3: integer;
   dx, dy: integer;
   lutX, lutY: array of integer;

 begin
   if src.PixelFormat <> pf24bit then src.PixelFormat := pf24bit;
   if dest.PixelFormat <> pf24bit then dest.PixelFormat := pf24bit;
   w := Dest.Width;
   h := Dest.Height;

   if (src.Width <= FThumbSize) and (src.Height <= FThumbSize) then
   begin
     dest.Assign(src);
     exit;
   end;

   iDst := (w * 24 + 31) and not 31;
   iDst := iDst div 8; //BytesPerScanline 
  iSrc := (Src.Width * 24 + 31) and not 31;
   iSrc := iSrc div 8;

   xscale := 1 / (w / src.Width);
   yscale := 1 / (h / src.Height);

   // X lookup table 
  SetLength(lutX, w);
   x1 := 0;
   x2 := trunc(xscale);
   for x := 0 to w - 1 do
   begin
     lutX[x] := x2 - x1;
     x1 := x2;
     x2 := trunc((x + 2) * xscale);
   end;

   // Y lookup table 
  SetLength(lutY, h);
   x1 := 0;
   x2 := trunc(yscale);
   for x := 0 to h - 1 do
   begin
     lutY[x] := x2 - x1;
     x1 := x2;
     x2 := trunc((x + 2) * yscale);
   end;

   dec(w);
   dec(h);
   RowDest := integer(Dest.Scanline[0]);
   RowSourceStart := integer(Src.Scanline[0]);
   RowSource := RowSourceStart;
   for y := 0 to h do
   begin
     dy := lutY[y];
     x1 := 0;
     x3 := 0;
     for x := 0 to w do
     begin
       dx:= lutX[x];
       iRed:= 0;
       iGrn:= 0;
       iBlu:= 0;
       RowSource := RowSourceStart;
       for iy := 1 to dy do
       begin
         pt := PRGB24(RowSource + x1);
         for ix := 1 to dx do
         begin
           iRed := iRed + pt.R;
           iGrn := iGrn + pt.G;
           iBlu := iBlu + pt.B;
           inc(pt);
         end;
         RowSource := RowSource - iSrc;
       end;
       iRatio := 65535 div (dx * dy);
       pt1 := PRGB24(RowDest + x3);
       pt1.R := (iRed * iRatio) shr 16;
       pt1.G := (iGrn * iRatio) shr 16;
       pt1.B := (iBlu * iRatio) shr 16;
       x1 := x1 + 3 * dx;
       inc(x3,3);
     end;
     RowDest := RowDest - iDst;
     RowSourceStart := RowSource;
   end;

   if dest.Height < 3 then exit;

   // Sharpening... 
  s1 := integer(dest.ScanLine[0]);
   iDst := integer(dest.ScanLine[1]) - s1;
   ny1 := Integer(s1);
   ny2 := ny1 + iDst;
   ny3 := ny2 + iDst;
   for y := 1 to dest.Height - 2 do
   begin
     for x := 0 to dest.Width - 3 do
     begin
       x1 := x * 3;
       x2 := x1 + 3;
       x3 := x1 + 6;

       c1 := pRGB24(ny1 + x1)^;
       c2 := pRGB24(ny1 + x3)^;
       c3 := pRGB24(ny2 + x2)^;
       c4 := pRGB24(ny3 + x1)^;
       c5 := pRGB24(ny3 + x3)^;

       r := (c1.R + c2.R + (c3.R * -12) + c4.R + c5.R) div -8;
       g := (c1.G + c2.G + (c3.G * -12) + c4.G + c5.G) div -8;
       b := (c1.B + c2.B + (c3.B * -12) + c4.B + c5.B) div -8;

       if r < 0 then r := 0 else if r > 255 then r := 255;
       if g < 0 then g := 0 else if g > 255 then g := 255;
       if b < 0 then b := 0 else if b > 255 then b := 255;

       pt1 := pRGB24(ny2 + x2);
       pt1.R := r;
       pt1.G := g;
       pt1.B := b;
     end;
     inc(ny1, iDst);
     inc(ny2, iDst);
     inc(ny3, iDst);
   end;
 end;
Проповедую design patterns, верую в MVC, доверяю eXtrime programming.
SunKnight вне форума Ответить с цитированием
Старый 03.10.2008, 16:53   #3
BOBAH13
Android Developer
Старожил Подтвердите свой е-майл
 
Аватар для BOBAH13
 
Регистрация: 19.02.2007
Сообщений: 3,708
По умолчанию

Юзаем опять такие gdi+ все легко, быстро и поддержка различных алгоритмов маштабирования.
BOBAH13 вне форума Ответить с цитированием
Старый 04.10.2008, 15:18   #4
RamireZ
Студент
Пользователь
 
Аватар для RamireZ
 
Регистрация: 30.05.2008
Сообщений: 61
По умолчанию

Спс,попробую
Дабы не засорять форум спрошу еще:
Есть ли у кого алгоритмы для нахождения функций синуса,косинуса и арккотангенса?

Последний раз редактировалось RamireZ; 04.10.2008 в 15:22.
RamireZ вне форума Ответить с цитированием
Старый 05.10.2008, 07:03   #5
Kostia
Участник клуба
 
Аватар для Kostia
 
Регистрация: 21.11.2007
Сообщений: 1,691
По умолчанию

Посмотри тут:
http://ru.wikipedia.org/wiki/%D0%A0%...BE%D1%80%D0%B0
и тут:
http://www.programmersforum.ru/showthread.php?t=27165

Последний раз редактировалось Kostia; 05.10.2008 в 10:40.
Kostia вне форума Ответить с цитированием
Старый 05.10.2008, 09:48   #6
BOBAH13
Android Developer
Старожил Подтвердите свой е-майл
 
Аватар для BOBAH13
 
Регистрация: 19.02.2007
Сообщений: 3,708
По умолчанию

не пойму, а модуль Math ? sin. cos
BOBAH13 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Чтение изображения из базы данных, Вместо изображения - "System.Byte[]" ruelCrow Общие вопросы .NET 3 10.07.2008 23:29
Изменить размеры Манжосов Денис :) Gamedev - cоздание игр: Unity, OpenGL, DirectX 2 16.05.2008 20:14
Microsoft Office Outlook : Размеры вложений ale140 Софт 0 12.12.2007 17:13
Изменить размеры страницы принтера Shuraken Win Api 1 30.08.2007 05:14
Как изменять размеры StringGrid Мышкой Inbox Компоненты Delphi 4 30.06.2007 14:34