Текущий архив: 2008.01.13;
Скачать: CL | DM;

Вниз

Искажение изображения.   Найти похожие ветки 

← →
Sergey UNN   (2006-12-13 18:49) [0]

Здравствуйте, форумчане !
У меня возник следующий вопрос : имеется изображение bitmap, необходимо его исказить, то есть промасштабировать на разные значения по ширине и высоте (как я это понимаю). Для меня эта задача новая, не опытен я в таких делах, пользовался поиском, нашел несколько методов. один из них основывался на Stretchе bitmapa - результаты ужасающие, изображение совершенно неприемлемого качества, так же наткнулся на некую процедуру
DeleteScansRect
, вот код :
unit DeleteScans;
//Renate Schaaf  
//renates@xmission.com  

interface

uses Windows, Graphics;

procedure DeleteScansRect(Src, Dest: TBitmap; rs, rd: TRect);
//scanline implementation of Stretchblt/Delete_Scans  
//about twice as fast  
//Stretches Src to Dest, rs is source rect, rd is dest. rect  
//The stretch is centered, i.e the center of rs is mapped to the center of rd.  
//Src, Dest are assumed to be bottom up  

implementation

uses Classes, math;

type
TRGBArray = array[0..64000] of TRGBTriple;
PRGBArray = ^TRGBArray;

TQuadArray = array[0..64000] of TRGBQuad;
PQuadArray = ^TQuadArray;

procedure DeleteScansRect(Src, Dest: TBitmap; rs, rd: TRect);
var
 xsteps, ysteps: array of Integer;
intscale: Integer;
i, x, y, x1, x2, bitspp, bytespp: Integer;
ts, td: PByte;
bs, bd, WS, hs, w, h: Integer;
Rows, rowd: PByte;
j, c: Integer;
pf: TPixelFormat;
xshift, yshift: Integer;
begin
WS := rs.Right - rs.Left;
hs := rs.Bottom - rs.Top;
w := rd.Right - rd.Left;
h := rd.Bottom - rd.Top;
pf := Src.PixelFormat;
if (pf <> pf32Bit) and (pf <> pf24bit) then
begin
pf := pf24bit;
Src.PixelFormat := pf;
end;
Dest.PixelFormat := pf;
if not (((w <= WS) and (h <= hs)) or ((w >= WS) and (h >= hs))) then
//we do not handle a mix of up-and downscaling,  
//using threadsafe StretchBlt instead.  
begin
Src.Canvas.Lock;
Dest.Canvas.Lock;
try
 SetStretchBltMode(Dest.Canvas.Handle, STRETCH_DELETESCANS);
 StretchBlt(Dest.Canvas.Handle, rd.Left, rd.Top, w, h,
 Src.Canvas.Handle, rs.Left, rs.Top, WS, hs, SRCCopy);
finally
 Dest.Canvas.Unlock;
 Src.Canvas.Unlock;
end;
Exit;
end;

if pf = pf24bit then
begin
bitspp := 24;
bytespp := 3;
end
else
begin
bitspp := 32;
bytespp := 4;
end;
bs := (Src.Width * bitspp + 31) and not 31;
bs := bs div 8; //BytesPerScanline Source  
bd := (Dest.Width * bitspp + 31) and not 31;
bd := bd div 8; //BytesPerScanline Dest  
if w < WS then //downsample  
begin
//first make arrays of the skipsteps  
 SetLength(xsteps, w);
SetLength(ysteps, h);
intscale := round(WS / w * $10000);
x1  := 0;
x2  := (intscale + $7FFF) shr 16;
c := 0;
for i := 0 to w - 1 do
begin
 xsteps[i] := (x2 - x1) * bytespp;
 x1  := x2;
 x2  := ((i + 2) * intscale + $7FFF) shr 16;
 if i = w - 2 then
 c := x1;
end;
xshift := min(max((WS - c) div 2, - rs.Left), Src.Width - rs.Right);
intscale := round(hs / h * $10000);
x1  := 0;
x2  := (intscale + $7FFF) shr 16;
c  := 0;
for i := 0 to h - 1 do
begin
 ysteps[i] := (x2 - x1) * bs;
 x1  := x2;
 x2  := ((i + 2) * intscale + $7FFF) shr 16;
 if i = h - 2 then
 c := x1;
end;
yshift := min(max((hs - c) div 2, - rs.Top), Src.Height - rs.Bottom);
if pf = pf24bit then
begin
 Rows := @PRGBArray(Src.Scanline[rs.Top + yshift])^[rs.Left + xshift];
 rowd := @PRGBArray(Dest.Scanline[rd.Top])^[rd.Left];
 for y := 0 to h - 1 do
 begin
 ts := Rows;
 td := rowd;
 for x := 0 to w - 1 do
 begin
 pRGBTriple(td)^ := pRGBTriple(ts)^;
 Inc(td, bytespp);
 Inc(ts, xsteps[x]);
 end;
 Dec(rowd, bd);
 Dec(Rows, ysteps[y]);
 end;
end
else
begin
 Rows := @PQuadArray(Src.Scanline[rs.Top + yshift])^[rs.Left + xshift];
 rowd := @PQuadArray(Dest.Scanline[rd.Top])^[rd.Left];
 for y := 0 to h - 1 do
 begin
 ts := Rows;
 td := rowd;
 for x := 0 to w - 1 do
 begin
 pRGBQuad(td)^ := pRGBQuad(ts)^;
 Inc(td, bytespp);
 Inc(ts, xsteps[x]);
 end;
 Dec(rowd, bd);
 Dec(Rows, ysteps[y]);
 end;
