procedure TGDIPMainForm.btn_splitt_tif_fileClick(Sender: TObject);
var
encoderClsid: TGUID;
encoderParameters: TEncoderParameters;
// parameterValue: TEncoderValue;
CompressionValue: ULONG;
ColorDepthValue: ULONG;
quality: ULONG;
stat: TStatus;
MulitFrameImage: TGPImage;
PageIndex: integer;
PageCount: integer;
NewFilename:
String;
dest: TGPBitmap;
g: TGPGraphics;
begin
stat_main.SimpleText := '
processing ' + edt_imagefilename.Text;
RootFolder := edt_outFolder.Text;
/// Get an tif image from the disk.
MulitFrameImage := TGPImage.Create(edt_imagefilename.Text);
/// Get the CLSID of the JPEG, TIFF ... encoder.
GetEncoderClsid('
image/png', encoderClsid);
/// Before we call Image::Save, we must initialize an
/// EncoderParameters object. The EncoderParameters object
/// has an array of EncoderParameter objects. In this
/// case, there is only one EncoderParameter object in the array.
/// The one EncoderParameter object has an array of values.
/// In this case, there is only one value (of type ULONG)
/// in the array. We will let this value vary from 0 to 100
// encoderParameters.Count := 2;
// encoderParameters.Parameter[1].Guid := EncoderCompression;
// encoderParameters.Parameter[1].Type_ := EncoderParameterValueTypeLong;
// encoderParameters.Parameter[1].NumberOfValues := 2;
// encoderParameters.Parameter[1].Value := @CompressionValue;
// encoderParameters.Count := 1;
// encoderParameters.Parameter[0].Guid := EncoderColorDepth;
// encoderParameters.Parameter[0].Type_ := EncoderParameterValueTypeLong;
// encoderParameters.Parameter[0].NumberOfValues := 1;
// encoderParameters.Parameter[0].Value := @ColorDepthValue;
// ColorDepthValue := PixelFormat16bppGrayScale;
// ColorDepthValue := PixelFormat16bppRGB565
// CompressionValue := CompressionNone;
// Save the image as ... a with quality level 0...100
encoderParameters.Count := 1;
encoderParameters.Parameter[0].Guid := EncoderQuality;
encoderParameters.Parameter[0].Type_ := EncoderParameterValueTypeLong;
encoderParameters.Parameter[0].NumberOfValues := 1;
encoderParameters.Parameter[0].Value := @quality;
quality := 100;
PageCount := GetFrameCount(MulitFrameImage);
ProgressBarPage.Min := 0;
ProgressBarPage.Max := PageCount;
for PageIndex := 0
to PageCount
do
begin
ProgressBarPage.StepBy(1);
PageFolder := '
page' + IntToStr(PageIndex) + '
\';
ThisFolder := RootFolder + PageFolder;
CreateFolderOnDemand(ThisFolder);
/// Display and save the page (index 0 ... MAX ).
MulitFrameImage.SelectActiveFrame(encoderClsid, PageIndex);
/// ------------------- VErsion TIFF ---------------------------------
NewFilename := ThisFolder + IntToStr(PageIndex) + '
__' +
ExtractFileName(edt_imagefilename.Text);
// stat := MulitFrameImage.Save(WideString(NewFilename), encoderClsid,
// @encoderParameters);
/// ------------------- Version png BUMMI ---------------------------------
NewFilename := ChangeFileExt(NewFilename, '
.png');
dest := TGPBitmap.Create(MulitFrameImage.GetWidth,
MulitFrameImage.GetHeight, PixelFormat16bppRGB565);
g := TGPGraphics.Create(dest);
g.DrawImage(MulitFrameImage, MakePoint(0, 0));
dest.Save(WideString(NewFilename), encoderClsid, @encoderParameters);
g.Free;
dest.Free;
if (stat = Ok)
then
stat_main.SimpleText := '
saved successfully (png).'
else
stat_main.SimpleText := '
Attempt to save failed.';
Application.ProcessMessages;
end;
MulitFrameImage.Free;
end;