Народ у меня такая проблема: в FAQ нашел текст программы масштабирования изображения с помощью интерполяции, но там написано что данный алгоритм подходит только для увеличения изображения! Но это не совсем так, если коэффициенты dx и dy задать меньше 1, то алгоритм будет уменьшать изображение, но при dx и dy меньше 0.5 он работает корректно, а при dx и dy в пределах от 0.5 до 1 кое-где появляются пиксели "левого" цвета!

Посьба у меня такая, подскажите пожалуйста как переделать алгоритм чтобы он работал корректно при любых dx и dy, а если это невозможно то подскажите другой гибкий алгоритм по уменьшению изображения!(Только без испрользования Stretch, или объединения по 4 пикселя)

Вот текст алгоритма:

Код

procedure Interpolate(var bm: TBitMap; dx, dy: single); var  bm1: TBitMap;  z1, z2: single;  k, k1, k2: single;  x1, y1: integer;  c: array [0..1, 0..1, 0..2] of byte;  res: array [0..2] of byte;  x, y: integer;  xp, yp: integer;  xo, yo: integer;  col: integer;  pix: TColor; begin  bm1 := TBitMap.Create;  bm1.Width := round(bm.Width * dx);  bm1.Height := round(bm.Height * dy);  for y := 0 to bm1.Height - 1 do begin    for x := 0 to bm1.Width - 1 do begin      xo := trunc(x / dx);      yo := trunc(y / dy);      x1 := round(xo * dx);      y1 := round(yo * dy);      for yp := 0 to 1 do        for xp := 0 to 1 do begin          pix := bm.Canvas.Pixels[xo + xp, yo + yp];          c[xp, yp, 0] := GetRValue(pix);          c[xp, yp, 1] := GetGValue(pix);          c[xp, yp, 2] := GetBValue(pix);        end;      for col := 0 to 2 do begin        k1 := (c[1,0,col] - c[0,0,col]) / dx;        z1 := x * k1 + c[0,0,col] - x1 * k1;        k2 := (c[1,1,col] - c[0,1,col]) / dx;        z2 := x * k2 + c[0,1,col] - x1 * k2;        k := (z2 - z1) / dy;        res[col] := round(y * k + z1 - y1 * k);      end;      bm1.Canvas.Pixels[x,y] := RGB(res[0], res[1], res[2]);    end;    Form1.Caption := IntToStr(round(100 * y / bm1.Height)) + '%';    Application.ProcessMessages;    if Application.Terminated then Exit;  end;  bm := bm1; end; const  dx = 5.5;  dy = 5.5;

Dmi-Afonin, ты читал правила форума???
Там было такое: "Нельзя задавать один и тот-же вопрос на двух сайтах"

На сколько мне помнится то по этому адресу: http://forum.sources.ru/index.php?showtopic=70506, у тебя уже есть вопрос.

Это сообщение отредактировал(а) Zero - 31.10.2004, 19:44

обычно делают так:
предполагают, что коэффициент - рациональное число (а других в компьютерах, обычно, и не бывает ), представляют его в виде дроби m/n
растягивают изображение в n раз, а потом сжимают в m
а вот для растяжения и сжатия есть уже два варианта:
1. пользоваться только теми пикселами, которые уже есть
2. вычислять значения новых пикселов по какому-то алгоритму
второй вариант может (и чаще всего) приводит к появлению пикселов "левых" цветов, хотя обычно их цвет находится где-то между цветами соседних (при сжатии можно заменять средним цветом, при растяжении - интерполировать), такой алгоритм может немного сгладить резкие переходы (что не всегда хорошо, например, для компьютерной графики типа всяких диаграмм, текстов)
первый вариант просто копирует пиксели нужное количество раз при растяжении и прореживает рисунок при сжатии, новых значений пикселов не появляется, но при этом плавные переходы могут немного испортиться (это не очень хорошо проявит себя на естественных изображениях)
---
на самом деле если не требуется очень высокое качество, лучше выбрать второй алгоритм, т.к. он проще.
а алгоритм простой (к примеру k=0.7)
1. представляем коэффициент в виде 7/10
2. растягиваем рисунок в 10 раз (копируем каждый пиксель 100 раз)
3. сжимаем в 7 раз - берем каждый 7-ой пиксель по горизонтали и по вертикали

