FloodFill ke Bitmap External

16Jan08

Masih terkait dengan posting saya yang ini. Sekarang saya mau melakukan operasi pengarsiran dengan cara banjir (floodfill) tapi tidak ke citra yang ada di memori melainkan citra bitmap yang ada di media penyimpanan eksternal (file). Hal ini disebabkan mungkin saja operasi ini dibutuhkan untuk file bitmap yang tidak mungkin diangkat ke memori karena terlalu besar.

Skema tipe data bentukan yang digunakan sebagai header masih sama seperti di posting saya sebelumnya. Strategi awal untuk melakukan operasi arsir adalah menggunakan algoritma yang bersifat non-rekursif dan mengimplementasi fungsi put_pixel dan get_pixel ke dalam file bitmap tersebut. Yang perlu di simpan adalah offset dari tiap baris bitmap (scanline). OK, Lets jump to the code..

procedure TForm1.floodFillBMP(filename: string; xx, yy: integer;
  color: dword);
var
  sl_cache : array [0..2] of array of byte;
  y_cache : integer;
  scanline : array of dword;
  i, j : integer;
  fs : TFileStream;
  header : TBMPHeader;
  BytesPerPel : byte;
  pal : array[0..255] of TBMPPaletteEntry;
  linespan : dword;
  stack : array of TPoint;
  span_up, span_down : boolean;

  procedure get_data_offset;
  var
    y : integer;
    offs : dword;
  begin
    linespan := header.dDataSize div header.dHeight;
    setlength(scanline, header.dHeight);
    offs := fs.Position;
    for y := high(scanline) downto 0 do begin
      scanline[y] := offs;
      offs := offs + linespan;
      //showmessage(format('%d %u', [y, scanline[y]]));
    end;
    for y := 0 to 2 do
      setlength(sl_cache[y], (header.dWidth * BytesPerPel));
    y_cache := -1;
    setlength(stack, 0);
  end;

  procedure read_cache(row : integer);
  begin
    if y_cache  <> row then begin
      if (row < header.dHeight-1) then begin
        fs.Position := scanline[row+1];
        fs.Read(sl_cache[2][0], length(sl_cache[2]));
      end;
      fs.Position := scanline[row];
      fs.Read(sl_cache[1][0], length(sl_cache[1]));
      if (row > 0) then begin
        fs.Position := scanline[row-1];
        fs.Read(sl_cache[0][0], length(sl_cache[0]));
      end;
      y_cache := row;
    end;
  end;

  procedure push(x, y: integer);
  begin
    setlength(stack, length(stack)+1);
    stack[high(stack)] := point(x, y);
  end;

  function pop:TPoint;
  begin
    result := stack[high(stack)];
    setlength(stack, length(stack)-1);
  end;

  procedure put_pixel(x, y: integer; val : integer);
  var
    b : byte;
  begin
    fs.Position := scanline[y] + (x * BytesPerPel);
    case BytesPerPel of
      3:begin
        b := (val shr 16) and $FF;
        fs.Write(b, sizeof(b));
        b := (val shr 8 ) and $FF;
        fs.Write(b, sizeof(b));
        b := val and $FF;
        fs.Write(b, sizeof(b));
      end;
      1:begin
        b := val;
        fs.Write(b, sizeof(b));
      end;
    end;
  end;

  function get_pixel_slow(x, y : integer):integer;
  var
    b1, b2, b3 : byte;
  begin
    case BytesPerPel of
      3:begin
        fs.Position := scanline[y] + (x * 3);
        fs.Read(b1, sizeof(b1));
        fs.Read(b2, sizeof(b2));
        fs.Read(b3, sizeof(b3));
        result := (b1 shl 16) + (b2 shl 8 ) + b3;
      end;
      1:begin
        fs.Position := scanline[y] + x;
        fs.Read(b1, sizeof(b1));
        result := b1;
      end;
    end;
  end;

  procedure _floodfill;
  var
    pt : TPoint;
    xmin, xmax, x : integer;
    sel : integer;

    function get_pixel(x: integer; yoffset: integer=0):integer;
    var off : integer;
    begin

      case BytesPerPel of
      3:begin
        off := x * 3;
        result := (sl_cache[1+yoffset][off] shl 16)
        +(sl_cache[1+yoffset][off+1] shl 8 )
        +(sl_cache[1+yoffset][off+2]);
      end;
      1:begin
        result := (sl_cache[1+yoffset][x]);
      end;
      end;

      //result := get_pixel_slow(x, y_cache+yoffset);
    end;

  begin
    push(xx, yy);
    read_cache(yy);
    sel := get_pixel(xx, 0);
    while length(stack)>0 do begin
      pt := pop;
      read_cache(pt.Y);
      xmin := pt.X;
      while (xmin > 0) and (sel = get_pixel(xmin-1)) do dec(xmin);
      xmax := pt.X;
      while (xmax < header.dWidth-1) and (sel = get_pixel(xmax+1)) do inc(xmax);
      span_up := false;
      span_down := false;
      for x := xmin to xmax do begin
        if (pt.Y > 0) then begin
          if not span_up and (sel = get_pixel(x, -1)) then begin
            span_up := true;
            push(x, pt.Y-1);
          end else if span_up and (sel <> get_pixel(x, -1)) then
            span_up := false;
        end;

        if (pt.Y < header.dHeight-1) then begin
          if not span_down and (sel = get_pixel(x, 1)) then begin
            span_down := true;
            push(x, pt.Y+1);
          end else if span_down and (sel <> get_pixel(x, 1)) then
            span_down := false;
        end;

        put_pixel(x, pt.Y, color);//fill
      end;
    end;
  end;

begin
  fs := TFileStream.Create(filename, fmOpenReadWrite);
  fs.Read(header, sizeof(header));
  BytesPerPel := (header.wBitPerPixel shr 3);
  if BytesPerPel < 2 then begin //read palette
    fs.Read(pal[0], header.dNumColors * sizeof(TBMPPaletteEntry));
  end;
  get_data_offset;
  _floodfill;
  fs.Free;
  showmessage('done');
end;

PS: source-code blm di-syntax-highlight..

Filed under: delphi, programming, work   |  1 Comment
Tags: external bitmap, floodfill, iterative