ieraw.pas

·ImageEn 2.3.0 ImageEn一组用于图像处理、查看和分析的Delphi控件。能够保存几种图像格式

      ifp.Read(data[0],len); //fread (data, 1, len, ifp);
      case (tag) of
        $ffc3:
          begin
            jhigh := (data[1] shl 8) + data[2];
            jwide := ((data[3] shl 8) + data[4])*2;
          end;
        $ffc4:
          begin
            init_decoder(rec^);
            dstart[1] := free_decode;
            dstart[0] := dstart[1];
            dp := @data;
            while ( integer(dp) < integer(@data)+len) and (dp^ < 2 ) do
            begin
              dstart[dp^] := free_decode;
              inc(dp);
              dp := make_decoder (rec^,pbytearray(dp), 0);
            end;
          end;
       end;
    until (tag = $ffda);

    xprogress.per1 := 100 / jhigh / 2;

    zero_after_ff := 1;
    getbits(rec^,-1);
    for jrow:=0 to jhigh-1 do
    begin
      with xprogress do
        if assigned(fOnProgress) then
          fOnProgress(Sender, trunc(per1 * jrow));
      for jcol:=0 to jwide-1 do
      begin
        dindex := dstart[jcol and 1];
        while ( dindex^.branch[0]<>nil ) do
          dindex := dindex^.branch[getbits(rec^,1)];
        len := dindex^.leaf;
        diff := getbits(rec^,len);
        if ((diff and (1 shl (len-1))) = 0) then
          dec(diff , (1 shl len) - 1 );
        if (jcol < 2) then
        begin
          inc(vpred[jcol] , diff);
          hpred[jcol] := vpred[jcol];
        end
        else
          inc( hpred[jcol and 1] , diff );
        diff := hpred[jcol and 1];
        if (diff < 0) then
          diff := 0;
        if (diff > $fff) then
          diff := $fff;
        jidx := jrow*jwide + jcol;
        if (raw_width = 5108) then
        begin
          i := jidx div (1680*jhigh);
          if (i < 2) then
          begin
            row := jidx div 1680 mod jhigh;
            col := jidx mod 1680 + i*1680;
          end
          else
          begin
            dec( jidx , 2*1680*jhigh );
            row := jidx div 1748;
            col := jidx mod 1748 + 2*1680;
          end;
        end
        else
        begin
          row := jidx div raw_width;
          col := jidx mod raw_width;
        end;
        if ( (row-top_margin) >= height) then
          continue;
        if ( (col-left_margin) < width) then
        begin

          if (row-top_margin>=0) and (col-left_margin>=0) then
            BAYER(rec^,row-top_margin,col-left_margin)^ := curve[diff] shl 2;

          if (min > curve[diff]) then
            min := curve[diff];
        end
        else
          inc(bblack , curve[diff] );
      end;
    end;
    if (raw_width > width) then
      black := (bblack shl 2) div ((raw_width - width) * height);
    if strcasecmp(make,'KODAK')=0 then
      black := min shl 2;
  end;
end;

procedure nikon_compressed_load_raw(rec:PRec);
const
  nikon_tree:array [0..28] of byte = (
    0,1,5,1,1,1,1,1,1,2,0,0,0,0,0,0,
    5,4,3,6,2,7,1,0,8,9,11,10,12
  );
var
  vpred:array [0..4-1] of integer;
  hpred:array [0..2-1] of integer;
  csize, row, col, i, len, diff:integer;
  curve:pwordarray;
  dindex:pdecode;
begin
  with rec^ do
  begin
    init_decoder(rec^);
    make_decoder (rec^,@nikon_tree, 0);

    ifp.Position:=curve_offset; //fseek (ifp, curve_offset, SEEK_SET);
    for i:=0 to 4-1 do
      vpred[i] := fget2(rec^,ifp);
    csize := fget2(rec^,ifp);
    curve := allocmem(csize * sizeof(word));
    merror (curve, 'nikon_compressed_load_raw()');
    for i:=0 to csize-1 do
      curve[i] := fget2(rec^,ifp);

    ifp.Position:=data_offset; //fseek (ifp, data_offset, SEEK_SET);
    getbits(rec^,-1);

    xprogress.per1 := 100 / height / 2;

    for row:=0 to height-1 do
    begin

      with xprogress do
        if assigned(fOnProgress) then
          fOnProgress(Sender, trunc(per1 * row));

      for col:=0 to raw_width-1 do
      begin
        dindex:=@first_decode;
        while (dindex^.branch[0]<>nil) do
          dindex := dindex^.branch[getbits(rec^,1)];
        len := dindex^.leaf;
        diff := getbits(rec^,len);
        if ((diff and (1 shl (len-1))) = 0) then
          dec( diff , (1 shl len) - 1 );
        if (col < 2) then
        begin
          i := 2*(row and 1) + (col and 1);
          inc(vpred[i] , diff);
          hpred[col] := vpred[i];
        end
        else
          inc( hpred[col and 1] , diff );
        if ( (col-left_margin) >= width) then
          continue;
        diff := hpred[col and 1];
        if (diff < 0) then
          diff := 0;
        if (diff >= csize) then
          diff := csize-1;
        BAYER(rec^,row,col-left_margin)^ := curve[diff] shl 2;
      end;
    end;
    freemem(curve);
  end;