если рисунки маленькие или памяти куча, на этом можно остановиться
если нет, можно немного соптимизировать: проводить сжатие и растяжение одновременно:
например, для строки:

Код

var  original:array of byte;  result:array of byte;  width:integer;  k:real;  c:integer; ...  for c:=0 to width-1 do    result[c]:=original[c*n/m];//или можно просто round(c/k)

что-то в этом роде... не проверял...
original - строка исходного изображения
result - строка, куда будет записан результат
m,n - представление k в виде дроби (если разложить на целые, быстрее будет)
width - длина строки

Dmi-Afonin: у меня была та же проблема, но я её решил, вот исходник конечного результата:

Код

Type    ARGB=array [0..1] of TRGB;    PARGB=^ARGB;    PRGB = ^TRGB; procedure Interpolate(x, y, Width, Height : Integer; Rect : TRect; var S, D : TBitmap); var  z1, z2: single;  k: single;  i, j: integer;  dw,dh, xo, yo: integer;  x1r,y1r : extended;  Xs, Xd : array of PARGB;  dx, dy : Extended; begin  S.PixelFormat:=Pf24bit;  D.PixelFormat:=Pf24bit;  D.Width:=Math.Max(D.Width,x+Width);  D.height:=Math.Max(D.height,y+Height);  dw:=Math.Min(D.Width-x,x+Width);  dh:=Math.Min(D.height-y,y+Height);  dx:=(Width)/(Rect.Right-Rect.Left-1);  dy:=(Height)/(Rect.Bottom-Rect.Top-1);  if (dx<1) or (dy<1) then exit;  SetLength(Xs,S.Height);  for i:=0 to S.Height - 1 do  Xs[i]:=S.scanline[i];  SetLength(Xd,D.Height);  for i:=0 to D.Height - 1 do  Xd[i]:=D.scanline[i];  for i := 0 to min(trunc((Rect.Bottom-Rect.Top-1)*dy)-1,dh-1) do begin      yo := trunc(i / dy)+Rect.Top;      y1r:= trunc(i / dy) * dy;      if yo+1>=S.height then Break;    for j := 0 to min(trunc((Rect.Right-Rect.Left-1)*dx)-1,dw-1) do begin      xo := trunc(j / dx)+Rect.Left;      x1r:= trunc(j / dx) * dx;      if xo+1>=S.Width then Continue;      begin        z1 := ((Xs[yo ,xo+ 1].r - Xs[yo,xo].r)/ dx)*(j - x1r) + Xs[yo,xo].r;        z2 := ((Xs[yo+1,xo+1].r - Xs[yo+1,xo].r) / dx)*(j - x1r) + Xs[yo+1,xo].r;        k := (z2 - z1) / dy;        Xd[i+y,j+x].r := trunc(i * k + z1 - y1r * k);        z1 := ((Xs[yo ,xo+ 1].g - Xs[yo,xo].g)/ dx)*(j - x1r) + Xs[yo,xo].g;        z2 := ((Xs[yo+1,xo+1].g - Xs[yo+1,xo].g) / dx)*(j - x1r) + Xs[yo+1,xo].g;        k := (z2 - z1) / dy;        Xd[i+y,j+x].g := trunc(i * k + z1 - y1r * k);        z1 := ((Xs[yo ,xo+ 1].b - Xs[yo,xo].b)/ dx)*(j - x1r) + Xs[yo,xo].b;        z2 := ((Xs[yo+1,xo+1].b - Xs[yo+1,xo].b) / dx)*(j - x1r) + Xs[yo+1,xo].b;        k := (z2 - z1) / dy;        Xd[i+y,j+x].b := trunc(i * k + z1 - y1r * k);      end;    end;  end; end;

Width, Height - ширина и высота исходного куска из S с начальной точкой в (х,у), Rect - кусок, куда он будет преобразован в D.

Цитата

его в виде дроби m/n растягивают изображение в n раз, а потом сжимают в m

А как же скорость работы???? зачем стягивать и растягивать, если можно сразу сделать необходимое действие... Тем более тут используется не линейное преобразование, а это: "result[c]:=original[c*n/m];" - вроде как простое линейное преобразование...