end;
end
else
begin
//first make arrays of the steps of uniform pixels  
 SetLength(xsteps, WS);
SetLength(ysteps, hs);
intscale := round(w / WS * $10000);
x1  := 0;
x2  := (intscale + $7FFF) shr 16;
c  := 0;
for i := 0 to WS - 1 do
begin
 xsteps[i] := x2 - x1;
 x1  := x2;
 x2  := ((i + 2) * intscale + $7FFF) shr 16;
 if x2 > w then
 x2 := w;
 if i = WS - 1 then
 c := x1;
end;
if c < w then //>is now not possible  
 begin
 xshift  := (w - c) div 2;
 yshift  := w - c - xshift;
 xsteps[WS - 1] := xsteps[WS - 1] + xshift;
 xsteps[0] := xsteps[0] + yshift;
end;
intscale := round(h / hs * $10000);
x1  := 0;
x2  := (intscale + $7FFF) shr 16;
c  := 0;
for i := 0 to hs - 1 do
begin
 ysteps[i] := (x2 - x1);
 x1  := x2;
 x2  := ((i + 2) * intscale + $7FFF) shr 16;
 if x2 > h then
 x2 := h;
 if i = hs - 1 then
 c := x1;
end;
if c < h then
begin
 yshift  := (h - c) div 2;
 ysteps[hs - 1] := ysteps[hs - 1] + yshift;
 yshift  := h - c - yshift;
 ysteps[0] := ysteps[0] + yshift;
end;
if pf = pf24bit then
begin
 Rows := @PRGBArray(Src.Scanline[rs.Top])^[rs.Left];
 rowd := @PRGBArray(Dest.Scanline[rd.Top])^[rd.Left];
 for y := 0 to hs - 1 do
 begin
 for j := 1 to ysteps[y] do
 begin
 ts := Rows;
 td := rowd;
 for x := 0 to WS - 1 do
 begin
  for i := 1 to xsteps[x] do
  begin
  pRGBTriple(td)^ := pRGBTriple(ts)^;
  Inc(td, bytespp);
  end;
  Inc(ts, bytespp);
 end;
 Dec(rowd, bd);
 end;
 Dec(Rows, bs);
 end;
end
else
begin
 Rows := @PQuadArray(Src.Scanline[rs.Top])^[rs.Left];
 rowd := @PQuadArray(Dest.Scanline[rd.Top])^[rd.Left];
 for y := 0 to hs - 1 do
 begin
 for j := 1 to ysteps[y] do
 begin
 ts := Rows;
 td := rowd;
 for x := 0 to WS - 1 do
 begin
  for i := 1 to xsteps[x] do
  begin
  pRGBQuad(td)^ := pRGBQuad(ts)^;
  Inc(td, bytespp);
  end;
  Inc(ts, bytespp);
 end;
 Dec(rowd, bd);
 end;
 Dec(Rows, bs);
 end;
end;
end;
end;


end.

однако воспользоватся не смог, выдает ошибку, пробовал разные варианты кода, поэтому приводить их сюда я не посчитал нужным, посему прошу опытных программистов помочь с примером использования (входных данных) и вообще точно разъяснить значения параметров r1 и r2. В англ. я видимо не особо силен - разобратся сам не смог.

Заранее большое спасибо, рассчитываю на понимание.

---

← →
antonn ©   (2006-12-13 21:26) [1]

> посему прошу опытных программистов помочь с примером
> использования (входных данных) и вообще точно
> разъяснить значения параметров r1 и r2. В англ. я
> видимо не особо силен - разобратся сам не смог.

может просто скажете, что вам нужно получить в результате?

---

← →
Sergey UNN   (2006-12-14 04:39) [2]

> Здравствуйте, форумчане !
> У меня возник следующий вопрос : имеется изображение bitmap,
>  необходимо его исказить, то есть промасштабировать на разные
> значения по ширине и высоте (как я это понимаю). Для меня
> эта задача новая, не опытен я в таких делах, пользовался
> поиском, нашел несколько методов. один из них основывался
> на Stretchе bitmapa - результаты ужасающие, изображение
> совершенно неприемлемого качества, так же наткнулся на некую
> процедуру

Мне нужно исказить изображение.

---

← →
Думкин ©   (2006-12-14 08:38) [3]

> Sergey UNN   (14.12.06 04:39) [2]

Исказить или поменять размер?
StretchBlt HALFTONE

---

← →
Stexen ©   (2006-12-16 04:53) [4]

ого, исходничек, как я понял исказить, это просто изменить размер не пропорционально???По-моему
> Думкин ©   (14.12.06 08:38) [3]
прав тут StretchBlt достаточно будет...


> наткнулся на некую процедуру
> DeleteScansRect

Почему то мне кажется что я тоже на нее натыкался давным давно...

А вообще зачем такие исходники кидать, если все равно наверняка никто не вчитывался...

Тебе нужны фильтры для масштабирования, если качество не устраивает при StretchBlt. У меня где то валялась библиотека, реализующая несколько фильров, если надо могу скинуть...
А вообще посмотри g32, там всего два алгоритма, но очень быстрые, хорошо реализованы.

---

← →
Сотрудник деканата   (2007-02-28 17:40) [5]

Исказить можно огромным количеством методов.

---

Страницы: 1 вся ветка

Текущий архив: 2008.01.13;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.016 c