{Copyright(c)2000 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
maley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to maley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
Please note if you are viewing this Delphi unit as a web page all you have to
do to turn it into a Delphi unit is save it with a ".pas" extension. The
html in the unit should not affect its performance.
}
unit ads_TifUtils;
(*UnitIndex Master Index Implementation Section Download UnitsDescription: ads_TifUtils.pas This unit contains the following routines.
AddPageToStream ClipBoardProcessor Msg PrintDescription PrintInstructionsBottom PrintInstructionsTop PrintSyntax PrintTitle TForm1.Button1Click_1 TForm1.Button1Click_10 TForm1.Button1Click_11 TForm1.Button1Click_12 TForm1.Button1Click_13 TForm1.Button1Click_14 TForm1.Button1Click_15 TForm1.Button1Click_16 TForm1.Button1Click_17 TForm1.Button1Click_18 TForm1.Button1Click_19 TForm1.Button1Click_2 TForm1.Button1Click_20 TForm1.Button1Click_21 TForm1.Button1Click_22 TForm1.Button1Click_3 TForm1.Button1Click_4 TForm1.Button1Click_5 TForm1.Button1Click_6 TForm1.Button1Click_7 TForm1.Button1Click_8 TForm1.Button1Click_9 TifAppendPage TifAppendPageAp TifAppendPageInstr TifBindPages TifDeletePage TifDeletePageAp TifDeletePageInstr TifDocBinderAp TifDocBinderInstr TifFlipAllPages TifFlipAllPagesAp TifFlipAllPagesInstr TifFlipPage TifFlipPageAp TifFlipPageInstr TifInsertPage TifInsertPageAp TifInsertPageInstr TifReplacePage TifReplacePageAp TifReplacePageInstr TifRotateAllPages TifRotateAllPagesAp TifRotateAllPagesInstr TifRotateAllPagesLeft TifRotateAllPagesLeftAp TifRotateAllPagesLeftInstr TifRotateAllPagesRight TifRotateAllPagesRightAp TifRotateAllPagesRightInstr TifRotatePage TifRotatePageAp TifRotatePageInstr TifRotatePageLeft TifRotatePageLeftAp TifRotatePageLeftInstr TifRotatePageRight TifRotatePageRightAp TifRotatePageRightInstr TifSwapPages TifSwapPagesAp TifSwapPagesInFiles TifSwapPagesInFilesAp TifSwapPagesInFilesInstr TifSwapPagesInstr TifToBMP TifToBMPAP TifToBMPInstr TifToEPS TifToEPSAp TifToEPSInstr TifToGIF TifToGIFAp TifToGIFInstr TifToGraphic TifToGraphicAp TifToGraphicInstr TifToJPG TifToJPGAp TifToJPGInstr TifToPCX TifToPCXAp TifToPCXInstr TifToPNG TifToPNGAp TifToPNGInstr TifToTGA TifToTGAAp TifToTGAInstr
*)
interface
uses
ILDocImg,Classes,Windows,SysUtils,Forms,dll96v1,Clipbrd,FileCtrl,Graphics,
ExtCtrls,StdCtrls,Buttons,Controls,Dialogs;
{
This unit contains many utilities for manipulating Tif files. This unit
can only be used in conjunction with the Skyline Tools product ImageLib
}
(*The following procedures can be used to create command line utilities
to manipulate *.tif files.
Example:
program TifToTGA;
uses
ads_TifUtils in 'ads_TifUtils.pas';
{$R *.RES}
Begin
TifToTGAAp;
End.
*)
Function TifBindPages(
SourceFiles : TStringList;
DestFile : String): Boolean;
Procedure TifAppendPageAp;
Procedure TifDeletePageAp;
Procedure TifDocBinderAp;
Procedure TifFlipAllPagesAp;
Procedure TifFlipPageAp;
Procedure TifInsertPageAp;
Procedure TifReplacePageAp;
Procedure TifRotateAllPagesAp;
Procedure TifRotateAllPagesLeftAp;
Procedure TifRotateAllPagesRightAp;
Procedure TifRotatePageAp;
Procedure TifRotatePageLeftAp;
Procedure TifRotatePageRightAp;
Procedure TifSwapPagesAp;
Procedure TifSwapPagesInFilesAp;
Procedure TifToBMPAP;
Procedure TifToEPSAp;
Procedure TifToGIFAp;
Procedure TifToGraphicAp;
Procedure TifToJPGAp;
Procedure TifToPCXAp;
Procedure TifToPNGAp;
Procedure TifToTGAAp;
{!~ TifToBMP
This utility converts a *.tif page into a *.BMP graphic format.
The TifPage located in the TifFile is converted to the new
graphic format. The results are output to NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifToBMP(
'Source/00003307.tif',//TifFile : String;
0, //TifPage : Integer;
'New/00000001.BMP' //NewFile : String
); //): Boolean
end;
}
Function TifToBMP(
TifFile : String;
TifPage : Integer;
NewFile : String
): Boolean;
{!~ TifToEPS
This utility converts a *.tif page into a *.EPS graphic format.
The TifPage located in the TifFile is converted to the new
graphic format. The results are output to NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifToEPS(
'Source/00003307.tif',//TifFile : String;
0, //TifPage : Integer;
'New/00000001.EPS' //NewFile : String
); //): Boolean
end;
}
Function TifToEPS(
TifFile : String;
TifPage : Integer;
NewFile : String
): Boolean;
{!~ TifToGIF
This utility converts a *.tif page into a *.GIF graphic format.
The TifPage located in the TifFile is converted to the new
graphic format. The results are output to NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifToGIF(
'Source/00003307.tif',//TifFile : String;
0, //TifPage : Integer;
'New/00000001.GIF' //NewFile : String
); //): Boolean
end;
}
Function TifToGIF(
TifFile : String;
TifPage : Integer;
NewFile : String
): Boolean;
{!~ TifToGraphic
This utility converts a *.tif page into another graphic format.
The graphic formats supported are: BMP, EPS, GIF, JPG, PCX,
PNG, and TGA. The TifPage located in the TifFile is converted
to the graphic format passed as Format. The results are output
to NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifToGraphic(
'BMP', //Format : String;
'Source/00003307.tif',//TifFile : String;
0, //TifPage : Integer;
'New/00000001.BMP' //NewFile : String
); //): Boolean
end;
}
Function TifToGraphic(
Format : String;
TifFile : String;
TifPage : Integer;
NewFile : String
): Boolean;
{!~ TifToJPG
This utility converts a *.tif page into a *.JPG graphic format.
The TifPage located in the TifFile is converted to the new
graphic format. The results are output to NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifToJPG(
'Source/00003307.tif',//TifFile : String;
0, //TifPage : Integer;
'New/00000001.JPG' //NewFile : String
); //): Boolean
end;
}
Function TifToJPG(
TifFile : String;
TifPage : Integer;
NewFile : String
): Boolean;
{!~ TifToPCX
This utility converts a *.tif page into a *.PCX graphic format.
The TifPage located in the TifFile is converted to the new
graphic format. The results are output to NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifToPCX(
'Source/00003307.tif',//TifFile : String;
0, //TifPage : Integer;
'New/00000001.PCX' //NewFile : String
); //): Boolean
end;
}
Function TifToPCX(
TifFile : String;
TifPage : Integer;
NewFile : String
): Boolean;
{!~ TifToPNG
This utility converts a *.tif page into a *.PNG graphic format.
The TifPage located in the TifFile is converted to the new
graphic format. The results are output to NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifToPNG(
'Source/00003307.tif',//TifFile : String;
0, //TifPage : Integer;
'New/00000001.PNG' //NewFile : String
); //): Boolean
end;
}
Function TifToPNG(
TifFile : String;
TifPage : Integer;
NewFile : String
): Boolean;
{!~ TifToTGA
This utility converts a *.tif page into a *.TGA graphic format.
The TifPage located in the TifFile is converted to the new
graphic format. The results are output to NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifToTGA(
'Source/00003307.tif',//TifFile : String;
0, //TifPage : Integer;
'New/00000001.TGA' //NewFile : String
); //): Boolean
end;
}
Function TifToTGA(
TifFile : String;
TifPage : Integer;
NewFile : String
): Boolean;
{!~ TifAppendPage
The page identified by SourcePageNum in the SourceFile is appended to the end
of the pages in the DestFile. If a NewFile is provided then the DestFile is
unchanged and the results of the Append are output to the NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifAppendPage(
'Source/00003307.tif',//SourceFile : String;
'Dest/00003331.tif', //DestFile : String;
0, //SourcePageNum : Integer;
'New/00000001.tif' //NewFile : String): Boolean;
);
end;
}
Function TifAppendPage(
SourceFile : String;
DestFile : String;
SourcePageNum : Integer;
NewFile : String): Boolean;
{!~ TifDeletePage
The page identified by SourcePageNum in the SourceFile is Deleted.
If a NewFile is provided then the SourceFile is unchanged and the
results of the Deletion are output to the NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifDeletePage(
'Source/00003307.tif',//SourceFile : String;
0, //SourcePageNum : Integer;
'New/00000001.tif'); //NewFile : String): Boolean;
end;
}
Function TifDeletePage(
SourceFile : String;
SourcePageNum : Integer;
NewFile : String
): Boolean;
{!~ TifFlipAllPages
All pages in the SourceFile arerotated 180 degrees. If a
NewFile is provided then the SourceFile is unchanged and
the results of the Rotation are output to the NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifFlipAllPages(
'Source/00003307.tif',//SourceFile : String;
'New/00000001.tif' //NewFile : String;
); // ): Boolean;
end;
}
Function TifFlipAllPages(
SourceFile : String;
NewFile : String
): Boolean;
{!~ TifFlipPage
The page identified by SourcePageNum in the SourceFile is
rotated 180 degrees. If a NewFile is provided then the
SourceFile is unchanged and the results of the Rotation
are output to the NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifFlipPage(
'Source/00003307.tif',//SourceFile : String;
1, //SourcePageNum : Integer;
'New/00000001.tif' //NewFile : String;
); // ): Boolean;
end;
}
Function TifFlipPage(
SourceFile : String;
SourcePageNum : Integer;
NewFile : String
): Boolean;
{!~ TifInsertPage
The page identified by SourcePageNum in the SourceFile is inserted
into the DestFile at the DestPageNum location. If a NewFile is provided
then the DestFile is unchanged and the results of the Insert are output
to the NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifInsertPage(
'Source/00003307.tif',//SourceFile : String;
'Dest/00003331.tif', //DestFile : String;
0, //SourcePageNum : Integer;
1, //DestPageNum : Integer;
'New/00000001.tif' //NewFile : String): Boolean;
);
end;
}
Function TifInsertPage(
SourceFile : String;
DestFile : String;
SourcePageNum : Integer;
DestPageNum : Integer;
NewFile : String): Boolean;
{!~ TifReplacePage
The page identified by SourcePageNum in the SourceFile replaces the page
in the DestFile at the DestPageNum location. If a NewFile is provided
then the DestFile is unchanged and the results of the Replacement are output
to the NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifReplacePage(
'Source/00003307.tif',//SourceFile : String;
'Dest/00003331.tif', //DestFile : String;
0, //SourcePageNum : Integer;
1, //DestPageNum : Integer
'New/00000001.tif' //NewFile : String;
); //): Boolean;
end;
}
Function TifReplacePage(
SourceFile : String;
DestFile : String;
SourcePageNum : Integer;
DestPageNum : Integer;
NewFile : String
): Boolean;
{!~ TifRotateAllPagesLeft
All pages in the SourceFile are rotated Left 90 degrees.
If a NewFile is provided then the SourceFile is unchanged
and the results of the Rotation are output to the NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifRotateAllPagesLeft(
'Source/00003307.tif',//SourceFile : String;
'New/00000001.tif' //NewFile : String;
); // ): Boolean;
end;
}
Function TifRotateAllPagesLeft(
SourceFile : String;
NewFile : String
): Boolean;
{!~ TifRotateAllPagesRight
All pages in the SourceFile are rotated Right 90 degrees.
If a NewFile is provided then the SourceFile is unchanged
and the results of the Rotation are output to the NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifRotateAllPagesRight(
'Source/00003307.tif',//SourceFile : String;
'New/00000001.tif' //NewFile : String;
); // ): Boolean;
end;
}
Function TifRotateAllPagesRight(
SourceFile : String;
NewFile : String
): Boolean;
{!~ TifRotatePage
The page identified by SourcePageNum in the SourceFile is rotated
Angle degrees CounterClockwise. If a NewFile is provided then the
SourceFile is unchanged and the results of the Rotation are output
to the NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifRotatePage(
'Source/00003307.tif',//SourceFile : String;
1, //SourcePageNum : Integer;
90, //Angle : Double;
'New/00000001.tif' //NewFile : String;
); // ): Boolean;
end;
}
Function TifRotatePage(
SourceFile : String;
SourcePageNum : Integer;
Angle : Double;
NewFile : String
): Boolean;
{!~ TifRotateAllPages
All pages in the SourceFile are rotated Angle degrees
CounterClockwise. If a NewFile is provided then the
SourceFile is unchanged and the results of the
Rotation are output to the NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifRotateAllPages(
'Source/00003307.tif',//SourceFile : String;
90, //Angle : Double;
'New/00000001.tif' //NewFile : String;
); // ): Boolean;
end;
}
Function TifRotateAllPages(
SourceFile : String;
Angle : Double;
NewFile : String
): Boolean;
{!~ TifRotatePageLeft
The page identified by SourcePageNum in the SourceFile is
rotated 90 degrees CounterClockwise. If a NewFile is
provided then the SourceFile is unchanged and the results
of the Rotation are output to the NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifRotatePageLeft(
'Source/00003307.tif',//SourceFile : String;
1, //SourcePageNum : Integer;
'New/00000001.tif' //NewFile : String;
); // ): Boolean;
end;
}
Function TifRotatePageLeft(
SourceFile : String;
SourcePageNum : Integer;
NewFile : String
): Boolean;
{!~ TifRotatePageRight
The page identified by SourcePageNum in the SourceFile is
rotated 90 degrees Clockwise. If a NewFile is provided
then the SourceFile is unchanged and the results of the
Rotation are output to the NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifRotatePageRight(
'Source/00003307.tif',//SourceFile : String;
1, //SourcePageNum : Integer;
'New/00000001.tif' //NewFile : String;
); // ): Boolean;
end;
}
Function TifRotatePageRight(
SourceFile : String;
SourcePageNum : Integer;
NewFile : String
): Boolean;
{!~ TifSwapPages
The Page1 and Page2 are swapped in the SourceFile. If a NewFile is provided
then the SourceFile is unchanged and the results of the Swap are output
to the NewFile.
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifSwapPages(
'Source/00003307.tif',//SourceFile : String;
8, //Page1 : Integer;
9, //Page2 : Integer;
'New/00000001.tif' //NewFile : String;
);
end;
}
Function TifSwapPages(
SourceFile : String;
Page1 : Integer;
Page2 : Integer;
NewFile : String
): Boolean;
{!~ TifSwapPagesInFiles
The SourcePageNum from the SourceFile is swapped
with the DestPageNum from the DestFile.
If NewSourceFile is not empty then the SourceFile
is unchanged and the results of the swap for the
SourceFile are output to the NewSourceFile.
If NewDestFile is not empty then the DestFile
is unchanged and the results of the swap for the
DestFile are output to the NewDestFile.
There are no optional parameters. On the command
line empty values need to be provided with "".
Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
TifSwapPagesInFiles(
'Source/00003307.tif',//SourceFile : String;
'Dest/00003308.tif', //DestFile : String;
8, //SourcePageNum : Integer;
9, //DestPageNum : Integer;
'New/00000001.tif', //NewSourceFile : String;
'New/00000002.tif' //NewDestFile : String;
);
end;
}
Function TifSwapPagesInFiles(
SourceFile : String;
DestFile : String;
SourcePageNum : Integer;
DestPageNum : Integer;
NewSourceFile : String;
NewDestFile : String
): Boolean;
implementation
//Unit Description UnitIndex Master Index
Procedure Msg(sg : String);
Var
Form : TForm;
pnlTop : TPanel;
Memo : TMemo;
pnlButton : TPanel;
Button : TBitBtn;
Label1 : TLabel;
MmoWidth : Integer;
sgApName : String;
Begin
Form := TForm.Create(nil);
pnlTop := TPanel.Create(Form);
Memo := TMemo.Create(Form);
pnlButton := TPanel.Create(Form);
Button := TBitBtn.Create(Form);
Label1 := TLabel.Create(Form);
Try
sgApName := ExtractFileName(ParamStr(0));
sgApName := Copy(sgApName,1,Length(sgApName)-4);
With Form Do
Begin
Caption := sgApName;
Position := poScreenCenter;
Font.Name := 'Courier';
Width := 800;
End;
With pnlTop Do
Begin
Parent := Form;
BevelInner := bvNone;
BevelInner := bvNone;
BorderWidth := 10;
Caption := ' ';
Height := 40;
Align := alTop;
End;
With Memo Do
Begin
Parent := pnlTop;
BorderStyle := bsNone;
Align := alClient;
ReadOnly := True;
Lines.Clear;
Lines.SetText(PChar(sg));
End;
With pnlButton Do
Begin
Parent := Form;
BevelInner := bvNone;
BevelInner := bvNone;
BorderWidth := 0;
Caption := ' ';
Height := 40;
Align := alBottom;
End;
With Label1 Do
Begin
Parent := pnlButton;
Left := 0;
Top := 0;
Caption := Memo.Lines[0];
AutoSize := True;
MmoWidth := Label1.Width;
End;
With Button Do
Begin
Parent := pnlButton;
Kind := bkOK;
ModalResult := mrOK;
End;
Form.Height := (Memo.Lines.Count * 13) + 20 + 40 + 30;
pnlTop.Align := alClient;
Form.width := 20 + mmoWidth + 10;
Button.Left := (pnlButton.Width - Button.Width) div 2;
Button.Top := (pnlButton.Height - Button.Height) div 2;
Label1.Visible := False;
Form.ShowModal;
Finally
Form .Free;
End;
End;
//Unit Description UnitIndex Master IndexFunction PrintInstructionsTop: String; Begin Result :=' ___________________________________________________________________ ' + #13 ; End; //Unit Description UnitIndex Master Index
Function PrintInstructionsBottom: String;
Begin
Result :=
'* *' + #13 +
'* Developed by: *' + #13 +
'* Richard Maley *' + #13 +
'* Advanced Delphi Systems *' + #13 +
'* www.advdelphisys.com *' + #13 +
'* *' + #13 +
'* Required Skyline Tools DLLs: *' + #13 +
'* ILAnot32.DLL *' + #13 +
'* I3Tif32.DLL *' + #13 +
'*___________________________________________________________________*' + #13 ;
End;
//Unit Description UnitIndex Master Index
Function PrintSyntax(Syntax : String): String;
Var
inLenSyntax : Integer;
inLenLine : Integer;
sgSyntaxLine : String;
sgEmptyLine : String;
Begin
sgEmptyLine := '* *';
inLenLine := Length(sgEmptyLine);
sgSyntaxLine := '* '+Syntax;
inLenSyntax := Length(sgSyntaxLine);
sgSyntaxLine := sgSyntaxLine+Copy(sgEmptyLine,inLenSyntax+1,inLenLine);
Result :=
'* *' + #13 +
'* Syntax: *' + #13 +
sgSyntaxLine + #13 +
'* *' + #13 +
'* Description: *' + #13 ;
End;
//Unit Description UnitIndex Master IndexFunction PrintDescription(Desc : String): String; Var inLenDesc : Integer; inLenLine : Integer; sgDescLine : String; sgEmptyLine : String; Begin sgEmptyLine := '* *'; inLenLine := Length(sgEmptyLine); sgDescLine := '* '+Desc; inLenDesc := Length(sgDescLine); sgDescLine := sgDescLine+Copy(sgEmptyLine,inLenDesc+1,inLenLine); Result := sgDescLine + #13; End; //Unit Description UnitIndex Master Index
Function PrintTitle: String; Var inLenDesc : Integer; inLenLine : Integer; sgDescLine : String; sgEmptyLine : String; Desc : String; Begin Desc := ExtractFileName(ParamStr(0)); Desc := Copy(Desc,1,Length(Desc)-4); sgEmptyLine := '* *'; inLenLine := Length(sgEmptyLine); sgDescLine := '* '+Desc; inLenDesc := Length(sgDescLine); sgDescLine := sgDescLine+Copy(sgEmptyLine,inLenDesc+1,inLenLine); Result := sgDescLine+#13; End; //Unit Description UnitIndex Master Index
Procedure TifToBMPInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifToBMP TifFile TifPage NewFile')+
PrintDescription('This utility converts a *.tif page into a *.BMP graphic format.')+
PrintDescription('The TifPage located in the TifFile is converted to the new')+
PrintDescription('graphic format. The results are output to NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifToEPSInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifToEPS TifFile TifPage NewFile')+
PrintDescription('This utility converts a *.tif page into a *.EPS graphic format.')+
PrintDescription('The TifPage located in the TifFile is converted to the new')+
PrintDescription('graphic format. The results are output to NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifToGIFInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifToGIF TifFile TifPage NewFile')+
PrintDescription('This utility converts a *.tif page into a *.GIF graphic format.')+
PrintDescription('The TifPage located in the TifFile is converted to the new')+
PrintDescription('graphic format. The results are output to NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifToGraphicInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifToGraphic Format TifFile TifPage NewFile')+
PrintDescription('This utility converts a *.tif page into another graphic format.')+
PrintDescription('The graphic formats supported are: BMP, EPS, GIF, JPG, PCX,')+
PrintDescription('PNG, and TGA. The TifPage located in the TifFile is converted')+
PrintDescription('to the graphic format passed as Format. The results are output')+
PrintDescription('to NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifToJPGInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifToJPG TifFile TifPage NewFile')+
PrintDescription('This utility converts a *.tif page into a *.JPG graphic format.')+
PrintDescription('The TifPage located in the TifFile is converted to the new')+
PrintDescription('graphic format. The results are output to NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifToPCXInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifToPCX TifFile TifPage NewFile')+
PrintDescription('This utility converts a *.tif page into a *.PCX graphic format.')+
PrintDescription('The TifPage located in the TifFile is converted to the new')+
PrintDescription('graphic format. The results are output to NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifToPNGInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifToPNG TifFile TifPage NewFile')+
PrintDescription('This utility converts a *.tif page into a *.PNG graphic format.')+
PrintDescription('The TifPage located in the TifFile is converted to the new')+
PrintDescription('graphic format. The results are output to NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifToTGAInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifToTGA TifFile TifPage NewFile')+
PrintDescription('This utility converts a *.tif page into a *.TGA graphic format.')+
PrintDescription('The TifPage located in the TifFile is converted to the new')+
PrintDescription('graphic format. The results are output to NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifAppendPageInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifAppendPage SourceFile DestFile SourcePageNum [NewFile]')+
PrintDescription('The page identified by SourcePageNum in the SourceFile is appended')+
PrintDescription('to the end of the pages in the DestFile. If a NewFile is provided')+
PrintDescription('then the DestFile is unchanged and the results of the Append are')+
PrintDescription('output to the NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifDocBinderInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifDocBinder SourceFile')+
PrintDescription('This utility produces multipage tifs out of single page tifs.')+
PrintDescription('The SourceFile is a text file that is structured as follows:')+
PrintDescription(' FullPathToSinglePageTif,FullPathToNewMultiPageTif')+
PrintDescription('Each single page tif should be listed on a separate line.')+
PrintDescription('The order of the Tif''s in the list establishes the page number')+
PrintDescription('ordering. Each time a new "FullPathToNewMultiPageTif" is found')+
PrintDescription('in the list it is assumed to be page one of a new document. If')+
PrintDescription('"FullPathToNewMultiPageTif" file already exists it is deleted')+
PrintDescription('and replaced with the new document. If no errors occur the')+
PrintDescription('SourceFile is deleted. If errors occur then the SourceFile is')+
PrintDescription('replaced with a new file containing only the failed tifs. To')+
PrintDescription('detect completion of the process check for deletion of the')+
PrintDescription('SourceFile or a change in its DateTime stamp.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifDeletePageInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifDeletePage SourceFile SourcePageNum [NewFile]')+
PrintDescription('The page identified by SourcePageNum in the SourceFile is Deleted.')+
PrintDescription('If a NewFile is provided then the SourceFile is unchanged and the')+
PrintDescription('results of the Deletion are output to the NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifFlipAllPagesInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifFlipAllPages SourceFile [NewFile]')+
PrintDescription('All pages in the SourceFile arerotated 180 degrees. If a')+
PrintDescription('NewFile is provided then the SourceFile is unchanged and')+
PrintDescription('the results of the Rotation are output to the NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifFlipPageInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifFlipPage SourceFile SourcePageNum [NewFile]')+
PrintDescription('The page identified by SourcePageNum in the SourceFile is')+
PrintDescription('rotated 180 degrees. If a NewFile is provided then the')+
PrintDescription('SourceFile is unchanged and the results of the Rotation')+
PrintDescription('are output to the NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifInsertPageInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifInsertPage SourceFile DestFile SourcePageNum DestPageNum [NewFile]')+
PrintDescription('The page identified by SourcePageNum in the SourceFile is inserted')+
PrintDescription('into the DestFile at the DestPageNum location. If a NewFile is')+
PrintDescription('provided then the DestFile is unchanged and the results of the')+
PrintDescription('Insert are output to the NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifReplacePageInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifReplacePage SourceFile DestFile SourcePageNum DestPageNum [NewFile]')+
PrintDescription('The page identified by SourcePageNum in the SourceFile replaces')+
PrintDescription('the page in the DestFile at the DestPageNum location. If a')+
PrintDescription('NewFile is provided then the DestFile is unchanged and the results')+
PrintDescription('of the Replacement are output to the NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifRotateAllPagesLeftInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifRotateAllPagesLeft SourceFile [NewFile]')+
PrintDescription('All pages in the SourceFile are rotated Left 90 degrees.')+
PrintDescription('If a NewFile is provided then the SourceFile is unchanged')+
PrintDescription('and the results of the Rotation are output to the NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifRotateAllPagesRightInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifRotateAllPagesRight SourceFile [NewFile]')+
PrintDescription('All pages in the SourceFile are rotated Right 90 degrees.')+
PrintDescription('If a NewFile is provided then the SourceFile is unchanged')+
PrintDescription('and the results of the Rotation are output to the NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifRotatePageInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifRotatePage SourceFile SourcePageNum Angle [NewFile]')+
PrintDescription('The page identified by SourcePageNum in the SourceFile is rotated')+
PrintDescription('Angle degrees CounterClockwise. If a NewFile is provided then the')+
PrintDescription('SourceFile is unchanged and the results of the Rotation are output')+
PrintDescription('to the NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifRotateAllPagesInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifRotateAllPages SourceFile Angle [NewFile]')+
PrintDescription('All pages in the SourceFile are rotated Angle degrees')+
PrintDescription('CounterClockwise. If a NewFile is provided then the')+
PrintDescription('SourceFile is unchanged and the results of the')+
PrintDescription('Rotation are output to the NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifRotatePageLeftInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifRotatePageLeft SourceFile SourcePageNum [NewFile]')+
PrintDescription('The page identified by SourcePageNum in the SourceFile is')+
PrintDescription('rotated 90 degrees CounterClockwise. If a NewFile is')+
PrintDescription('provided then the SourceFile is unchanged and the results')+
PrintDescription('of the Rotation are output to the NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifRotatePageRightInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifRotatePageRight SourceFile SourcePageNum [NewFile]')+
PrintDescription('The page identified by SourcePageNum in the SourceFile is')+
PrintDescription('rotated 90 degrees Clockwise. If a NewFile is provided')+
PrintDescription('then the SourceFile is unchanged and the results of the')+
PrintDescription('Rotation are output to the NewFile.')+
PrintInstructionsBottom
);
End;
//Unit Description UnitIndex Master Index
Procedure TifSwapPagesInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintSyntax('TifSwapPages SourceFile Page1 Page2 [NewFile]')+
PrintDescription('The Page1 and Page2 are swapped in the SourceFile. If a')+
PrintDescription('NewFile is provided then the SourceFile is unchanged and')+
PrintDescription('the results of the Swap are output to the NewFile.')+
PrintInstructionsBottom);
End;
//Unit Description UnitIndex Master Index
Procedure TifSwapPagesInFilesInstr;
Begin
Msg(
PrintInstructionsTop+
PrintTitle+
PrintDescription('')+
PrintDescription('Syntax:')+
PrintDescription(' '+'TifSwapPagesInFiles SourceFile DestFile')+
PrintDescription(' '+'SourcePageNum DestPageNum NewSourceFile NewDestFile')+
PrintDescription('')+
PrintDescription('Description:')+
PrintDescription('The SourcePageNum from the SourceFile is swapped with the')+
PrintDescription('DestPageNum from the DestFile. If NewSourceFile is not empty then')+
PrintDescription('the SourceFile is unchanged and the results of the swap for the')+
PrintDescription('SourceFile are output to the NewSourceFile. If NewDestFile is not')+
PrintDescription('empty then the DestFile is unchanged and the results of the swap')+
PrintDescription('for the DestFile are output to the NewDestFile. There are no')+
PrintDescription('optional parameters. On the command line empty values need to be')+
PrintDescription('provided with "".')+
PrintDescription('* *')+
PrintDescription('* Developed by: Richard Maley, Advanced Delphi Systems *')+
PrintDescription('* www.advdelphisys.com *')+
PrintDescription('* Required DLLs: ILAnot32.DLL, I3Tif32.DLL *')+
PrintDescription('*___________________________________________________________________*')
);
End;
//Unit Description UnitIndex Master Index
Function AddPageToStream(
TempStream : TMemoryStream;
IL : ILDocumentImage;
HDIB : Thandle;
Append : Boolean;
TifComp : TTiffCompression) : Boolean;
var
Resolution : SmallInt;
Usize : Longint;
p : Pointer;
ImageSize : LongInt;
lStream : TMemoryStream;
begin
Try
Resolution:=24;
ImageSize:=GlobalSize(HDib);
If Not Append Then
Begin
Usize:=LongInt(ImageSize)+ Round(LongInt(ImageSize) / 5);
P := GlobalAllocPtr(HeapAllocFlags, Usize);
If Not Assigned(P) Then raise ErrorInvalid.Create(iOutOfMemory);
TempStream.Clear;
End
Else
Begin
lStream:=TMemoryStream.Create;
TempStream.SaveToStream(lStream);
USize:=lStream.Size;
P := GlobalAllocPtr(HeapAllocFlags, Usize+(LongInt(ImageSize)+ Round(LongInt(ImageSize) / 5)));
if not Assigned(P) then raise ErrorInvalid.Create(iOutOfMemory);
lStream.Seek(0,0);
lStream.Read(P^,USize);
lStream.Free;
TempStream.Clear;
End;
PutTifBlobDib(
P,
USize,
GetTiffCompression(TifComp),
Append,
Resolution,
HDIB,
LongInt(IL),
nil);
TempStream.Write(P^,USize);
GlobalFreePtr(P);
Result := True;
Except
Result := False;
End;
end;
//Unit Description UnitIndex Master Index
Function ClipBoardProcessor(
Action : String;
DestFile : String;
PageNum : Integer;
IL : ILDocumentImage): Boolean;
Var
hDIB : THandle;
ILDibClass : ILDocuDib;
TifComp : TTiffCompression;
Begin
Try
Result := False;
Action := Trim(UpperCase(Action));
If Clipboard.HasFormat(CF_DIB) Then
Begin
If Not OpenClipBoard(Application.Handle) Then Exit;
hDIB :=GetClipboardData(CF_DIB);
If hDIB <> 0 Then
Begin
ILDibClass :=ILDocuDib.Create;
Try
ILDibClass.DibBitmap:=PBitmapInfo(GlobalLock(IL.AssignDib(hDIB)));
CloseClipboard;
If ILDibClass.Bits < 2 Then
Begin
TifComp:=sFAXCCITT4;
End
Else
Begin
TifComp:=sPACKBITS;
End;
If Action = 'APPEND' Then
Begin
If PutTifFileDib(
DestFile,
GetTiffCompression(TifComp),
True,
ILDibClass.Bits,
GlobalHandle(ILDibClass.DibBitmap),
LongInt(IL),
nil
)
Then Result := True;
Exit;
End;
If Action = 'INSERT' Then
Begin
If InsertTifFileDib(
DestFile,
GetTiffCompression(TifComp),
PageNum,
ILDibClass.Bits,
GlobalHandle(ILDibClass.DibBitmap),
LongInt(IL),
nil)
Then Result := True;
Exit;
End;
If Action = 'REPLACE' Then
Begin
If UpdateTifFileDib(
DestFile,
GetTiffCompression(TifComp),
PageNum,
ILDibClass.Bits,
GlobalHandle(ILDibClass.DibBitmap),
LongInt(IL),
nil)
Then Result := True;
Exit;
End;
Finally
ILDibClass.Free;
End;
End;
End;
Except
Result := False;
End;
End;
{!~ TifAppendPage
The page identified by SourcePageNum in the SourceFile is appended to the end
of the pages in the DestFile. If a NewFile is provided then the DestFile is
unchanged and the results of the Append are output to the NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifAppendPage(
'Source/00003307.tif',//SourceFile : String;
'Dest/00003331.tif', //DestFile : String;
0, //SourcePageNum : Integer;
'New/00000001.tif' //NewFile : String): Boolean;
);
end;
}
//Unit Description UnitIndex Master Index
Function TifAppendPage(
SourceFile : String;
DestFile : String;
SourcePageNum : Integer;
NewFile : String): Boolean;
Var
IL : ILDocumentImage;
incounter : Integer;
inPageCount : Integer;
inPageNum : Integer;
NewDir : String;
TempStream : TMemoryStream;
Begin
TempStream :=TMemoryStream.Create;
IL := ILDocumentImage.Create(nil);
Try
Try
Result := False;
IL.TifSaveCompress := sFAXCCITT4;
If Not FileExists(SourceFile) Then Exit;
If Not FileExists(DestFile) Then Exit;
//Validate SourcePageNum
IL.ReadTifFile(SourceFile,0,24);
inPageCount := IL.TiffPageCount;
If SourcePageNum < 0 Then Exit;
If SourcePageNum > inPageCount-1 Then Exit;
//Determine size of DestFile
IL.ReadTifFile(DestFile,0,24);
inPageCount := IL.TiffPageCount;
inPageNum := 0;
For inCounter := 0 To inPageCount-1 Do
Begin
If inPageNum = 0 Then
Begin
IL.ReadTifFile(DestFile,inCounter,24);
AddPageToStream(
TempStream, //TempStream : TMemoryStream;
IL, //IL : ILDocumentImage;
IL.GetOurDib, //HDIB : Thandle;
False, //Append : Boolean;
IL.TifSaveCompress); //TifComp : TTiffCompression) : Boolean;
End
Else
Begin
IL.ReadTifFile(DestFile,inCounter,24);
AddPageToStream(
TempStream, //TempStream : TMemoryStream;
IL, //IL : ILDocumentImage;
IL.GetOurDib, //HDIB : Thandle;
True, //Append : Boolean;
IL.TifSaveCompress); //TifComp : TTiffCompression) : Boolean;
End;
inPageNum := inPageNum + 1;
End;
IL.ReadTifFile(SourceFile,SourcePageNum,24);
AddPageToStream(
TempStream, //TempStream : TMemoryStream;
IL, //IL : ILDocumentImage;
IL.GetOurDib, //HDIB : Thandle;
False, //Append : Boolean;
IL.TifSaveCompress); //TifComp : TTiffCompression) : Boolean;
If Trim(NewFile) <> '' Then
Begin
NewDir := ExtractFilePath(NewFile);
If NewDir <> '' Then
Begin
If Not DirectoryExists(NewDir) Then ForceDirectories(NewDir);
End;
If FileExists(NewFile) Then DeleteFile(NewFile);
TempStream.SaveToFile(NewFile);
End
Else
Begin
If FileExists(DestFile) Then DeleteFile(DestFile);
TempStream.SaveToFile(DestFile);
End;
Result := True;
Except
Result := False;
End;
Finally
IL .Free;
TempStream .Free;
End;
End;
{!~ TifInsertPage
The page identified by SourcePageNum in the SourceFile is inserted
into the DestFile at the DestPageNum location. If a NewFile is provided
then the DestFile is unchanged and the results of the Insert are output
to the NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifAppendPage(
'Source/00003307.tif',//SourceFile : String;
'Dest/00003331.tif', //DestFile : String;
'New/00000001.tif', //NewFile : String;
0, //SourcePageNum : Integer;
1 //DestPageNum : Integer): Boolean;
);
end;
}
//Unit Description UnitIndex Master Index
Function TifInsertPage(
SourceFile : String;
DestFile : String;
SourcePageNum : Integer;
DestPageNum : Integer;
NewFile : String): Boolean;
Var
IL : ILDocumentImage;
incounter : Integer;
inPageCount : Integer;
inPageNum : Integer;
NewDir : String;
TempStream : TMemoryStream;
Begin
TempStream :=TMemoryStream.Create;
IL := ILDocumentImage.Create(nil);
Try
Try
Result := False;
TempStream.Clear;
IL.TifSaveCompress := sFAXCCITT4;
If Not FileExists(SourceFile) Then Exit;
If Not FileExists(DestFile) Then Exit;
//Validate SourcePageNum
IL.ReadTifFile(SourceFile,0,24);
inPageCount := IL.TiffPageCount;
If SourcePageNum < 0 Then Exit;
If SourcePageNum > inPageCount-1 Then Exit;
//Validate DestPageNum
IL.ReadTifFile(DestFile,0,24);
inPageCount := IL.TiffPageCount;
If DestPageNum < 0 Then DestPageNum := 0;
If DestPageNum > inPageCount-1 Then DestPageNum := inPageCount;
inPageNum := 0;
For inCounter := 0 To inPageCount - 1 Do
Begin
If DestPageNum = inCounter Then
Begin
If inPageNum = 0 Then
Begin
IL.ReadTifFile(SourceFile,SourcePageNum,24);
AddPageToStream(
TempStream, //TempStream : TMemoryStream;
IL, //IL : ILDocumentImage;
IL.GetOurDib, //HDIB : Thandle;
False, //Append : Boolean;
IL.TifSaveCompress); //TifComp : TTiffCompression) : Boolean;
End
Else
Begin
IL.ReadTifFile(SourceFile,SourcePageNum,24);
AddPageToStream(
TempStream, //TempStream : TMemoryStream;
IL, //IL : ILDocumentImage;
IL.GetOurDib, //HDIB : Thandle;
True, //Append : Boolean;
IL.TifSaveCompress); //TifComp : TTiffCompression) : Boolean;
End;
inPageNum := inPageNum + 1;
End;
If inPageNum = 0 Then
Begin
IL.ReadTifFile(DestFile,inCounter,24);
AddPageToStream(
TempStream, //TempStream : TMemoryStream;
IL, //IL : ILDocumentImage;
IL.GetOurDib, //HDIB : Thandle;
False, //Append : Boolean;
IL.TifSaveCompress); //TifComp : TTiffCompression) : Boolean;
End
Else
Begin
IL.ReadTifFile(DestFile,inCounter,24);
AddPageToStream(
TempStream, //TempStream : TMemoryStream;
IL, //IL : ILDocumentImage;
IL.GetOurDib, //HDIB : Thandle;
True, //Append : Boolean;
IL.TifSaveCompress); //TifComp : TTiffCompression) : Boolean;
End;
inPageNum := inPageNum + 1;
End;
If DestPageNum >= inPageCount Then
Begin
IL.ReadTifFile(SourceFile,SourcePageNum,24);
AddPageToStream(
TempStream, //TempStream : TMemoryStream;
IL, //IL : ILDocumentImage;
IL.GetOurDib, //HDIB : Thandle;
True, //Append : Boolean;
IL.TifSaveCompress); //TifComp : TTiffCompression) : Boolean;
End;
If Trim(NewFile) <> '' Then
Begin
NewDir := ExtractFilePath(NewFile);
If NewDir <> '' Then
Begin
If Not DirectoryExists(NewDir) Then ForceDirectories(NewDir);
End;
If FileExists(NewFile) Then DeleteFile(NewFile);
TempStream.SaveToFile(NewFile);
End
Else
Begin
If FileExists(DestFile) Then DeleteFile(DestFile);
TempStream.SaveToFile(DestFile);
End;
Result := True;
Except
Result := False;
End;
Finally
IL .Free;
TempStream .Free;
End;
End;
{!~ TifReplacePage
The page identified by SourcePageNum in the SourceFile replaces the page
in the DestFile at the DestPageNum location. If a NewFile is provided
then the DestFile is unchanged and the results of the Replacement are output
to the NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifReplacePage(
'Source/00003307.tif',//SourceFile : String;
'Dest/00003331.tif', //DestFile : String;
0, //SourcePageNum : Integer;
1, //DestPageNum : Integer
'New/00000001.tif' //NewFile : String;
); //): Boolean;
end;
}
//Unit Description UnitIndex Master Index
Function TifReplacePage(
SourceFile : String;
DestFile : String;
SourcePageNum : Integer;
DestPageNum : Integer;
NewFile : String): Boolean;
Var
IL : ILDocumentImage;
incounter : Integer;
inPageCount : Integer;
inPageNum : Integer;
NewDir : String;
TempStream : TMemoryStream;
Begin
TempStream :=TMemoryStream.Create;
IL := ILDocumentImage.Create(nil);
Try
Try
Result := False;
TempStream.Clear;
IL.TifSaveCompress := sFAXCCITT4;
If Not FileExists(SourceFile) Then Exit;
If Not FileExists(DestFile) Then Exit;
//Validate SourcePageNum
IL.ReadTifFile(SourceFile,0,24);
inPageCount := IL.TiffPageCount;
If SourcePageNum < 0 Then Exit;
If SourcePageNum > inPageCount-1 Then Exit;
//Validate DestPageNum
IL.ReadTifFile(DestFile,0,24);
inPageCount := IL.TiffPageCount;
If DestPageNum < 0 Then Exit;
If DestPageNum > inPageCount-1 Then Exit;
inPageNum := 0;
For inCounter := 0 To inPageCount - 1 Do
Begin
If DestPageNum = inCounter Then
Begin
If inPageNum = 0 Then
Begin
IL.ReadTifFile(SourceFile,SourcePageNum,24);
AddPageToStream(
TempStream, //TempStream : TMemoryStream;
IL, //IL : ILDocumentImage;
IL.GetOurDib, //HDIB : Thandle;
False, //Append : Boolean;
IL.TifSaveCompress); //TifComp : TTiffCompression) : Boolean;
End
Else
Begin
IL.ReadTifFile(SourceFile,SourcePageNum,24);
AddPageToStream(
TempStream, //TempStream : TMemoryStream;
IL, //IL : ILDocumentImage;
IL.GetOurDib, //HDIB : Thandle;
True, //Append : Boolean;
IL.TifSaveCompress); //TifComp : TTiffCompression) : Boolean;
End;
inPageNum := inPageNum + 1;
Continue;
End;
If inPageNum = 0 Then
Begin
IL.ReadTifFile(DestFile,inCounter,24);
AddPageToStream(
TempStream, //TempStream : TMemoryStream;
IL, //IL : ILDocumentImage;
IL.GetOurDib, //HDIB : Thandle;
False, //Append : Boolean;
IL.TifSaveCompress); //TifComp : TTiffCompression) : Boolean;
End
Else
Begin
IL.ReadTifFile(DestFile,inCounter,24);
AddPageToStream(
TempStream, //TempStream : TMemoryStream;
IL, //IL : ILDocumentImage;
IL.GetOurDib, //HDIB : Thandle;
True, //Append : Boolean;
IL.TifSaveCompress); //TifComp : TTiffCompression) : Boolean;
End;
inPageNum := inPageNum + 1;
End;
If Trim(NewFile) <> '' Then
Begin
NewDir := ExtractFilePath(NewFile);
If NewDir <> '' Then
Begin
If Not DirectoryExists(NewDir) Then ForceDirectories(NewDir);
End;
If FileExists(NewFile) Then DeleteFile(NewFile);
TempStream.SaveToFile(NewFile);
End
Else
Begin
If FileExists(DestFile) Then DeleteFile(DestFile);
TempStream.SaveToFile(DestFile);
End;
Result := True;
Except
Result := False;
End;
Finally
IL .Free;
TempStream .Free;
End;
End;
{!~ TifDeletePage
The page identified by SourcePageNum in the SourceFile is Deleted.
If a NewFile is provided then the SourceFile is unchanged and the
results of the Deletion are output to the NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifDeletePage(
'Source/00003307.tif',//SourceFile : String;
0, //SourcePageNum : Integer;
'New/00000001.tif'); //NewFile : String): Boolean;
end;
}
//Unit Description UnitIndex Master Index
Function TifDeletePage(
SourceFile : String;
SourcePageNum : Integer;
NewFile : String
): Boolean;
Var
NewDir : String;
inPageCount : Integer;
IL : ILDocumentImage;
inCounter : Integer;
inPageNum : Integer;
TempStream : TMemoryStream;
Begin
TempStream :=TMemoryStream.Create;
IL := ILDocumentImage.Create(nil);
Try
Try
Result := False;
IL.TifSaveCompress := sFAXCCITT4;
If Not FileExists(SourceFile) Then Exit;
IL.ReadTifFile(SourceFile,SourcePageNum,24);
inPageCount := IL.TiffPageCount;
If SourcePageNum < 0 Then Exit;
If SourcePageNum > inPageCount-1 Then Exit;
inPageNum := 0;
For inCounter := 0 To inPageCount-1 Do
Begin
If inCounter = SourcePageNum Then Continue;
If inPageNum > 0 Then
Begin
IL.ReadTifFile(SourceFile,inCounter,24);
AddPageToStream(
TempStream, //TempStream : TMemoryStream;
IL, //IL : ILDocumentImage;
il.GetOurDib, //HDIB : Thandle;
True, //Append : Boolean;
IL.TifSaveCompress); //TifComp : TTiffCompression) : Boolean;
End
Else
Begin
IL.ReadTifFile(SourceFile,inCounter,24);
AddPageToStream(
TempStream, //TempStream : TMemoryStream;
IL, //IL : ILDocumentImage;
il.GetOurDib, //HDIB : Thandle;
False, //Append : Boolean;
IL.TifSaveCompress); //TifComp : TTiffCompression) : Boolean;
End;
inPageNum := inPageNum + 1;
End;
If Trim(NewFile) <> '' Then
Begin
NewDir := ExtractFilePath(NewFile);
If NewDir <> '' Then
Begin
If Not DirectoryExists(NewDir) Then ForceDirectories(NewDir);
End;
If FileExists(NewFile) Then DeleteFile(NewFile);
TempStream.SaveToFile(NewFile);
End
Else
Begin
If FileExists(SourceFile) Then DeleteFile(SourceFile);
TempStream.SaveToFile(SourceFile);
End;
Result := True;
Except
Result := False;
End;
Finally
IL.Free;
TempStream.Free;
End;
End;
{!~ TifSwapPages
The Page1 and Page2 are swapped in the SourceFile. If a NewFile is provided
then the SourceFile is unchanged and the results of the Swap are output
to the NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifSwapPages(
'Source/00003307.tif',//SourceFile : String;
8, //Page1 : Integer;
9, //Page2 : Integer;
'New/00000001.tif' //NewFile : String;
);
end;
}
//Unit Description UnitIndex Master Index
Function TifSwapPages(
SourceFile : String;
Page1 : Integer;
Page2 : Integer;
NewFile : String
): Boolean;
Var
DestFile : String;
SourcePageNum : Integer;
DestPageNum : Integer;
NewSourceFile : String;
NewDestFile : String;
Begin
DestFile := SourceFile;
SourcePageNum := Page1;
DestPageNum := Page2;
NewSourceFile := NewFile;
NewDestFile := NewFile;
Result :=
TifSwapPagesInFiles(
SourceFile, //SourceFile : String;
DestFile, //DestFile : String;
SourcePageNum, //SourcePageNum : Integer;
DestPageNum, //DestPageNum : Integer;
NewSourceFile, //NewSourceFile : String;
NewDestFile //NewDestFile : String
); //): Boolean;
End;
{!~ TifRotatePage
The page identified by SourcePageNum in the SourceFile is rotated
Angle degrees CounterClockwise. If a NewFile is provided then the
SourceFile is unchanged and the results of the Rotation are output
to the NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifRotatePage(
'Source/00003307.tif',//SourceFile : String;
1, //SourcePageNum : Integer;
90, //Angle : Double;
'New/00000001.tif' //NewFile : String;
); // ): Boolean;
end;
}
//Unit Description UnitIndex Master Index
Function TifRotatePage(
SourceFile : String;
SourcePageNum : Integer;
Angle : Double;
NewFile : String
): Boolean;
Var
IL : ILDocumentImage;
incounter : Integer;
inPageCount : Integer;
inPageNum : Integer;
NewDir : String;
TempStream : TMemoryStream;
Begin
TempStream :=TMemoryStream.Create;
IL := ILDocumentImage.Create(nil);
Try
Try
Result := False;
TempStream.Clear;
IL.TifSaveCompress := sFAXCCITT4;
If Not FileExists(SourceFile) Then Exit;
//Validate SourcePageNum
IL.ReadTifFile(SourceFile,0,24);
inPageCount := IL.TiffPageCount;
If SourcePageNum < 0 Then Exit;
If SourcePageNum > inPageCount-1 Then Exit;
inPageNum := 0;
For inCounter := 0 To inPageCount - 1 Do
Begin
IL.ReadTifFile(SourceFile,inCounter,24);
If SourcePageNum = inCounter Then IL.Rotate(Angle,clWhite);
If inPageNum = 0 Then
Begin
AddPageToStream(
TempStream, //TempStream : TMemoryStream;
IL, //IL : ILDocumentImage;
IL.GetOurDib, //HDIB : Thandle;
False, //Append : Boolean;
IL.TifSaveCompress); //TifComp : TTiffCompression) : Boolean;
End
Else
Begin
AddPageToStream(
TempStream, //TempStream : TMemoryStream;
IL, //IL : ILDocumentImage;
IL.GetOurDib, //HDIB : Thandle;
True, //Append : Boolean;
IL.TifSaveCompress); //TifComp : TTiffCompression) : Boolean;
End;
inPageNum := inPageNum + 1;
End;
If Trim(NewFile) <> '' Then
Begin
NewDir := ExtractFilePath(NewFile);
If NewDir <> '' Then
Begin
If Not DirectoryExists(NewDir) Then ForceDirectories(NewDir);
End;
If FileExists(NewFile) Then DeleteFile(NewFile);
TempStream.SaveToFile(NewFile);
End
Else
Begin
If FileExists(SourceFile) Then DeleteFile(SourceFile);
TempStream.SaveToFile(SourceFile);
End;
Result := True;
Except
Result := False;
End;
Finally
IL .Free;
TempStream .Free;
End;
End;
{!~ TifRotatePageRight
The page identified by SourcePageNum in the SourceFile is
rotated 90 degrees Clockwise. If a NewFile is provided
then the SourceFile is unchanged and the results of the
Rotation are output to the NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifRotatePageRight(
'Source/00003307.tif',//SourceFile : String;
1, //SourcePageNum : Integer;
'New/00000001.tif' //NewFile : String;
); // ): Boolean;
end;
}
//Unit Description UnitIndex Master Index
Function TifRotatePageRight(
SourceFile : String;
SourcePageNum : Integer;
NewFile : String
): Boolean;
Begin
Result :=
TifRotatePage(
SourceFile, //SourceFile : String;
SourcePageNum, //SourcePageNum : Integer;
270, //Angle : Double;
NewFile //NewFile : String
); //): Boolean;
End;
{!~ TifRotatePageLeft
The page identified by SourcePageNum in the SourceFile is
rotated 90 degrees CounterClockwise. If a NewFile is
provided then the SourceFile is unchanged and the results
of the Rotation are output to the NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifRotatePageLeft(
'Source/00003307.tif',//SourceFile : String;
1, //SourcePageNum : Integer;
'New/00000001.tif' //NewFile : String;
); // ): Boolean;
end;
}
//Unit Description UnitIndex Master Index
Function TifRotatePageLeft(
SourceFile : String;
SourcePageNum : Integer;
NewFile : String
): Boolean;
Begin
Result :=
TifRotatePage(
SourceFile, //SourceFile : String;
SourcePageNum, //SourcePageNum : Integer;
90, //Angle : Double;
NewFile //NewFile : String
); //): Boolean;
End;
{!~ TifFlipPage
The page identified by SourcePageNum in the SourceFile is
rotated 180 degrees. If a NewFile is provided then the
SourceFile is unchanged and the results of the Rotation
are output to the NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifFlipPage(
'Source/00003307.tif',//SourceFile : String;
1, //SourcePageNum : Integer;
'New/00000001.tif' //NewFile : String;
); // ): Boolean;
end;
}
//Unit Description UnitIndex Master Index
Function TifFlipPage(
SourceFile : String;
SourcePageNum : Integer;
NewFile : String
): Boolean;
Begin
Result :=
TifRotatePage(
SourceFile, //SourceFile : String;
SourcePageNum, //SourcePageNum : Integer;
180, //Angle : Double;
NewFile //NewFile : String
); //): Boolean;
End;
{!~ TifRotateAllPages
All pages in the SourceFile are rotated Angle degrees
CounterClockwise. If a NewFile is provided then the
SourceFile is unchanged and the results of the
Rotation are output to the NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifRotateAllPages(
'Source/00003307.tif',//SourceFile : String;
90, //Angle : Double;
'New/00000001.tif' //NewFile : String;
); // ): Boolean;
end;
}
//Unit Description UnitIndex Master Index
Function TifRotateAllPages(
SourceFile : String;
Angle : Double;
NewFile : String
): Boolean;
Var
IL : ILDocumentImage;
incounter : Integer;
inPageCount : Integer;
inPageNum : Integer;
NewDir : String;
TempStream : TMemoryStream;
Begin
TempStream :=TMemoryStream.Create;
IL := ILDocumentImage.Create(nil);
Try
Try
Result := False;
TempStream.Clear;
IL.TifSaveCompress := sFAXCCITT4;
If Not FileExists(SourceFile) Then Exit;
IL.ReadTifFile(SourceFile,0,24);
inPageCount := IL.TiffPageCount;
inPageNum := 0;
For inCounter := 0 To inPageCount - 1 Do
Begin
IL.ReadTifFile(SourceFile,inCounter,24);
IL.Rotate(Angle,clWhite);
If inPageNum = 0 Then
Begin
AddPageToStream(
TempStream, //TempStream : TMemoryStream;
IL, //IL : ILDocumentImage;
IL.GetOurDib, //HDIB : Thandle;
False, //Append : Boolean;
IL.TifSaveCompress); //TifComp : TTiffCompression) : Boolean;
End
Else
Begin
AddPageToStream(
TempStream, //TempStream : TMemoryStream;
IL, //IL : ILDocumentImage;
IL.GetOurDib, //HDIB : Thandle;
True, //Append : Boolean;
IL.TifSaveCompress); //TifComp : TTiffCompression) : Boolean;
End;
inPageNum := inPageNum + 1;
End;
If Trim(NewFile) <> '' Then
Begin
NewDir := ExtractFilePath(NewFile);
If NewDir <> '' Then
Begin
If Not DirectoryExists(NewDir) Then ForceDirectories(NewDir);
End;
If FileExists(NewFile) Then DeleteFile(NewFile);
TempStream.SaveToFile(NewFile);
End
Else
Begin
If FileExists(SourceFile) Then DeleteFile(SourceFile);
TempStream.SaveToFile(SourceFile);
End;
Result := True;
Except
Result := False;
End;
Finally
IL .Free;
TempStream .Free;
End;
End;
{!~ TifFlipAllPages
All pages in the SourceFile arerotated 180 degrees. If a
NewFile is provided then the SourceFile is unchanged and
the results of the Rotation are output to the NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifFlipAllPages(
'Source/00003307.tif',//SourceFile : String;
'New/00000001.tif' //NewFile : String;
); // ): Boolean;
end;
}
//Unit Description UnitIndex Master Index
Function TifFlipAllPages(
SourceFile : String;
NewFile : String
): Boolean;
Begin
Result :=
TifRotateAllPages(
SourceFile, //SourceFile : String;
180, //Angle : Double;
NewFile //NewFile : String
); //): Boolean;
End;
{!~ TifRotateAllPagesLeft
All pages in the SourceFile are rotated Left 90 degrees.
If a NewFile is provided then the SourceFile is unchanged
and the results of the Rotation are output to the NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifRotateAllPagesLeft(
'Source/00003307.tif',//SourceFile : String;
'New/00000001.tif' //NewFile : String;
); // ): Boolean;
end;
}
//Unit Description UnitIndex Master Index
Function TifRotateAllPagesLeft(
SourceFile : String;
NewFile : String
): Boolean;
Begin
Result :=
TifRotateAllPages(
SourceFile, //SourceFile : String;
90, //Angle : Double;
NewFile //NewFile : String
); //): Boolean;
End;
{!~ TifRotateAllPagesRight
All pages in the SourceFile are rotated Right 90 degrees.
If a NewFile is provided then the SourceFile is unchanged
and the results of the Rotation are output to the NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifRotateAllPagesRight(
'Source/00003307.tif',//SourceFile : String;
'New/00000001.tif' //NewFile : String;
); // ): Boolean;
end;
}
//Unit Description UnitIndex Master Index
Function TifRotateAllPagesRight(
SourceFile : String;
NewFile : String
): Boolean;
Begin
Result :=
TifRotateAllPages(
SourceFile, //SourceFile : String;
270, //Angle : Double;
NewFile //NewFile : String
); //): Boolean;
End;
{!~ TifSwapPagesInFiles
The SourcePageNum from the SourceFile is swapped
with the DestPageNum from the DestFile.
If NewSourceFile is not empty then the SourceFile
is unchanged and the results of the swap for the
SourceFile are output to the NewSourceFile.
If NewDestFile is not empty then the DestFile
is unchanged and the results of the swap for the
DestFile are output to the NewDestFile.
There are no optional parameters. On the command
line empty values need to be provided with "".
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifSwapPagesInFiles(
'Source/00003307.tif',//SourceFile : String;
'Dest/00003308.tif', //DestFile : String;
8, //SourcePageNum : Integer;
9, //DestPageNum : Integer;
'New/00000001.tif', //NewSourceFile : String;
'New/00000002.tif' //NewDestFile : String;
);
end;
}
//Unit Description UnitIndex Master Index
Function TifSwapPagesInFiles(
SourceFile : String;
DestFile : String;
SourcePageNum : Integer;
DestPageNum : Integer;
NewSourceFile : String;
NewDestFile : String
): Boolean;
Var
IL : ILDocumentImage;
incounter : Integer;
inPageCount : Integer;
inPageNum : Integer;
NewDir : String;
TempStreamS : TMemoryStream;
TempStreamD : TMemoryStream;
Append : Boolean;
FileName : String;
TempStream : TMemoryStream;
PageNum : Integer;
Begin
TempStreamS :=TMemoryStream.Create;
TempStreamD :=TMemoryStream.Create;
IL := ILDocumentImage.Create(nil);
Try
Try
Result := False;
TempStreamS.Clear;
TempStreamD.Clear;
IL.TifSaveCompress := sFAXCCITT4;
If Not FileExists(SourceFile) Then Exit;
If Not FileExists(DestFile) Then Exit;
//Validate SourcePageNum
IL.ReadTifFile(SourceFile,0,24);
inPageCount := IL.TiffPageCount;
If SourcePageNum < 0 Then Exit;
If SourcePageNum > inPageCount-1 Then Exit;
//Validate DestPageNum
IL.ReadTifFile(DestFile,0,24);
inPageCount := IL.TiffPageCount;
If DestPageNum < 0 Then Exit;
If DestPageNum > inPageCount-1 Then Exit;
inPageNum := 0;
For inCounter := 0 To inPageCount - 1 Do
Begin
TempStream := TempStreamD;
If (SourcePageNum = inCounter) And (SourceFile = DestFile) Then
Begin
FileName := DestFile;
PageNum := DestPageNum;
If inPageNum = 0 Then Append := False Else Append := True;
IL.ReadTifFile(FileName,PageNum,24);
AddPageToStream(TempStream,IL,IL.GetOurDib,Append,IL.TifSaveCompress);
Inc(inPageNum);
Continue;
End;
If DestPageNum = inCounter Then
Begin
FileName := SourceFile;
PageNum := SourcePageNum;
If inPageNum = 0 Then Append := False Else Append := True;
IL.ReadTifFile(FileName,PageNum,24);
AddPageToStream(TempStream,IL,IL.GetOurDib,Append,IL.TifSaveCompress);
Inc(inPageNum);
Continue;
End;
FileName := DestFile;
PageNum := inCounter;
If inPageNum = 0 Then Append := False Else Append := True;
IL.ReadTifFile(FileName,PageNum,24);
AddPageToStream(TempStream,IL,IL.GetOurDib,Append,IL.TifSaveCompress);
Inc(inPageNum);
End;
IL.ReadTifFile(SourceFile,0,24);
inPageCount := IL.TiffPageCount;
inPageNum := 0;
For inCounter := 0 To inPageCount - 1 Do
Begin
TempStream := TempStreamS;
If (DestPageNum = inCounter) And (SourceFile = DestFile) Then
Begin
FileName := SourceFile;
PageNum := SourcePageNum;
If inPageNum = 0 Then Append := False Else Append := True;
IL.ReadTifFile(FileName,PageNum,24);
AddPageToStream(TempStream,IL,IL.GetOurDib,Append,IL.TifSaveCompress);
Inc(inPageNum);
Continue;
End;
If SourcePageNum = inCounter Then
Begin
FileName := DestFile;
PageNum := DestPageNum;
If inPageNum = 0 Then Append := False Else Append := True;
IL.ReadTifFile(FileName,PageNum,24);
AddPageToStream(TempStream,IL,IL.GetOurDib,Append,IL.TifSaveCompress);
Inc(inPageNum);
Continue;
End;
FileName := SourceFile;
PageNum := inCounter;
If inPageNum = 0 Then Append := False Else Append := True;
IL.ReadTifFile(FileName,PageNum,24);
AddPageToStream(TempStream,IL,IL.GetOurDib,Append,IL.TifSaveCompress);
Inc(inPageNum);
End;
If Trim(NewSourceFile) <> '' Then
Begin
NewDir := ExtractFilePath(NewSourceFile);
If NewDir <> '' Then
Begin
If Not DirectoryExists(NewDir) Then ForceDirectories(NewDir);
End;
If FileExists(NewSourceFile) Then DeleteFile(NewSourceFile);
TempStreamS.SaveToFile(NewSourceFile);
End
Else
Begin
If FileExists(SourceFile) Then DeleteFile(SourceFile);
TempStreamS.SaveToFile(SourceFile);
End;
If Trim(NewDestFile) <> '' Then
Begin
NewDir := ExtractFilePath(NewDestFile);
If NewDir <> '' Then
Begin
If Not DirectoryExists(NewDir) Then ForceDirectories(NewDir);
End;
If FileExists(NewDestFile) Then DeleteFile(NewDestFile);
TempStreamD.SaveToFile(NewDestFile);
End
Else
Begin
If FileExists(DestFile) Then DeleteFile(DestFile);
TempStreamD.SaveToFile(DestFile);
End;
Result := True;
Except
Result := False;
End;
Finally
IL .Free;
TempStreamD .Free;
TempStreamS .Free;
End;
End;
{!~ TifToGraphic
This utility converts a *.tif page into another graphic format.
The graphic formats supported are: BMP, EPS, GIF, JPG, PCX,
PNG, and TGA. The TifPage located in the TifFile is converted
to the graphic format passed as Format. The results are output
to NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifToGraphic(
'BMP', //Format : String;
'Source/00003307.tif',//TifFile : String;
0, //TifPage : Integer;
'New/00000001.tif' //NewFile : String
); //): Boolean
end;
}
//Unit Description UnitIndex Master Index
Function TifToGraphic(
Format : String;
TifFile : String;
TifPage : Integer;
NewFile : String
): Boolean;
Var
IL : ILDocumentImage;
inPageCount : Integer;
Begin
IL := ILDocumentImage.Create(nil);
Try
Try
Result := False;
Format := UpperCase(Trim(Format));
If Not
(
(Format = 'EPS') Or
(Format = 'TGA') Or
(Format = 'BMP') Or
(Format = 'PCX') Or
(Format = 'JPG') Or
(Format = 'JPEG') Or
(Format = 'PNG') Or
(Format = 'GIF')
)
Then Exit;
//If the TifFile does not exist get out of here
If Not FileExists(TifFile) Then Exit;
//If it is not a *.tif file get out of here
If UpperCase(Copy(TifFile,Length(TifFile)-2,3)) <> 'TIF' Then Exit;
//Validate SourcePageNum
IL.ReadTifFile(TifFile,0,24);
inPageCount := IL.TiffPageCount;
If TifPage < 0 Then Exit;
If TifPage > inPageCount-1 Then Exit;
IL.ReadTifFile(TifFile,TifPage,24);
IL.TifSaveCompress := sFAXCCITT4;
If FileExists(NewFile) Then DeleteFile(NewFile);
If Format = 'EPS' Then
Begin
IL.WriteEPSFile(NewFile,TifPage,IL.ScaleDoc,1,2,0,1,0,24);
Result := True;
Exit;
End;
If Format = 'TGA' Then
Begin
IL.WriteTGAFile(NewFile,TifPage,IL.ScaleDoc,24);
Result := True;
Exit;
End;
If Format = 'BMP' Then
Begin
IL.WriteBMPFile(NewFile,TifPage,IL.ScaleDoc,24);
Result := True;
Exit;
End;
If Format = 'PCX' Then
Begin
IL.WritePCXFile(NewFile,TifPage,IL.ScaleDoc,24);
Result := True;
Exit;
End;
If (Format = 'JPG') Or (Format = 'JPEG') Then
Begin
IL.WriteJPGFile(NewFile,TifPage,IL.ScaleDoc,100,5,24);
Result := True;
Exit;
End;
If Format = 'PNG' Then
Begin
IL.WritePNGFile(NewFile,TifPage,IL.ScaleDoc,0,24);
Result := True;
Exit;
End;
If Format = 'GIF' Then
Begin
IL.WriteGIFFile(NewFile,TifPage,IL.ScaleDoc,24);
Result := True;
Exit;
End;
Result := True;
Except
Result := False;
End;
Finally
IL.Free;
End;
End;
{!~ TifToBMP
This utility converts a *.tif page into a *.BMP graphic format.
The TifPage located in the TifFile is converted to the new
graphic format. The results are output to NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifToBMP(
'Source/00003307.tif',//TifFile : String;
0, //TifPage : Integer;
'New/00000001.BMP' //NewFile : String
); //): Boolean
end;
}
//Unit Description UnitIndex Master Index
Function TifToBMP(
TifFile : String;
TifPage : Integer;
NewFile : String
): Boolean;
Begin
Result :=
TifToGraphic(
'BMP', //Format : String;
TifFile, //TifFile : String;
TifPage, //TifPage : Integer;
NewFile //NewFile : String
); //): Boolean;
End;
{!~ TifToEPS
This utility converts a *.tif page into a *.EPS graphic format.
The TifPage located in the TifFile is converted to the new
graphic format. The results are output to NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifToEPS(
'Source/00003307.tif',//TifFile : String;
0, //TifPage : Integer;
'New/00000001.EPS' //NewFile : String
); //): Boolean
end;
}
//Unit Description UnitIndex Master Index
Function TifToEPS(
TifFile : String;
TifPage : Integer;
NewFile : String
): Boolean;
Begin
Result :=
TifToGraphic(
'EPS', //Format : String;
TifFile, //TifFile : String;
TifPage, //TifPage : Integer;
NewFile //NewFile : String
); //): Boolean;
End;
{!~ TifToGIF
This utility converts a *.tif page into a *.GIF graphic format.
The TifPage located in the TifFile is converted to the new
graphic format. The results are output to NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifToGIF(
'Source/00003307.tif',//TifFile : String;
0, //TifPage : Integer;
'New/00000001.GIF' //NewFile : String
); //): Boolean
end;
}
//Unit Description UnitIndex Master Index
Function TifToGIF(
TifFile : String;
TifPage : Integer;
NewFile : String
): Boolean;
Begin
Result :=
TifToGraphic(
'GIF', //Format : String;
TifFile, //TifFile : String;
TifPage, //TifPage : Integer;
NewFile //NewFile : String
); //): Boolean;
End;
{!~ TifToJPG
This utility converts a *.tif page into a *.JPG graphic format.
The TifPage located in the TifFile is converted to the new
graphic format. The results are output to NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifToJPG(
'Source/00003307.tif',//TifFile : String;
0, //TifPage : Integer;
'New/00000001.JPG' //NewFile : String
); //): Boolean
end;
}
//Unit Description UnitIndex Master Index
Function TifToJPG(
TifFile : String;
TifPage : Integer;
NewFile : String
): Boolean;
Begin
Result :=
TifToGraphic(
'JPG', //Format : String;
TifFile, //TifFile : String;
TifPage, //TifPage : Integer;
NewFile //NewFile : String
); //): Boolean;
End;
{!~ TifToPCX
This utility converts a *.tif page into a *.PCX graphic format.
The TifPage located in the TifFile is converted to the new
graphic format. The results are output to NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifToPCX(
'Source/00003307.tif',//TifFile : String;
0, //TifPage : Integer;
'New/00000001.PCX' //NewFile : String
); //): Boolean
end;
}
//Unit Description UnitIndex Master Index
Function TifToPCX(
TifFile : String;
TifPage : Integer;
NewFile : String
): Boolean;
Begin
Result :=
TifToGraphic(
'PCX', //Format : String;
TifFile, //TifFile : String;
TifPage, //TifPage : Integer;
NewFile //NewFile : String
); //): Boolean;
End;
{!~ TifToPNG
This utility converts a *.tif page into a *.PNG graphic format.
The TifPage located in the TifFile is converted to the new
graphic format. The results are output to NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifToPNG(
'Source/00003307.tif',//TifFile : String;
0, //TifPage : Integer;
'New/00000001.PNG' //NewFile : String
); //): Boolean
end;
}
//Unit Description UnitIndex Master Index
Function TifToPNG(
TifFile : String;
TifPage : Integer;
NewFile : String
): Boolean;
Begin
Result :=
TifToGraphic(
'PNG', //Format : String;
TifFile, //TifFile : String;
TifPage, //TifPage : Integer;
NewFile //NewFile : String
); //): Boolean;
End;
{!~ TifToTGA
This utility converts a *.tif page into a *.TGA graphic format.
The TifPage located in the TifFile is converted to the new
graphic format. The results are output to NewFile.
Example:
//Unit Description UnitIndex Master Index
procedure TForm1.Button1Click(Sender: TObject);
begin
TifToTGA(
'Source/00003307.tif',//TifFile : String;
0, //TifPage : Integer;
'New/00000001.TGA' //NewFile : String
); //): Boolean
end;
}
//Unit Description UnitIndex Master Index
Function TifToTGA(
TifFile : String;
TifPage : Integer;
NewFile : String
): Boolean;
Begin
Result :=
TifToGraphic(
'TGA', //Format : String;
TifFile, //TifFile : String;
TifPage, //TifPage : Integer;
NewFile //NewFile : String
); //): Boolean;
End;
//Unit Description UnitIndex Master Index
Procedure TifToBMPAP;
Procedure PrintInstructions(Format : String);
Begin
If Format = 'BMP' Then TifToBMPInstr;
If Format = 'EPS' Then TifToEPSInstr;
If Format = 'GIF' Then TifToGIFInstr;
If Format = 'JPG' Then TifToJPGInstr;
If Format = 'PCX' Then TifToPCXInstr;
If Format = 'PNG' Then TifToPNGInstr;
If Format = 'TGA' Then TifToTGAInstr;
End;
Var
Format : String;
TifFile : String;
TifPage : Integer;
NewFile : String;
begin
Format := 'BMP';
If ParamCount < 3 Then
Begin
PrintInstructions(Format);
End
Else
Begin
TifFile := ParamStr(1);
TifPage := StrToInt(ParamStr(2));
NewFile := ParamStr(3);
Try
If Not
ads_TifUtils.
TifToGraphic(
Format, //Format : String;
TifFile , //TifFile : String;
TifPage, //TifPage : Integer;
NewFile //NewFile : String
) //): Boolean
Then PrintInstructions(Format);
Except
PrintInstructions(Format);
End;
End;
end;
//Unit Description UnitIndex Master Index
Procedure TifSwapPagesAp;
Procedure PrintInstructions;
Begin
TifSwapPagesInstr;
End;
Var
SourceFile : String;
Page1 : Integer;
Page2 : Integer;
NewFile : String;
begin
If ParamCount < 3 Then
Begin
PrintInstructions;
End
Else
Begin
Try
SourceFile := ParamStr(1);
Page1 := StrToInt(ParamStr(2));
Page2 := StrToInt(ParamStr(3));
If ParamCount > 3 Then NewFile := ParamStr(4) Else NewFile := '';
If Not
ads_TifUtils.
TifSwapPages(
SourceFile, //SourceFile : String;
Page1, //Page1 : Integer;
Page2, //Page2 : Integer;
NewFile //NewFile : String
) //): Boolean;
Then PrintInstructions;
Except
PrintInstructions;
End;
End;
end;
//Unit Description UnitIndex Master Index
Procedure TifAppendPageAp;
Procedure PrintInstructions;
Begin
TifAppendPageInstr;
End;
Var
SourceFile : String;
DestFile : String;
SourcePageNum : Integer;
NewFile : String;
begin
If ParamCount < 3 Then
Begin
PrintInstructions;
End
Else
Begin
SourceFile := ParamStr(1);
DestFile := ParamStr(2);
If ParamCount > 3 Then
Begin
NewFile := ParamStr(4);
End
Else
Begin
NewFile := '';
End;
Try
SourcePageNum := StrToInt(ParamStr(3));
If Not
ads_TifUtils.
TifAppendPage(
SourceFile, //SourceFile : String;
DestFile, //DestFile : String;
SourcePageNum, //SourcePageNum : Integer;
NewFile //NewFile : String): Boolean;
)
Then PrintInstructions;
Except
PrintInstructions;
End;
End;
end;
//Unit Description UnitIndex Master Index
Procedure TifDocBinderAp;
Procedure PrintInstructions;
Begin
TifDocBinderInstr;
End;
Var
SourceFile : String;
boReturn : Boolean;
lst : TStringList;
lstPblms : TStringList;
arFiles : Array of Array of String;
inCounter : Integer;
inCounter2 : Integer;
SourceFiles: TStringList;
inPos : Integer;
sgTemp : String;
lstSource : TStringList;
lstDest : TStringList;
inCount : Integer;
inDexOf : Integer;
lstBad : TStringList;
inBad : Integer;
begin
If ParamCount < 1 Then
Begin
PrintInstructions;
End
Else
Begin
SourceFile := ParamStr(1);
lst := TStringList.Create();
lstPblms := TStringList.Create();
lstSource := TStringList.Create();
lstDest := TStringList.Create();
lstBad := TStringList.Create();
SourceFiles := TStringList.Create();
Try
lst .Clear;
lstPblms .Clear;
lstSource .Clear;
lstDest .Clear;
lstBad .Clear;
SourceFiles.Clear;
Try
lst.LoadFromFile(SourceFile);
Except
Msg(SourceFile+' does not exist!');
Exit;
End;
inCount := lst.Count;
SetLength(arFiles,2,inCount);
For inCounter := 0 To inCount - 1 Do
Begin
sgTemp := lst[inCounter];
inPos := Pos(',',sgTemp);
If inPos > 0 Then
Begin
arFiles[0,inCounter] := UpperCase(Copy(sgTemp,1,inPos-1));
arFiles[1,inCounter] := UpperCase(Copy(sgTemp,inPos+1,length(sgTemp)-inPos));
End
Else
Begin
arFiles[0,inCounter] := '';
arFiles[1,inCounter] := '';
End;
End;
lstSource.Duplicates := dupIgnore;
lstDest .Duplicates := dupIgnore;
lstSource.Sorted := True;
lstDest .Sorted := True;
For inCounter := 0 To inCount -1 Do
Begin
lstDest .Add(arFiles[1,inCounter]);
lstSource.Add(arFiles[0,inCounter]);
End;
For inCounter := 0 To lstDest.count - 1 Do
Begin
sgTemp := lstDest[inCounter];
inDexOf:= lstSource.IndexOf(sgTemp);
If inDexOf <> -1 Then
Begin
lstBad.Add(sgTemp);
End;
End;
For inBad := 0 To lstBad.Count - 1 Do
Begin
sgTemp := UpperCase(lstBad[inBad]);
For inCounter := 0 To inCount - 1 Do
Begin
If (arFiles[0,inCounter] = sgTemp) Or (arFiles[1,inCounter] = sgTemp) Then
Begin
lstPblms.Add(arFiles[0,inCounter]+','+arFiles[1,inCounter]);
arFiles[0,inCounter] := '';
arFiles[1,inCounter] := '';
End;
End;
End;
For inBad := (lstBad.Count - 1) DownTo 0 Do
Begin
sgTemp := UpperCase(lstBad[inBad]);
inDexOf:= lstDest.IndexOf(sgTemp);
If inDexOf <> -1 Then lstDest.Delete(inDexOf);
End;
SourceFiles.Sorted := False;
For inCounter := 0 To (lstDest.Count - 1) Do
Begin
sgTemp := lstDest[inCounter];
SourceFiles.Clear;
For inCounter2 := 0 To inCount - 1 Do
Begin
If arFiles[1,inCounter2] = sgTemp Then
SourceFiles.Add(arFiles[0,inCounter2]);
End;
boReturn :=
TifBindPages(
SourceFiles, //SourceFiles : TStringList;
sgTemp );//DestFile : String): Boolean;
If Not boReturn Then
Begin
For inCounter2 := 0 To (SourceFiles.Count - 1) Do
Begin
lstPblms.Add(SourceFiles[inCounter2]+','+sgTemp);
End;
End;
End;
Finally
If lstPblms.Count < 1 Then
Begin
DeleteFile(SourceFile);
End
else
Begin
lstPblms.SaveToFile(SourceFile);
End;
lst .Free;
lstPblms .Free;
lstSource .Free;
lstDest .Free;
lstBad .Free;
SourceFiles.Free;
End;
End;
end;
//Unit Description UnitIndex Master Index
Procedure TifDeletePageAp;
Procedure PrintInstructions;
Begin
TifDeletePageInstr;
End;
Var
SourceFile : String;
SourcePageNum : Integer;
NewFile : String;
begin
If ParamCount < 2 Then
Begin
PrintInstructions;
End
Else
Begin
SourceFile := ParamStr(1);
If ParamCount > 2 Then
Begin
NewFile := ParamStr(3);
End
Else
Begin
NewFile := '';
End;
Try
SourcePageNum := StrToInt(ParamStr(2));
If Not
ads_TifUtils.
TifDeletePage(
SourceFile, //SourceFile : String;
SourcePageNum, //SourcePageNum : Integer;
NewFile //NewFile : String): Boolean;
)
Then PrintInstructions;
Except
PrintInstructions;
End;
End;
end;
//Unit Description UnitIndex Master Index
Procedure TifFlipAllPagesAp;
Procedure PrintInstructions;
Begin
TifFlipAllPagesInstr;
End;
Var
SourceFile : String;
NewFile : String;
Begin
If ParamCount < 1 Then
Begin
PrintInstructions;
End
Else
Begin
SourceFile := ParamStr(1);
If ParamCount > 1 Then
Begin
NewFile := ParamStr(2);
End
Else
Begin
NewFile := '';
End;
Try
If Not
ads_TifUtils.
TifFlipAllPages(
SourceFile, //SourceFile : String;
NewFile //NewFile : String): Boolean;
)
Then PrintInstructions;
Except
PrintInstructions;
End;
End;
End;
//Unit Description UnitIndex Master Index
Procedure TifFlipPageAp;
Procedure PrintInstructions;
Begin
TifFlipPageInstr;
End;
Var
SourceFile : String;
SourcePageNum : Integer;
NewFile : String;
Begin
If ParamCount < 2 Then
Begin
PrintInstructions;
End
Else
Begin
SourceFile := ParamStr(1);
If ParamCount > 2 Then
Begin
NewFile := ParamStr(3);
End
Else
Begin
NewFile := '';
End;
Try
SourcePageNum := StrToInt(ParamStr(2));
If Not
ads_TifUtils.
TifFlipPage(
SourceFile, //SourceFile : String;
SourcePageNum, //SourcePageNum : Integer;
NewFile //NewFile : String): Boolean;
)
Then PrintInstructions;
Except
PrintInstructions;
End;
End;
End;
//Unit Description UnitIndex Master Index
Procedure TifInsertPageAp;
Procedure PrintInstructions;
Begin
TifInsertPageInstr;
End;
Var
SourceFile : String;
DestFile : String;
SourcePageNum : Integer;
DestPageNum : Integer;
NewFile : String;
begin
If ParamCount < 4 Then
Begin
PrintInstructions;
End
Else
Begin
SourceFile := ParamStr(1);
DestFile := ParamStr(2);
If ParamCount > 4 Then
Begin
NewFile := ParamStr(5);
End
Else
Begin
NewFile := '';
End;
Try
SourcePageNum := StrToInt(ParamStr(3));
DestPageNum := StrToInt(ParamStr(4));
If Not
ads_TifUtils.
TifInsertPage(
SourceFile, //SourceFile : String;
DestFile, //DestFile : String;
SourcePageNum, //SourcePageNum : Integer;
DestPageNum, //DestPageNum : Integer;
NewFile //NewFile : String): Boolean;
)
Then PrintInstructions;
Except
PrintInstructions;
End;
End;
end;
//Unit Description UnitIndex Master Index
Procedure TifReplacePageAp;
Procedure PrintInstructions;
Begin
TifReplacePageInstr;
End;
Var
SourceFile : String;
DestFile : String;
SourcePageNum : Integer;
DestPageNum : Integer;
NewFile : String;
begin
If ParamCount < 4 Then
Begin
PrintInstructions;
End
Else
Begin
SourceFile := ParamStr(1);
DestFile := ParamStr(2);
If ParamCount > 4 Then
Begin
NewFile := ParamStr(5);
End
Else
Begin
NewFile := '';
End;
Try
SourcePageNum := StrToInt(ParamStr(3));
DestPageNum := StrToInt(ParamStr(4));
If Not
ads_TifUtils.
TifReplacePage(
SourceFile, //SourceFile : String;
DestFile, //DestFile : String;
SourcePageNum, //SourcePageNum : Integer;
DestPageNum, //DestPageNum : Integer;
NewFile //NewFile : String): Boolean;
)
Then PrintInstructions;
Except
PrintInstructions;
End;
End;
end;
//Unit Description UnitIndex Master Index
Procedure TifRotateAllPagesAp;
Procedure PrintInstructions;
Begin
TifRotateAllPagesInstr;
End;
Var
SourceFile : String;
Angle : Double;
NewFile : String;
begin
If ParamCount < 2 Then
Begin
PrintInstructions;
End
Else
Begin
SourceFile := ParamStr(1);
If ParamCount > 2 Then
Begin
NewFile := ParamStr(3);
End
Else
Begin
NewFile := '';
End;
Try
Angle := StrToFloat(ParamStr(2));
If Not
ads_TifUtils.
TifRotateAllPages(
SourceFile, //SourceFile : String;
Angle, //Angle : Double;
NewFile //NewFile : String): Boolean;
)
Then PrintInstructions;
Except
PrintInstructions;
End;
End;
end;
//Unit Description UnitIndex Master Index
Procedure TifRotateAllPagesLeftAp;
Procedure PrintInstructions;
Begin
TifRotateAllPagesLeftInstr;
End;
Var
SourceFile : String;
NewFile : String;
begin
If ParamCount < 1 Then
Begin
PrintInstructions;
End
Else
Begin
SourceFile := ParamStr(1);
If ParamCount > 1 Then
Begin
NewFile := ParamStr(2);
End
Else
Begin
NewFile := '';
End;
Try
If Not
ads_TifUtils.
TifRotateAllPagesLeft(
SourceFile, //SourceFile : String;
NewFile //NewFile : String): Boolean;
)
Then PrintInstructions;
Except
PrintInstructions;
End;
End;
end;
//Unit Description UnitIndex Master Index
Procedure TifRotateAllPagesRightAp;
Procedure PrintInstructions;
Begin
TifRotateAllPagesRightInstr;
End;
Var
SourceFile : String;
NewFile : String;
Begin
If ParamCount < 1 Then
Begin
PrintInstructions;
End
Else
Begin
SourceFile := ParamStr(1);
If ParamCount > 1 Then
Begin
NewFile := ParamStr(2);
End
Else
Begin
NewFile := '';
End;
Try
If Not
ads_TifUtils.TifRotateAllPagesRight(
SourceFile, //SourceFile : String;
NewFile //NewFile : String): Boolean;
)
Then PrintInstructions;
Except
PrintInstructions;
End;
End;
end;
//Unit Description UnitIndex Master Index
Procedure TifRotatePageAp;
Procedure PrintInstructions;
Begin
TifRotatePageInstr;
End;
Var
SourceFile : String;
SourcePageNum : Integer;
Angle : Double;
NewFile : String;
Begin
If ParamCount < 3 Then
Begin
PrintInstructions;
End
Else
Begin
SourceFile := ParamStr(1);
If ParamCount > 3 Then
Begin
NewFile := ParamStr(4);
End
Else
Begin
NewFile := '';
End;
Try
SourcePageNum := StrToInt(ParamStr(2));
Angle := StrToFloat(ParamStr(3));
If Not
ads_TifUtils.
TifRotatePage(
SourceFile, //SourceFile : String;
SourcePageNum, //SourcePageNum : Integer;
Angle, //Angle : Double;
NewFile //NewFile : String): Boolean;
)
Then PrintInstructions;
Except
PrintInstructions;
End;
End;
End;
//Unit Description UnitIndex Master Index
Procedure TifRotatePageLeftAp;
Procedure PrintInstructions;
Begin
TifRotatePageLeftInstr;
End;
Var
SourceFile : String;
SourcePageNum : Integer;
NewFile : String;
begin
If ParamCount < 2 Then
Begin
PrintInstructions;
End
Else
Begin
SourceFile := ParamStr(1);
If ParamCount > 2 Then
Begin
NewFile := ParamStr(3);
End
Else
Begin
NewFile := '';
End;
Try
SourcePageNum := StrToInt(ParamStr(2));
If Not
ads_TifUtils.
TifRotatePageLeft(
SourceFile, //SourceFile : String;
SourcePageNum, //SourcePageNum : Integer;
NewFile //NewFile : String): Boolean;
)
Then PrintInstructions;
Except
PrintInstructions;
End;
End;
end;
//Unit Description UnitIndex Master Index
Procedure TifRotatePageRightAp;
Procedure PrintInstructions;
Begin
TifRotatePageRightInstr;
End;
Var
SourceFile : String;
SourcePageNum : Integer;
NewFile : String;
begin
If ParamCount < 2 Then
Begin
PrintInstructions;
End
Else
Begin
SourceFile := ParamStr(1);
If ParamCount > 2 Then
Begin
NewFile := ParamStr(3);
End
Else
Begin
NewFile := '';
End;
Try
SourcePageNum := StrToInt(ParamStr(2));
If Not
ads_TifUtils.
TifRotatePageRight(
SourceFile, //SourceFile : String;
SourcePageNum, //SourcePageNum : Integer;
NewFile //NewFile : String): Boolean;
)
Then PrintInstructions;
Except
PrintInstructions;
End;
End;
end;
//Unit Description UnitIndex Master Index
Procedure TifSwapPagesInFilesAp;
Procedure PrintInstructions;
Begin
TifSwapPagesInFilesInstr;
End;
Var
SourceFile : String;
DestFile : String;
SourcePageNum : Integer;
DestPageNum : Integer;
NewSourceFile : String;
NewDestFile : String;
Begin
If ParamCount < 6 Then
Begin
PrintInstructions;
End
Else
Begin
Try
SourceFile := ParamStr(1);
DestFile := ParamStr(2);
SourcePageNum := StrToInt(ParamStr(3));
DestPageNum := StrToInt(ParamStr(4));