반응형
//---------------------------------------------------------------------
// Write your own 24 Bit BMP
// (C) K.O. Thaha Hussain MCA, 2003 Sept
// I used Hexadecimal Numbers just for Style
// Hex editors make use of that system.
// (Example $28 in Hex is Equal to 40 in decimal system. You can make use
// either hex or Decimal system
// --------------------------------------------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, Buttons;
Type
TBmpHeader = Packed Record
bfType1 : Byte;
bfType2 : Byte;
bfSize : LongInt;
bfReserved1 : Word;
bfReserved2 : Word;
bfOffBits : LongInt;
biSize : LongInt;
biWidth : LongInt;
biHeight : LongInt;
biPlanes : Word;
biBitCount : Word;
biCompression : LongInt;
biSizeImage : LongInt;
biXPelsPerMeter : LongInt;
biYPelsPerMeter : LongInt;
biClrUsed : LongInt;
biClrImportant : LongInt;
End ;
// Each pixel is a combination of Blue, Green and Red Values
// In other words, A pixel is uniquely represented by 3 bytes
// Maximum Value of any of them is $FF (255 in Decimal)
TRGB = Record
rgbBlue : BYTE; //intensity of blue in the color
rgbGreen: BYTE; //intensity of green in the color
rgbRed : BYTE; //intensity of red in the color
End;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
Var
MyBitmapHeader : TBmpHeader;
MyRGB : TRGBQUAD;
MyFile : File;
MyBuffer : Byte ;
i, j : Integer;
begin
With MyBitmapHeader do
Begin
bfType1 := $42;
bfType2 := $4D;
bfSize := $00000000;
bfReserved1 := $0000;
bfReserved2 := $0000;
bfOffBits := $36;
biSize := $28;
biWidth := $0000000A;
biHeight := $0000000A;
biPlanes := $0001;
biBitCount := $0018;
biCompression := $00000000;
biSizeImage := $00000000;
biXPelsPerMeter := $00000000;
biYPelsPerMeter := $00000000;
biClrUsed := $00000000;
biClrImportant := $00000000;
end;
//Open output file
AssignFile(MyFile, 'C:\HelloWorld.BMP');
Rewrite(MyFile,1);
//Finish writing the Header
BlockWrite (MyFile, MyBitmapHeader, SizeOf(TBmpHeader));
//Now starts the data part
MyRGB.rgbBlue :=$FF;
MyRGB.rgbGreen := $cc;
MyRGB.rgbRed := $FF;
// This will be a pale magenta color
// For Bright Red:- Blue = $00, Green =$00 and Red= $FF
for i:= 1 to 10 do
begin
for j:= 1 to 10 do
begin
BlockWrite(MyFile, MyRGB, 3); //Block size is 3 bytes
end;
//Two Zeroes should be padded
//to make each row a multiple of 4
// ie, 10 mod 4 = 2 (zeroes should be
//padded two times)
MyBuffer := $00;
BlockWrite(MyFile, MyBuffer, 1);
MyBuffer := $00;
BlockWrite(MyFile, MyBuffer, 1);
end;
CloseFile(MyFile);
ShowMessage ('BMP file is successfully written!');
end;
procedure TForm1.FormShow(Sender: TObject);
begin
Caption:= 'Thaha Hussain''s 24 bit BMP creation demonstration';
Button1.Caption:= 'Write my BMP';
end;
end.
// Write your own 24 Bit BMP
// (C) K.O. Thaha Hussain MCA, 2003 Sept
// I used Hexadecimal Numbers just for Style
// Hex editors make use of that system.
// (Example $28 in Hex is Equal to 40 in decimal system. You can make use
// either hex or Decimal system
// --------------------------------------------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, Buttons;
Type
TBmpHeader = Packed Record
bfType1 : Byte;
bfType2 : Byte;
bfSize : LongInt;
bfReserved1 : Word;
bfReserved2 : Word;
bfOffBits : LongInt;
biSize : LongInt;
biWidth : LongInt;
biHeight : LongInt;
biPlanes : Word;
biBitCount : Word;
biCompression : LongInt;
biSizeImage : LongInt;
biXPelsPerMeter : LongInt;
biYPelsPerMeter : LongInt;
biClrUsed : LongInt;
biClrImportant : LongInt;
End ;
// Each pixel is a combination of Blue, Green and Red Values
// In other words, A pixel is uniquely represented by 3 bytes
// Maximum Value of any of them is $FF (255 in Decimal)
TRGB = Record
rgbBlue : BYTE; //intensity of blue in the color
rgbGreen: BYTE; //intensity of green in the color
rgbRed : BYTE; //intensity of red in the color
End;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
Var
MyBitmapHeader : TBmpHeader;
MyRGB : TRGBQUAD;
MyFile : File;
MyBuffer : Byte ;
i, j : Integer;
begin
With MyBitmapHeader do
Begin
bfType1 := $42;
bfType2 := $4D;
bfSize := $00000000;
bfReserved1 := $0000;
bfReserved2 := $0000;
bfOffBits := $36;
biSize := $28;
biWidth := $0000000A;
biHeight := $0000000A;
biPlanes := $0001;
biBitCount := $0018;
biCompression := $00000000;
biSizeImage := $00000000;
biXPelsPerMeter := $00000000;
biYPelsPerMeter := $00000000;
biClrUsed := $00000000;
biClrImportant := $00000000;
end;
//Open output file
AssignFile(MyFile, 'C:\HelloWorld.BMP');
Rewrite(MyFile,1);
//Finish writing the Header
BlockWrite (MyFile, MyBitmapHeader, SizeOf(TBmpHeader));
//Now starts the data part
MyRGB.rgbBlue :=$FF;
MyRGB.rgbGreen := $cc;
MyRGB.rgbRed := $FF;
// This will be a pale magenta color
// For Bright Red:- Blue = $00, Green =$00 and Red= $FF
for i:= 1 to 10 do
begin
for j:= 1 to 10 do
begin
BlockWrite(MyFile, MyRGB, 3); //Block size is 3 bytes
end;
//Two Zeroes should be padded
//to make each row a multiple of 4
// ie, 10 mod 4 = 2 (zeroes should be
//padded two times)
MyBuffer := $00;
BlockWrite(MyFile, MyBuffer, 1);
MyBuffer := $00;
BlockWrite(MyFile, MyBuffer, 1);
end;
CloseFile(MyFile);
ShowMessage ('BMP file is successfully written!');
end;
procedure TForm1.FormShow(Sender: TObject);
begin
Caption:= 'Thaha Hussain''s 24 bit BMP creation demonstration';
Button1.Caption:= 'Write my BMP';
end;
end.
반응형