| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

smoothresize

Тимофей123 ©   (2009-11-10 16:10:00) 

данной процедурой меняю размер
procedure SmoothResize(Width, Height : integer; S,D : TBitmap);
type
 TRGBArray = array[Word] of TRGBTriple;
 pRGBArray = ^TRGBArray;
var
 x, y: Integer;
 xP, yP: Integer;
 Mx, My: Integer;
 SrcLine1, SrcLine2: pRGBArray;
 t3: Integer;
 z, z2, iz2: Integer;
 DstLine: pRGBArray;
 DstGap: Integer;
 w1, w2, w3, w4: Integer;
begin
 S.PixelFormat := pf24Bit;
 D.PixelFormat := pf24Bit;
 if Width*Height=0 then
 begin
  D.Assign(S);
  exit;
 end;
 D.Width:=Width;
 D.Height:=Height;
 if (S.Width = D.Width) and (S.Height = D.Height) then
   D.Assign(S)
 else
 begin
   DstLine := D.ScanLine[0];
   DstGap  := Integer(D.ScanLine[1]) - Integer(DstLine);
   Mx := MulDiv(S.Width+1, $10000, D.Width);
   My := MulDiv(S.Height+1, $10000, D.Height);
   yP  := 0;
   for y := 0 to pred(D.Height) do
   begin
     xP := 0;
     SrcLine1 := S.ScanLine[yP shr 16];
     if (yP shr 16 < pred(S.Height))and(Y<>D.Height-1) then
       SrcLine2 := S.ScanLine[succ(yP shr 16)]
     else
     begin
       SrcLine1 := S.ScanLine[S.Height-2];
       SrcLine2 := S.ScanLine[S.Height-1];
     end;
     z2  := succ(yP and $FFFF);
     iz2 := succ((not yp) and $FFFF);
     for x := 0 to pred(D.Width) do
     begin
       t3 := xP shr 16;
       z  := xP and $FFFF;
       w2 := MulDiv(z, iz2, $10000);
       w1 := iz2 - w2;
       w4 := MulDiv(z, z2, $10000);
       w3 := z2 - w4;
       if (t3>=S.Width-1)or(x=D.Width-1) then
        t3:=S.Width-2;
       DstLine[x].rgbtRed := (SrcLine1[t3].rgbtRed * w1 +
         SrcLine1[t3 + 1].rgbtRed * w2 + SrcLine2[t3].rgbtRed * w3 + SrcLine2[t3 + 1].rgbtRed * w4) shr 16;
       DstLine[x].rgbtGreen := (SrcLine1[t3].rgbtGreen * w1 + SrcLine1[t3 + 1].rgbtGreen * w2 +
         SrcLine2[t3].rgbtGreen * w3 + SrcLine2[t3 + 1].rgbtGreen * w4) shr 16;
       DstLine[x].rgbtBlue := (SrcLine1[t3].rgbtBlue * w1 +
         SrcLine1[t3 + 1].rgbtBlue * w2 +SrcLine2[t3].rgbtBlue * w3 +  SrcLine2[t3 + 1].rgbtBlue * w4) shr 16;
       Inc(xP, Mx);
     end; {for}
     Inc(yP, My);
     DstLine := pRGBArray(Integer(DstLine) + DstGap);
   end; {for}
 end; {if}
end; {SmoothResize}
Вызываю так:


var jpg:TJpegImage;
   bm:TBitmap;
begin
 try
jpg:=TJpegImage.Create;
bm:=TBitmap.Create;
jpg.LoadFromFile(GetCurrentDir+'\4.jpg');
jpg.DIBNeeded;
bm.Assign(jpg);

SmoothResize(100,100,bm,img1.Picture.Bitmap);

jpg.Free;
bm.Free;
except
end;

Почему то вылезает ошибка scan line index out of range.

---

Sapersky   (2009-11-10 18:16:00) [1]

Используй StretchBlt в режиме Halftone. Он несколько медленнее, но вряд ли ты это заметишь. Зато качество лучше при сильном уменьшении. И не вылетает :)

---

Тимофей123   (2009-11-10 17:47:00) [2]

согласен, я и не оправдывался:)

---

Сергей М.   (2009-11-10 17:01:00) [3]

> не умею пользоваться отладчиком


Это не оправдание.
Учись пользоваться.

---

Тимофей123   (2009-11-10 16:47:00) [4]

когда y = 94 то вот здесь  

for y := 0 to pred(D.Height) do
   begin
     xP := 0;
      SrcLine1 := S.ScanLine[yP shr 16];на этом месте вылезает ошибка про scan line

вызываю так
SmoothResize(100,100,bm,img1.Picture.Bitmap);

---

Тимофей123   (2009-11-10 16:43:00) [5]

bm:=TBitmap.Create;
bm.LoadFromFile(GetCurrentDir+'\4.bmp');
SmoothResize(200,100,bm,img1.Picture.Bitmap);
bm.SaveToFile(GetCurrentDir+'\xz.bmp');эту строку уже не обрабатывает, я та к понял что из за ошибка про scan line
bm.Free;
except
end;

---

Amoeba   (2009-11-10 16:41:00) [6]

> Тимофей123   (10.11.09 16:30) [2]
>
> не умею пользоваться отладчиком.

Учитесь, иначе далеко не уедете.

---

Тимофей123   (2009-11-10 16:30:00) [7]

не умею пользоваться отладчиком.
По сути: у меня есьт bmp, в ней находится изображение, мне нужно чтобы это изображение увеличилось в размерах раза в 2, затем поместить обратно в эту bmp. Но с реализацией проблемы:(

---

Сергей М.   (2009-11-10 16:13:00) [8]

А что сказал по этому поводу отладчик ?

---

Наверх