21. Práca s bitmapou


posledná zmena: 4.12.2002

Banner Text 3.12.2002

    čo sme sa doteraz naučili

    • bitmapy vieme zo súboru prečítať, vieme ich vykresliť do grafickej plochy a tiež ich vieme zapísať do súboru
    • práca s farebnými bodmi bitmapy pomocou Pixels je často nepoužiteľne pomalá

    čo sa budeme dnes učiť

    • ak budeme pracovať s farebnými bodmi bitmapy pomocou ScanLine, práca sa veľmi zrýchli a konečne môžeme vytvárať veľmi zaujímavé efekty s obrázkami
    • vykonanie niektorých dôležitých častí programu môžeme chrániť konštrukciou try ... finally ... end

Práca s bitmapou

  • doteraz sme vedeli pracovať s farebnými bodmi bitmapy (s pixelmi) len pomocou vlastnosti Pixels[x,y] - o tomto ale vieme, že je to veľmi pomalý mechanizmus a v praxi často nepoužiteľný
  • naučíme sa pracovať s oveľa rýchlejším mechanizmom ScanLine[y] - pomocou neho dostávame "priamy" prístup k jednému celému riadku bitmapy a veľmi rýchlo môžeme farebné zložky nielen čítať ale aj modifikovať
    • na rozdiel od Pixels, ktorý bol vlastnosťou (property) TCanvas, ScanLine je vlastnosťou TBitmap a teda priamo s Image sa takto pracuje komplikovanejšie
  • výsledkom ScanLine[y] (túto vlastnosť môžeme len čítať) je netypový smerník na postupnosť, t.j. pole RGB zložiek - trojíc bajtov:

trojica farebných zložiek RGB: 

type
  TRGB = record
    B,G,R:byte;
  end;

k postupnosti môžeme pristupovať napr. tak ako s "null-terminated string": 

type
  PRGB = ^TRGB;
var
  d:PRGB;
...
  d:=bmp.ScanLine[y];
  for i:=0 to bmp.Width-1 do begin
    d^.R:=0;
    inc(d);         // nasledujúci pixel
  end;

alebo ako smerník na pole: 

type
  TRGBArray = array[word] of TRGB;    // dostatočne veľká hranica
  PRGBArray = ^TRGBArray;

Pozn.

  • v štandardných knižniciach Delphi existujú podobné deklarácie:
    • TRGBTriple je podobné nášmu TRGB (v unite Windows)
    • PRGBTripleArray je podobné nášmu PRGBArray (v unite Graphics)
  • prvý príklad ukazuje, ako môžeme pomocou ScanLine vytvoriť vlastnú bitmapu - predpokladáme, že vo formulári máme Image1 veľkosti 256x256:

vytvorenie jednofarebnej bitmapy: 

procedure TForm1.Button1Click(Sender: TObject);
var
  bmp:TBitmap;
  i,j:integer;
begin
  bmp:=TBitmap.Create;
  bmp.PixelFormat:=pf24bit;
  bmp.Width:=256;
  bmp.Height:=256;

  for i:=0 to 255 do
    for j:=0 to 255 do
      PRGBArray(bmp.ScanLine[i])^[j].B:=0;

  Image1.Canvas.Draw(0,0,bmp);
  bmp.Free;
end;
  • keď vytvoríme novú bitmapu (TBitmap.Create), každý jej pixel je biely - v tejto ukážke všetkým pixelom vynulujeme modrú zložku RGB, t.j. vytvoríme žltú
  • nasledujúci príklad je veľmi podobný, len každý pixel novej bitmapy bude trochu iný

vytvorenie farebnej bitmapy: 

procedure TForm1.Button1Click(Sender: TObject);
var
  bmp:TBitmap;
  i,j:integer;
  c:TRGB;
begin
  bmp:=TBitmap.Create;
  bmp.PixelFormat:=pf24bit;
  bmp.Width:=256;
  bmp.Height:=256;

  for i:=0 to 255 do
    for j:=0 to 255 do begin
      c.R:=i; c.B:=255-i; c.G:=j;
      PRGBArray(bmp.ScanLine[i])[j]:=c;
    end;

  Image1.Canvas.Draw(0,0,bmp);
  bmp.Free;
