Пусть имеется

Код

var Graphic : TGraphic;

Мы туда поместили какое-то изображение (или JPEG или GIF или PSD или ещёчто-нибудь) и теперь очень хочется отобразить его в области 100х100 пикселей, причём чтобы при этом использовался не убогий StretchDraw, а другой алгоритм отображения со сглаживанием. Можно ли такое осуществить без использования промежуточной битмапки (или даже 2 у меня получается)? Есть ли БЫСТРЫЕ алгоритмы прорисовки со сглаживанием? Я обычно длаю так, но мне мало:

Код

procedure stretchcool(width,height : integer;var s,d:tbitmap); var i,j,h,k,p,w:integer;     p2,p1: pargb; col,r,g,b,dobx,doby,t1,t2 : integer; begin s.PixelFormat:=pf24bit; d.PixelFormat:=pf24bit; d.Width:=width; d.Height:=height; if s.Width>=width then dobx:=-1 else dobx:=0; if s.Height>=Height then doby:=-1 else doby:=0; for i:=0 to height-1 do begin  if i<height then  if height<>0 then  p1:=d.ScanLine[i];  for j:=0 to  width-1 do  begin   col:=0;   r:=0;   g:=0;   b:=0;   if height=0 then continue;   if doby<>0 then t1:=round((s.height /height)*(i+1))+doby else t1:=floor((s.height /height)*(i+1));   for k:=round((s.height/height)*(i)) to t1{floor((bitmap.height /height)*(i+1))} do   begin    if k<s.height then    if k>=0 then    p2:=s.ScanLine[k];    if width=0 then continue;    if dobx<>0 then t2:=round((s.Width /Width)*(j+1))+doby else t2:=floor((s.Width /Width)*(j+1));    for p:=round((s.Width/Width)*(j)) to t2{floor((bitmap.Width /Width)*(j+1))+dobx} do    begin     if p<s.width then     begin     inc(col);     inc(r,(p2[p].r));     inc(g,p2[p].g);     inc(b,p2[p].b);     end;    end;   end;   if col<>0 then   begin    p1[j].r:=round((r/col));    p1[j].g:=round((g/col));    p1[j].b:=round((b/col));   end;  end; end; s.PixelFormat:=pf24bit; end; .... fbmp:=Tbitmap.create; fbmp.PixelFormat:=pf24bit; fb:=Tbitmap.create; fb.PixelFormat:=pf24bit; fbmp.Assign(fpic.graphic); stretchcool(100,100,fbmp,fb); fbmp.free; MyObject.canvar.Draw(fb); fb.free;

Что-то кажется, что можно быстрее... Кто-нибудь знает, как?

Делал однажды предварительный просмотр для печати, и там сделал такую процедурину для уменьшения картинки с "глаживанием" - должна быть побыстрее твоей, т.к. используются только целочисленные операции, да и к тому же прооптимизировал её как мог (а твоя процедурина почему-то не захотела работать - AV):

Код

procedure QuickReduce2 (NewWidth, NewHeight : integer; BmpIn, BmpOut : TBitmap); var  x, y, xi1, yi1, xi2, yi2, xx, yy, lw1 : integer;  bufw, bufh, outw, outh : integer;  sumr, sumb, sumg, pixcnt : dword;  adrIn, adrOut, adrLine0, deltaLine, deltaLine2 : DWORD; begin  BmpOut.Width := NewWidth;  BmpOut.Height := NewHeight;  BmpIn.PixelFormat := pf24bit;  BmpOut.PixelFormat := pf24bit;  bufw := BmpIn.Width;  bufh := BmpIn.Height;  outw := BmpOut.Width;  outh := BmpOut.Height;  adrLine0 := DWORD(bmpIn.ScanLine[0]);  deltaLine := DWORD(BmpIn.ScanLine[1]) - adrLine0;  yi2 := 0;  for y := 0 to outh-1 do  begin    adrOut := DWORD(BmpOut.ScanLine[y]);    yi1 := yi2 + 1;    yi2 := ((y+1) * bufh) div outh - 1;    if yi2 > bufh-1 then yi2 := bufh;    xi2 := 0;    for x := 0 to outw-1 do    begin      xi1 := xi2 + 1;      xi2 := ((x+1) * bufw) div outw - 1;      if xi2 > bufw-1 then xi2 := bufw-1; //      lw1 := xi2-xi1+1;      deltaLine2 := deltaLine - lw1*3;      sumb := 0;      sumg := 0;      sumr := 0;      adrIn := adrLine0 + yi1*deltaLine + xi1*3;      for yy := yi1 to yi2 do      begin        for xx := 1 to lw1 do        begin          Inc(sumb, PByte(adrIn+0)^);          Inc(sumg, PByte(adrIn+1)^);          Inc(sumr, PByte(adrIn+2)^);          Inc(adrIn, 3);        end;        Inc (adrIn, deltaLine2);      end;      pixcnt := (yi2-yi1+1)*lw1;      PByte(adrOut+0)^ := sumb div pixcnt;      PByte(adrOut+1)^ := sumg div pixcnt;      PByte(adrOut+2)^ := sumr div pixcnt;      Inc(adrOut, 3);    end;  end; end;

