From 5f2f4a8cbb2d5c827e16edb8782953a125ee24d8 Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Thu, 5 Mar 2009 16:22:57 +0000 Subject: [PATCH] Adds initial support to read xwd image format git-svn-id: trunk@12859 - --- .gitattributes | 2 + packages/fcl-image/Makefile.fpc | 2 +- packages/fcl-image/examples/Makefile.fpc | 2 +- packages/fcl-image/examples/xwdtobmp.pas | 64 +++++ packages/fcl-image/src/fpreadxwd.pas | 297 +++++++++++++++++++++++ packages/fcl-image/src/xwdfile.pp | 2 + 6 files changed, 367 insertions(+), 2 deletions(-) create mode 100644 packages/fcl-image/examples/xwdtobmp.pas create mode 100644 packages/fcl-image/src/fpreadxwd.pas diff --git a/.gitattributes b/.gitattributes index a645df0786..ed4189fdfa 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1397,6 +1397,7 @@ packages/fcl-image/examples/Makefile svneol=native#text/plain packages/fcl-image/examples/Makefile.fpc svneol=native#text/plain packages/fcl-image/examples/drawing.pp svneol=native#text/plain packages/fcl-image/examples/imgconv.pp svneol=native#text/plain +packages/fcl-image/examples/xwdtobmp.pas svneol=native#text/plain packages/fcl-image/fpmake.pp svneol=native#text/plain packages/fcl-image/src/bmpcomn.pp svneol=native#text/plain packages/fcl-image/src/clipping.pp svneol=native#text/plain @@ -1432,6 +1433,7 @@ packages/fcl-image/src/fpreadpsd.pas svneol=native#text/plain packages/fcl-image/src/fpreadtga.pp svneol=native#text/plain packages/fcl-image/src/fpreadtiff.pas svneol=native#text/plain packages/fcl-image/src/fpreadxpm.pp svneol=native#text/plain +packages/fcl-image/src/fpreadxwd.pas svneol=native#text/plain packages/fcl-image/src/fptiffcmn.pas svneol=native#text/plain packages/fcl-image/src/fpwritebmp.pp svneol=native#text/plain packages/fcl-image/src/fpwritejpeg.pas svneol=native#text/plain diff --git a/packages/fcl-image/Makefile.fpc b/packages/fcl-image/Makefile.fpc index a6caab69e7..3d400aa6f0 100644 --- a/packages/fcl-image/Makefile.fpc +++ b/packages/fcl-image/Makefile.fpc @@ -12,7 +12,7 @@ units=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm \ fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg \ pcxcomn fpreadpcx fpwritepcx fptiffcmn fpreadtiff fpwritetiff \ targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer \ - extinterpolation fpreadgif fpreadpsd + extinterpolation fpreadgif fpreadpsd xwdfile fpreadxwd units_win32=freetypeh freetype ftfont units_linux=freetypeh freetype ftfont units_freebsd=freetypeh freetype ftfont diff --git a/packages/fcl-image/examples/Makefile.fpc b/packages/fcl-image/examples/Makefile.fpc index 2a741e960d..3a6ad2d8fe 100644 --- a/packages/fcl-image/examples/Makefile.fpc +++ b/packages/fcl-image/examples/Makefile.fpc @@ -3,7 +3,7 @@ # [target] -programs=imgconv drawing +programs=imgconv drawing xwdtobmp [require] packages=fcl-image diff --git a/packages/fcl-image/examples/xwdtobmp.pas b/packages/fcl-image/examples/xwdtobmp.pas new file mode 100644 index 0000000000..832a3b27cc --- /dev/null +++ b/packages/fcl-image/examples/xwdtobmp.pas @@ -0,0 +1,64 @@ +{ + Converts a xwd image to a bpm image + + Usage: xwdtobmp [source] [dest] + + Author: Felipe Monteiro de Carvalho + + License: Public domain +} +program xwdtobmp; + +{$ifdef fpc} + {$mode objfpc}{$H+} +{$endif} + +{$ifndef fpc} + {$define win32} +{$endif} + + +{$ifdef win32} + {$apptype console} +{$endif} + +uses FPWriteBMP, FPReadXWD, classes, FPImage, sysutils; + +var + img : TFPMemoryImage; + reader : TFPCustomImageReader; + Writer : TFPCustomimageWriter; + ReadFile, WriteFile, WriteOptions : string; +begin + if ParamCount <> 2 then + begin + WriteLn('Usage: xwdtobmp [source] [dest]'); + Exit; + end; + + try + writeln ('Initing'); + Reader := TFPReaderXWD.Create; + Writer := TFPWriterBMP.Create; + TFPWriterBMP(Writer).BitsPerPixel:=32; + img := TFPMemoryImage.Create(0,0); + img.UsePalette:=false; + ReadFile := ParamStr(1); + WriteFile := ParamStr(2); + + writeln ('Reading image'); + img.LoadFromFile (ReadFile, Reader); + + writeln ('Writing image'); + img.SaveToFile (WriteFile, Writer); + + writeln ('Clean up'); + Reader.Free; + Writer.Free; + Img.Free; + except + on e : exception do + writeln ('Error: ',e.message); + end; +end. + diff --git a/packages/fcl-image/src/fpreadxwd.pas b/packages/fcl-image/src/fpreadxwd.pas new file mode 100644 index 0000000000..d3b03085ff --- /dev/null +++ b/packages/fcl-image/src/fpreadxwd.pas @@ -0,0 +1,297 @@ +{*****************************************************************************} +{ + This file is part of the Free Pascal's "Free Components Library". + Copyright (c) 2003 by Mazen NEIFER of the Free Pascal development team + + BMP reader implementation. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} +{*****************************************************************************} +{ 08/2005 by Giulio Bernardi: + - Added support for 16 and 15 bpp bitmaps. + - If we have bpp <= 8 make an indexed image instead of converting it to RGB + - Support for RLE4 and RLE8 decoding + - Support for top-down bitmaps +} + +{$mode objfpc} +{$h+} + +unit FPReadXWD; + +interface + +uses FPImage, classes, sysutils, xwdfile; + +type + TXWDColors = array of TXWDColor; + + { TFPReaderXWD } + + TFPReaderXWD = class (TFPCustomImageReader) + private + continue: boolean; // needed for onprogress event + percent: byte; + percentinterval : longword; + percentacc : longword; + Rect : TRect; + procedure SwapXWDFileHeader(var Header: TXWDFileHeader); + procedure SwapXWDColor(var Color: TXWDColor); + procedure WriteScanLine(Row: Integer; Img: TFPCustomImage); + protected + XWDFileHeader: TXWDFileHeader; // The header, as read from the file + WindowName: array of Char; + XWDColors: TXWDColors; + LineBuf: PByte; // Buffer for 1 line + + // required by TFPCustomImageReader + procedure InternalRead (Stream:TStream; Img:TFPCustomImage); override; + function InternalCheck (Stream:TStream) : boolean; override; + public + constructor Create; override; + destructor Destroy; override; + end; + +implementation + +//============================================================================== +// Endian utils +// +// Copied from LCLProc unit +//============================================================================== +{$R-} +function BEtoN(const AValue: DWord): DWord; +begin + {$IFDEF ENDIAN_BIG} + Result := AValue; + {$ELSE} + Result := (AValue shl 24) + or ((AValue and $0000FF00) shl 8) + or ((AValue and $00FF0000) shr 8) + or (AValue shr 24); + {$ENDIF} +end; +{$R+} + +constructor TFPReaderXWD.create; +begin + inherited create; + +end; + +destructor TFPReaderXWD.Destroy; +begin + If (LineBuf<>Nil) then + begin + FreeMem(LineBuf); + LineBuf:=Nil; + end; + + SetLength(WindowName, 0); + + SetLength(XWDColors, 0); + + inherited destroy; +end; + +procedure TFPReaderXWD.SwapXWDColor(var Color: TXWDColor); +begin + Color.pixel := BEtoN(Color.pixel); + + Color.red := swap(Color.red); + Color.green := swap(Color.green); + Color.blue := swap(Color.blue); +end; + +procedure TFPReaderXWD.SwapXWDFileHeader(var Header: TXWDFileHeader); +begin + Header.header_size := BEtoN(Header.header_size); + Header.file_version := BEtoN(Header.file_version); + Header.pixmap_format := BEtoN(Header.pixmap_format); + Header.pixmap_depth := BEtoN(Header.pixmap_depth); + Header.pixmap_width := BEtoN(Header.pixmap_width); + Header.pixmap_height := BEtoN(Header.pixmap_height); + Header.xoffset := BEtoN(Header.xoffset); + Header.byte_order := BEtoN(Header.byte_order); + Header.bitmap_unit := BEtoN(Header.bitmap_unit); + Header.bitmap_unit := BEtoN(Header.bitmap_bit_order); + Header.bitmap_pad := BEtoN(Header.bitmap_pad); + Header.bits_per_pixel := BEtoN(Header.bits_per_pixel); + Header.bytes_per_line := BEtoN(Header.bytes_per_line); + Header.visual_class := BEtoN(Header.visual_class); + Header.red_mask := BEtoN(Header.red_mask); + Header.green_mask := BEtoN(Header.green_mask); + Header.blue_mask := BEtoN(Header.blue_mask); + Header.bits_per_rgb := BEtoN(Header.bits_per_rgb); + Header.colormap_entries := BEtoN(Header.colormap_entries); + Header.ncolors := BEtoN(Header.ncolors); + Header.window_width := BEtoN(Header.window_width); + Header.window_height := BEtoN(Header.window_height); + Header.window_x := BEtoN(Header.window_x); + Header.window_y := BEtoN(Header.window_y); + Header.window_bdrwidth := BEtoN(Header.window_bdrwidth); +end; + +procedure TFPReaderXWD.WriteScanLine(Row : Integer; Img : TFPCustomImage); +var + Column: Integer; + buffer: Cardinal; + MyColor: TFPColor; +begin + MyColor.alpha := 0; + + case XWDFileHeader.bits_per_pixel of + 1 : + for Column:=0 to Img.Width-1 do + if ((LineBuf[Column div 8] shr (7-(Column and 7)) ) and 1) <> 0 then + img.Pixels[Column,Row]:=1 + else + img.Pixels[Column,Row]:=0; + 4 : + for Column:=0 to img.Width-1 do + img.Pixels[Column,Row]:=(LineBuf[Column div 2] shr (((Column+1) and 1)*4)) and $0f; + 8 : + for Column:=0 to img.Width-1 do + img.Pixels[Column,Row]:=LineBuf[Column]; + 16 : + for Column:=0 to img.Width-1 do + img.Pixels[Column,Row]:=LineBuf[Column]; + 24 : + for Column:=0 to img.Width-1 do + img.Pixels[Column,Row]:=LineBuf[Column]; + 32 : + for Column:=0 to img.Width-1 do + begin + Move(LineBuf[Column * 4], buffer, 4); +// WriteLn(IntToHex(buffer, 8)); + +{ buffer := buffer mod (256 * 256 * 256); + MyColor.red := Word((buffer div 256 * 256) * 256); + buffer := buffer mod (256 * 256); + MyColor.green := Word((buffer div 256) * 256); + buffer := buffer mod 256; + MyColor.blue := Word((buffer) * 256);} + + buffer := buffer mod (256 * 256 * 256); + MyColor.blue := Word((buffer div 256 * 256) * 256); + buffer := buffer mod (256 * 256); + MyColor.green := Word((buffer div 256) * 256); + buffer := buffer mod 256; + MyColor.red := Word((buffer) * 256); + + img.Colors[Column,Row] := MyColor; + end; + end; + +{ inc(percentacc,4); + if percentacc>=percentinterval then + begin + percent:=percent+(percentacc div percentinterval); + percentacc:=percentacc mod percentinterval; + Progress(psRunning,percent,false,Rect,'',continue); + end;} +end; + +procedure TFPReaderXWD.InternalRead(Stream: TStream; Img: TFPCustomImage); +var + Color: TFPColor; + Size, Row, i, Index: Integer; +begin + {**************************************************************************** + Initialization + ****************************************************************************} + Rect.Left:=0; Rect.Top:=0; Rect.Right:=0; Rect.Bottom:=0; + continue:=true; + Progress(psStarting,0,false,Rect,'',continue); + if not continue then exit; + + Img.UsePalette := True; +// Img.Palette.Clear; + Color.alpha := 0; + + {**************************************************************************** + The file is on big-endian format, so it needs to be swaped on little-endian CPUs + ****************************************************************************} + Stream.Position := 0; //* Causes error if removed, but should be + + Stream.Read(XWDFileHeader, SizeOf(TXWDFileHeader)); + +{$ifdef ENDIAN_LITTLE} + SwapXWDFileHeader(XWDFileHeader); +{$endif} + + {**************************************************************************** + Now reads the window name + ****************************************************************************} + Size := XWDFileHeader.header_size - SizeOf(TXWDFileHeader); + + // Avoids allocating too much space for the string + if Size > 256 then raise Exception.Create('Window name string too big. The file might be corrupted.'); + + SetLength(WindowName, Size); + + Stream.Read(WindowName[0], Size); + + {**************************************************************************** + Fills the palette + ****************************************************************************} + SetLength(XWDColors, XWDFileHeader.ncolors); + + Img.Palette.Count := 256; + + for i := 1 to XWDFileHeader.ncolors do + begin + Stream.Read(XWDColors[i - 1], SizeOf(TXWDColor)); + + {$ifdef ENDIAN_LITTLE} + SwapXWDColor(XWDColors[i - 1]); + {$endif} + + Color.red := XWDColors[i - 1].red; + Color.green := XWDColors[i - 1].green; + Color.blue := XWDColors[i - 1].blue; + + Index := XWDColors[i - 1].pixel mod 256; +// WriteLn(IntToHex(Index, 8)); + Img.Palette.Color[Index] := Color; + end; + + {**************************************************************************** + Reads the matrix of colors + ****************************************************************************} + Img.SetSize(XWDFileHeader.pixmap_width, XWDFileHeader.pixmap_height); + + GetMem(LineBuf, XWDFileHeader.bytes_per_line); + + for Row := 0 to Img.Height - 1 do + begin + Stream.Read(LineBuf[0], XWDFileHeader.bytes_per_line); + WriteScanLine(Row, Img); + if not continue then exit; + end; + + Progress(psEnding,100,false,Rect,'',continue); +end; + +function TFPReaderXWD.InternalCheck (Stream:TStream): boolean; +var + Header: TXWDFileHeader; +begin + stream.Read(Header, SizeOf(Header)); + {$IFDEF ENDIAN_LITTLE} + SwapXWDFileHeader(Header); + {$ENDIF} + Result := Header.file_version = XWD_FILE_VERSION; // Just check magic number +end; + +initialization + + ImageHandlers.RegisterImageReader ('XWD Format', 'xwd', TFPReaderXWD); + +end. diff --git a/packages/fcl-image/src/xwdfile.pp b/packages/fcl-image/src/xwdfile.pp index 649f0c3bfc..471921aacd 100644 --- a/packages/fcl-image/src/xwdfile.pp +++ b/packages/fcl-image/src/xwdfile.pp @@ -3,6 +3,8 @@ The original headers are part of the X11 headers located at: /usr/X11R6/include/X11/XWDFile.h + or + Mandriva 2006: /usr/include/X11/XWDFile.h But the file was added to fcl-image so that xwd files can be read in any system.