Klipping Bitmap Berukuran Besar (> 10MB) langsung dari filenya

28Des07

Baru kemaren berurusan sama file bitmap (.BMP) yang ukurannya mendekati 50 MB. Persoalannya adalah bagaimana mengambil beberapa bagian (klipping/cropping) yang berukuran relatif kecil (100×100 pixel) tanpa harus mengorbankan kecepatan dan memori.

cara trivialnya adalah dengan membaca bitmap tersebut (pakai TBitmap), lalu digambarkan di bitmap lain yang ukurannya lebih kecil.. yeah, so… trivial.. tapi persoalannya file ini kalau dibuka pakai penampil citra (irfanview/paint.net) aja perlu waktu beberapa detik, dan lagipula kalau membuka file ini menggunakan TBitmap peak-memory langsung naik ke 60 MB (walaupun hanya sesaat). Kalau lagi luang sih baik-baik aja, tapi kalau dalam kondisi ekstrim memori hampir penuh bisa-bisa gagal..

akhirnya terpaksa membaca deskripsi format file dari sini dan membaca langsung ke file. Ternyata file bitmap banyak macamnya jadi untuk mempermudah saya hanya berurusan dengan bitmap dengan format 8 dan 24 bit per pixel yang tidak dimampatkan (menggunakan RLE).

so, this is the code..

record yang perlu dipersiapkan adalah header dan entri utk palet (sebetulnya bisa dilewat jika menggunakan bitmap yang bit per pixelnya > 16). struktur headernya seperti ini :

TBMPHeader = packed record
    sID : array[1..2] of char;
    dFileSize : dword;
    dReserved : dword;
    dBitmapDataOffset : dword;
    dHeaderSize : cardinal;
    dWidth, dHeight : dword;
    wNumPlanes : word;
    wBitPerPixel : word;
    dCompressionType : dword;
    dDataSize : dword;
    dHRes, dVRes : dword;
    dNumColors : dword;
    dNumImportantColors : dword;
  end;

TBMPPaletteEntry=packed record
    r,g,b,unused:byte;
  end;

Untuk mengakses file, saya menggunakan turunan TStream (TFileStream). Kodenya ada dalam prosedur LoadBMP. dalam kode di bawah, saya membaca bitmap dalam matriks datamatrix

procedure TForm1.loadBMP(filename: string);
var
  stream : TFileStream;
  header : TBMPHeader;
  x,y : integer; {offset posisi yang ingin diambil}
  msize : integer; {dimensi matriks}

  procedure read_palette;
  var
    i : integer;
    pal : array of TBMPPaletteEntry;
  begin
    if header.wBitPerPixel < 16 then begin
      setlength(pal, header.dNumColors);
      if length(pal) > 0 then
      stream.Read(pal[0], header.dNumColors * sizeof(TBMPPaletteEntry));
    end;
  end;

  procedure read_bitmap_data;
  var
    i, j : integer;
    linespan : dword;
    oldpos : dword;
    calcSize : dword;
    datamatrix : array of array of byte;
    mstream : TMemoryStream;
  begin
    setlength(datamatrix, msize);
    for i := 0 to high(datamatrix) do
      setlength(datamatrix[i], msize * (header.wBitPerPixel shr 3));

    stream.Position := header.dBitmapDataOffset;
    { kadang field DataSize bernilai 0 }
    calcSize := stream.Size-stream.Position;
    if header.dDataSize <> calcSize then header.dDataSize := calcSize;

    { jumlah byte yang diperlukan untuk menyimpan tiap baris pixel }
    linespan := header.dDataSize div header.dHeight;

    { skip some lines }
    stream.Position := stream.Position
            + (linespan * (header.dHeight-y-length(datamatrix)))
            + (x * (header.wBitPerPixel shr 3));

    { read upward }
    i := y+length(datamatrix)-1;
    while i >= y do begin
      oldpos := stream.Position;
      stream.Read(datamatrix[i-y][0], length(datamatrix[i-y]));
      stream.Position := oldpos + linespan;
      dec(i);
    end;

    { dump as raw bytes }
    mStream := TMemoryStream.Create;
    for i := 0 to high(datamatrix) do begin
      mStream.Write(datamatrix[i][0], length(datamatrix[i]));
    end;
    mStream.SaveToFile(changefileext(filename, '.raw'));
    mStream.Free;
  end;

begin
  x := 410;
  y := 280;
  msize := 120;
  stream := TFileStream.Create(filename, fmOpenRead);
  stream.Read(header, sizeof(header));
  if header.sID <> 'BM' then begin
    showmessage('this is not a valid bitmap file');
    exit;
  end;
  //read_palette; //comment jika di skip
  read_bitmap_data;
  stream.Free;
end;

oya, dalam kode diatas pembacaannya dimulai dari baris terbawah karena penyimpanan pixel dalam file BMP terbalik (baris pixel paling bawah disimpan terlebih dahulu dan seterusnya ke baris pertama paling atas).

Filed under: delphi, programming, work   |  2 Comments
Tags: bitmap, crop, delphi, graphic, image processing, stream