jpg.pas

至于这小软件的用途

      Pal.palPalEntry[x].peBlue := C;
      Pal.palPalEntry[x].peFlags := 0;
    end
  else
    for x := 0 to Pal.palNumEntries-1 do
    begin
      Pal.palPalEntry[x].peRed := cinfo.colormap^[2]^[x];
      Pal.palPalEntry[x].peGreen := cinfo.colormap^[1]^[x];
      Pal.palPalEntry[x].peBlue := cinfo.colormap^[0]^[x];
      Pal.palPalEntry[x].peFlags := 0;
    end;
  Result := CreatePalette(PLogPalette(@Pal)^);
end;

{ Rammt die Colormap aus dem Referenz-Bitmap in den Decoder. Ergebnis ist
  dann ein auf dieselbe Palette gerendertes Bitmap }
procedure SetColorMap(var cinfo: jpeg_decompress_struct; P: HPalette);
var
  Pal: TMaxLogPalette;
  Count, I: Integer;
begin
  Count := GetPaletteEntries(P, 0, 256, Pal.palPalEntry);
  if Count = 0 then Exit;       // jpeg_destroy will free colormap
  cinfo.colormap := cinfo.common.mem.alloc_sarray(@cinfo.common, JPOOL_IMAGE, Count, 3);
  cinfo.actual_number_of_colors := Count;
  for I := 0 to Count-1 do
  begin
    Byte(cinfo.colormap^[2]^[I]) := Pal.palPalEntry[I].peRed;
    Byte(cinfo.colormap^[1]^[I]) := Pal.palPalEntry[I].peGreen;
    Byte(cinfo.colormap^[0]^[I]) := Pal.palPalEntry[I].peBlue;
  end;
end;

{ JPEGLib-Decoding -> TJPGDecoder -> OnProgress }
procedure JPEGLIBCallback(const cinfo: jpeg_common_struct);
var R: TRect;
begin
  if (cinfo.progress = nil) or (cinfo.progress^.instance = nil) then Exit;
  with cinfo.progress^ do
  begin
    if cinfo.is_decompressor then
      with j_decompress_ptr(@cinfo)^ do
      begin
        R := Rect(0, last_scanline, output_width, output_scanline);
        if R.Bottom < last_scanline then
          R.Bottom := output_height;
      end
       else R := Rect(0,0,0,0);
      //with TJPGDecoder(instance) do JPGProgressCallback(R);
  end;
end;

