unit ads_GraphicConversion;
{Copyright(c)2016 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
dickmaley@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 dickmaley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
(*UnitIndex Master Index Implementation Section Download UnitsDescription: ads_GraphicConversion.pas This unit contains the following routines.
BitmapToGif_1 BitmapToGif_2 BitmapToGif_3 BitmapToGif_4 BitmapToGif_5 BitmapToJPeg_1 BitmapToJPeg_2 BitmapToJPeg_3 BitmapToJPeg_4 BitmapToJPeg_5 BitmapToPng_1 BitmapToPng_2 BitmapToPng_3 BitmapToPng_4 BitmapToPng_5 BitmapToPng_6 BitmapToTiff_1 BitmapToTiff_2 BitmapToTiff_3 BitmapToTiff_4 BitmapToTiff_5 BitmapToTiff_6 GifToBitmap_1 GifToBitmap_2 GifToBitmap_3 GifToBitmap_4 GifToBitmap_5 GifToJPeg_1 GifToJPeg_2 GifToJPeg_3 GifToJPeg_4 GifToJPeg_5 GifToTiff_1 GifToTiff_2 GifToTiff_3 GifToTiff_4 GifToTiff_5 GifToTiff_6 JPegToBitmap_1 JPegToBitmap_2 JPegToBitmap_3 JPegToBitmap_4 JPegToBitmap_5 JpegToGif_1 JpegToGif_2 JpegToGif_3 JpegToGif_4 JpegToGif_5 JpegToTiff_1 JpegToTiff_2 JpegToTiff_3 JpegToTiff_4 JpegToTiff_5 JpegToTiff_6 PngToBitmap_1 PngToBitmap_2 PngToBitmap_3 PngToBitmap_4 PngToBitmap_5 PngToBitmap_6
*)
interface
Uses
Windows,WinProcs,WinTypes, Graphics, Classes, Jpeg, {}GifImage{},
{}PNGImage{};
Function BitmapToPng(Bitmap: TBitmap;Stream: TStream): Boolean; Overload;
Function BitmapToPng(Bitmap: TBitmap;PngFile: String): Boolean; Overload;
Function BitmapToPng(BitmapFile,PngFile: String): Boolean; Overload;
Function BitmapToPng(BitmapFile,PngFile: String; DeleteSource: Boolean): Boolean; Overload;
Function BitmapToPng(BitmapFile: String): Boolean; Overload;
Function BitmapToPng(BitmapFile: String; DeleteSource: Boolean): Boolean; Overload;
Function PngToBitmap(Png: TPngImage;Stream: TStream): Boolean; Overload;
Function PngToBitmap(Png: TPngImage;BitmapFile: String): Boolean; Overload;
Function PngToBitmap(PngFile,BitmapFile: String): Boolean; Overload;
Function PngToBitmap(PngFile,BitmapFile: String; DeleteSource: Boolean): Boolean; Overload;
Function PngToBitmap(PngFile: String): Boolean; Overload;
Function PngToBitmap(PngFile: String; DeleteSource: Boolean): Boolean; Overload;
Function BitmapToGif(Bitmap: TBitmap;Gif: TGifImage): Boolean; Overload;
Function BitmapToGif(BitmapFile,GifFile: String): Boolean; Overload;
Function BitmapToGif(BitmapFile,GifFile: String; DeleteSource: Boolean): Boolean; Overload;
Function BitmapToGif(BitmapFile: String): Boolean; Overload;
Function BitmapToGif(BitmapFile: String; DeleteSource: Boolean): Boolean; Overload;
Function BitmapToJPeg(Bitmap: TBitmap;Jpeg: TJpegImage): Boolean; Overload;
Function BitmapToJPeg(BitmapFile,JpegFile: String): Boolean; Overload;
Function BitmapToJPeg(BitmapFile,JpegFile: String; DeleteSource: Boolean): Boolean; Overload;
Function BitmapToJPeg(BitmapFile: String): Boolean; Overload;
Function BitmapToJPeg(BitmapFile: String; DeleteSource: Boolean): Boolean; Overload;
Function BitmapToTiff(Bitmap: TBitmap;Stream: TStream): Boolean; Overload;
Function BitmapToTiff(Bitmap: TBitmap;TiffFile: String): Boolean; Overload;
Function BitmapToTiff(BitmapFile,TiffFile: String): Boolean; Overload;
Function BitmapToTiff(BitmapFile,TiffFile: String; DeleteSource: Boolean): Boolean; Overload;
Function BitmapToTiff(BitmapFile: String): Boolean; Overload;
Function BitmapToTiff(BitmapFile: String; DeleteSource: Boolean): Boolean; Overload;
Function GifToBitmap(Gif: TGifImage;Bitmap: TBitmap): Boolean; Overload;
Function GifToBitmap(GifFile,BitmapFile: String): Boolean; Overload;
Function GifToBitmap(GifFile,BitmapFile: String; DeleteSource: Boolean): Boolean; Overload;
Function GifToBitmap(GifFile: String): Boolean; Overload;
Function GifToBitmap(GifFile: String; DeleteSource: Boolean): Boolean; Overload;
Function GifToJPeg(Gif: TGifImage;Jpeg: TJpegImage): Boolean; Overload;
Function GifToJPeg(GifFile,JpegFile: String): Boolean; Overload;
Function GifToJPeg(GifFile,JpegFile: String; DeleteSource: Boolean): Boolean; Overload;
Function GifToJPeg(GifFile: String): Boolean; Overload;
Function GifToJPeg(GifFile: String; DeleteSource: Boolean): Boolean; Overload;
Function GifToTiff(Gif: TGifImage;Stream: TStream): Boolean; Overload;
Function GifToTiff(Gif: TGifImage;TiffFile: String): Boolean; Overload;
Function GifToTiff(GifFile,TiffFile: String): Boolean; Overload;
Function GifToTiff(GifFile,TiffFile: String; DeleteSource: Boolean): Boolean; Overload;
Function GifToTiff(GifFile: String): Boolean; Overload;
Function GifToTiff(GifFile: String; DeleteSource: Boolean): Boolean; Overload;
Function JPegToBitmap(Jpeg: TJpegImage;Bitmap: TBitmap): Boolean; Overload;
Function JPegToBitmap(JpegFile,BitmapFile: String): Boolean; Overload;
Function JPegToBitmap(JpegFile,BitmapFile: String; DeleteSource: Boolean): Boolean; Overload;
Function JPegToBitmap(JpegFile: String): Boolean; Overload;
Function JPegToBitmap(JpegFile: String; DeleteSource: Boolean): Boolean; Overload;
Function JpegToGif(Jpeg: TJpegImage;Gif: TGifImage): Boolean; Overload;
Function JpegToGif(JpegFile,GifFile: String): Boolean; Overload;
Function JpegToGif(JpegFile,GifFile: String; DeleteSource: Boolean): Boolean; Overload;
Function JpegToGif(JpegFile: String): Boolean; Overload;
Function JpegToGif(JpegFile: String; DeleteSource: Boolean): Boolean; Overload;
Function JpegToTiff(Jpeg: TJpegImage;Stream: TStream): Boolean; Overload;
Function JpegToTiff(Jpeg: TJpegImage;TiffFile: String): Boolean; Overload;
Function JpegToTiff(JpegFile,TiffFile: String): Boolean; Overload;
Function JpegToTiff(JpegFile,TiffFile: String; DeleteSource: Boolean): Boolean; Overload;
Function JpegToTiff(JpegFile: String): Boolean; Overload;
Function JpegToTiff(JpegFile: String; DeleteSource: Boolean): Boolean; Overload;
implementation
Uses
SysUtils;
//Unit Description UnitIndex Master Index
Function JPegToBitmap(Jpeg: TJpegImage;Bitmap: TBitmap): Boolean;
Begin
Try
Bitmap.Assign(JPeg);
Result := True;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function JPegToBitmap(JpegFile,BitmapFile: String): Boolean; Overload;
Var
Bitmap : TBitmap;
Jpeg : TJpegImage;
Begin
Result := False;
If Not FileExists(JpegFile) Then Exit;
Bitmap := TBitmap.Create();
Jpeg := TJpegImage.Create();
Try
Try
Jpeg.LoadFromFile(JpegFile);
Result := JPegToBitmap(Jpeg,Bitmap);
If Result Then
Begin
If FileExists(BitmapFile) Then DeleteFile(BitmapFile);
Bitmap.SaveToFile(BitmapFile);
End;
Except
Result := False;
End;
Finally
Bitmap.Free;
Jpeg .Free;
End;
End;
//Unit Description UnitIndex Master IndexFunction JPegToBitmap(JpegFile: String; DeleteSource: Boolean): Boolean; Overload; Var FileExtOld : String; FileExtNew : String; FileNew : String; FileOld : String; Begin FileOld := JpegFile; FileExtNew := '.bmp'; Result := False; If Not FileExists(FileOld) Then Exit; FileExtOld := ExtractFileExt(FileOld); FileNew := Copy(FileOld,1,Length(FileOld)-Length(FileExtOld))+FileExtNew; Result := JPegToBitmap(FileOld,FileNew); If DeleteSource Then If Result Then If FileExists(FileOld) Then DeleteFile(FileOld); End; //Unit Description UnitIndex Master Index
Function JPegToBitmap(JpegFile: String): Boolean; Overload; Begin Result := JPegToBitmap(JpegFile, True); End; //Unit Description UnitIndex Master Index
Function JPegToBitmap(JpegFile,BitmapFile: String; DeleteSource: Boolean): Boolean; Overload;
Begin
Result := JPegToBitmap(JpegFile,BitmapFile);
If DeleteSource Then
Begin
If FileExists(JpegFile) Then DeleteFile(JpegFile);
Result := Not FileExists(JpegFile);
End;
End;
//Unit Description UnitIndex Master Index
Function BitmapToJPeg(BitmapFile,JpegFile: String): Boolean; Overload;
Var
Bitmap : TBitmap;
Jpeg : TJpegImage;
Begin
Result := False;
If Not FileExists(BitmapFile) Then Exit;
Bitmap := TBitmap.Create();
Jpeg := TJpegImage.Create();
Try
Try
Bitmap.LoadFromFile(BitmapFile);
Result := BitmapToJPeg(Bitmap,Jpeg);
If Result Then
Begin
If FileExists(JpegFile) Then DeleteFile(JpegFile);
Jpeg.SaveToFile(JpegFile);
End;
Except
Result := False;
End;
Finally
Bitmap.Free;
Jpeg .Free;
End;
End;
//Unit Description UnitIndex Master Index
Function BitmapToJPeg(Bitmap: TBitmap;Jpeg: TJpegImage): Boolean;
Begin
Try
Jpeg.Assign(Bitmap);
Result := True;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master IndexFunction BitmapToJPeg(BitmapFile: String; DeleteSource: Boolean): Boolean; Overload; Var FileExtOld : String; FileExtNew : String; FileNew : String; FileOld : String; Begin FileOld := BitmapFile; FileExtNew := '.jpg'; Result := False; If Not FileExists(FileOld) Then Exit; FileExtOld := ExtractFileExt(FileOld); FileNew := Copy(FileOld,1,Length(FileOld)-Length(FileExtOld))+FileExtNew; Result := BitmapToJpeg(FileOld,FileNew); If DeleteSource Then If Result Then If FileExists(FileOld) Then DeleteFile(FileOld); End; //Unit Description UnitIndex Master Index
Function BitmapToJPeg(BitmapFile: String): Boolean; Overload; Begin Result := BitmapToJPeg(BitmapFile, True); End; //Unit Description UnitIndex Master Index
Function BitmapToJPeg(BitmapFile,JpegFile: String; DeleteSource: Boolean): Boolean; Overload;
Begin
Result := BitmapToJPeg(BitmapFile,JpegFile);
If DeleteSource Then
Begin
If FileExists(BitmapFile) Then DeleteFile(BitmapFile);
Result := Not FileExists(BitmapFile);
End;
End;
//Unit Description UnitIndex Master Index
Function GifToBitmap(Gif: TGifImage;Bitmap: TBitmap): Boolean;
begin
Result := False;
If Gif = nil Then Exit;
Try
Bitmap.Assign(Gif.Bitmap);
Result := True;
Except
Result := False;
End;
end;
//Unit Description UnitIndex Master Index
Function GifToBitmap(GifFile,BitmapFile: String): Boolean; Overload;
Var
Bitmap : TBitmap;
Gif : TGifImage;
Begin
Result := False;
If Not FileExists(GifFile) Then Exit;
Bitmap := TBitmap.Create();
Gif := TGifImage.Create();
Try
Try
Gif.LoadFromFile(GifFile);
Result := GifToBitmap(Gif,Bitmap);
If Result Then
Begin
If FileExists(BitmapFile) Then DeleteFile(BitmapFile);
Bitmap.SaveToFile(BitmapFile);
End;
Except
Result := False;
End;
Finally
Bitmap.Free;
Gif .Free;
End;
End;
//Unit Description UnitIndex Master Index
Function GifToBitmap(GifFile,BitmapFile: String; DeleteSource: Boolean): Boolean; Overload;
Begin
Result := GifToBitmap(GifFile,BitmapFile);
If DeleteSource Then
Begin
If FileExists(GifFile) Then DeleteFile(GifFile);
Result := Not FileExists(GifFile);
End;
End;
//Unit Description UnitIndex Master IndexFunction GifToBitmap(GifFile: String; DeleteSource: Boolean): Boolean; Overload; Var FileExtOld : String; FileExtNew : String; FileNew : String; FileOld : String; Begin FileOld := GifFile; FileExtNew := '.bmp'; Result := False; If Not FileExists(FileOld) Then Exit; FileExtOld := ExtractFileExt(FileOld); FileNew := Copy(FileOld,1,Length(FileOld)-Length(FileExtOld))+FileExtNew; Result := GifToBitmap(FileOld,FileNew); If DeleteSource Then If Result Then If FileExists(FileOld) Then DeleteFile(FileOld); End; //Unit Description UnitIndex Master Index
Function GifToBitmap(GifFile: String): Boolean; Overload; Begin Result := GifToBitmap(GifFile, True); End; //Unit Description UnitIndex Master Index
Function BitmapToGif(BitmapFile,GifFile: String): Boolean; Overload;
Var
Bitmap : TBitmap;
Gif : TGifImage;
Begin
Result := False;
If Not FileExists(BitmapFile) Then Exit;
Bitmap := TBitmap.Create();
Gif := TGifImage.Create();
Try
Try
Bitmap.LoadFromFile(BitmapFile);
Result := BitmapToGif(Bitmap,Gif);
If Result Then
Begin
If FileExists(GifFile) Then DeleteFile(GifFile);
Gif.SaveToFile(GifFile);
End;
Except
Result := False;
End;
Finally
Bitmap.Free;
Gif .Free;
End;
End;
//Unit Description UnitIndex Master Index
Function BitmapToGif(Bitmap: TBitmap;Gif: TGifImage): Boolean;
Begin
Try
Gif.Assign(Bitmap);
Result := True;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master IndexFunction BitmapToGif(BitmapFile: String; DeleteSource: Boolean): Boolean; Overload; Var FileExtOld : String; FileExtNew : String; FileNew : String; FileOld : String; Begin FileOld := BitmapFile; FileExtNew := '.gif'; Result := False; If Not FileExists(FileOld) Then Exit; FileExtOld := ExtractFileExt(FileOld); FileNew := Copy(FileOld,1,Length(FileOld)-Length(FileExtOld))+FileExtNew; Result := BitmapToGif(FileOld,FileNew); If DeleteSource Then If Result Then If FileExists(FileOld) Then DeleteFile(FileOld); End; //Unit Description UnitIndex Master Index
Function BitmapToGif(BitmapFile: String): Boolean; Overload; Begin Result := BitmapToGif(BitmapFile, True); End; //Unit Description UnitIndex Master Index
Function BitmapToGif(BitmapFile,GifFile: String; DeleteSource: Boolean): Boolean; Overload;
Begin
Result := BitmapToGif(BitmapFile,GifFile);
If DeleteSource Then
Begin
If FileExists(BitmapFile) Then DeleteFile(BitmapFile);
Result := Not FileExists(BitmapFile);
End;
End;
//Unit Description UnitIndex Master Index
Function GifToJpeg(Gif: TGifImage;Jpeg: TJpegImage): Boolean; Overload;
Var
Bitmap : TBitmap;
Begin
Result := False;
If Gif = nil Then Exit;
Try
Bitmap := TBitmap.Create();
Try
Bitmap.Assign(Gif.Bitmap);
Result := BitmapToJPeg(Bitmap,Jpeg);
Finally
Bitmap.Free;
End;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function GifToJPeg(GifFile,JpegFile: String): Boolean; Overload;
Var
Gif : TGifImage;
Jpeg : TJpegImage;
Begin
Result := False;
If Not FileExists(GifFile) Then Exit;
Gif := TGifImage .Create();
Jpeg := TJpegImage.Create();
Try
Try
Gif.LoadFromFile(GifFile);
Result := GifToJPeg(Gif,Jpeg);
If Result Then
Begin
If FileExists(JpegFile) Then DeleteFile(JpegFile);
Jpeg.SaveToFile(JpegFile);
End;
Except
Result := False;
End;
Finally
Gif .Free;
Jpeg .Free;
End;
End;
//Unit Description UnitIndex Master IndexFunction GifToJPeg(GifFile: String; DeleteSource: Boolean): Boolean; Overload; Var FileExtOld : String; FileExtNew : String; FileNew : String; FileOld : String; Begin FileOld := GifFile; FileExtNew := '.jpg'; Result := False; If Not FileExists(FileOld) Then Exit; FileExtOld := ExtractFileExt(FileOld); FileNew := Copy(FileOld,1,Length(FileOld)-Length(FileExtOld))+FileExtNew; Result := GifToJpeg(FileOld,FileNew); If DeleteSource Then If Result Then If FileExists(FileOld) Then DeleteFile(FileOld); End; //Unit Description UnitIndex Master Index
Function GifToJPeg(GifFile: String): Boolean; Overload; Begin Result := GifToJPeg(GifFile, True); End; //Unit Description UnitIndex Master Index
Function GifToJPeg(GifFile,JpegFile: String; DeleteSource: Boolean): Boolean; Overload;
Begin
Result := GifToJPeg(GifFile,JpegFile);
If DeleteSource Then
Begin
If FileExists(GifFile) Then DeleteFile(GifFile);
Result := Not FileExists(GifFile);
End;
End;
//******************************************************************************
//Unit Description UnitIndex Master Index
Function JpegToGif(Jpeg: TJpegImage;Gif: TGifImage): Boolean; Overload;
Var
Bitmap : TBitmap;
Begin
Result := False;
If Jpeg = nil Then Exit;
Try
Bitmap := TBitmap.Create();
Try
Bitmap.Assign(Jpeg);
Result := BitmapToGif(Bitmap,Gif);
Finally
Bitmap.Free;
End;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function JpegToGif(JpegFile,GifFile: String): Boolean; Overload;
Var
Jpeg : TJpegImage;
Gif : TGifImage;
Begin
Result := False;
If Not FileExists(JpegFile) Then Exit;
Jpeg := TJpegImage .Create();
Gif := TGifImage.Create();
Try
Try
Jpeg.LoadFromFile(JpegFile);
Result := JpegToGif(Jpeg,Gif);
If Result Then
Begin
If FileExists(GifFile) Then DeleteFile(GifFile);
Gif.SaveToFile(GifFile);
End;
Except
Result := False;
End;
Finally
Jpeg .Free;
Gif .Free;
End;
End;
//Unit Description UnitIndex Master IndexFunction JpegToGif(JpegFile: String; DeleteSource: Boolean): Boolean; Overload; Var FileExtOld : String; FileExtNew : String; FileNew : String; FileOld : String; Begin FileOld := JpegFile; FileExtNew := '.jpg'; Result := False; If Not FileExists(FileOld) Then Exit; FileExtOld := ExtractFileExt(FileOld); FileNew := Copy(FileOld,1,Length(FileOld)-Length(FileExtOld))+FileExtNew; Result := JpegToGif(FileOld,FileNew); If DeleteSource Then If Result Then If FileExists(FileOld) Then DeleteFile(FileOld); End; //Unit Description UnitIndex Master Index
Function JpegToGif(JpegFile: String): Boolean; Overload; Begin Result := JpegToGif(JpegFile, True); End; //Unit Description UnitIndex Master Index
Function JpegToGif(JpegFile,GifFile: String; DeleteSource: Boolean): Boolean; Overload;
Begin
Result := JpegToGif(JpegFile,GifFile);
If DeleteSource Then
Begin
If FileExists(JpegFile) Then DeleteFile(JpegFile);
Result := Not FileExists(JpegFile);
End;
End;
//Unit Description UnitIndex Master Index
Function BitmapToTiff(Bitmap: TBitmap;TiffFile: String): Boolean; Overload;
Var
Stream : TFileStream;
Begin
Result := False;
If Bitmap = nil Then Exit;
If Bitmap.Handle = 0 Then Exit;
Try
Stream := TFileStream.Create(TiffFile,fmCreate);
Try
If FileExists(TiffFile) Then DeleteFile(TiffFile);
Result := BitmapToTiff(Bitmap,Stream);
Finally
Stream.Free;
End;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function BitmapToTiff(BitmapFile,TiffFile: String): Boolean; Overload;
Var
Bitmap : TBitmap;
Begin
Result := False;
If Not FileExists(BitmapFile) Then Exit;
Try
Bitmap := TBitmap.Create();
Try
Bitmap.LoadFromFile(BitmapFile);
Result := BitmapToTiff(Bitmap,TiffFile);
Finally
Bitmap.Free;
End;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function BitmapToTiff(BitmapFile,TiffFile: String; DeleteSource: Boolean): Boolean; Overload;
Begin
Try
Result := BitmapToTiff(BitmapFile,TiffFile);
If Result Then If DeleteSource Then DeleteFile(BitmapFile);
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function BitmapToTiff(BitmapFile: String; DeleteSource: Boolean): Boolean; Overload;
Begin
Try
Result := BitmapToTiff(BitmapFile,ChangeFileExt(BitmapFile,'.tif'));
If Result Then If DeleteSource Then DeleteFile(BitmapFile);
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function BitmapToTiff(BitmapFile: String): Boolean; Overload;
Begin
Try
Result := BitmapToTiff(BitmapFile,True);
Except
Result := False;
End;
End;
//***START TIFF ROUTINES BY Wolfgang Krug ****************************************
type
PDirEntry = ^TDirEntry;
TDirEntry = record
_Tag : Word;
_Type : Word;
_Count : LongInt;
_Value : LongInt;
end;
{$IFDEF WINDOWS}
CONST
{$ELSE}
VAR
{$ENDIF}
{ TIFF File Header: }
TifHeader : array[0..7] of Byte = (
$49, $49, { Intel byte order }
$2a, $00, { TIFF version (42) }
$08, $00, $00, $00 ); { Pointer to the first directory }
NoOfDirs : array[0..1] of Byte = ( $0F, $00 ); { Number of tags within the directory }
DirectoryBW : array[0..13] of TDirEntry = (
( _Tag: $00FE; _Type: $0004; _Count: $00000001; _Value: $00000000 ), { NewSubFile: Image with full solution (0) }
( _Tag: $0100; _Type: $0003; _Count: $00000001; _Value: $00000000 ), { ImageWidth: Value will be set later }
( _Tag: $0101; _Type: $0003; _Count: $00000001; _Value: $00000000 ), { ImageLength: Value will be set later }
( _Tag: $0102; _Type: $0003; _Count: $00000001; _Value: $00000001 ), { BitsPerSample: 1 }
( _Tag: $0103; _Type: $0003; _Count: $00000001; _Value: $00000001 ), { Compression: No compression }
( _Tag: $0106; _Type: $0003; _Count: $00000001; _Value: $00000001 ), { PhotometricInterpretation: 0, 1 }
( _Tag: $0111; _Type: $0004; _Count: $00000001; _Value: $00000000 ), { StripOffsets: Ptr to the adress of the image data }
( _Tag: $0115; _Type: $0003; _Count: $00000001; _Value: $00000001 ), { SamplesPerPixels: 1 }
( _Tag: $0116; _Type: $0004; _Count: $00000001; _Value: $00000000 ), { RowsPerStrip: Value will be set later }
( _Tag: $0117; _Type: $0004; _Count: $00000001; _Value: $00000000 ), { StripByteCounts: xs*ys bytes pro strip }
( _Tag: $011A; _Type: $0005; _Count: $00000001; _Value: $00000000 ), { X-Resolution: Adresse }
( _Tag: $011B; _Type: $0005; _Count: $00000001; _Value: $00000000 ), { Y-Resolution: (Adresse) }
( _Tag: $0128; _Type: $0003; _Count: $00000001; _Value: $00000002 ), { Resolution Unit: (2)= Unit ZOLL }
( _Tag: $0131; _Type: $0002; _Count: $0000000A; _Value: $00000000 )); { Software: }
DirectoryCOL : array[0..14] of TDirEntry = (
( _Tag: $00FE; _Type: $0004; _Count: $00000001; _Value: $00000000 ), { NewSubFile: Image with full solution (0) }
( _Tag: $0100; _Type: $0003; _Count: $00000001; _Value: $00000000 ), { ImageWidth: Value will be set later }
( _Tag: $0101; _Type: $0003; _Count: $00000001; _Value: $00000000 ), { ImageLength: Value will be set later }
( _Tag: $0102; _Type: $0003; _Count: $00000001; _Value: $00000008 ), { BitsPerSample: 4 or 8 }
( _Tag: $0103; _Type: $0003; _Count: $00000001; _Value: $00000001 ), { Compression: No compression }
( _Tag: $0106; _Type: $0003; _Count: $00000001; _Value: $00000003 ), { PhotometricInterpretation: 3 }
( _Tag: $0111; _Type: $0004; _Count: $00000001; _Value: $00000000 ), { StripOffsets: Ptr to the adress of the image data }
( _Tag: $0115; _Type: $0003; _Count: $00000001; _Value: $00000001 ), { SamplesPerPixels: 1 }
( _Tag: $0116; _Type: $0004; _Count: $00000001; _Value: $00000000 ), { RowsPerStrip: Value will be set later }
( _Tag: $0117; _Type: $0004; _Count: $00000001; _Value: $00000000 ), { StripByteCounts: xs*ys bytes pro strip }
( _Tag: $011A; _Type: $0005; _Count: $00000001; _Value: $00000000 ), { X-Resolution: Adresse }
( _Tag: $011B; _Type: $0005; _Count: $00000001; _Value: $00000000 ), { Y-Resolution: (Adresse) }
( _Tag: $0128; _Type: $0003; _Count: $00000001; _Value: $00000002 ), { Resolution Unit: (2)= Unit ZOLL }
( _Tag: $0131; _Type: $0002; _Count: $0000000A; _Value: $00000000 ), { Software: }
( _Tag: $0140; _Type: $0003; _Count: $00000300; _Value: $00000008 ) );{ ColorMap: Color table startadress }
DirectoryRGB : array[0..14] of TDirEntry = (
( _Tag: $00FE; _Type: $0004; _Count: $00000001; _Value: $00000000 ), { NewSubFile: Image with full solution (0) }
( _Tag: $0100; _Type: $0003; _Count: $00000001; _Value: $00000000 ), { ImageWidth: Value will be set later }
( _Tag: $0101; _Type: $0003; _Count: $00000001; _Value: $00000000 ), { ImageLength: Value will be set later }
( _Tag: $0102; _Type: $0003; _Count: $00000003; _Value: $00000008 ), { BitsPerSample: 8 }
( _Tag: $0103; _Type: $0003; _Count: $00000001; _Value: $00000001 ), { Compression: No compression }
( _Tag: $0106; _Type: $0003; _Count: $00000001; _Value: $00000002 ), { PhotometricInterpretation:
0=black, 2 power BitsPerSample -1 =white }
( _Tag: $0111; _Type: $0004; _Count: $00000001; _Value: $00000000 ), { StripOffsets: Ptr to the adress of the image data }
( _Tag: $0115; _Type: $0003; _Count: $00000001; _Value: $00000003 ), { SamplesPerPixels: 3 }
( _Tag: $0116; _Type: $0004; _Count: $00000001; _Value: $00000000 ), { RowsPerStrip: Value will be set later }
( _Tag: $0117; _Type: $0004; _Count: $00000001; _Value: $00000000 ), { StripByteCounts: xs*ys bytes pro strip }
( _Tag: $011A; _Type: $0005; _Count: $00000001; _Value: $00000000 ), { X-Resolution: Adresse }
( _Tag: $011B; _Type: $0005; _Count: $00000001; _Value: $00000000 ), { Y-Resolution: (Adresse) }
( _Tag: $011C; _Type: $0003; _Count: $00000001; _Value: $00000001 ), { PlanarConfiguration:
Pixel data will be stored continous }
( _Tag: $0128; _Type: $0003; _Count: $00000001; _Value: $00000002 ), { Resolution Unit: (2)= Unit ZOLL }
( _Tag: $0131; _Type: $0002; _Count: $0000000A; _Value: $00000000 )); { Software: }
NullString : array[0..3] of Byte = ( $00, $00, $00, $00 );
X_Res_Value : array[0..7] of Byte = ( $6D,$03,$00,$00, $0A,$00,$00,$00 ); { Value for X-Resolution:
87,7 Pixel/Zoll (SONY SCREEN) }
Y_Res_Value : array[0..7] of Byte = ( $6D,$03,$00,$00, $0A,$00,$00,$00 ); { Value for Y-Resolution: 87,7 Pixel/Zoll }
Software : array[0..9] of Char = ( 'K', 'r', 'u', 'w', 'o', ' ', 's', 'o', 'f', 't');
BitsPerSample : array[0..2] of Word = ( $0008, $0008, $0008 );
//Unit Description UnitIndex Master Index
Function BitmapToTiff(Bitmap: TBitmap;Stream: TStream): Boolean; Overload;
//Function WriteTiffToStream ( Stream : TStream; Bitmap : TBitmap ): Boolean;
var
BM : HBitmap;
Header, Bits : PChar;
BitsPtr : PChar;
TmpBitsPtr : PChar;
HeaderSize : {$IFDEF WINDOWS} INTEGER {$ELSE} DWORD {$ENDIF} ;
BitsSize : {$IFDEF WINDOWS} LongInt {$ELSE} DWORD {$ENDIF} ;
Width, Height: {$IFDEF WINDOWS} LongInt {$ELSE} Integer {$ENDIF} ;
DataWidth : {$IFDEF WINDOWS} LongInt {$ELSE} Integer {$ENDIF} ;
BitCount : {$IFDEF WINDOWS} LongInt {$ELSE} Integer {$ENDIF} ;
ColorMapRed : array[0..255,0..1] of Byte;
ColorMapGreen: array[0..255,0..1] of Byte;
ColorMapBlue : array[0..255,0..1] of Byte;
ColTabSize : Integer;
I, K : {$IFDEF WINDOWS} LongInt {$ELSE} Integer {$ENDIF} ;
Red, Blue : Char;
{$IFDEF WINDOWS}
RGBArr : Packed Array[0..2] OF CHAR ;
{$ENDIF}
BmpWidth : {$IFDEF WINDOWS} LongInt {$ELSE} Integer {$ENDIF} ;
OffsetXRes : LongInt;
OffsetYRes : LongInt;
OffsetSoftware : LongInt;
OffsetStrip : LongInt;
OffsetDir : LongInt;
OffsetBitsPerSample : LongInt;
{$IFDEF WINDOWS}
MemHandle : THandle ;
MemStream : TMemoryStream ;
ActPos, TmpPos : LongInt;
{$ENDIF}
Begin
Result := False;
Try
BM := Bitmap.Handle;
if BM = 0 then exit;
Result := True;
GetDIBSizes(BM, HeaderSize, BitsSize);
{$IFDEF WINDOWS}
MemHandle := GlobalAlloc ( HeapAllocFlags, HeaderSize + BitsSize ) ;
Header := GlobalLock ( MemHandle ) ;
MemStream := TMemoryStream.Create ;
{$ELSE}
GetMem (Header, HeaderSize + BitsSize);
{$ENDIF}
try
Bits := Header + HeaderSize;
if GetDIB(BM, Bitmap.Palette, Header^, Bits^) then
begin
{ Read Image description }
Width := PBITMAPINFO(Header)^.bmiHeader.biWidth;
Height := PBITMAPINFO(Header)^.bmiHeader.biHeight;
BitCount := PBITMAPINFO(Header)^.bmiHeader.biBitCount;
{$IFDEF WINDOWS}
{ Read Bits into MemoryStream for 16 - Bit - Version }
MemStream.Write ( Bits^, BitsSize ) ;
{$ENDIF}
{ Count max No of Colors }
ColTabSize := (1 shl BitCount);
BmpWidth := Trunc(BitsSize / Height);
{ ========================================================================== }
{ 1 Bit - Bilevel-Image }
{ ========================================================================== }
if BitCount = 1 then // Monochrome Images
begin
DataWidth := ((Width+7) div 8);
DirectoryBW[1]._Value := LongInt(Width); { Image Width }
DirectoryBW[2]._Value := LongInt(abs(Height)); { Image Height }
DirectoryBW[8]._Value := LongInt(abs(Height)); { Rows per Strip }
DirectoryBW[9]._Value := LongInt(DataWidth * abs(Height) ); { Strip Byte Counts }
{ Write TIFF - File for Bilevel-Image }
{-------------------------------------}
{ Write Header }
Stream.Write ( TifHeader,sizeof(TifHeader) );
OffsetStrip := Stream.Position ;
{ Write Image Data }
if Height < 0 then
begin
for I:=0 to Height-1 do
begin
{$IFNDEF WINDOWS}
BitsPtr := Bits + I*BmpWidth;
Stream.Write ( BitsPtr^, DataWidth);
{$ELSE}
MemStream.Position := I*BmpWidth;
Stream.CopyFrom ( MemStream, DataWidth ) ;
{$ENDIF}
end;
end
else
begin
{ Flip Image }
for I:=1 to Height do
begin
{$IFNDEF WINDOWS}
BitsPtr := Bits + (Height-I)*BmpWidth;
Stream.Write ( BitsPtr^, DataWidth);
{$ELSE}
MemStream.Position := (Height-I)*BmpWidth;
Stream.CopyFrom ( MemStream, DataWidth ) ;
{$ENDIF}
end;
end;
OffsetXRes := Stream.Position ;
Stream.Write ( X_Res_Value, sizeof(X_Res_Value));
OffsetYRes := Stream.Position ;
Stream.Write ( Y_Res_Value, sizeof(Y_Res_Value));
OffsetSoftware := Stream.Position ;
Stream.Write ( Software, sizeof(Software));
{ Set Adresses into Directory }
DirectoryBW[ 6]._Value := OffsetStrip; { StripOffset }
DirectoryBW[10]._Value := OffsetXRes; { X-Resolution }
DirectoryBW[11]._Value := OffsetYRes; { Y-Resolution }
DirectoryBW[13]._Value := OffsetSoftware; { Software }
{ Write Directory }
OffsetDir := Stream.Position ;
Stream.Write ( NoOfDirs, sizeof(NoOfDirs));
Stream.Write ( DirectoryBW, sizeof(DirectoryBW));
Stream.Write ( NullString, sizeof(NullString));
{ Update Start of Directory }
Stream.Seek ( 4, soFromBeginning ) ;
Stream.Write ( OffsetDir, sizeof(OffsetDir));
end;
{ ========================================================================== }
{ 4, 8, 16 Bit - Image with Color Table }
{ ========================================================================== }
if BitCount in [4, 8, 16] then
begin
DataWidth := Width;
if BitCount = 4 then
begin
{ If we have only 4 bit per pixel, we have to
truncate the size of the image to a byte boundary }
Width := (Width div BitCount) * BitCount;
if BitCount = 4 then DataWidth := Width div 2;
end;
DirectoryCOL[1]._Value := LongInt(Width); { Image Width }
DirectoryCOL[2]._Value := LongInt(abs(Height)); { Image Height }
DirectoryCOL[3]._Value := LongInt(BitCount); { BitsPerSample }
DirectoryCOL[8]._Value := LongInt(Height); { Image Height }
DirectoryCOL[9]._Value := LongInt(DataWidth * abs(Height) ); { Strip Byte Counts }
for I:=0 to ColTabSize-1 do
begin
ColorMapRed [I][1] := PBITMAPINFO(Header)^.bmiColors[I].rgbRed;
ColorMapRed [I][0] := 0;
ColorMapGreen[I][1] := PBITMAPINFO(Header)^.bmiColors[I].rgbGreen;
ColorMapGreen[I][0] := 0;
ColorMapBlue [I][1] := PBITMAPINFO(Header)^.bmiColors[I].rgbBlue;
ColorMapBlue [I][0] := 0;
end;
DirectoryCOL[14]._Count := LongInt(ColTabSize*3);
{ Write TIFF - File for Image with Color Table }
{----------------------------------------------}
{ Write Header }
Stream.Write ( TifHeader,sizeof(TifHeader) );
Stream.Write ( ColorMapRed, ColTabSize*2 );
Stream.Write ( ColorMapGreen, ColTabSize*2 );
Stream.Write ( ColorMapBlue, ColTabSize*2 );
OffsetXRes := Stream.Position ;
Stream.Write ( X_Res_Value, sizeof(X_Res_Value));
OffsetYRes := Stream.Position ;
Stream.Write ( Y_Res_Value, sizeof(Y_Res_Value));
OffsetSoftware := Stream.Position ;
Stream.Write ( Software, sizeof(Software));
OffsetStrip := Stream.Position ;
{ Write Image Data }
if Height < 0 then
begin
for I:=0 to Height-1 do
begin
{$IFNDEF WINDOWS}
BitsPtr := Bits + I*BmpWidth;
Stream.Write ( BitsPtr^, DataWidth);
{$ELSE}
MemStream.Position := I*BmpWidth;
Stream.CopyFrom ( MemStream, DataWidth ) ;
{$ENDIF}
end;
end
else
begin
{ Flip Image }
for I:=1 to Height do
begin
{$IFNDEF WINDOWS}
BitsPtr := Bits + (Height-I)*BmpWidth;
Stream.Write ( BitsPtr^, DataWidth);
{$ELSE}
MemStream.Position := (Height-I)*BmpWidth;
Stream.CopyFrom ( MemStream, DataWidth ) ;
{$ENDIF}
end;
end;
{ Set Adresses into Directory }
DirectoryCOL[ 6]._Value := OffsetStrip; { StripOffset }
DirectoryCOL[10]._Value := OffsetXRes; { X-Resolution }
DirectoryCOL[11]._Value := OffsetYRes; { Y-Resolution }
DirectoryCOL[13]._Value := OffsetSoftware; { Software }
{ Write Directory }
OffsetDir := Stream.Position ;
Stream.Write ( NoOfDirs, sizeof(NoOfDirs));
Stream.Write ( DirectoryCOL, sizeof(DirectoryCOL));
Stream.Write ( NullString, sizeof(NullString));
{ Update Start of Directory }
Stream.Seek ( 4, soFromBeginning ) ;
Stream.Write ( OffsetDir, sizeof(OffsetDir));
end;
if BitCount in [24, 32] then
begin
{ ========================================================================== }
{ 24, 32 - Bit - Image with with RGB-Values }
{ ========================================================================== }
DirectoryRGB[1]._Value := LongInt(Width); { Image Width }
DirectoryRGB[2]._Value := LongInt(Height); { Image Height }
DirectoryRGB[8]._Value := LongInt(Height); { Image Height }
DirectoryRGB[9]._Value := LongInt(3*Width*Height); { Strip Byte Counts }
{ Write TIFF - File for Image with RGB-Values }
{ ------------------------------------------- }
{ Write Header }
Stream.Write ( TifHeader, sizeof(TifHeader));
OffsetXRes := Stream.Position ;
Stream.Write ( X_Res_Value, sizeof(X_Res_Value));
OffsetYRes := Stream.Position ;
Stream.Write ( Y_Res_Value, sizeof(Y_Res_Value));
OffsetBitsPerSample := Stream.Position ;
Stream.Write ( BitsPerSample, sizeof(BitsPerSample));
OffsetSoftware := Stream.Position ;
Stream.Write ( Software, sizeof(Software));
OffsetStrip := Stream.Position ;
{ Exchange Red and Blue Color-Bits }
for I:=0 to Height-1 do
begin
{$IFNDEF WINDOWS}
BitsPtr := Bits + I*BmpWidth;
{$ELSE}
MemStream.Position := I*BmpWidth ;
{$ENDIF}
for K:=0 to Width-1 do
begin
{$IFNDEF WINDOWS}
Blue := (BitsPtr)^ ;
Red := (BitsPtr+2)^;
(BitsPtr)^ := Red;
(BitsPtr+2)^ := Blue;
if BitCount = 24
then BitsPtr := BitsPtr + 3 // 24 - Bit Images
else BitsPtr := BitsPtr + 4; // 32 - Bit images
{$ELSE}
MemStream.Read ( RGBArr, SizeOf(RGBArr) ) ;
MemStream.Seek ( -SizeOf(RGBArr), soFromCurrent ) ;
Blue := RGBArr[0];
Red := RGBArr[2];
RGBArr[0] := Red;
RGBArr[2] := Blue;
MemStream.Write ( RGBArr, SizeOf(RGBArr) ) ;
if BitCount = 32 then
MemStream.Seek ( 1, soFromCurrent ) ;
{$ENDIF}
end;
end;
// If we have 32-Bit Image: skip every 4-th pixel
if BitCount = 32 then
begin
for I:=0 to Height-1 do
begin
{$IFNDEF WINDOWS}
BitsPtr := Bits + I*BmpWidth;
TmpBitsPtr := BitsPtr;
{$ELSE}
MemStream.Position := I*BmpWidth ;
ActPos := MemStream.Position;
TmpPos := ActPos;
{$ENDIF}
for k:=0 to Width-1 do
begin
{$IFNDEF WINDOWS}
(TmpBitsPtr)^ := (BitsPtr)^;
(TmpBitsPtr+1)^ := (BitsPtr+1)^;
(TmpBitsPtr+2)^ := (BitsPtr+2)^;
TmpBitsPtr := TmpBitsPtr + 3;
BitsPtr := BitsPtr + 4;
{$ELSE}
MemStream.Seek ( ActPos, soFromBeginning ) ;
MemStream.Read ( RGBArr, SizeOf(RGBArr) ) ;
MemStream.Seek ( TmpPos, soFromBeginning ) ;
MemStream.Write( RGBArr, SizeOf(RGBArr) ) ;
TmpPos := TmpPos + 3;
ActPos := ActPos + 4;
{$ENDIF}
end;
end;
end;
{ Write Image Data }
if Height < 0 then
begin
BmpWidth := Trunc(BitsSize / Height);
for I:=0 to Height-1 do
begin
{$IFNDEF WINDOWS}
BitsPtr := Bits + I*BmpWidth;
Stream.Write ( BitsPtr^, Width*3 ) ;
{$ELSE}
MemStream.Position := I*BmpWidth ;
Stream.CopyFrom ( MemStream, Width*3 ) ;
{$ENDIF}
end;
end
else
begin
{ Write Image Data and Flip Image horizontally }
BmpWidth := Trunc(BitsSize / Height);
for I:=1 to Height do
begin
{$IFNDEF WINDOWS}
BitsPtr := Bits + (Height-I)*BmpWidth;
Stream.Write ( BitsPtr^, Width*3 );
{$ELSE}
MemStream.Position := (Height-I)*BmpWidth;
Stream.CopyFrom ( MemStream, Width*3 ) ;
{$ENDIF}
end;
end;
{ Set Offset - Adresses into Directory }
DirectoryRGB[ 3]._Value := OffsetBitsPerSample; { BitsPerSample }
DirectoryRGB[ 6]._Value := OffsetStrip; { StripOffset }
DirectoryRGB[10]._Value := OffsetXRes; { X-Resolution }
DirectoryRGB[11]._Value := OffsetYRes; { Y-Resolution }
DirectoryRGB[14]._Value := OffsetSoftware; { Software }
{ Write Directory }
OffsetDir := Stream.Position ;
Stream.Write ( NoOfDirs, sizeof(NoOfDirs));
Stream.Write ( DirectoryRGB, sizeof(DirectoryRGB));
Stream.Write ( NullString, sizeof(NullString));
{ Update Start of Directory }
Stream.Seek ( 4, soFromBeginning ) ;
Stream.Write ( OffsetDir, sizeof(OffsetDir));
end;
end;
finally
{$IFDEF WINDOWS}
GlobalUnlock ( MemHandle ) ;
GlobalFree ( MemHandle ) ;
MemStream.Free ;
{$ELSE}
FreeMem(Header);
{$ENDIF}
end;
Except
Result := False;
End;
end;
//***END TIFF ROUTINES BY Wolfgang Krug ****************************************
//Unit Description UnitIndex Master Index
Function GifToTiff(Gif: TGifImage;Stream: TStream): Boolean; Overload;
Var
Bitmap : TBitmap;
Begin
Result := False;
If Gif = nil Then Exit;
Try
Bitmap := TBitmap.Create();
Try
Result := GifToBitmap(Gif,Bitmap);
If Result Then Result := BitmapToTiff(Bitmap,Stream);
Finally
Bitmap.Free;
End;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function GifToTiff(Gif: TGifImage;TiffFile: String): Boolean; Overload;
Var
Stream : TFileStream;
Begin
Result := False;
If Gif = nil Then Exit;
Try
Stream := TFileStream.Create(TiffFile,fmCreate);
Try
If FileExists(TiffFile) Then DeleteFile(TiffFile);
Result := GifToTiff(Gif,Stream);
Finally
Stream.Free;
End;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function GifToTiff(GifFile,TiffFile: String): Boolean; Overload;
Var
Gif : TGifImage;
Begin
Result := False;
If Not FileExists(GifFile) Then Exit;
Try
Gif := TGifImage.Create();
Try
Gif.LoadFromFile(GifFile);
Result := GifToTiff(Gif,TiffFile);
Finally
Gif.Free;
End;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function GifToTiff(GifFile,TiffFile: String; DeleteSource: Boolean): Boolean; Overload;
Begin
Try
Result := GifToTiff(GifFile,TiffFile);
If Result Then If DeleteSource Then DeleteFile(GifFile);
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function GifToTiff(GifFile: String; DeleteSource: Boolean): Boolean; Overload;
Begin
Try
Result := GifToTiff(GifFile,ChangeFileExt(GifFile,'.tif'));
If Result Then If DeleteSource Then DeleteFile(GifFile);
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function GifToTiff(GifFile: String): Boolean; Overload;
Begin
Try
Result := GifToTiff(GifFile,True);
Except
Result := False;
End;
End;
//*****************************************************************************
//Unit Description UnitIndex Master Index
Function JpegToTiff(Jpeg: TJpegImage;Stream: TStream): Boolean; Overload;
Var
Bitmap : TBitmap;
Begin
Result := False;
If Jpeg = nil Then Exit;
Try
Bitmap := TBitmap.Create();
Try
Result := JpegToBitmap(Jpeg,Bitmap);
If Result Then Result := BitmapToTiff(Bitmap,Stream);
Finally
Bitmap.Free;
End;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function JpegToTiff(Jpeg: TJpegImage;TiffFile: String): Boolean; Overload;
Var
Stream : TFileStream;
Begin
Result := False;
If Jpeg = nil Then Exit;
Try
Stream := TFileStream.Create(TiffFile,fmCreate);
Try
If FileExists(TiffFile) Then DeleteFile(TiffFile);
Result := JpegToTiff(Jpeg,Stream);
Finally
Stream.Free;
End;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function JpegToTiff(JpegFile,TiffFile: String): Boolean; Overload;
Var
Jpeg : TJpegImage;
Begin
Result := False;
If Not FileExists(JpegFile) Then Exit;
Try
Jpeg := TJpegImage.Create();
Try
Jpeg.LoadFromFile(JpegFile);
Result := JpegToTiff(Jpeg,TiffFile);
Finally
Jpeg.Free;
End;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function JpegToTiff(JpegFile,TiffFile: String; DeleteSource: Boolean): Boolean; Overload;
Begin
Try
Result := JpegToTiff(JpegFile,TiffFile);
If Result Then If DeleteSource Then DeleteFile(JpegFile);
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function JpegToTiff(JpegFile: String; DeleteSource: Boolean): Boolean; Overload;
Begin
Try
Result := JpegToTiff(JpegFile,ChangeFileExt(JpegFile,'.tif'));
If Result Then If DeleteSource Then DeleteFile(JpegFile);
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function JpegToTiff(JpegFile: String): Boolean; Overload;
Begin
Try
Result := JpegToTiff(JpegFile,True);
Except
Result := False;
End;
End;
//*****************************************************************************
//Unit Description UnitIndex Master Index
Function BitmapToPng(Bitmap: TBitmap;Stream: TStream): Boolean; Overload;
Var
Png : TPngImage;
Begin
Result := False;
If Bitmap = nil Then Exit;
If Bitmap.Handle = 0 Then Exit;
Try
Png := TPngImage.Create();
Try
Png.Assign(Bitmap);
Png.SaveToStream(Stream);
Result := True;
Finally
Png.Free;
End;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function BitmapToPng(Bitmap: TBitmap;PngFile: String): Boolean; Overload;
Var
Stream : TFileStream;
Begin
Result := False;
If Bitmap = nil Then Exit;
If Bitmap.Handle = 0 Then Exit;
Try
Stream := TFileStream.Create(PngFile,fmCreate);
Try
If FileExists(PngFile) Then DeleteFile(PngFile);
Result := BitmapToPng(Bitmap,Stream);
Finally
Stream.Free;
End;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function BitmapToPng(BitmapFile,PngFile: String): Boolean; Overload;
Var
Bitmap : TBitmap;
Begin
Result := False;
If Not FileExists(BitmapFile) Then Exit;
Try
Bitmap := TBitmap.Create();
Try
Bitmap.LoadFromFile(BitmapFile);
Result := BitmapToPng(Bitmap,PngFile);
Finally
Bitmap.Free;
End;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function BitmapToPng(BitmapFile,PngFile: String; DeleteSource: Boolean): Boolean; Overload;
Begin
Try
Result := BitmapToPng(BitmapFile,PngFile);
If Result Then If DeleteSource Then DeleteFile(BitmapFile);
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function BitmapToPng(BitmapFile: String): Boolean; Overload;
Begin
Try
Result := BitmapToPng(BitmapFile,True);
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function BitmapToPng(BitmapFile: String; DeleteSource: Boolean): Boolean; Overload;
Begin
Try
Result := BitmapToPng(BitmapFile,ChangeFileExt(BitmapFile,'.png'));
If Result Then If DeleteSource Then DeleteFile(BitmapFile);
Except
Result := False;
End;
End;
//*****************************************************************************
//Unit Description UnitIndex Master Index
Function PngToBitmap(Png: TPngImage;Stream: TStream): Boolean; Overload;
Var
Bitmap : TBitmap;
Begin
Result := False;
If Png = nil Then Exit;
Try
Bitmap := TBitmap.Create();
Try
Bitmap.Assign(Png);
Bitmap.SaveToStream(Stream);
Result := True;
Finally
Bitmap.Free;
End;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function PngToBitmap(Png: TPngImage;BitmapFile: String): Boolean; Overload;
Var
Stream : TFileStream;
Begin
Result := False;
If Png = nil Then Exit;
Try
Stream := TFileStream.Create(BitmapFile,fmCreate);
Try
If FileExists(BitmapFile) Then DeleteFile(BitmapFile);
Result := PngToBitmap(Png,Stream);
Finally
Stream.Free;
End;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function PngToBitmap(PngFile,BitmapFile: String): Boolean; Overload;
Var
Png : TPngImage;
Begin
Result := False;
If Not FileExists(PngFile) Then Exit;
Try
Png := TPngImage.Create();
Try
Png.LoadFromFile(PngFile);
Result := PngToBitmap(Png,BitmapFile);
Finally
Png.Free;
End;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function PngToBitmap(PngFile,BitmapFile: String; DeleteSource: Boolean): Boolean; Overload;
Begin
Try
Result := PngToBitmap(PngFile,BitmapFile);
If Result Then If DeleteSource Then DeleteFile(PngFile);
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function PngToBitmap(PngFile: String): Boolean; Overload;
Begin
Try
Result := PngToBitmap(PngFile,True);
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function PngToBitmap(PngFile: String; DeleteSource: Boolean): Boolean; Overload;
Begin
Try
Result := PngToBitmap(PngFile,ChangeFileExt(PngFile,'.Bitmap'));
If Result Then If DeleteSource Then DeleteFile(PngFile);
Except
Result := False;
End;
End;
end.
//
//