iopreviews.pas

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

    Label67.Top := 61;
    Label68.Top := 77;
    Label69.Top := 61;
    Label70.top := 77;
{$ENDIF}

    //PageControl1.ActivePage:=PageControl1.FindNextPage(nil,true,true);
  end
  else
  begin
    // normal tabs
    TabSheetJPEG1.TabVisible := (ppAll in pp) or (ppJPEG in pp);
    if assigned(fi) and (ppJPEG in fi^.DialogPage) and (TabSheetJPEG1.TabVisible) then
      PageControl1.ActivePage := TabSheetJPEG1;

    TabSheetTIFF1.TabVisible := (ppAll in pp) or (ppTIFF in pp);
    if assigned(fi) and (ppTIFF in fi^.DialogPage) and (TabSheetTIFF1.TabVisible) then
      PageControl1.ActivePage := TabSheetTIFF1;

    TabSheetGIF1.TabVisible := (ppAll in pp) or (ppGIF in pp);
    if assigned(fi) and (ppGIF in fi^.DialogPage) and (TabSheetGIF1.TabVisible) then
      PageControl1.ActivePage := TabSheetGIF1;

    TabSheetBMP1.Tabvisible := (ppAll in pp) or (ppBMP in pp);
    if assigned(fi) and (ppBMP in fi^.DialogPage) and (TabSheetBMP1.Tabvisible) then
      PageControl1.ActivePage := TabSheetBMP1;

    TabSheetPCX1.Tabvisible := (ppAll in pp) or (ppPCX in pp);
    if assigned(fi) and (ppPCX in fi^.DialogPage) and (TabSheetPCX1.Tabvisible) then
      PageControl1.ActivePage := TabSheetPCX1;

{$IFDEF IEINCLUDEPNG}
    TabSheetPNG1.TabVisible := (ppAll in pp) or (ppPNG in pp);
    if assigned(fi) and (ppPNG in fi^.DialogPage) and (TabSheetPNG1.TabVisible) then
      PageControl1.ActivePage := TabSheetPNG1;
{$ENDIF}

    TabSheetTGA1.TabVisible := (ppAll in pp) or (ppTGA in pp);
    if assigned(fi) and (ppTGA in fi^.DialogPage) and (TabSheetTGA1.TabVisible) then
      PageControl1.ActivePage := TabSheetTGA1;

{$IFDEF IEINCLUDEJPEG2000}
    TabSheetJ20001.TabVisible := (ppAll in pp) or (ppJ2000 in pp);
    if assigned(fi) and (ppJ2000 in fi^.DialogPage) and (TabSheetJ20001.TabVisible) then
      PageControl1.ActivePage := TabSheetJ20001;
{$ENDIF}

    //PageControl1.ActivePage:=PageControl1.FindNextPage(nil,true,true);
  end;
  // fill TIFF compression comboboxes
  ComboBox2.Items.Clear;
  ComboBox2.Items.Add('UNCOMPRESSED');
  ComboBox2.Items.Add('CCITT1D');
  ComboBox2.Items.Add('G3FAX1D');
  ComboBox2.Items.Add('G3FAX2D');
  ComboBox2.Items.Add('G4FAX');
  if HasTIFFLZW then
    ComboBox2.Items.Add('LZW');
  ComboBox2.Items.Add('JPEG');
  ComboBox2.Items.Add('PACKBITS');
  ComboBox2.Items.Add('ZIP');
  ComboBox16.Items.Assign(ComboBox2.Items);
  //
  imageen1.SetChessboardStyle(12,bsSolid);
  imageen2.SetChessboardStyle(12,bsSolid);
  
  PageControl1.Visible := true;
  ResetParameters;
  ApplyParameters;
  // fit
  imageen1.Fit;
  //
  if assigned(application) then
    application.processmessages;
  PageControl1Change(self); // it calls CopyOrg
  //
  fInitialized:=true;
  ApplyAct;
end;

// Apply

procedure TfIOPreviews.Button4Click(Sender: TObject);
begin
  Button1Click(self);
  Button4.Enabled := False;
end;

/////////////////////////////////////////////////////////////////////////////////////
// works only with current page

procedure TfIOPreviews.ApplyAct;
var
  mf: TMemoryStream;
  ns: TNulStream;
  ncol: integer;
  CursorBak: TCursor;