end;

procedure nikon_load_raw(rec:PRec);
var
  irow, row, col, i:integer;
begin
  with rec^ do
  begin
    getbits(rec^,-1);
    xprogress.per1 := 100 / height / 2;
    for irow:=0 to height-1 do
    begin

      with xprogress do
        if assigned(fOnProgress) then
          fOnProgress(Sender, trunc(per1 * row));

      row := irow;
      if (model[0] = 'E') then
      begin
        row := irow * 2 mod height + irow div (height div 2);
        if (row = 1) and (strtointdef(string(pchar(@model[1])),0) < 5000) then
        begin
          ifp.Position:=ifp.Size; //fseek (ifp, 0, SEEK_END);
          ifp.Position:=ifp.Position div 2; //fseek (ifp, ftell(ifp)/2, SEEK_SET);
          getbits(rec^,-1);
        end;
      end;
      for col:=0 to raw_width-1 do
      begin
        i := getbits(rec^,12);
        if ((col-left_margin) < width) and ((col-left_margin)>=0) then
          BAYER(rec^,row,col-left_margin)^ := i shl 2;
        if (tiff_data_compression = 34713) and ((col mod 10) = 9) then
          getbits(rec^,8);
      end;
    end;
  end;
end;

(*
   Figure out if a NEF file is compressed.  These fancy heuristics
   are only needed for the D100, thanks to a bug in some cameras
   that tags all images as "compressed".
 *)
function nikon_is_compressed(var rec:TRec):integer;
var
  test:array [0..256-1] of byte;
  i:integer;
begin
  with rec do
  begin
    if (tiff_data_compression <> 34713) then
    begin
      result:=0;
      exit;
    end;
    if strcmp(model,'D100')<>0 then
    begin
      result:=1;
      exit;
    end;
    ifp.Position:=data_offset; //fseek (ifp, data_offset, SEEK_SET);
    ifp.Read(test[0],256); //fread (test, 1, 256, ifp);
    i:=15;
    while (i < 256) do
    begin
      if (test[i]<>0) then
      begin
        result:=1;
        exit;
      end;
      inc(i,16);
    end;
    result:=0;
  end;
end;

(*
   Returns 1 for a Coolpix 990, 0 for a Coolpix 995.
 *)
function nikon_e990(var rec:TRec):integer;
const
  often:array [0..3] of byte = ( $00, $55, $aa, $ff );
var
  i:integer;
  histo:array [0..256-1] of integer;
  _c:byte;
begin
  with rec do
  begin
    memset (@histo, 0, sizeof(histo));
    ifp.Position:=2064*1540*3 div 4; //fseek (ifp, 2064*1540*3/4, SEEK_SET);
    for i:=0 to 2000-1 do
    begin
      ifp.Read(_c,1); //fgetc(ifp)
      inc(histo[_c]);
    end;
    for i:=0 to 4-1 do
      if (histo[often[i]] > 400) then
      begin
        result:=1;
        exit;
      end;
    result:=0;
  end;
end;

(*
   Returns 1 for a Coolpix 2100, 0 for anything else.
 *)
function nikon_e2100(var rec:TRec):integer;
var
  t:array [0..12-1] of byte;
  i:integer;
begin
  with rec do
  begin
    ifp.Position:=0; //fseek (ifp, 0, SEEK_SET);
    for i:=0 to 1024-1 do
    begin
      ifp.Read(t[0],12);  //fread (t, 1, 12, ifp);
      if (((t[2] and t[4] and t[7] and t[9]) shr 4 and t[1] and t[6] and t[8] and t[11] and 3) <> 3) then
      begin
        result:=0;
        exit;
      end;
    end;
    result:=1;
  end;
end;

(*
   Separates a Minolta DiMAGE Z2 from a Nikon E4300.
 *)
function minolta_z2(var rec:TRec):integer;
var
  i:integer;
  tail:array [0..424-1] of char;
