iej2000.pas

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

             if xProgress.Aborting^ then
                break;
          end;
       end;
    //*)
  end;
  outopts := 'rate=' + iefloattostr(IOParams.J2000_Rate);
  if IOParams.J2000_ScalableBy = ioJ2000_Rate then
    outopts := outopts + ' prg=lrcp'
  else if IOParams.J2000_ScalableBy = ioJ2000_Resolution then
    outopts := outopts + ' prg=rlcp';
  jas_image_encode(im, js, format, pchar(outopts));
  jas_stream_flush(js);
  jas_stream_close(js);
  if im <> nil then
    jas_image_destroy(im);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////

function _malloc(size: Integer): Pointer; cdecl;
begin
  result := allocmem(size);
end;

procedure _free(P: Pointer); cdecl;
begin
  FreeMem(P);
end;

function _memset(P: Pointer; B: Byte; count: Integer): pointer; cdecl;
begin
  FillChar(P^, count, B);
  result := P;
end;

function _memcpy(dest, source: Pointer; count: Integer): pointer; cdecl;
begin
  Move(source^, dest^, count);
  result := dest;
end;

function __ftol: integer;
var
  f: double;
begin
  asm
   	lea    eax, f             //  BC++ passes floats on the FPU stack
    	fstp  qword ptr [eax]     //  Delphi passes floats on the CPU stack
  end;
  if f > 2147483647.0 then
    f := 2147483647.0;
  if f < -2147483648.0 then
    f := 2147483648.0;
  result := integer(Trunc(f));
end;

procedure __assert(__cond: pchar; __file: pchar; __line: integer); cdecl;
begin
end;

procedure _abort; cdecl;
begin
end;

procedure _iejdebug(p: pchar); cdecl;
begin
  //
  //outputdebugstring(p);
end;

function _memmove(dest, source: Pointer; count: Integer): pointer; cdecl;
begin
  Move(source^, dest^, count);
  result := dest;
end;

function _strlen(str: pchar): integer; cdecl;
begin
  result := strlen(str);
end;

function _realloc(block: pointer; size: integer): pointer; cdecl;
begin
  reallocmem(block, size);
  result := block;
end;

function _fscanf(f: pointer; format: pchar): integer; cdecl;
begin
  result := 0;
end;

// not used in Jasper

procedure _unlink; cdecl;
begin
end;

// not used in Jasper

procedure _setmode; cdecl;
begin
end;

// not used in Jasper

procedure _fputc; cdecl;
begin
end;