Удалено модератором... Высказывайся по-культурнее...
На том сайте мне ничего не подсказали толкового. А остальным больше спосибо, сейчас буду пробовать.


Это сообщение отредактировал(а) p0s0l - 31.10.2004, 18:57

Illusion Dolphin будь другом напиши пожалуйста, что за идентификатор Math, и как задавать Rect или скинь на мыло полный исходник [email protected]. Заранее благодарен!!!

Цитата

что за идентификатор Math

это точное указание модуля, откуда брать эту функцию.

Код

uses ... , math;

Rect задаётся очень просто:
Rect(x1,y1,x2,x2), где (x1,y1) - начальная точка, (x2,y2) - конечная точка.
P.S. А ругаться не нужно, это тоже записано в правилах форума !

Illusion Dolphin огромное спасибо сейчас попробую!

Illusion Dolphin Что то у меня никак не получается вот исходный текст посмотри пожалуйста, что не так!!!

Код

unit Unit1; interface uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, ExtDlgs, Menus, ExtCtrls, Buttons, ComCtrls, StdCtrls, Gauges, math; type  TRGB=record  r:byte;  g:byte;  b:byte;  end;  ARGB=array [0..1] of TRGB;  PARGB=^ARGB;  PRGB = ^TRGB;  TForm1 = class(TForm)    MainMenu1: TMainMenu;    N1: TMenuItem;    N2: TMenuItem;    N3: TMenuItem;    N4: TMenuItem;    N5: TMenuItem;    OpenPictureDialog1: TOpenPictureDialog;    SavePictureDialog1: TSavePictureDialog;    N7: TMenuItem;    N8: TMenuItem;    ScrollBox1: TScrollBox;    Image1: TImage;    GroupBox1: TGroupBox;    Gauge1: TGauge;    ComboBox1: TComboBox;    ComboBox2: TComboBox;    StaticText1: TStaticText;    StaticText2: TStaticText;    StaticText3: TStaticText;    StaticText4: TStaticText;    procedure N2Click(Sender: TObject);    procedure N4Click(Sender: TObject);    procedure N5Click(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure N7Click(Sender: TObject);    procedure N8Click(Sender: TObject);    procedure FormCreate(Sender: TObject);  private    { Private declarations }  public    { Public declarations }  end; var  Form1: TForm1;  i,j,k,n: Longint;  ColCount: integer;  Filename,s: string;  BM, BM1: TBitmap;  dx,dy: real; implementation {$R *.dfm} procedure Interpolate(x, y, Width, Height : Integer; Rect : TRect; var S, D : TBitmap); var z1, z2: single; k: single; i, j: integer; dw,dh, xo, yo: integer; x1r,y1r : extended; Xs, Xd : array of PARGB; dx, dy : Extended; begin Form1.Image1.AutoSize:=False; S.PixelFormat:=Pf24bit; D.PixelFormat:=Pf24bit; D.Width:=Math.Max(D.Width,x+Width); D.height:=Math.Max(D.height,y+Height); dw:=Math.Min(D.Width-x,x+Width); dh:=Math.Min(D.height-y,y+Height); dx:=(Width)/(Rect.Right-Rect.Left-1); dy:=(Height)/(Rect.Bottom-Rect.Top-1); if (dx<1) or (dy<1) then exit; SetLength(Xs,S.Height); for i:=0 to S.Height - 1 do Xs[i]:=S.scanline[i]; SetLength(Xd,D.Height); for i:=0 to D.Height - 1 do Xd[i]:=D.scanline[i]; for i := 0 to min(trunc((Rect.Bottom-Rect.Top-1)*dy)-1,dh-1) do begin  yo := trunc(i / dy)+Rect.Top;  y1r:= trunc(i / dy) * dy;  if yo+1>=S.height then Break; for j := 0 to min(trunc((Rect.Right-Rect.Left-1)*dx)-1,dw-1) do begin  xo := trunc(j / dx)+Rect.Left;  x1r:= trunc(j / dx) * dx;  if xo+1>=S.Width then Continue;  begin   z1 := ((Xs[yo ,xo+ 1].r - Xs[yo,xo].r)/ dx)*(j - x1r) + Xs[yo,xo].r;   z2 := ((Xs[yo+1,xo+1].r - Xs[yo+1,xo].r) / dx)*(j - x1r) + Xs[yo+1,xo].r;   k := (z2 - z1) / dy;   Xd[i+y,j+x].r := trunc(i * k + z1 - y1r * k);   z1 := ((Xs[yo ,xo+ 1].g - Xs[yo,xo].g)/ dx)*(j - x1r) + Xs[yo,xo].g;   z2 := ((Xs[yo+1,xo+1].g - Xs[yo+1,xo].g) / dx)*(j - x1r) + Xs[yo+1,xo].g;   k := (z2 - z1) / dy;   Xd[i+y,j+x].g := trunc(i * k + z1 - y1r * k);   z1 := ((Xs[yo ,xo+ 1].b - Xs[yo,xo].b)/ dx)*(j - x1r) + Xs[yo,xo].b;   z2 := ((Xs[yo+1,xo+1].b - Xs[yo+1,xo].b) / dx)*(j - x1r) + Xs[yo+1,xo].b;   k := (z2 - z1) / dy;   Xd[i+y,j+x].b := trunc(i * k + z1 - y1r * k);  end; end; end; { Form1.Gauge1.Progress :=0;  Form1.Image1.Width:=d.Width;  Form1.Image1.Height:=d.Height;  Form1.Image1.Picture.Graphic:=d;     } end; procedure TForm1.N2Click(Sender: TObject); begin  Bm:=Tbitmap.Create;  Image1.AutoSize:=True;  If OpenPictureDialog1.Execute then begin  Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);  BM.LoadFromFile(OpenPictureDialog1.FileName);  end; end; procedure TForm1.N4Click(Sender: TObject); begin   SavePictureDialog1.FileName := FileName;   If not SavePictureDialog1.Execute then exit;   FileName := SavePictureDialog1.FileName;   ColCount := Pos ('.', FileName);   if ColCount <= 0 then s := '.bmp';   FileName := FileName + s;   Image1.Picture.SaveToFile(FileName); end; procedure TForm1.N5Click(Sender: TObject); begin  Close; end; procedure TForm1.FormDestroy(Sender: TObject); begin  BM.free;  bm1.Free; end; procedure TForm1.N7Click(Sender: TObject); begin    try    bm1:=Tbitmap.create;  //  dx:=strtofloat(Combobox1.Text) / 100;   // dy:=strtofloat(Combobox2.Text) / 100;    Interpolate(0,0,100,100,rect(0,0,200,200),bm,bm1);    Image1.Picture.Graphic:=bm1;    except    Showmessage('Îøèáêà: Çàãðóçèòå èçîáðàæåíèå, èëè ââåäèòå êîððåêòíîå çíà÷åíèå ìàñøòàáà');    exit;    end; end; procedure TForm1.N8Click(Sender: TObject); begin Form1.Image1.Width:=BM.Width; Form1.Image1.Height:=Bm.Height; Form1.Image1.Picture.Graphic:=BM; end; procedure TForm1.FormCreate(Sender: TObject); begin //  dx:= 1.0; //  dy:= 1.0; end; end.

Вот пример использования:

Код

procedure TForm1.Button1Click(Sender: TObject); var b1,b2 : Tbitmap; can: TCanvas; begin b1:=Tbitmap.Create; b2:=Tbitmap.Create; b1.Width:=50; b1.Height:=50; can := TCanvas.Create; can.Handle := GetDC(0); b1.Canvas.CopyRect(Bounds(0, 0, 50, 50), can, Bounds(0, 0, 50, 50)); ReleaseDC(0, can.Handle); Interpolate(0,0,500,500,rect(0,0,50,50),b1,b2); canvas.Draw(10,10,b2); b1.free; b2.free; end;

P.S. я наверное неправильно сказал параметры - первые параметры это куда это спроецировать на D то, что находится в Rect S.
Добавлено @ 19:19
ты ещё спрашивал как сделать это рабочим при любых коэффициентах... то, что я дал - это только для увеличения, для уменьшения юзай эту, параметры у енё точно те же (для совместимости)

Код

procedure 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;

Еще раз спасибо тебе Illusion Dolphin ты мне очень помог.



Это сообщение отредактировал(а) p0s0l - 31.10.2004, 19:48

Ура народ у меня всё получилось!!! Всем огромное спасибо, особенно Illusion Dolphin. Ты меня очень выручил.