end;
  • v nasledujúcich príkladoch predpokladáme, že máme k dispozícii globálnu premennú bmp1, do ktorej vo FormCreate prečítame nejakú bitmapu, vo FormDestroy ju uvoľníme a vo formulári je položený Image1 veľkosti 256x256:

načítanie a zobrazenie bitmapy: 

var
  bmp1:TBitmap;

procedure TForm1.FormCreate(Sender: TObject);
begin
  bmp1:=TBitmap.Create;
  bmp1.LoadFromFile('parrots.bmp');
  Image1.Canvas.Draw(0,0,bmp1);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  bmp1.Free;
end;
  • ďalej sa na formulári nachádza Image2 tiež veľkosti 256x256 a niekoľko tlačidiel

kópia bitmapy - 1. verzia: 

procedure TForm1.Button1Click(Sender: TObject);
var
  bmp2:TBitmap;
  i,j:integer;
begin
  bmp2:=TBitmap.Create;
  bmp2.PixelFormat:=pf24bit;
  bmp2.Width:=bmp1.Width;
  bmp2.Height:=bmp1.Height;

  for i:=0 to bmp1.Height-1 do
    for j:=0 to bmp1.Width-1 do
      PRGBArray(bmp2.ScanLine[i])^[j]:=
          PRGBArray(bmp1.ScanLine[i])^[j];

  Image2.Canvas.Draw(0,0,bmp2);
  bmp2.Free;
end;

Pozn.

  • samozrejme, že kópiu bitmapy vieme aj jednoduchšie pomocou bmp2.Assign(bmp1) - tu sa ale učíme pracovať so ScanLine

kópia bitmapy - 2. verzia: 

procedure TForm1.Button1Click(Sender: TObject);
var
  bmp2:TBitmap;
  i,j:integer;
  r1,r2:PRGBArray;
begin
  bmp2:=TBitmap.Create;
  bmp2.PixelFormat:=pf24bit;
  bmp2.Width:=bmp1.Width;
  bmp2.Height:=bmp1.Height;

  for i:=0 to bmp1.Height-1 do begin
    r1:=bmp1.ScanLine[i];
    r2:=bmp2.ScanLine[i];
    for j:=0 to bmp1.Width-1 do
      r2^[j]:=r1^[j];     // alebo r2[j]:=r1[j];
  end;

  Image2.Canvas.Draw(0,0,bmp2);
  bmp2.Free;
end;

veľmi podobný je zrkadlový obraz: 

procedure TForm1.Button2Click(Sender: TObject);
var
  bmp2:TBitmap;
  w,h,i,j:integer;
  r1,r2:PRGBArray;
begin
  w:=bmp1.Width; h:=bmp1.Height;
  bmp2.PixelFormat:=pf24bit;
  bmp2:=TBitmap.Create;
  bmp2.Width:=w;
  bmp2.Height:=h;

  for i:=0 to h-1 do begin
    r1:=bmp1.ScanLine[i];
    r2:=bmp2.ScanLine[i];
    for j:=0 to w-1 do
      r2[j]:=r1[w-1-j];
  end;

  Image2.Canvas.Draw(0,0,bmp2);
  bmp2.Free;
end;

Chránené príkazy

  • pri programovaní sa často stretávame so situáciou, že niektoré príkazy potrebujeme bezpodmienečne vykonať, aj keď sa z nejakých dôvodov preruší výpočet, napr. pre výskyt chyby alebo ukončenie procedúry pomocou exit
    • napr. vždy keď v procedúre vytvoríme pomocnú bitmapu, pred ukončením ju musíme zrušiť, podobne, vždy, keď otvoríme súbor, na záver ho musíme zatvoriť, ...
  • môžeme použiť konštrukciu: try postupnosťPríkazov1 finally postupnosťPríkazov2 end:
    • ak počas vykonávania prvej postupnosti príkazov vznikne nejaké prerušenie (exit, break, spadnutie na chybe), tak sa pokračuje v druhej postupnosti príkazov
    • ak prvá časť skončí bez chyby, tak sa normálne pokračuje v druhej časti
    • try ... end si môžete predstaviť ako begin ... end, pričom, ak v ňom nastane nejaké prerušenie, vykonajú sa ešte upratovacie akcie
    • konštrukcie try ... end môžu byť navzájom vnorené rovnako ako begin ... end
  • v objektovom pascale existuje ešte veľmi podobná konštrukcia try ... except ... end - môžete si ju naštudovať v Helpe
  • jednoduché príklady na try ... finally ... end