type
  (*
    TIETmpStream=class(TMemoryStream)
     public
        destructor Destroy; override;
        constructor Create;
    end;

    constructor TIETmpStream.Create;
    begin
     inherited;
    end;

    destructor TIETmpStream.Destroy;
    begin
       inherited;
    end;
    //*)

    //(*
  TIETmpStream = class(TFileStream)
  private
    fFileName: string;
  public
    constructor Create;
    destructor Destroy; override;
  end;

constructor TIETmpStream.Create;
var
  temppath: array[0..MAX_PATH] of char;
  tempfile: array[0..MAX_PATH] of char;
begin
  if DefTEMPPATH = '' then
  begin
    GetTempPath(250, temppath);
    IEForceDirectories(string(temppath));
    GetTempFileName(temppath, 'imageen', 0, tempfile);
  end
  else
    GetTempFileName(pchar(DefTEMPPATH), 'imageen', 0, tempfile);
  inherited Create(string(tempfile), fmCreate);
  fFileName := string(tempfile);
end;

destructor TIETmpStream.Destroy;
begin
  inherited;
  deletefile(fFileName);
end;
//*)

function _open(path: pchar; access, mode: integer): integer; cdecl;
var
  ss: TIETmpStream;
begin
  if path = 'TEMPSTREAM' then
  begin
    result := integer(TIETmpStream.Create)
  end
  else
    result := integer(path);
end;

function _read(stream: integer; buf: pointer; len: integer): integer; cdecl;
var
  st: TStream;
begin
  st := TStream(pointer(stream));
  result := st.Read(pbyte(buf)^, len);
end;

function _close(stream: integer): integer; cdecl;
var
  st: tstream;
begin
  result := 0;
  st := TStream(pointer(stream));
  if (st is TIETmpStream) then
  begin
    FreeAndNil(st);
  end;
end;

function _write(stream: integer; buf: pointer; len: integer): integer; cdecl;
var
  st: tstream;
begin
  st := TStream(pointer(stream));
  result := st.Write(pbyte(buf)^, len);
end;

function _lseek(stream: integer; offset: integer; fromwhere: integer): integer; cdecl;
var
  st: tstream;
begin
  st := TStream(pointer(stream));
  case fromwhere of
    0: // SEEK_SET
      result := st.seek(offset, soFromBeginning);
    1: // SEEK_CUR
      result := st.seek(offset, soFromCurrent);
    2: // SEEK_END
      result := st.seek(offset, soFromEnd);
  else
    result := -1;
  end;
end;

// we suppose that s is not null

function _tmpnam(s: pchar): pchar; cdecl;
begin
  result := s;
  strpcopy(s, 'TEMPSTREAM');
end;

// used only for stdio io

procedure _fread; cdecl;
begin
end;

// used only for stdio io

function _fwrite(buf: pchar; size, n: integer; fil: pointer): integer; cdecl;
begin
  result := size * n;
end;

// used only for stdio io

procedure _fseek; cdecl;
begin
end;

// used only for stdio io

procedure _fclose; cdecl;
begin
end;

function _isspace(c: integer): integer; cdecl;
begin
  result := integer(c <= 32);
end;

function _isalpha(c: integer): integer; cdecl;
begin
  result := integer(((c >= 65) and (c <= 90)) or ((c >= 97) and (c <= 122)) or (c = 95));
end;

function _isdigit(c: integer): integer; cdecl;
begin
  result := integer((c >= 48) and (c <= 57));
end;

function _atol(s: pchar): integer; cdecl;
begin
  result := strtointdef(s, 0);
end;

function _strchr(s: pchar; c: integer): pchar; cdecl;
begin
  result := strscan(s, char(c));
end;

function _atof(s: pchar): double; cdecl;
var
  q: string;
  p1: integer;
begin
  q := string(s);
  p1 := pos(' ', q);
  if p1 = 0 then
    p1 := length(q) + 1;
  setlength(q, p1 - 1);
  result := IEStrToFloatDef(q, 0);
end;

function _sqrt(x: double): double; cdecl;
begin
  result := sqrt(x);
end;

function _strrchr(s: pchar; c: integer): pchar; cdecl;
begin
  result := strrscan(s, char(c));
end;

function _isprint(c: integer): integer; cdecl;
begin
  result := integer(c > 31);
end;

function _strncpy(dest, src: pchar; maxlen: integer): pchar; cdecl;
begin
  result := strmove(dest, src, maxlen);
end;

procedure __llmul;
asm
		push	edx
		push	eax
		mov		eax, [esp+16]
		mul		dword ptr [esp]
		mov		ecx, eax
		mov		eax, [esp+4]
		mul		dword ptr [esp+12]
		add		ecx, eax
		mov		eax, [esp]
		mul		dword ptr [esp+12]
		add		edx, ecx
		pop		ecx
		pop		ecx
		ret		8
end;

procedure __lldiv;
asm
		push    ebp
		push    ebx
		push    esi
		push    edi
		xor		edi,edi
		mov     ebx,20[esp]
		mov     ecx,24[esp]
		or      ecx,ecx
		jnz     @__lldiv@slow_ldiv
		or      edx,edx
		jz      @__lldiv@quick_ldiv
		or      ebx,ebx
		jz      @__lldiv@quick_ldiv
@__lldiv@slow_ldiv:
		or      edx,edx
		jns     @__lldiv@onepos
		neg     edx
		neg     eax
		sbb     edx,0
		or      edi,1
@__lldiv@onepos:
		or      ecx,ecx
		jns     @__lldiv@positive
		neg     ecx
		neg     ebx
		sbb     ecx,0
		xor		edi,1
@__lldiv@positive:
		mov     ebp,ecx
		mov     ecx,64
		push    edi
		xor     edi,edi
		xor     esi,esi
@__lldiv@xloop:
		shl     eax,1
		rcl     edx,1
		rcl     esi,1
		rcl     edi,1
		cmp     edi,ebp
		jb      @__lldiv@nosub
		ja      @__lldiv@subtract
		cmp     esi,ebx
		jb      @__lldiv@nosub
@__lldiv@subtract:
		sub     esi,ebx
		sbb     edi,ebp
		inc     eax
@__lldiv@nosub:
		loop    @__lldiv@xloop
		pop     ebx
		test    ebx,1
		jz      @__lldiv@finish
		neg     edx
		neg     eax
		sbb     edx,0
@__lldiv@finish:
		pop     edi
		pop     esi
		pop     ebx
		pop     ebp
		ret     8
@__lldiv@quick_ldiv:
		div     ebx
		xor     edx,edx
		jmp     @__lldiv@finish
end;

procedure jpc_seglist_remove; external;
procedure jpc_seg_destroy; external;
procedure jpc_seglist_insert; external;
procedure jpc_decode; external;
procedure jp2_decode; external;
procedure jp2_encode; external;
procedure jp2_validate; external;
procedure jpc_seg_alloc; external;
procedure jas_stream_puts; external;

{$L jp2_enc.obj}
{$L jpc_enc.obj}
{$L jpc_dec.obj}
{$L jpc_t1dec.obj}
{$L jpc_t1enc.obj}
{$L jpc_t2enc.obj}
{$L jpc_t2dec.obj}
{$L jpc_t2cod.obj}
{$L jpc_t1cod.obj}
{$L jpc_tsfb.obj}
{$L jpc_qmfb.obj}
{$L jpc_mct.obj}
{$L jpc_bs.obj}
{$L jas_getopt.obj}
{$L jp2_dec.obj}
{$L jas_init.obj}
{$L jpc_mqdec.obj}
{$L jpc_mqenc.obj}
{$L jpc_mqcod.obj}
{$L jas_tvp.obj}
{$L jp2_cod.obj}
{$L jas_image.obj}
{$L jpc_cs.obj}
{$L jas_seq.obj}
{$L jas_malloc.obj}
{$L jas_stream.obj}
{$L jas_string.obj}
{$L jas_version.obj}
{$L jpc_math.obj}
{$L jpc_util.obj}
{$L jpc_tagtree.obj}
{$L jas_debug.obj}

{$L xlibcj2.obj}

initialization
  begin
    CreateYCbCrLookup;
    jas_init;
  end;

finalization
  begin
    jas_image_clearfmts;
  end;

{$ELSE} // IEINCLUDEJPEG2000

interface

implementation

{$ENDIF}

end.