ieraw.pas

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

(*
   dcraw.c -- Dave Coffin's raw photo decoder
   Copyright 1997-2004 by Dave Coffin, dcoffin a cybercom o net

   This is a portable ANSI C program to convert raw image files from
   any digital camera into PPM format.  TIFF and CIFF parsing are
   based upon public specifications, but no such documentation is
   available for the raw sensor data, so writing this program has
   been an immense effort.

   This code is freely licensed for all uses, commercial and
   otherwise.  Comments, questions, and encouragement are welcome.

   $Revision: 1.215 $
   $Date: 2004/11/05 06:48:50 $

   November 2004: Converted to Delphi by Fabrizio Di Vittorio ([e-mail])
 *)

{!!
<FS>List of supported Camera RAW formats<FN>

Supported in internal implementation of ImageEn.
There is a free external plugin (dll) which is more updated. Look <L http://www.hicomponents.com/ndownloads_plgins.asp>here</L> for more details.

Canon PowerShot 600
Canon PowerShot A5
Canon PowerShot A5 Zoom
Canon PowerShot A50
Canon PowerShot Pro70
Canon PowerShot Pro90 IS
Canon PowerShot G1
Canon PowerShot G2
Canon PowerShot G3
Canon PowerShot G5
Canon PowerShot G6
Canon PowerShot S30
Canon PowerShot S40
Canon PowerShot S45
Canon PowerShot S50
Canon PowerShot S70
Canon PowerShot Pro1
Canon EOS D30
Canon EOS D60
Canon EOS 10D
Canon EOS 20D
Canon EOS 300D
Canon EOS DIGITAL REBEL
Canon EOS Kiss Digital
Canon EOS D2000C
Canon EOS-1D
Canon EOS-1DS
Canon EOS-1D Mark II
Canon EOS-1Ds Mark II
Casio QV-2000UX
Casio QV-3000EX
Casio QV-3500EX
Casio QV-4000
Casio QV-5700
Casio Exlim Pro 600
Contax N DIGITAL
Creative PC-CAM 600
Creo Leaf Valeo 22
Fuji FinePix S2Pro
Fuji FinePix S5000
Fuji FinePix S7000
Fuji FinePix E550
Fuji FinePix F700
Fuji FinePix S20Pro
Imacon Ixpress
Kodak DC20 (see Oliver Hartman's page)
Kodak DC25 (see Jun-ichiro Itoh's page)
Kodak DC40 (aka "Logitech Fotoman Pixtura")
Kodak DC50
Kodak DC120 (also try kdc2tiff)
Kodak DCS315C
Kodak DCS330C
Kodak DCS420
Kodak DCS460
Kodak DCS460A
Kodak DCS520C
Kodak DCS560C
Kodak DCS620C
Kodak DCS620X
Kodak DCS660C
Kodak DCS660M
Kodak DCS720X
Kodak DCS760C
Kodak DCS760M
Kodak EOSDCS1
Kodak EOSDCS3B
Kodak NC2000F
Kodak ProBack
Kodak PB645C
Kodak PB645H
Kodak PB645M
Kodak DCS Pro 14n
Kodak DCS Pro 14nx
Kodak DCS Pro SLR/c
Kodak DCS Pro SLR/n
Konica KD-400Z
Konica KD-510Z
Leica Digilux 2
Minolta DiMAGE 5
Minolta DiMAGE 7
Minolta DiMAGE 7i
Minolta DiMAGE 7Hi
Minolta DiMAGE A1
Minolta DiMAGE A2
Minolta DiMAGE G400
Minolta DiMAGE G500
Minolta DiMAGE G600
Minolta DiMAGE Z2
Nikon D1
Nikon D1H
Nikon D1X
Nikon D100
Nikon D2H
Nikon D70
Nikon E950 ("DIAG RAW" hack)
Nikon E990 ("DIAG RAW" hack)
Nikon E995 ("DIAG RAW" hack)
Nikon E2100 ("DIAG RAW" hack)
Nikon E2500 ("DIAG RAW" hack)
Nikon E4300 ("DIAG RAW" hack)
Nikon E4500 ("DIAG RAW" hack)
Nikon E5000
Nikon E5400
Nikon E5700
Nikon E8700
Nikon E8800
Olympus C5050Z
Olympus C5060WZ
Olympus C8080WZ
Olympus E-1
Olympus E-10
Olympus E-20
Panasonic DMC-LC1
Pentax *ist D
Pentax Optio S
Pentax Optio S4
Phase One LightPhase
Phase One H10
Phase One H20
Phase One H25
Rollei d530flex
Sigma SD9
Sigma SD10
Sinar 12582980-byte
Sony DSC-F828

!!}

unit ieraw;

{$I ie.inc}

interface

{$ifdef IEINCLUDERAWFORMATS}

uses SysUtils,Windows,Classes,hyiedefs,hyieutils,jpegfilt,imageenproc,imageenio, ieview;

procedure IEReadCameraRAWStream(InputStream: TStream; Bitmap: TIEBitmap; var IOParams: TIOParamsVals; var Progress: TProgressRec; Preview: boolean);
function IERAWTryStream(Stream:TStream):boolean;

function IECRWGetCIFFAsExif(Stream:TStream; var IOParams:TIOParamsVals):boolean;
function IECRWGetJpeg(Bitmap:TIEBitmap; Stream:TStream):boolean;

{$endif}

implementation

{$ifdef IEINCLUDERAWFORMATS}

{$WARNINGS OFF}
{$HINTS OFF}


const LONG_BIT = (8 * sizeof (integer));

type

  pdecode=^decode;
  decode=record
    branch:array [0..1] of pdecode;
    leaf:integer;
  end;

  tword4array=array [0..maxint div 16] of array [0..3] of word;
  pword4array=^tword4array;

  tint64array=array [0..maxint div 16] of int64;
  pint64array=^tint64array;

  PRec=^TRec;

  TIELoadRaw=procedure(rec:PRec);

  TRec=record
    image:pword4array; // 'ushort (*image)[4]'
    ifp:TStream;
    order:word;
    make,model,model2:array [0..63] of char;
    timestamp:ttimestamp;
    data_offset, curve_offset, curve_length:integer;
    tiff_data_compression, kodak_data_compression:integer;
    raw_height, raw_width, top_margin, left_margin:integer;
    height, width, colors, black, rgb_max:integer;
    iheight, iwidth, shrink:integer;
    is_canon, is_cmy, is_foveon, use_coeff, trim, flip, xmag, ymag:integer;
    zero_after_ff:integer;
    filters:dword;
    white:array [0..7] of array [0..7] of word;
    load_raw:TIELoadRaw;
    gamma_val, bright, red_scale, blue_scale:single;
    four_color_rgb, document_mode, quick_interpolate:integer;
    use_auto_wb, use_camera_wb, use_secondary:integer;
    camera_red, camera_blue:single;
    pre_mul: array [0..3] of single;
    coeff:array [0..2] of array [0..3] of single;
    histogram:array [0..$2000-1] of integer;
    jpeg_buffer:array [0..4096-1] of char;
    pad:array [0..128-1] of dword;
    decrypt_p:dword;
    getbits_bitbuf:dword;
    getbits_vbits:integer;
    make_decoder_leaf:integer;
    radc_token_s:pintegerarray;
    radc_token_dstart:array [0..18-1] of pdecode;
    radc_token_dindex:pdecode;
    vng_interpolate_cp:pinteger;
    first_decode:array [0..2047] of decode;
    second_decode:pdecode;
    free_decode:pdecode;
    needrot45:boolean;
    xprogress:TProgressRec;
  end;



procedure InitRec(var rec:TRec);
begin
  with rec do
  begin
    getbits_bitbuf:=0;
    getbits_vbits:=0;
    make_decoder_leaf:=0;
    radc_token_s:=nil;
    fillchar(radc_token_dstart,sizeof(radc_token_dstart),0);
    radc_token_dindex:=nil;
    vng_interpolate_cp:=nil;
  end;
end;

function strcasecmp(Str1, Str2:PChar):integer;
begin
  result:=stricomp(Str1,Str2);
end;

function strcmp(Str1,Str2:PChar):integer;
begin
  result:=strcomp(Str1,Str2);
end;

function strncmp(Str1,Str2:PChar; n:integer):integer;
begin
  result:=strlcomp(Str1,Str2,n);
end;

function ftell(s:TStream):integer;
begin
  result:=s.Position;
end;

function fgetc(s:TStream):byte;
begin
  s.Read(result,1);
end;

(*
   In order to inline this calculation, I make the risky
   assumption that all filter patterns can be described
   by a repeating pattern of eight rows and two columns

   Return values are either 0/1/2/3 = G/M/C/Y or 0/1/2/3 = R/G1/B/G2
 *)
function FC(var rec:TRec; row,col:dword):integer;
begin
  with rec do
  	result := (filters shr (((row shl 1 and 14) + (col and 1)) shl 1) and 3);
end;

function BAYER(var rec:TRec; row,col:dword):pword;
begin
  with rec do
  	//result := @(image[(row shr shrink)*iwidth + (col shr shrink)][FC(row,col)]);
    result := @(image[(row shr shrink)*iwidth + (col shr shrink)][ (filters shr (((row shl 1 and 14) + (col and 1)) shl 1) and 3) ]);
end;

(*
   PowerShot 600 uses 0xe1e4e1e4:

	  0 1 2 3 4 5
	0 G M G M G M
	1 C Y C Y C Y
	2 M G M G M G
	3 C Y C Y C Y

   PowerShot A5 uses 0x1e4e1e4e:

	  0 1 2 3 4 5
	0 C Y C Y C Y
	1 G M G M G M
	2 C Y C Y C Y
	3 M G M G M G

   PowerShot A50 uses 0x1b4e4b1e:

	  0 1 2 3 4 5
	0 C Y C Y C Y
	1 M G M G M G
	2 Y C Y C Y C
	3 G M G M G M
	4 C Y C Y C Y
	5 G M G M G M
	6 Y C Y C Y C
	7 M G M G M G

   PowerShot Pro70 uses 0x1e4b4e1b:

	  0 1 2 3 4 5
	0 Y C Y C Y C
	1 M G M G M G
	2 C Y C Y C Y
	3 G M G M G M
	4 Y C Y C Y C
	5 G M G M G M
	6 C Y C Y C Y
	7 M G M G M G

   PowerShots Pro90 and G1 use 0xb4b4b4b4:

	  0 1 2 3 4 5
	0 G M G M G M
	1 Y C Y C Y C

   All RGB cameras use one of these Bayer grids:

	0x16161616:	0x61616161:	0x49494949:	0x94949494:

	  0 1 2 3 4 5	  0 1 2 3 4 5	  0 1 2 3 4 5	  0 1 2 3 4 5
	0 B G B G B G	0 G R G R G R	0 G B G B G B	0 R G R G R G
	1 G R G R G R	1 B G B G B G	1 R G R G R G	1 G B G B G B
	2 B G B G B G	2 G R G R G R	2 G B G B G B	2 R G R G R G
	3 G R G R G R	3 B G B G B G	3 R G R G R G	3 G B G B G B

 *)

function memcmp(buf1, buf2: pbyte; count: integer): integer;
begin
  if count = 0 then
    result := 0
  else
  begin
    dec(count);
    while (count > 0) and (buf1^ = buf2^) do
    begin
      inc(buf1);
      inc(buf2);
      dec(count);
    end;
    result := buf1^ - buf2^;
  end;
end;

function memmem (haystack:pchar; haystacklen:integer; needle:pchar; needlelen:integer):pchar;
var
  c:integer;
begin
  for c := integer(haystack) to integer(haystack) + haystacklen - needlelen do
    if (memcmp (pbyte(c), pbyte(needle), needlelen)=0) then
    begin
      result:= pchar(c);
      exit;
    end;
  result:=nil;
end;

procedure merror (ptr:pointer; where:pchar);
begin
  if (ptr<>nil) then
    exit;
  raise Exception.Create(': Out of memory in '+where);
end;

(*
   Get a 2-byte integer, making no assumptions about CPU byte order.
   Nor should we assume that the compiler evaluates left-to-right.
 *)
function fget2 (var rec:TRec; f:TStream):word;
var
  a,b:byte;
begin
  with rec do
  begin
    f.Read(a,1);
    f.Read(b,1);
    if (order = $4949) then		(* "II" means little-endian *)
      result:=a + (b shl 8)
    else				(* "MM" means big-endian *)
      result:=(a shl 8) + b;
  end;
end;

(*
   Same for a 4-byte integer.
 *)
function fget4 (var rec:TRec; f:TStream):integer;
var
  a, b, c, d:byte;
begin
  with rec do
  begin
    f.Read(a,1);
    f.Read(b,1);
    f.Read(c,1);
    f.Read(d,1);
    if (order = $4949) then
      result:= a + (b shl 8) + (c shl 16) + (d shl 24)
    else
      result:= (a shl 24) + (b shl 16) + (c shl 8) + d;
  end;
end;

procedure canon_600_load_raw(rec:PRec);
var
  data:array [0..1119] of byte;
  dp:pbytearray;
  pixel:array [0..895] of word;
  pix:pwordarray;
  irow, orow, col:integer;
begin
  with rec^ do
  begin
    orow:=0;
    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));
          
      ifp.Read(data[0],1120); //fread (data, 1120, 1, ifp);
      dp:=@data;
      pix:=@pixel;
      while integer(dp) < integer(@data)+1120 do
      begin
        pix[0] := (dp[0] shl 2) + (dp[1] shr 6    );
        pix[1] := (dp[2] shl 2) + (dp[1] shr 4 and 3);
        pix[2] := (dp[3] shl 2) + (dp[1] shr 2 and 3);
        pix[3] := (dp[4] shl 2) + (dp[1]      and 3);
        pix[4] := (dp[5] shl 2) + (dp[9]      and 3);
        pix[5] := (dp[6] shl 2) + (dp[9] shr 2 and 3);
        pix[6] := (dp[7] shl 2) + (dp[9] shr 4 and 3);
        pix[7] := (dp[8] shl 2) + (dp[9] shr 6    );
        inc(pbyte(dp),10);
        inc(pword(pix),8);
      end;
      for col:=0 to width-1 do
        BAYER(rec^,orow,col)^ := pixel[col] shl 4;
      for col:=width to 896-1 do
        inc(black, pixel[col]);
      inc(orow,2);
      if (orow > height) then
        orow := 1;
    end;
    black := ( black shl 4) div ((896 - width) * height);
  end;
end;

procedure canon_a5_load_raw(rec:PRec);
var