p0s0l: Спасибо за пример, попробую. Я как только отослал свою функцию, так сразу увидел, что её можно оптимизировать ещё (писал даааавно). Но интересует всёже один момент. Ведь в начале у меня имеется TGraphic, а в конечном итоге мне нужно отобразить его на TBitmap. Так можно ли сделать функцию вида:

Код

procedure QuickReduce2 (NewWidth, NewHeight : integer; GrpIn : TGraphic; BmpOut : TBitmap);

В которой GrpIn не будет предварительно преобразовываться в TBitmap, в можно будет работать именно с GrpIn? Если взять JPEG, то там имеется такая вещь: при попытке прорисовки она сначала декодируется, а потом уже прорисовывается, так можно ли в таком случае сделать что-то вроде этого:

Код

TGraphic.Decode; //в JPEG как минимум преобразуется в DIB TGraphic.Decoded_Bitmap_or_DIB.scanline;

8)
Иначе говоря - сгладить и уменьшить - это одно, но нужно ещё и сам "технологический процесс" отладить, т.к. промежуточныйе битмапы, на мой взгляд, можно убрать... но как?

И ещё!
Что значат

Цитата

yi1 := yi2 + 1;

и

Цитата

xi1 := xi2 + 1;

?
С +1 проблемы с преобразованием при низком коэффициенте уменьшения (первая строка (как и полоска слева) - не обрабатывается)

Цитата(Illusion @ 14.8.2004, 12:43)

И ещё! Что значат yi1 := yi2 + 1; и xi1 := xi2 + 1; ? С +1 проблемы с преобразованием при низком коэффициенте уменьшения (первая строка (как и полоска слева) - не обрабатывается)

Да, это моя недодумка, +1 нужен, иначе будут некрасивости, т.к. одна и та же линия будет считаться в нескольких линиях одновременно... Для исправления надо сделать:
yi2 := -1;
...
xi2 := -1;

ДОБАВЛЕНО ПОЗЖЕ:

Код

procedure QuickReduce(NewWidth, NewHeight : integer; BmpIn, BmpOut : TBitmap); var x, y, xi1, yi1, xi2, yi2, xx, yy, lw1 : integer; bufw, bufh, outw, outh : integer; sumr, sumb, sumg, pixcnt : dword; adrIn, adrOut, adrLine0, deltaLine, deltaLine2 : DWORD; begin BmpOut.Width := NewWidth; BmpOut.Height := NewHeight; BmpIn.PixelFormat := pf24bit; BmpOut.PixelFormat := pf24bit; bufw := BmpIn.Width; bufh := BmpIn.Height; outw := BmpOut.Width; outh := BmpOut.Height; adrLine0 := DWORD(bmpIn.ScanLine[0]); deltaLine := DWORD(BmpIn.ScanLine[1]) - adrLine0; yi2 := -1; for y := 0 to outh-1 do begin   adrOut := DWORD(BmpOut.ScanLine[y]);   yi1 := yi2 + 1;   yi2 := ((y+1) * bufh) div outh - 1;   if yi2 > bufh-1 then yi2 := bufh;   xi2 := -1;   for x := 0 to outw-1 do   begin     xi1 := xi2 + 1;     xi2 := ((x+1) * bufw) div outw - 1;     if xi2 > bufw-1 then xi2 := bufw-1; //     lw1 := xi2-xi1+1;     deltaLine2 := deltaLine - lw1*3;     sumb := 0;     sumg := 0;     sumr := 0;     adrIn := adrLine0 + yi1*deltaLine + xi1*3;     for yy := yi1 to yi2 do     begin       for xx := 1 to lw1 do       begin         Inc(sumb, PByte(adrIn+0)^);         Inc(sumg, PByte(adrIn+1)^);         Inc(sumr, PByte(adrIn+2)^);         Inc(adrIn, 3);       end;       Inc (adrIn, deltaLine2);     end;     pixcnt := (yi2-yi1+1)*lw1;     if pixcnt<>0 then     begin      PByte(adrOut+0)^ := sumb div pixcnt;      PByte(adrOut+1)^ := sumg div pixcnt;      PByte(adrOut+2)^ := sumr div pixcnt;     end;     Inc(adrOut, 3);   end; end; end;