takto slušne by sme mali pracovať so súborom: 

  ...
  AssignFile(t,'súbor.txt'); Rewrite(t);   // alebo Reset(t);
  try
    ...
       // práca so súborom
    ...
  finally
    CloseFile(t);
  end;
  ...

takto slušne by sme mali pracovať s bitmapami: 

  ...
  bmp:=TBitmap.Create;
  try
    ...
       // práca s bitmapou
    ...
  finally
    bmp.Free;
  end;
  ...

zrkadlovo otočíme bitmapu aj s try a finally: 

procedure TForm1.Button2Click(Sender: TObject);
var
  bmp2:TBitmap;
  w,h,i,j:integer;
  r1,r2:PRGBArray;
begin
  w:=bmp1.Width; h:=bmp1.Height;
  bmp2:=TBitmap.Create;
  try
    bmp2.PixelFormat:=pf24bit;
    bmp2.Width:=w;
    bmp2.Height:=h;

    for i:=0 to h-1 do begin
      r1:=bmp1.ScanLine[i];
      r2:=bmp2.ScanLine[i];
      for j:=0 to w-1 do
        r2[j]:=r1[w-1-j];
    end;

    Image2.Canvas.Draw(0,0,bmp2);
  finally
    bmp2.Free;
  end;
end;

symetricky podľa hlavnej uhlopriečky: 

procedure TForm1.Button3Click(Sender: TObject);
var
  bmp2:TBitmap;
  w,h,i,j:integer;
  r1,r2:PRGBArray;
begin
  w:=bmp1.Width; h:=bmp1.Height;
  bmp2:=TBitmap.Create;
  try
    bmp2.PixelFormat:=pf24bit;
    bmp2.Width:=w;
    bmp2.Height:=h;

    for i:=0 to h-1 do begin
      r1:=bmp1.ScanLine[i];
      for j:=0 to w-1 do begin
        r2:=bmp2.ScanLine[j];
        r2[i]:=r1[j];
      end;
    end;

    Image2.Canvas.Draw(0,0,bmp2);
  finally
    bmp2.Free;
  end;
end;

cyklický posun celých riadkov o päť (resp. viac) smerom hore: 

procedure TForm1.Button4Click(Sender: TObject);
var
  bmp2:TBitmap;
  w,h,i:integer;
  r1,r2:PRGBArray;
begin
  w:=bmp1.Width; h:=bmp1.Height;
  bmp2:=TBitmap.Create;
  try
    bmp2.PixelFormat:=pf24bit;
    bmp2.Width:=w;
    bmp2.Height:=h;

    for i:=0 to h-1 do begin
      r1:=bmp1.ScanLine[(i+5) mod h];  // alebo (i+h div 2) mod h 
      r2:=bmp2.ScanLine[i];
      move(r1^,r2^,sizeof(TRGB)*w);  // sizeof(TRGB) je 3
    end;

    Image2.Canvas.Draw(0,0,bmp2);
  finally
    bmp2.Free;
  end;
end;

ak by sme chceli viackrát posúvať (napr. v časovači) tú istú bitmapu: 

procedure TForm1.FormCreate(Sender: TObject);
begin
  bmp1:=TBitmap.Create;
  bmp1.LoadFromFile('parrots.bmp');
  Image1.Canvas.Draw(0,0,bmp1);
  Image2.Canvas.Draw(0,0,bmp1);
  DoubleBuffered:=true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  bmp1,bmp2:TBitmap;
  w,h,i:integer;
  r1,r2:PRGBArray;
begin
  bmp1:=TBitmap.Create;
  try
    w:=Image2.Width; h:=Image2.Height;
    bmp1.PixelFormat:=pf24bit;
    bmp1.Width:=w;
    bmp1.Height:=h;
    bmp1.Canvas.Draw(0,0,Image2.Picture.Graphic);

    bmp2:=TBitmap.Create;
    try
      bmp2.PixelFormat:=pf24bit;
      bmp2.Width:=w;
      bmp2.Height:=h;

      for i:=0 to h-1 do begin
        r1:=bmp1.ScanLine[(i+5) mod h];
        r2:=bmp2.ScanLine[i];
        move(r1^,r2^,3*w);
      end;

      Image2.Canvas.Draw(0,0,bmp2);
    finally
      bmp2.Free;
    end;
  finally
    bmp1.Free;
  end;
