Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Быстрое отображение TGraphic

Автор: Illusion Dolphin 13.8.2004, 21:30

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

Код


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;

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

Автор: p0s0l 14.8.2004, 01:11

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

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

Автор: Illusion Dolphin 14.8.2004, 08:29

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

Код


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

Код


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

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

Автор: Illusion Dolphin 14.8.2004, 12:43

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

Цитата

yi1 := yi2 + 1;

Цитата

xi1 := xi2 + 1;

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

Автор: p0s0l 14.8.2004, 17:38

Цитата(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 вообще...