begin
  if not fInitialized then
    exit;

  CursorBak := Screen.Cursor;
  try
  Screen.Cursor := crHourGlass;

  mf := TMemoryStream.Create;
  ns := TNulStream.Create;
  imageen1.IO.DefaultDitherMethod := fDefaultDitherMethod;
  xper := 0;
  if (PageControl1.ActivePage = TabSheetJPEG1) or (PageControl1.ActivePage = TabSheetJPEG2) then
  begin
    // JPEG and JPEG simplified
    xdiv := 2;
    imageen1.IO.Params.JPEG_QUALITY := JPEG_Quality;
    imageen1.IO.Params.JPEG_COLORSPACE := TIOJPEGColorspace(JPEG_Photometric);
    case JPEG_DCTMethod of
      0: imageen1.IO.Params.JPEG_DCTMETHOD := ioJPEG_ISLOW;
      1: imageen1.IO.Params.JPEG_DCTMETHOD := ioJPEG_IFAST;
      2: imageen1.IO.Params.JPEG_DCTMETHOD := ioJPEG_FLOAT;
    end;
    imageen1.IO.Params.JPEG_OPTIMALHUFFMAN := JPEG_OptimalHuffman;
    imageen1.IO.Params.JPEG_SMOOTH := JPEG_Smooth;
    imageen1.IO.Params.JPEG_PROGRESSIVE := JPEG_Progressive;
    imageen1.IO.SaveToStreamJpeg(mf);
    label25.caption := inttostr(mf.size) + ' bytes';
    label76.caption := inttostr(mf.size) + ' bytes';
    mf.position := 0;
    xper := 50;
    imageen2.IO.LoadFromStreamJpeg(mf);
  end
  else if PageControl1.ActivePage = TabSheetJ20001 then
  begin
{$IFDEF IEINCLUDEJPEG2000}
    // JPEG2000
    xdiv := 2;
    imageen1.IO.Params.J2000_Rate := J2000_Rate;
    imageen1.IO.Params.J2000_ColorSpace := TIOJ2000ColorSpace(J2000_ColorSpace);
    imageen1.IO.Params.BitsPerSample := 8;
    imageen1.IO.Params.SamplesPerPixel := 3;
    imageen1.IO.SaveToStreamJ2K(mf); // uses only codestream
    Label70.caption := inttostr(mf.size) + ' bytes';
    mf.position := 0;
    xper := 50;
    imageen2.IO.LoadFromStreamJ2K(mf);
{$ENDIF}
  end
  else if (PageControl1.ActivePage = TabSheetTIFF1) or (PageControl1.ActivePage = TabSheetTIFF2) then
  begin
    // TIFF
    xdiv := 1;
    imageen1.IO.Params.TIFF_LZWDecompFunc := TIFF_LZWDecompFunc;
    imageen1.IO.Params.TIFF_LZWCompFunc := TIFF_LZWCompFunc;
    imageen1.IO.Params.TIFF_Compression := TIFF_Compression;
    imageen1.IO.Params.TIFF_PhotometInterpret := TIFF_PhotometInterpret;
    imageen1.IO.Params.SamplesPerPixel := TIFF_SamplesPerPixel;
    imageen1.IO.Params.BitsPerSample := TIFF_BitsPerSample;
    imageen1.IO.SaveToStreamTIFF(ns);
    label18.caption := inttostr(ns.size) + ' bytes';
    Label80.caption := inttostr(ns.size) + ' bytes';
    try
    imageen2.Assign( imageen1 );
    except
      Caption:='Result can not be shown but parameters may be entered';
    end;
    imageen2.IO.params.Assign( imageen1.IO.Params );
    if ((TIFF_PhotometInterpret = IOTIFF_BLACKISZERO) or (TIFF_photometInterpret = IOTIFF_WHITEISZERO)) and
      (TIFF_BitsPerSample = 8) and (TIFF_SamplesPerPixel = 1) then
    begin
      imageen2.proc.ConvertToGray;
      freemem(imageen2.IO.Params.ColorMap);
      imageen2.IO.Params.fColorMap := nil;
      imageen2.IO.Params.fColorMapCount := 0;
    end
    else if TIFF_PhotometInterpret < ioTIFF_CMYK then
    begin
      ncol := _GetNumCol(imageen2.IO.Params.BitsPerSample, imageen2.IO.Params.SamplesPerPixel);
      if ncol <= 256 then
      begin
        if imageen2.IO.Params.fColorMap <> nil then
          freemem(imageen2.IO.Params.fColorMap);
        getmem(imageen2.IO.Params.fColorMap, sizeof(TRGB) * ncol);
        imageen2.IO.Params.fcolorMapCount := ncol;
        imageen2.proc.ConvertToPalette(ncol, imageen2.IO.Params.fColorMap, fDefaultDitherMethod);
      end
      else
      begin
        freemem(imageen2.IO.Params.ColorMap);
        imageen2.IO.Params.fColorMap := nil;
        imageen2.IO.Params.fColorMapCount := 0;
      end;
    end;
  end
  else if (PageControl1.ActivePage = TabSheetGIF1) or (PageControl1.ActivePage = TabSheetGIF2) then
  begin
    // GIF
    xdiv := 1;
    imageen1.IO.Params.BitsPerSample := GIF_BitsPerSample;
    imageen1.IO.Params.SamplesPerPixel := 1;
    imageen1.IO.Params.GIF_Interlaced := GIF_Interlaced;
    imageen1.IO.SaveToStreamGIF(ns);
    label30.caption := inttostr(ns.size) + ' bytes';
    Label86.caption := inttostr(ns.size) + ' bytes';
    try
    imageen2.Assign( imageen1 );
    except
      Caption:='Result can not be shown but parameters may be entered';
    end;
    imageen2.IO.params.Assign( imageen1.IO.Params );
    ncol := _GetNumCol(imageen2.IO.Params.BitsPerSample, imageen2.IO.Params.SamplesPerPixel);
    if ncol <= 256 then
    begin
      if imageen2.IO.Params.fColorMap <> nil then
        freemem(imageen2.IO.Params.fColorMap);
      getmem(imageen2.IO.Params.fColorMap, sizeof(TRGB) * ncol);
      imageen2.IO.Params.fcolorMapCount := ncol;
      imageen2.proc.ConvertToPalette(ncol, imageen2.IO.Params.fColorMap, fDefaultDitherMethod);
    end
    else
    begin
      freemem(imageen2.IO.Params.ColorMap);
      imageen2.IO.Params.fColorMap := nil;
      imageen2.IO.Params.fColorMapCount := 0;
    end;
  end
  else if PageControl1.ActivePage = TabSheetBMP1 then
  begin
    // BMP
    xdiv := 1;
    with imageen1.IO do
    begin
      Params.BMP_Compression := BMP_Compression;
      case BMP_BitsPerPixel of
        0:
          begin
            Params.BitsPerSample := 1;
            Params.SamplesPerPixel := 1;
          end;
        1:
          begin
            Params.BitsPerSample := 4;
            Params.SamplesPerPixel := 1;
          end;
        2:
          begin
            Params.BitsPerSample := 8;
            Params.SamplesPerPixel := 1;
          end;
        3:
          begin
            Params.BitsPerSample := 8;
            Params.SamplesPerPixel := 3;
          end;
        4:
          begin
            Params.BitsPerSample := 8;
            Params.SamplesPerPixel := 3;
          end;
      end;
      SaveToStreamBMP(ns);
      label42.caption := inttostr(ns.size) + ' bytes';
      try
      imageen2.assign( imageen1 );
      except
        Caption:='Result can not be shown but parameters may be entered';
      end;
      imageen2.IO.params.Assign( imageen1.IO.Params );
      ncol := _GetNumCol(imageen2.IO.Params.BitsPerSample, imageen2.IO.Params.SamplesPerPixel);
      if ncol <= 256 then
      begin
        imageen2.proc.ConvertTo(ncol, fDefaultDitherMethod);
      end;
    end;
  end
  else if PageControl1.ActivePage = TabSheetPCX1 then
  begin
    // PCX
    xdiv := 1;
    with imageen1.IO do
    begin
      Params.PCX_Compression := PCX_Compression;
      case PCX_BitsPerPixel of
        0:
          begin
            Params.BitsPerSample := 1;
            Params.SamplesPerPixel := 1;
          end;
        1:
          begin
            Params.BitsPerSample := 4;
            Params.SamplesPerPixel := 1;
          end;
        2:
          begin
            Params.BitsPerSample := 8;
            Params.SamplesPerPixel := 1;
          end;
        3:
          begin
            Params.BitsPerSample := 8;
            Params.SamplesPerPixel := 3;
          end;
      end;
      SaveToStreamPCX(ns);
      label48.caption := inttostr(ns.size) + ' bytes';
      try
      imageen2.assign( imageen1 );
      except
        Caption:='Result can not be shown but parameters may be entered';
      end;
      imageen2.IO.params.Assign( imageen1.IO.Params );
      ncol := _GetNumCol(imageen2.IO.Params.BitsPerSample, imageen2.IO.Params.SamplesPerPixel);
      if ncol <= 256 then
      begin
        imageen2.proc.ConvertTo(ncol, fDefaultDitherMethod);
      end;
    end;
  end
  else if PageControl1.ActivePage = TabSheetPNG1 then
  begin
    // PNG
{$IFDEF IEINCLUDEPNG}
    xdiv := 1;
    with imageen1.IO do
    begin
      case PNG_Colors of
        0:
          begin
            Params.BitsPerSample := 1;
            Params.SamplesPerPixel := 1;
          end;
        1:
          begin
            Params.BitsPerSample := 8;
            Params.SamplesPerPixel := 1;
          end;
        2:
          begin
            Params.BitsPerSample := 8;
            Params.SamplesPerPixel := 3;
          end;
      end;
      Params.PNG_Interlaced := PNG_Interlaced;
      Params.PNG_Filter := TIOPNGFilter(PNG_Filter);
      Params.PNG_Compression := PNG_Compression;
      SaveToStreamPNG(ns);
      Label53.caption := inttostr(ns.size) + ' bytes';
      try
      imageen2.assign( imageen1 );
      except
        Caption:='Result can not be shown but parameters may be entered';
      end;
      imageen2.IO.params.Assign( imageen1.IO.Params );
      ncol := _GetNumCol(imageen2.IO.Params.BitsPerSample, imageen2.IO.Params.SamplesPerPixel);
      if ncol <= 256 then
      begin
        if imageen2.IO.Params.fColorMap <> nil then
          freemem(imageen2.IO.Params.fColorMap);
        getmem(imageen2.IO.Params.fColorMap, sizeof(TRGB) * ncol);
        imageen2.IO.Params.fcolorMapCount := ncol;
        imageen2.proc.ConvertToPalette(ncol, imageen2.IO.Params.fColorMap, fDefaultDitherMethod);
      end
      else
      begin
        freemem(imageen2.IO.Params.ColorMap);
        imageen2.IO.Params.fColorMap := nil;
        imageen2.IO.Params.fColorMapCount := 0;
      end;
    end;
{$ENDIF}
  end
  else if PageControl1.ActivePage = TabSheetTGA1 then
  begin
    // TGA
    xdiv := 1;
    with imageen1.IO do
    begin
      case TGA_Colors of
        0:
          begin
            Params.BitsPerSample := 1;
            Params.SamplesPerPixel := 1;
          end;
        1:
          begin
            Params.BitsPerSample := 8;
            Params.SamplesPerPixel := 1;
          end;
        2:
          begin
            Params.BitsPerSample := 8;
            Params.SamplesPerPixel := 3;
          end;
      end;
      Params.TGA_Compressed := TGA_Compressed;
      SaveToStreamTGA(ns);
      Label61.caption := inttostr(ns.size) + ' bytes';
      try
      imageen2.assign( imageen1 );
      except
        Caption:='Result can not be shown but parameters may be entered';
      end;
      imageen2.IO.params.Assign( imageen1.IO.Params );
      ncol := _GetNumCol(imageen2.IO.Params.BitsPerSample, imageen2.IO.Params.SamplesPerPixel);
      if ncol <= 256 then
      begin
        if imageen2.IO.Params.fColorMap <> nil then
          freemem(imageen2.IO.Params.fColorMap);
        getmem(imageen2.IO.Params.fColorMap, sizeof(TRGB) * ncol);
        imageen2.IO.Params.fcolorMapCount := ncol;
        imageen2.proc.ConvertToPalette(ncol, imageen2.IO.Params.fColorMap, fDefaultDitherMethod);
      end
      else
      begin
        freemem(imageen2.IO.Params.ColorMap);
        imageen2.IO.Params.fColorMap := nil;
        imageen2.IO.Params.fColorMapCount := 0;
      end;
    end;
  end;
  ProgressBar1.Position := 0;
  FreeAndNil(mf);
  FreeAndNil(ns);

  finally
    Screen.Cursor := CursorBak;
  end;