diff options
author | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2007-07-23 08:54:39 +0000 |
---|---|---|
committer | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2007-07-23 08:54:39 +0000 |
commit | 1e00430227e56fd2691f8374418f352c171039b1 (patch) | |
tree | 0451194af432a8b80270defb403bb100f1e95d90 /src/corelib/gfx_imgfmt_bmp.pas | |
parent | 2ecc101eb1573c272d570289987807c44937631b (diff) | |
download | fpGUI-1e00430227e56fd2691f8374418f352c171039b1.tar.xz |
The first part of removing the obsolete fpGUI and replacing it with the new multi-handle design from the prototypes directory.
Diffstat (limited to 'src/corelib/gfx_imgfmt_bmp.pas')
-rw-r--r-- | src/corelib/gfx_imgfmt_bmp.pas | 313 |
1 files changed, 313 insertions, 0 deletions
diff --git a/src/corelib/gfx_imgfmt_bmp.pas b/src/corelib/gfx_imgfmt_bmp.pas new file mode 100644 index 00000000..3748d5c7 --- /dev/null +++ b/src/corelib/gfx_imgfmt_bmp.pas @@ -0,0 +1,313 @@ +{ + BMP format image parser +} + +unit gfx_imgfmt_bmp; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, + SysUtils, + fpgfx, + gfxbase, fpcanvas; + +procedure ReadImage_BMP(img: TfpgImage; bmp: Pointer; bmpsize: longword); +function LoadImage_BMP(const AFileName: string): TfpgImage; +function CreateImage_BMP(bmp: Pointer; bmpsize: longword): TfpgImage; + +implementation + +function CreateImage_BMP(bmp: Pointer; bmpsize: longword): TfpgImage; +begin + Result := TfpgImage.Create; + ReadImage_BMP(Result, bmp, bmpsize); +end; + +function LoadImage_BMP(const AFileName: string): TfpgImage; +var + AFile: file of char; + AImageData: Pointer; + AImageDataSize: longint; +begin + Result := nil; + if not FileExists(AFileName) then + Exit; //==> + + AssignFile(AFile, AFileName); + FileMode := fmOpenRead; // read-only + Reset(AFile); + AImageDataSize := FileSize(AFile); + GetMem(AImageData, AImageDataSize); + try + BlockRead(AFile, AImageData^, AImageDataSize); + Result := TfpgImage.Create; + ReadImage_BMP(Result, AImageData, AImageDataSize); + finally + CloseFile(AFile); + FreeMem(AImageData); + end; +end; + + +type + // Windows BMP format description: + // Below is the exact order how how information is stored in a BMP file. + + TBMPHeaderRec = packed record + signature: word; + filesize: longword; + reserved: longword; + dataoffset: longword; + end; + PBMPHeaderRec = ^TBMPHeaderRec; + + TBMPInfoHeaderRec = packed record + headersize: longword; // = 40 + Width: longword; + Height: longword; + planes: word; + bitcount: word; + compression: longword; + imagesize: longword; // bytes in the image data (after the color table) + XpixelsPerM: longword; + YpixelsPerM: longword; + ColorsUsed: longword; + ColorsImportant: longword; + end; + PBMPInfoHeaderRec = ^TBMPInfoHeaderRec; + + // Then follows the Color Table if bitcount <= 8 + + TBMPColorTableRec = packed record + red: byte; + green: byte; + blue: byte; + reserved: byte; + end; + + // Then follows the image data + // Every line padded to 32 bits + // The lines stored bottom-up + +type + PByte = ^byte; + Pword = ^word; + Plongword = ^longword; + +procedure ReadImage_BMP(img: TfpgImage; bmp: Pointer; bmpsize: longword); +var + bh: PBMPHeaderRec; + ih: PBMPInfoHeaderRec; + p: PByte; + ppal: plongword; + pcol: Plongword; + palsize: integer; + pdata: PByte; + b: byte; + bit: byte; + bcnt: byte; + linecnt: longword; + pixelcnt: longword; + pdest: Plongword; + depth: integer; + + function GetPalColor(cindex: longword): longword; + var + pc: Plongword; + begin + pc := ppal; + Inc(pc, cindex); + Result := pc^; + end; + +begin + if img = nil then + Exit; //==> + + img.FreeImage; + + p := bmp; + PByte(bh) := p; + ppal := nil; + if bh^.filesize <> bmpsize then + Exit; //==> + + pdata := bmp; + Inc(pdata, bh^.dataoffset); + Inc(p, SizeOf(TBMPHeaderRec)); + PByte(ih) := p; + depth := ih^.bitcount; + + if depth > 1 then + img.AllocateImage(32, ih^.Width, ih^.Height)// color image + else + begin + img.AllocateImage(1, ih^.Width, ih^.Height); + img.AllocateMask; + end; + + //Writeln('width: ',img.width,' height: ',img.height,' depth: ',depth); + //Writeln('compression: ',ih^.compression); + + Inc(p, SizeOf(TBMPInfoHeaderRec)); + + if ih^.bitcount <= 8 then + begin + // reading color palette + case ih^.bitcount of + 1: palsize := 2; + 4: palsize := 16; + else + palsize := 256; + end; + + GetMem(ppal, palsize * SizeOf(longword)); + + pcol := ppal; + pixelcnt := 0; + while integer(p) < integer(pdata) do + begin + pcol^ := Plongword(p)^; + //Writeln('color: ',HexStr(pcol^,8)); + Inc(pcol); + Inc(Plongword(p)); + Inc(pixelcnt); + end; + //writeln(pixelcnt,' colors loaded.'); + end; + + pdest := img.ImageData; + Inc(pdest, img.Width * (img.Height - 1)); // bottom-up line order + p := bmp; + Inc(p, bh^.dataoffset); + + // reading the data... + case ih^.bitcount of + 1: + begin + // direct line transfer + //writeln('reading 1-bit color bitmap'); + linecnt := 0; + bcnt := img.Width div 32; + if (img.Width and $1F) > 0 then + Inc(bcnt); + + pdest := img.ImageData; + Inc(pdest, bcnt * (img.Height - 1)); // bottom-up line order + repeat + move(p^, pdest^, bcnt * 4); + Inc(p, bcnt * 4); + Dec(pdest, bcnt); + Inc(linecnt); + until linecnt >= img.Height; + + //Writeln(linecnt,' lines loaded.'); + move(img.ImageData^, img.MaskData^, img.ImageDataSize); + img.Invert; + end; + + 4: + begin + //writeln('reading 4-bit color'); + linecnt := 0; + repeat + // parse one line.. + bit := 0; + pixelcnt := 0; + bcnt := 0; + repeat + if bit = 0 then + b := (p^ shr 4) and $0F + else + begin + b := p^ and $0F; + Inc(p); + Inc(bcnt); + end; + + pdest^ := GetPalColor(b); + Inc(pdest); + Inc(pixelcnt); + bit := bit xor 1; + until pixelcnt >= img.Width; + + while (bcnt mod 4) <> 0 do + begin + Inc(bcnt); + Inc(p); + end; + + Inc(linecnt); + Dec(pdest, img.Width * 2); // go to next line + until linecnt >= img.Height; + end; + + 8: + begin + //writeln('reading 8-bit color'); + linecnt := 0; + repeat + // parse one line.. + pixelcnt := 0; + repeat + pdest^ := GetPalColor(p^); + Inc(p); + Inc(pdest); + Inc(pixelcnt); + until pixelcnt >= img.Width; + + while (pixelcnt mod 4) <> 0 do + begin + Inc(pixelcnt); + Inc(p); + end; + + Inc(linecnt); + Dec(pdest, img.Width * 2); // go to next line + until linecnt >= img.Height; + end; + + 24: + begin + //writeln('reading truecolor'); + linecnt := 0; + repeat + // parse one line.. + pixelcnt := 0; + repeat + pdest^ := p^; + Inc(p); + pdest^ := pdest^ or (longword(p^) shl 8); + Inc(p); + pdest^ := pdest^ or (longword(p^) shl 16); + Inc(p); + Inc(pdest); + Inc(pixelcnt); + until pixelcnt >= img.Width; + + pixelcnt := img.Width * 3; + while (pixelcnt mod 4) <> 0 do + begin + Inc(pixelcnt); + Inc(p); + end; + + Inc(linecnt); + Dec(pdest, img.Width * 2); // go to next line + until linecnt >= img.Height; + end; + else + writeln('Unsupported BMP format!'); + end; + + if ppal <> nil then + FreeMem(ppal); + + img.UpdateImage; +end; + +end. + |