end;

veľmi zaujímavý rozmazávací efekt: 

procedure TForm1.Button5Click(Sender: TObject);
var
  bmp2:TBitmap;
  X,Y,sX,sY:Integer;
  d1,d2:PRGBArray;
begin
  bmp2:=TBitmap.Create;
  try
    bmp2.PixelFormat:=pf24bit;
    bmp2.Width:=256;
    bmp2.Height:=256;
    for Y:=0 to 255 do begin
      d2:=bmp2.ScanLine[Y];
      for X:=0 to 255 do begin
        sX:=X+random(5)-2;
        if sX<0 then sX:=-sX; if sX>255 then sX:=510-sX;
        sY:=Y+random(5)-2;
        if sY<0 then sY:=-sY; if sY>255 then sY:=510-sY;
        d1:=bmp1.ScanLine[sY];
        d2[X]:=d1[sX];
      end;
    end;
    Image1.Canvas.Draw(0,0,bmp2);
  finally
    bmp2.Free;
  end;
end;

prípadne efekt rozťahovania od stredu smerom ku okrajom: 

procedure TForm1.Button6Click(Sender: TObject);
var
  bmp2:TBitmap;
  X,Y,sX,sY:Integer;
  d1,d2:PRGBArray;
begin
  bmp2:=TBitmap.Create;
  try
    bmp2.PixelFormat:=pf24bit;
    bmp2.Width:=256;
    bmp2.Height:=256;
    for Y:=0 to 255 do begin
      d2:=bmp2.ScanLine[Y];
      for X:=0 to 255 do begin
        sX:=128+(X-128)*127 div 130;
        sY:=128+(Y-128)*127 div 130;
        d1:=bmp1.ScanLine[sY];
        d2[x]:=d1[sX];
      end;
    end;
    Image1.Canvas.Draw(0,0,bmp2);
  finally
    bmp2.Free;
  end;
end;

posledný efekt vylepšíme: pridáme časovač, pre ktorý Enabled=false a interval=50: 

procedure TForm1.Timer1Timer(Sender: TObject);
var
  bmp2:TBitmap;
  X,Y,sX,sY:Integer;
  d1,d2:PRGBArray;
begin
  bmp2:=TBitmap.Create;
  try
    bmp2.PixelFormat:=pf24bit;
    bmp2.Width:=256;
    bmp2.Height:=256;
    for Y:=0 to 255 do begin
      d2:=bmp2.ScanLine[Y];
      for X:=0 to 255 do begin
        sX:=128+(X-128)*127 div (127+Random(5));  // skúste napr. 14
        sY:=128+(Y-128)*127 div (127+Random(5));  // skúste napr. 14
        d1:=bmp1.ScanLine[sY];
        d2[x]:=d1[sX];
      end;
    end;
    d2:=bmp2.ScanLine[128];
    d2[128].R:=(Random(256)+d2[128].R) div 2;
    d2[128].G:=(Random(256)+d2[128].G) div 2;
    d2[128].B:=(Random(256)+d2[128].B) div 2;
    bmp1.Free;
    bmp1:=bmp2; bmp2:=nil;
    Image1.Canvas.Draw(0,0,bmp1);
  finally
    bmp2.Free;
  end;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  Timer1.Enabled:=not Timer1.Enabled;
end;
  • od  konštanty v Random závisí, ako rýchlo sa bude útvar rozmazávať
  • na záver do stredu bitmapy dávame "skoro náhodne" zafarbenú bodku

NDÚ:

  • premyslite, ako dorobiť všetky dnešné programy tak, aby fungovali pre ľubovoľne veľké bitmapy
  • podobne ako rozmazávanie s časovačom zrealizujte aj cyklické rolovanie s časovačom
    • do formulára položte aj TrackBar, pomocou ktorého budete meniť počet, o koľko riadkov sa bude posúvať - t.j. rýchlosť posúvania
  • zrealizujte čo najkrajšie otáčanie bitmapy o ľubovoľný uhol
  • rozmazávanie bitmapy: každý pixel sa vypočíta ako priemer so svojimi susedmi (stačí susedov v riadku)

© 2002 AB, KVI
blaho@fmph.uniba.sk