132 lines
4.2 KiB
ObjectPascal
132 lines
4.2 KiB
ObjectPascal
Interface
|
|
uses crt, { GetDir }
|
|
graph; { function GetPixel }
|
|
|
|
type { integer numbers }
|
|
{ from unit bitmaps XPERT software production Tamer Fakhoury }
|
|
_bit = $00000000..$00000001; {number 1 bit without sign = (0..1) }
|
|
_byte = $00000000..$000000FF; {number 1 byte without sign = (0..255)}
|
|
_word = $00000000..$0000FFFF; {number 2 bytes without sign = (0..65 535)}
|
|
_dWord = $00000000..$7FFFFFFF; {number 4 bytes without sign = (0..4 294 967 296)}
|
|
_longInt = $80000000..$7FFFFFFF; {number 4 bytes with sign
|
|
= (-2 147 483 648..2 147 483 648}
|
|
|
|
TbmpFileHeader =
|
|
record
|
|
ID: _word; { Must be 'BM' =19778=$424D for windows }
|
|
FileSize: _dWord; { Size of this file in bytes }
|
|
Reserved: _dWord; { ??? }
|
|
bmpDataOffset: _dword; { = 54 = $36 from begining of file to begining of bmp data }
|
|
end;
|
|
|
|
TbmpInfoHeader =
|
|
record
|
|
InfoHeaderSize: _dword; { Size of Info header
|
|
= 28h = 40 (decimal)
|
|
for windows }
|
|
Width,
|
|
Height: _longInt; { Width and Height of image in pixels }
|
|
Planes, { number of planes of bitmap }
|
|
BitsPerPixel: _word; { Bits can be 1, 4, 8, 24 or 32 }
|
|
Compression,
|
|
bmpDataSize: _dword; { in bytes rounded to the next 4 byte boundary }
|
|
XPixPerMeter, { horizontal resolution in pixels }
|
|
YPixPerMeter: _longInt; { vertical }
|
|
NumbColorsUsed,
|
|
NumbImportantColors: _dword; {= NumbColorUsed}
|
|
end; { TbmpHeader = Record ... }
|
|
|
|
T32Color =
|
|
record { 4 byte = 32 bit }
|
|
Blue: byte;
|
|
Green: byte;
|
|
Red: byte;
|
|
Alfa: byte
|
|
end;
|
|
|
|
var directory,
|
|
bmpFileName: string;
|
|
bmpFile: file; { untyped file }
|
|
bmpFileHeader: TbmpFileHeader;
|
|
bmpInfoHeader: TbmpInfoHeader;
|
|
color32: T32Color;
|
|
RowSizeInBytes: integer;
|
|
BytesPerPixel: integer;
|
|
|
|
const defaultBmpFileName = 'test';
|
|
DefaultDirectory = 'c:\bp\';
|
|
DefaultExtension = '.bmp';
|
|
bmpFileHeaderSize = 14;
|
|
{ compression specyfication }
|
|
bi_RGB = 0; { compression }
|
|
bi_RLE8 = 1;
|
|
bi_RLE4 = 2;
|
|
bi_BITFIELDS = 3;
|
|
|
|
bmp_OK = 0;
|
|
bmp_NotBMP = 1;
|
|
bmp_OpenError = 2;
|
|
bmp_ReadError = 3;
|
|
|
|
Procedure CreateBmpFile32(directory: string; FileName: string;
|
|
iWidth, iHeight: _LongInt);
|
|
|
|
{************************************************}
|
|
Implementation {-----------------------------}
|
|
{************************************************}
|
|
|
|
Procedure CreateBmpFile32(directory: string; FileName: string;
|
|
iWidth, iHeight: _LongInt);
|
|
var
|
|
x, y: integer;
|
|
begin
|
|
if directory = '' then
|
|
GetDir(0, directory);
|
|
if FileName = '' then
|
|
FileName: = DefaultBmpFileName;
|
|
{ create a new file on a disk in a given directory with given name }
|
|
Assign(bmpFile, directory + FileName + DefaultExtension);
|
|
ReWrite(bmpFile, 1);
|
|
|
|
{ fill the headers }
|
|
with bmpInfoHeader, bmpFileHeader do
|
|
begin
|
|
ID := 19778;
|
|
InfoheaderSize := 40;
|
|
width := iWidth;
|
|
height := iHeight;
|
|
BitsPerPixel := 32;
|
|
BytesPerPixel := BitsPerPixel div 8;
|
|
reserved := 0;
|
|
bmpDataOffset := InfoHeaderSize + bmpFileHeaderSize;
|
|
planes := 1;
|
|
compression := bi_RGB;
|
|
XPixPerMeter := 0;
|
|
YPixPerMeter := 0;
|
|
NumbColorsUsed := 0;
|
|
NumbImportantColors := 0;
|
|
|
|
RowSizeInBytes := (Width * BytesPerPixel); { only for >=8 bits per pixel }
|
|
bmpDataSize := height * RowSizeinBytes;
|
|
FileSize := InfoHeaderSize + bmpFileHeaderSize + bmpDataSize;
|
|
|
|
{ copy headers to disk file }
|
|
BlockWrite(bmpFile, bmpFileHeader, bmpFileHeaderSize);
|
|
BlockWrite(bmpFile, bmpInfoHeader, infoHeaderSize);
|
|
|
|
{ fill the pixel data area }
|
|
for y := (height - 1) downto 0 do
|
|
begin
|
|
for x := 0 to (width - 1) do
|
|
begin { Pixel(x,y) }
|
|
color32.Blue := 255;
|
|
color32.Green := 0;
|
|
color32.Red := 0;
|
|
color32.Alfa := 0;
|
|
BlockWrite(bmpFile, color32, 4);
|
|
end; { for x ... }
|
|
end; { for y ... }
|
|
Close(bmpFile);
|
|
end; { with bmpInfoHeader, bmpFileHeader }
|
|
end; { procedure }
|