{
procedure TJPGDecoder.LoadFromStream(Stream: TStream; const Target: TBitmap);

var
  DC: HDC;  // Ermittlung der Farbtiefe, falls ColorDepth = jpgAuto
  FOutputFormat: TJPGColorDepth;  // tats鋍hlich verwendetes Format

var
  LinesPerCall,
  LinesRead: Integer;
  DestScanLine:
  Pointer;
  PtrInc: Integer;  // DestScanLine += PtrInc * LinesPerCall
  jc: TJPEGContext;
  GeneratePalette: Boolean;  // 8 Bit Target ohne RefPalette

  procedure ResetDestination;  // wieder ab Oberkante (next pass)

  begin
    JPGProgressCallBack(FDecodedPictureRect);  // letztes Rect, soweit vorhanden
    DestScanLine := Target.ScanLine[0];
    FLastLinePainted := -1;
  end;

begin
  Target.FreeImage;
  if Stream.Size > 0 then
  begin
    // Farbtiefe bei jpgAuto 黚er das Display bestimmen
    if ColorDepth = jpgAuto then
    begin
      DC := GetDC(0);
      if (GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES)) <= 8 then FOutputFormat := jpg8Bit
                                                                         else FOutputFormat := jpg24Bit;
      ReleaseDC(0, DC);
    end
    else FOutputFormat := ColorDepth;

    GeneratePalette := True;
    FAbortLoading := False;

    FillChar(jc, sizeof(jc), 0);
    jc.err := jpeg_std_error;
    jc.common.err := @jc.err;

    jpeg_CreateDecompress(jc.d, JPEG_LIB_VERSION, SizeOf(jc.d));
    try
      jc.progress.progress_monitor := @JPEGLIBCallback;
      jc.progress.instance := Self;
      jc.common.progress := @jc.progress;

      jpeg_stdio_src(jc.d, Stream);
      jpeg_read_header(jc.d, True);    // require Image
      jc.d.scale_num := 1;
      jc.d.scale_denom := FDivScale;
      jc.d.do_block_smoothing := True;

      if FOutputFormat = jpgGray then jc.d.out_color_space := JCS_GRAYSCALE;
      if (FOutputFormat = jpgGray) or (FOutputFormat = jpg8Bit) then
      begin
        jc.d.quantize_colors := True;
        jc.d.desired_number_of_colors := 236;
      end;

      jc.d.dct_method := JDCT_ISLOW;  // Standard. Float ist unwesentlich besser, aber 20 Prozent langsamer
      if FDither then jc.d.dither_mode := JDITHER_FS  // Ordered ist nicht schneller, aber h溥licher
                 else jc.d.dither_mode := JDITHER_NONE;
      jc.FinalDCT := jc.d.dct_method;
      jc.FinalTwoPassQuant := jc.d.two_pass_quantize;  // True
      jc.FinalDitherMode := jc.d.dither_mode;  // FS

      if Assigned(FOnProgress) and jpeg_has_multiple_scans(jc.d) then
      begin  // maximaler Speed beim Progressing, Hi Q erst beim letzten Scan
        jc.d.enable_2pass_quant := jc.d.two_pass_quantize;
        jc.d.dct_method := JDCT_IFAST;
        jc.d.two_pass_quantize := False;
        jc.d.dither_mode := JDITHER_ORDERED;
        jc.d.buffered_image := True;
      end;

      // Format des Bitmaps und Palettenbestimmung
      if (FOutputFormat = jpg8Bit) or (jc.d.out_color_space = JCS_GRAYSCALE) then
      begin
        Target.PixelFormat := pf8Bit;
        if (FRefPalBMP <> nil) and (FRefPalBMP.Palette <> 0) then
        begin  // Ergebnis-Bitmap mit derselben Palette wie Referenz
          SetColorMap(jc.d,FRefPalBMP.Palette);
          Target.Palette := CopyPalette(FRefPalBMP.Palette);
          GeneratePalette := False;  // keine neue (optimale) Palette ermitteln
        end;
      end
      else Target.PixelFormat := pf24Bit;

      jpeg_start_decompress(jc.d);  // liefert erst einmal JPGInfo
      with Target do
      begin  // Bitmap-Gr鲞e
        Width := jc.d.output_width;
        Height := jc.d.output_height;
        ResetDestination;  // Ziel der Ausgabe, Oberkante Display, Timing
        PtrInc := Integer(ScanLine[1]) - Integer(DestScanline);
        if (PtrInc > 0) and ((PtrInc and 3) = 0) then
           // Width = ScanWidth und Bitmap ist Top Down (n鋍hste Windows-Version?)
          LinesPerCall := jc.d.rec_outbuf_height // mehrere Scanlines pro Aufruf
        else
          LinesPerCall := 1; // dabei wird's wohl einstweilen bleiben...
      end;

      if jc.d.buffered_image then  // progressiv. Decoding mit Min Quality (= max speed)
      begin
        while jpeg_consume_input(jc.d) <> JPEG_REACHED_EOI do
        begin
          jpeg_start_output(jc.d, jc.d.input_scan_number);
          // beim ersten Pass Palette zusammenbasteln
          if (jc.common.progress^.completed_passes = 0) and (jc.d.colormap <> nil)
            and (Target.PixelFormat = pf8bit) and GeneratePalette then
          begin
            Target.Palette := BuildPalette(jc.d);
          end;
          // ein kompletter Pass. Reset Oberkante progressives Display
          ResetDestination;
          while (jc.d.output_scanline < jc.d.output_height) do
          begin
            LinesRead := jpeg_read_scanlines(jc.d, @DestScanline, LinesPerCall);
            Inc(Integer(DestScanline), PtrInc * LinesRead);
            if FAbortLoading then Exit;
          end;
          jpeg_finish_output(jc.d);
        end;
        // f黵 den letzten Pass die tats鋍hlich gew黱schte Ausgabequalit鋞
        jc.d.dct_method := jc.FinalDCT; jc.d.dither_mode := jc.FinalDitherMode;
        if jc.FinalTwoPassQuant then
        begin
          jc.d.two_pass_quantize := True; jc.d.colormap := nil;
        end;
        jpeg_start_output(jc.d, jc.d.input_scan_number);
        ResetDestination;  // wieder ab Zeile 0
      end;

      // Palette (bei progressiven JPEGS die endg黮tige, bei Baseline die einzige)
      if (not jc.d.buffered_image or jc.FinalTwoPassQuant) and
        (jc.d.colormap <> nil) and GeneratePalette then
      begin
        Target.Palette := BuildPalette(jc.d);
        ResetDestination;
      end;

      // letzter Pass f黵 progressive JPGs, erster & einziger f黵 Baseline-JPGs
      while (jc.d.output_scanline < jc.d.output_height) do
      begin
        LinesRead := jpeg_read_scanlines(jc.d, @DestScanline, LinesPerCall);
        Inc(Integer(DestScanline), PtrInc * LinesRead);
        if FAbortLoading then Exit;
      end;

      if jc.d.buffered_image then jpeg_finish_output(jc.d);
      jpeg_finish_decompress(jc.d);

      // Progressive Darstellung: Endergebnis
      FLastLinePainted := -1;
      JPGProgressCallBack(FDecodedPictureRect);

    finally
      if jc.common.err <> nil then jpeg_destroy(jc.common);
      jc.common.err := nil;
    end;
  end;
end;
}
//----------------------------------------------------------------------------------------------------------------------

procedure GetJPEGInfo(Stream: TStream; var Width, Height: Cardinal);

var
  jc: TJPEGContext;

begin
  FillChar(jc, SizeOf(jc), 0);
  jc.err := jpeg_std_error;
  jc.common.err := @jc.err;
  jpeg_CreateDecompress(@jc.d, JPEG_LIB_VERSION, SizeOf(jc.d));
  try
    jpeg_stdio_src(@jc.d, Stream);
    jpeg_read_header(@jc.d, False);
    Width := jc.d.image_width;
    Height := jc.d.image_height;
  finally
    jpeg_destroy(@jc.common);
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure GetJPEGInfo(FileName: String; var Width, Height: Cardinal);

var
  Stream: TFileStream;

begin
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
  try
    GetJPEGInfo(Stream, Width, Height);
  finally
    Stream.Free;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

initialization
  with jpeg_std_error do
  begin
    error_exit := @JpegError;
    emit_message := @EmitMessage;
    output_message := @OutputMessage;
    format_message := @FormatMessage;
    reset_error_mgr := @ResetErrorMgr;
  end;
end.