begin
  with rec do
  begin
    ifp.Position:=ifp.Size-sizeof(tail); //fseek (ifp, -sizeof tail, SEEK_END);
    ifp.Read(tail[0],sizeof(tail)); //fread (tail, 1, sizeof tail, ifp);
    for i:=0 to sizeof(tail)-1 do
      if (tail[i]<>#0) then
      begin
        result:=1;
        exit;
      end;
    result:=0;
  end;
end;

procedure nikon_e2100_load_raw(rec:PRec);
var
  data:array [0..3432-1] of byte;
  dp:pbytearray;
  pixel:array [0..2288-1] of word;
  pix:pwordarray;
  row, col:integer;
begin
  with rec^ do
  begin
    xprogress.per1 := 100 / height / 2;
    row:=0;
    while (row <= height) do
    begin

      with xprogress do
        if assigned(fOnProgress) then
          fOnProgress(Sender, trunc(per1 * row));

      if (row = height) then
      begin
        ifp.Position:=ifp.Position+IEIFI(width=1616 , 8792,424); //fseek (ifp, width==1616 ? 8792:424, SEEK_CUR);
        row := 1;
      end;
      ifp.Read(data[0],width*3 div 2); //fread (data, 1, width*3/2, ifp);
      dp:=@data;
      pix:=@pixel;
      while ( integer(pix) < integer(@pixel)+width*sizeof(word) ) do
      begin
        pix[0] := (dp[2] shr 4) + (dp[ 3] shl 4);
        pix[1] := (dp[2] shl 8) +  dp[ 1];
        pix[2] := (dp[7] shr 4) + (dp[ 0] shl 4);
        pix[3] := (dp[7] shl 8) +  dp[ 6];
        pix[4] := (dp[4] shr 4) + (dp[ 5] shl 4);
        pix[5] := (dp[4] shl 8) +  dp[11];
        pix[6] := (dp[9] shr 4) + (dp[10] shl 4);
        pix[7] := (dp[9] shl 8) +  dp[ 8];
        inc(pbyte(dp),12);
        inc(pword(pix),8);
      end;
      for col:=0 to width-1 do
        BAYER(rec^,row,col)^ := (pixel[col] and $fff) shl 2;
      inc(row,2);
    end;
  end;
end;

procedure nikon_e950_load_raw(rec:PRec);
var
  irow, row, col:integer;
begin
  with rec^ do
  begin
    getbits(rec^,-1);
    xprogress.per1 := 100 / height / 2;
    for irow:=0 to height-1 do
    begin

      with xprogress do
        if assigned(fOnProgress) then
          fOnProgress(Sender, trunc(per1 * irow));

      row := irow * 2 mod height;
      for col:=0 to width-1 do
        BAYER(rec^,row,col)^ := getbits(rec^,10) shl 4;
      col:=28;
      while ( col<>0 ) do
      begin
        getbits(rec^,8);
        dec(col);
      end;
    end;
  end;
end;

function ntohs(netshort:word):word;
begin
  //result:=swap(netshort);
  result:=IESwapWord(netshort);
end;

function htons(netshort:word):word;
begin
  //result:=swap(netshort);
  result:=IESwapWord(netshort);
end;


function htonl(netlong:integer):integer;
begin
  result:=IESwapDWord(netlong);
end;

(*
   The Fuji Super CCD is just a Bayer grid rotated 45 degrees.
 *)
procedure fuji_s2_load_raw(rec:PRec);
var
  pixel:array [0..2944-1] of word;
  row, col, r, c:integer;
begin
  with rec^ do
  begin
    ifp.position:=ifp.position+(2944*24+32)*2; //fseek (ifp, (2944*24+32)*2, SEEK_CUR);
    xprogress.per1 := 100 / 2144 / 2;
    for row:=0 to 2144-1 do
    begin

      with xprogress do
        if assigned(fOnProgress) then
          fOnProgress(Sender, trunc(per1 * row));

      ifp.Read(pixel[0],2*2944); //fread (pixel, 2, 2944, ifp);
      for col:=0 to 2880-1 do
      begin
        r := row + ((col+1) shr 1);
        c := 2143 - row + (col shr 1);

        //BAYER(rec^,r,c)^ := ntohs(pixel[col]) shl 2;
        image[(r shr shrink)*iwidth + (c shr shrink)][ (filters shr (((r shl 1 and 14) + (c and 1)) shl 1) and 3) ]
          :=ntohs(pixel[col]) shl 2;
          
      end;
    end;
    needrot45:=true;
  end;
end;

procedure swab( src:pchar; dest:pchar; nbytes:integer );
var
  b1, b2:char;
begin
  while (nbytes > 1) do
  begin
    b1 := src^; inc(src);
    b2 := src^; inc(src);
    dest^ := b2; inc(dest);
    dest^ := b1; inc(dest);
    dec(nbytes , 2);
  end;
end;


procedure fuji_common_load_raw (var rec:TRec; ncol:integer; icol:integer; nrow:integer);
var
  pixel:array [0..2048-1] of word;
  row, col, r, c:integer;
begin
  with rec do
  begin
    xprogress.per1 := 100 / nrow / 2;
    for row:=0 to nrow-1 do
    begin

      with xprogress do
        if assigned(fOnProgress) then
          fOnProgress(Sender, trunc(per1 * row));

      ifp.Read(pixel[0],2*ncol); //fread (pixel, 2, ncol, ifp);
      if (ntohs($aa55) = $aa55)	then(* data is little-endian *)
        swab (pchar(@pixel), pchar(@pixel), ncol*2);
      for col:=0 to icol do
      begin
        r := icol - col + (row shr 1);
        c := col + ((row+1) shr 1);
        BAYER(rec,r,c)^ := pixel[col] shl 2;