Mega Code Archive
How to produce a simple bumpmapping
<![CDATA[
Title: How to produce a simple bumpmapping
Uses {....,} Unit_Bumpmapping;
procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Picture.LoadFromFile('mybitmap.bmp');
//Init bumpmapping and set color to cyan (2*r,3*g,+4*b)
Bump_Init(Image1.Picture.Bitmap, 2,3,4);
end;
// ----- animate bumpmapping -----
procedure TForm1.Timer1Timer(Sender: TObject);
const
XPos: Single = 0.1;
YPos: Single = 0.3;
begin
//Timer1.Interval:=40;
//Image1.Stretch:=TRUE !!!!
//Position des Lichtpunktes ?ndern
XPos := XPos + 0.02;
YPos := YPos + 0.01;
//Auf 2Pi begrenzen
if (XPos 2 * PI) then XPos := XPos - 2 * PI;
if (YPos 2 * PI) then YPos := YPos - 2 * PI;
with Image1.Picture do
Bump_Do(Bitmap,
trunc(Sin(XPos) * (Bitmap.Width shr 1) + (Bitmap.Width shr 1)),
trunc(Sin(YPos) * (Bitmap.Height shr 1) + (Bitmap.Height shr 1))
)
end;
// ----- Close -----
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Bump_Flush();
end;
}
/////////////////// Unit Unit_Bumpmapping ////////////////////////////
unit Unit_Bumpmapping;
interface
uses Windows, Graphics;
// ----- Bumpmapping procedures -----
procedure Bump_Init(SourceBitMap: TBitmap; r: Single = 3; g: Single = 3.6;
b: Single = 4);
procedure Bump_Flush();
procedure Bump_Do(Target: TBitmap; XLight, YLight: Integer);
procedure Bump_SetSource(SourceBitMap: TBitmap);
procedure Bump_SetColor(r, g, b: Single);
implementation
type
PBitmap = ^TBitmap;
TLine = array[0..MaxInt div SizeOf(TRGBQUAD) - 1] of TRGBQUAD;
PLine = ^TLine;
ColorArray: array of TRGBQuad;
SourceArray: array of Byte;
TargetBMP: TBitmap;
Black: TRGBQuad;
White: TRGBQuad;
procedure Bump_SetSource(SourceBitMap: TBitmap);
var
iX, iY: Integer;
z: Integer;
sLine: PLine;
iDot: Integer;
begin
SourceBitmap.PixelFormat := pf32Bit;
SetLength(SourceArray, SourceBitMap.Height * SourceBitMap.Width);
for iY := 0 to SourceBitMap.Height - 1 do
begin
//Scanline holen
sLine := SourceBitMap.ScanLine[iY];
//Und durchwursten
for iX := 0 to SourceBitMap.Width - 1 do
begin
//Koordinaten errechnene
z := iY * SourceBitMap.Width + iX;
//Grauwert bestimmen
idot := sLine[iX].rgbRed;
idot := idot + sLine[iX].rgbGreen;
idot := idot + sLine[iX].rgbBlue;
iDot := (iDot div 3);
//Und eintragen
SourceArray[z] := iDot;
end;
end;
end;
procedure Bump_SetColor(r, g, b: Single);
var
iIndex: Integer;
c: Byte;
begin
if (r 4) then r := 4;
if (r 0) then r := 0;
if (g 4) then g := 4;
if (g 0) then g := 0;
if (b 4) then b := 4;
if (b 0) then b := 0;
SetLength(ColorArray, 255);
FillMemory(ColorArray, 255 * SizeOf(TRGBQuad), 0);
//Schoener Blauverlauf
for iIndex := 0 to 127 do
begin
c := 63 - iIndex div 2;
ColorArray[iIndex].rgbRed := round(c * r);
ColorArray[iIndex].rgbGreen := round(c * g);
ColorArray[iIndex].rgbBlue := round(c * b);
end;
Black.rgbRed := 0;
Black.rgbBlue := 0;
Black.rgbGreen := 0;
White.rgbRed := 255;
White.rgbBlue := 255;
White.rgbGreen := 255;
end;
procedure Bump_Do(Target: TBitmap; XLight, YLight: Integer);
var
iX, iY: Integer;
sLine: PLine;
iR1, iT1: Integer;
iR, iT: Integer;
z: Integer;
begin
for iY := 1 to TargetBMP.Height - 2 do
begin
//Scanline holen
sLine := TargetBMP.ScanLine[iY];
//Startposition im Quell-Array
z := iY * TargetBMP.Width;
iT1 := (iY - YLight);
//Und alle Pixel durchwursten
for iX := 1 to TargetBMP.Width - 2 do
begin
Inc(z);
iT := iT1 - (SourceArray[z + TargetBMP.Width] -
SourceArray[z - TargetBMP.Width]);
iR := (iX - XLight) - (SourceArray[z + 1] - SourceArray[z - 1]);
//Absolut machen
if (iR 0) then iR := -iR;
if (iT 0) then iT := -iT;
iR1 := iR + iT;
if (iR1 129) then
begin
sLine[iX] := ColorArray[iR1];
end
else
begin
//Ansonsten schwarz
sLine[iX] := Black;
end;
end;
end;
Target.Assign(TargetBMP);
end;
procedure Bump_Init(SourceBitMap: TBitmap; r: Single = 3; g: Single = 3.6;
b: Single = 4);
begin
TargetBMP := TBitmap.Create;
with TargetBMP do
begin
Height := SourceBitMap.Height;
Width := SourceBitMap.Width;
PixelFormat := pf32Bit;
end;
//Farbtabellen initialisieren
Bump_SetColor(r, g, b);
//Und aus dem Quellbitmap ein Array machen
Bump_SetSource(SourceBitmap);
end;
procedure Bump_Flush();
begin
TargetBMP.Free;
SetLength(ColorArray, 0);
end;
end.
]]>