{read bitmaps what this unit does not do does not read RLE encoded bitmaps does not read OS/2 bitmaps} {http://www.awitness.org/delphi_pascal_tutorial/index.html} unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, ExtDlgs; type TBitmapFileHeader = record bmfIdentifier : Word; {'BM'} bmfFileSize : dWord; bmfReserved : dWord; bmfBitMapDataOffset : dWord; {from begin of file} end; {followed by the bitmapinfoheader} TBitmapInfoHeader = record biSize: Longint; {size of tbitmapinfoheader} biWidth: Longint; {bitmap width} biHeight: Longint; ( height of bitmap) biPlanes: Word; {always 1} biBitCount: Word; {number color bits 4 = 16 colors, 8 = 256 pixel is a byte} biCompression: Longint; {compression used, 0 } biSizeImage: Longint; (size of the pixel data) biXPelsPerMeter: Longint; {not used, 0 } biYPelsPerMeter: Longint; {not used, 0 } biClrUsed: Longint; {number of colors used, set to 0 } biClrImportant: Longint; {important colors, set to 0 } end; {followed by the palette data} TForm1 = class(TForm) Button1: TButton; Image1: TImage; OpenPictureDialog1: TOpenPictureDialog; Memo1: TMemo; Memo2: TMemo; procedure Button1Click(Sender: TObject); Procedure WriteBitMapInfoToMemo; procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; BitmapFileHeader : TBitmapFileHeader; BitmapInfoHeader : TBitmapInfoHeader; RedByte, BlueByte, GreenByte : Byte; AWord : Word; Amt : Integer; {var variable, total bytes returned by blockread} AByte : Byte; ALongint : Longint; AChar : Char; BMPalette : PLogPalette; {logical pallette structure for bitmap} BMhPalette : HPALETTE; palcount : integer; implementation {$R *.DFM} procedure TForm1.Button1Click(Sender: TObject); var f: file; idstr:string[2]; Bitmap : TBitmap; y, i, rowlength : integer; pb : Pointer; begin If OpenPictureDialog1.Execute then begin AssignFile(f, OpenPictureDialog1.FileName); Reset(f, 1); idstr := ''; {a bitmap file starts with the id 'BM'} BlockRead(f, AChar, 1, amt); idstr := Achar; BlockRead(f, Achar, 1, amt); idstr := idstr + Achar; If idstr <> 'BM' then begin MessageDlg('The file is not a valid bitmap', mterror, [mbok],0); CloseFile(f); Exit; end; {read the file header info} BlockRead(f, Alongint, 4, amt); BitmapFileHeader.bmfFileSize := Alongint; BlockRead(f, Alongint, 4, amt); BitmapFileHeader.bmfReserved := Alongint; BlockRead(f, Alongint, 4, amt); BitmapFileHeader.bmfBitMapDataOffset := Alongint; {read the bitmap info header} BlockRead(f, Alongint, 4, amt); BitmapInfoHeader.biSize := Alongint; {size of header itself} BlockRead(f, Alongint, 4, amt); BitmapInfoHeader.biWidth := Alongint; BlockRead(f, Alongint, 4, amt); BitmapInfoHeader.biHeight := Alongint; Blockread(f, AWord, 2, amt); BitmapInfoHeader.biPlanes := Aword; Blockread(f, AWord, 2, amt); BitmapInfoHeader.biBitCount := Aword; {bits per pixel} BlockRead(f, Alongint, 4, amt); BitmapInfoHeader.biCompression := Alongint; BlockRead(f, Alongint, 4, amt); BitmapInfoHeader.biSizeImage := Alongint; BlockRead(f, Alongint, 4, amt); BitmapInfoHeader.biXPelsPerMeter := Alongint; BlockRead(f, Alongint, 4, amt); BitmapInfoHeader.biYPelsPerMeter := Alongint; BlockRead(f, Alongint, 4, amt); BitmapInfoHeader.biClrUsed := Alongint; BlockRead(f, Alongint, 4, amt); BitmapInfoHeader.biClrImportant := Alongint; Bitmap := TBitmap.Create; Bitmap.Width := BitmapInfoHeader.biWidth ; Bitmap.Height := BitmapInfoHeader.biHeight ; case BitMapInfoHeader.biBitCount of 1 : Bitmap.PixelFormat := pf1bit; 4 : Bitmap.PixelFormat := pf4bit; 8 : Bitmap.PixelFormat := pf8bit; 15 : Bitmap.PixelFormat := pf15bit; 16 : Bitmap.PixelFormat := pf16bit; 24 : Bitmap.PixelFormat := pf24bit; 32 : Bitmap.PixelFormat := pf32bit; { : XORBitmap.PixelFormat := pfCustom;} end; {get the color palette} If BitmapInfoHeader.biClrUsed <= 256 then begin palcount := BitmapInfoHeader.biClrUsed ; GetMem(BMPalette, sizeof(TLogPalette) + sizeof(TPaletteEntry) * palcount); BMPalette.palVersion := $300; BMPalette.palNumEntries := palcount; {reading in a RGB table red first results in a backwards colored bitmap and so this code reads in the blue first} for i := 0 to palcount - 1 do begin BlockRead(f, BlueByte, 1, Amt); BlockRead(f, GreenByte, 1, Amt); BlockRead(f, RedByte, 1, Amt); BlockRead(f, AByte, 1, Amt); {The flag byte} BMPalette.palPalEntry[i].peBlue := BlueByte; BMPalette.palPalEntry[i].peGreen := GreenByte; BMPalette.palPalEntry[i].peRed := RedByte; BMPalette.palPalEntry[i].peFlags := Abyte; end; BMhPalette := CreatePalette(BMPalette^); If (BMhPalette <> 0) and (BitMapInfoHeader.biBitCount <= 8) then Bitmap.Palette := BMhPalette; end; {if color count <= 256} {get the pixel data of the bitmap} Rowlength := (BitmapInfoHeader.biWidth * BitmapInfoHeader.biBitCount) div 8; {pixel data is stored upside down, so fill bitmap from bottom up} for y := BitmapInfoHeader.biHeight - 1 downto 0 do begin pb := BitMap.ScanLine[y]; {get ^ address of first byte on row} BlockRead(f, pb^, RowLength, amt); end; CloseFile(f); Image1.Picture.Bitmap := Bitmap; WriteBitmapInfoToMemo; end; end; Procedure TForm1.WriteBitMapInfoToMemo; begin Memo1.Lines.Append(ExtractFileName(OpenPictureDialog1.filename)); Memo1.Lines.Append(' '); Memo1.Lines.Append('File size : ' + IntTostr(BitmapFileHeader.bmfFileSize)); Memo1.Lines.Append('Data offset ' + IntToStr(BitmapFileHeader.bmfBitMapDataOffset)); Memo2.Lines.Append('Size : ' + IntToStr(BitMapInfoHeader.biSize )); Memo2.Lines.Append('Width : ' + IntToStr(BitMapInfoHeader.biWidth )); Memo2.Lines.Append('Height x 2 : ' + IntToStr(BitMapInfoHeader.biHeight )); Memo2.Lines.Append('Planes : ' + IntToStr(BitMapInfoHeader.biPlanes )); Memo2.Lines.Append('Pixel Bit Count: ' + IntToStr(BitMapInfoHeader.biBitCount )); Memo2.Lines.Append('Compression : ' + IntToStr(BitMapInfoHeader.biCompression )); Memo2.Lines.Append('Size Image : ' + IntToStr(BitMapInfoHeader.biSizeImage )); Memo2.Lines.Append('PPM x : ' + IntToStr(BitMapInfoHeader.biXPelsPerMeter )); Memo2.Lines.Append('PPM y : ' + IntToStr(BitMapInfoHeader.biYPelsPerMeter )); Memo2.Lines.Append('Colors used : ' + IntToStr(BitMapInfoHeader.biClrUsed )); Memo2.Lines.Append('Important Clrs : ' + IntToStr(BitMapInfoHeader.biClrImportant )); Memo2.Lines.Append(' '); end; procedure TForm1.FormCreate(Sender: TObject); begin OpenPictureDialog1.DefaultExt := GraphicExtension(TBitmap); OpenPictureDialog1.Filter := GraphicFilter(TBitmap); end; end.