كيف يتم تحويل الصورة من jpg إلى bmp
أو إلى أي لاحقة أخرى كالـ (Gif )
وشكراً لكم مقدماً .
كيف يتم تحويل الصور من لاحقة إلى أخرى:
مغلق
السلام عليكم
اخي العزيز
هدا كود لتحويل من bmp الى jpg
uses Jpeg;
procedure TForm1.Button1Click(Sender: TObject);
var
bmp : Tbitmap;
jpg : TJpegImage;
begin
bmp := Tbitmap.Create;
jpg := TJpegImage.Create;
bmp.LoadFromFile ( 'c:1.bmp' );
jpg.Assign( bmp );
jpg.SaveToFile ( 'c:1.jpg' );
jpg.Free;
bmp.Free;
end;
شكرأ لك أخي العزيز على سرعة ردّك علي ولكن هل يمكن جعلها بالعكس أي من jpg إلى bmp
السلام عليكم
جرب الكود الموجود هنا
http://homepages.borland.com/efg2lab/Graph...hics/BMPJPG.htm
http://perso.wanadoo.fr/joel.joly/bmpversjpg.html
يمكن الحصول على نتائج اخرى هنا
http://www.google.com/search?hl=en&lr=&ie=...vert+jpg+to+bmp
(f)
CIONO1
هناك حتى الأحلام أصبحت ممنوعة ...
إنه لعار أن ننتمي لهكذا أوطان ... لكن ... ربما العار أن نكون نحن أبناء لتلكم أوطان .. من يدري ؟!!
ليعلم أولئك ... إنّ الشعوب إنْ هي استيقظت تسحق ظُلامََهَا ...
There, even in dreams u r wanted
To be a programmer, how a nice dream it was
Leaving ...
أعيدوا لإسمي لونه المفضل
السلام عليكم
سوف تجد في هذين الموقعين طرق تحويل jpg الى bmp والعكس مع تحديد نسبة الضغط وعدد الالوان المستخدمة
http://www.dev4arabs.com/ar/delphi/resours...p?s=2&id=12&k=2
http://www.dev4arabs.com/ar/delphi/resours...p?s=2&id=40&k=2
مع تحياتي
والسلام
لا تحزن:
إن كنت فقيرا فغيرك محبوس في دين، وإن كنت لا تملك وسيلة نقل فسواك مبتور القدمين، وان كنت تشكوا من آلام فغيرك يرقدون على الاسرة البيضاء و من سنوات، وان فقدت ولدا فغيرك فقد عددا من الأولاد و في حادث واحد.
لا تحزن:
فأنت تشرب الماء الزلال، و تستنشق الهواء الطلق، و تمشي على قدميك معافى، و تنام ليلك آمنا.
اخي العزيز فادي
بالنسبة لعملية التحويل بين نوعيات الصور
فاليك هذه الأكواد للتحويل بين اهم نوعيات الصور
اولاً التحويل من BMP الى Jpeg
Uses
JPEG;
procedure TForm1.BitBtn1Click(Sender: TObject);
var Bitmap: TBitmap;
JpegImg: TJpegImage;
begin
Bitmap := TBitmap.Create;
try
Bitmap.LoadFromFile('c:bmppic.bmp');
JpegImg := TJpegImage.Create;
try
JpegImg.Assign(Bitmap);
JpegImg.SaveToFile('c:jpgpic.jpg');
finally
JpegImg.Free
end;
finally
Bitmap.Free
end;
end;ثانياً التحويل من BMP الى TIFF
unit Bmp2Tiff;
interface
uses WinProcs, WinTypes, Classes, Graphics, ExtCtrls;
type
PDirEntry = ^TDirEntry;
TDirEntry = record
_Tag : Word;
_Type : Word;
_Count : LongInt;
_Value : LongInt;
end;
procedure WriteTiffToStream ( Stream : TStream; Bitmap : TBitmap );
procedure WriteTiffToFile ( Filename : string; Bitmap : TBitmap );
{$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 );
implementation
procedure WriteTiffToStream ( Stream : TStream ; Bitmap : TBitmap ) ;
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
BM := Bitmap.Handle;
if BM = 0 then exit;
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 [1] := PBITMAPINFO(Header)^.bmiColors.rgbRed;
ColorMapRed [0] := 0;
ColorMapGreen[1] := PBITMAPINFO(Header)^.bmiColors.rgbGreen;
ColorMapGreen[0] := 0;
ColorMapBlue [1] := PBITMAPINFO(Header)^.bmiColors.rgbBlue;
ColorMapBlue [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;
end;
(*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
procedure WriteTiffToFile ( Filename : string; Bitmap : TBitmap );
VAR Stream : TFileStream ;
BEGIN
Stream := TFileStream.Create ( FileName, fmCreate ) ;
TRY
WriteTiffToStream ( Stream, Bitmap ) ;
FINALLY
Stream.Free ;
END ;
END ;
end.
//-----------------
//Sample call in you program
Uses
bmp2Tiff;
.....
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
Image1.Picture.LoadFromFile(OpenDialog1.FileName);
// Save Image as TIFF in the same path with extension '.TIF'
WriteTiffToFile( ChangeFileExt(OpenDialog1.FileName, '.TIF'),
Image1.Picture.Bitmap );
end;
ثالثا التحويل من Jpeg الى BMP
uses JPEG;
Function Jpeg2Bitmap(JPEGFile : String) : TBitmap;
var
oJPEG : TJPEGImage;
aFormat : Word;
aData : THandle;
aPalette : HPALETTE;
begin
oJPEG := TJPEGImage.Create ;
oJPEG.LoadFromFile(JPEGFile);
oJPEG.SaveToClipboardFormat(aFormat,aData,aPalette);
oJPEG.Free;
Result := TBitmap.Create;
Result.LoadFromClipboardFormat(aFormat,aData,aPalette);
end;
//Sample call:
//.........................
var
oBitmap: TBitmap;
begin
//read the JPEG file and convert it to TBitmap class
oBitmap := Jpeg2Bitmap('c:WindowsParadise.jpg');
//save the TBitmap to a bitmap file.
oBitmap.SaveToFile('c:WindowsParadise.bmp');
//.........................
end;
رابعاً التحويل من WMF الى JPEG
procedure TForm1.Button1Click(Sender: TObject);
var Pic: TPicture;
JpegImg: TJpegImage;
Img : TImage;
begin
Pic := TPicture.Create;
Img := TImage.Create(self);
try
Pic.LoadFromFile('c:wmfpic.wmf');
JpegImg := TJpegImage.Create;
try
Img.Height := Pic.Height;
Img.Width := Pic.Width;
Img.Canvas.Draw(0,0,Pic.Graphic );
JpegImg.Assign(Img.picture.Bitmap );
JpegImg.SaveToFile('c:jpgpic.jpg');
finally
JpegImg.Free
end;
finally
Pic.Free;
Img.Free;
end;
end;
خامساً التحويل من TIF الى PDF
function TifToPDF(TIFFilename, PDFFilename: string): boolean;
var
AcroApp : variant;
AVDoc : variant;
PDDoc : variant;
IsSuccess : Boolean;
begin
result := false;
if not fileexists(TIFFilename) then exit;
try
AcroApp := CreateOleObject('AcroExch.App');
AVDoc := CreateOleObject('AcroExch.AVDoc');
AVDoc.Open(TIFFilename, '');
AVDoc := AcroApp.GetActiveDoc;
if AVDoc.IsValid then
begin
PDDoc := AVDoc.GetPDDoc;
PDDoc.SetInfo ('Title', '');
PDDoc.SetInfo ('Author', '');
PDDoc.SetInfo ('Subject', '');
PDDoc.SetInfo ('Keywords', '');
result := PDDoc.Save(1 or 4 or 32, PDFFilename);
PDDoc.Close;
end;
AVDoc.Close(True);
AcroApp.Exit;
finally
VarClear(PDDoc);
VarClear(AVDoc);
VarClear(AcroApp);
end;
end;
وتقبل اطيب تحياتي اخوك SUM
هذا الموضوع مغلق.