Цитата(Illusion @ 14.8.2004, 08:29)

В которой GrpIn не будет предварительно преобразовываться в TBitmap, в можно будет работать именно с GrpIn? Если взять JPEG, то там имеется такая вещь: при попытке прорисовки она сначала декодируется, а потом уже прорисовывается, так можно ли в таком случае сделать что-то вроде этого: Код  TGraphic.Decode; //в JPEG как минимум преобразуется в DIB TGraphic.Decoded_Bitmap_or_DIB.scanline;  8) Иначе говоря - сгладить и уменьшить - это одно, но нужно ещё и сам "технологический процесс" отладить, т.к. промежуточныйе битмапы, на мой взгляд, можно убрать... но как?

Тоже однажды пытался обойти этот момент... Единственное, что я тогда придумал, это типа такого способа (сразу исправленный вариант):

Код

type  TMyJPEGImage = class(TJPEGImage)  public    property Bitmap;  end; procedure QuickReduce (NewWidth, NewHeight : integer; GrpIn : TGraphic; BmpOut : TBitmap); var  x, y, xi1, yi1, xi2, yi2, xx, yy, lw1 : integer;  bufw, bufh, outw, outh : integer;  sumr, sumb, sumg, pixcnt : dword;  adrIn, adrOut, adrLine0, deltaLine, deltaLine2 : DWORD;  BmpIn : TBitmap;  BmpFree : boolean; begin  BmpFree := False;  if GrpIn is TJPEGImage then    BmpIn := TMyJPEGImage(GrpIn).Bitmap  else  if GrpIn is TBitmap then    BmpIn := TBitmap(GrpIn)  else  begin    BmpIn := TBitmap.Create;    BmpIn.Width := GrpIn.Width;    BmpIn.Height := GrpIn.Height;    BmpIn.Canvas.Draw(0, 0, GrpIn);    BmpFree := True;  end;  BmpOut.Width := NewWidth;  BmpOut.Height := NewHeight;  BmpIn.PixelFormat := pf24bit;  BmpOut.PixelFormat := pf24bit;  bufw := BmpIn.Width;  bufh := BmpIn.Height;  outw := BmpOut.Width;  outh := BmpOut.Height;  adrLine0 := DWORD(bmpIn.ScanLine[0]);  deltaLine := DWORD(BmpIn.ScanLine[1]) - adrLine0;  yi2 := -1;  for y := 0 to outh-1 do  begin    adrOut := DWORD(BmpOut.ScanLine[y]);    yi1 := yi2+1;    yi2 := ((y+1) * bufh) div outh - 1;    xi2 := -1;    for x := 0 to outw-1 do    begin      xi1 := xi2+1;      xi2 := ((x+1) * bufw) div outw - 1;      lw1 := xi2-xi1+1;      deltaLine2 := deltaLine - lw1*3;      sumb := 0;      sumg := 0;      sumr := 0;      adrIn := adrLine0 + yi1*deltaLine + xi1*3;      for yy := yi1 to yi2 do      begin        for xx := 1 to lw1 do        begin          Inc(sumb, PByte(adrIn+0)^);          Inc(sumg, PByte(adrIn+1)^);          Inc(sumr, PByte(adrIn+2)^);          Inc(adrIn, 3);        end;        Inc (adrIn, deltaLine2);      end;      pixcnt := (yi2-yi1+1)*lw1;      PByte(adrOut+0)^ := sumb div pixcnt;      PByte(adrOut+1)^ := sumg div pixcnt;      PByte(adrOut+2)^ := sumr div pixcnt;      Inc(adrOut, 3);    end;  end;  if BmpFree then BmpIn.Free; end;

Т.е. надо учитывать каждый возможный наследник TGraphic, который может прийти в QuickReduce, для неучтенных наследников сделан способ через промежуточный битмап... Для TJPEGImage надо делать через взлом класса - вынос Bitmap в Public-часть... Сомневаюсь, что можно как-то легче, т.к. у самого TGraphic нет такого свойства как Bitmap вообще...