Title: produce a simple bumpmapping?
//////////////////////////////////////////////////////////////////////
///
/// Einfaches Bumpmapping.
/// Ist vom Algorithmus sehr einfach, erzeugt aber ansehnliche Efffekte
/// (c) 2005 Borg@Sven-of-Nine.de
///
/// Beispielprogramm auch unter http://www.Sven-of-Nine.de
///
/////////////////////////////////////////////////////////////////////}
///////////// Beispiel / Example /////////////////////////////////////
Uses {....,} Unit_Bumpmapping;
// ----- Init 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;
//Und ausgeben
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
// ----- ein paar nützliche Types definieren -----
type
PBitmap = ^TBitmap;
//Kleines Arry zum schnelleren Zugriff auf Bitmaps
TLine = array[0..MaxInt div SizeOf(TRGBQUAD) - 1] of TRGBQUAD;
PLine = ^TLine;
// ----- Einige interne Variablen -----
var
ColorArray: array of TRGBQuad; //Array für die Farbtabelle beim Bumpmapping
SourceArray: array of Byte; //Quell Muster
TargetBMP: TBitmap; //ZielBitmap
Black: TRGBQuad; //Schwart
White: TRGBQuad; //Weiß
// ----- Die Quelle für das Bumpmapping erzeugen -----
// ----- aus einem Bitmap wird ein Schwarzweißarray erzeugt -----
procedure Bump_SetSource(SourceBitMap: TBitmap);
var
iX, iY: Integer;
z: Integer;
sLine: PLine;
iDot: Integer;
begin
//QuellArray erzeugen
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;
// ----- Farbtabelle erzeugen -----
procedure Bump_SetColor(r, g, b: Single);
var
iIndex: Integer;
c: Byte;
begin
if (r 4) then r := 4;
if (r then r := 0;
if (g 4) then g := 4;
if (g then g := 0;
if (b 4) then b := 4;
if (b then b := 0;
//Länge setzen
SetLength(ColorArray, 255);
//Und erstmalschwarz machen
FillMemory(ColorArray, 255 * SizeOf(TRGBQuad), 0);
//Schoener Blauverlauf
for iIndex := 0 to 127 do
begin
c := 63 - iIndex div 2;
//Hier kann die Farber eingestellt werden 0.0-4.0
ColorArray[iIndex].rgbRed := round(c * r);
ColorArray[iIndex].rgbGreen := round(c * g);
ColorArray[iIndex].rgbBlue := round(c * b);
end;
//Schwarz und Weiß definieren
Black.rgbRed := 0;
Black.rgbBlue := 0;
Black.rgbGreen := 0;
White.rgbRed := 255;
White.rgbBlue := 255;
White.rgbGreen := 255;
end;
// ----- Eigentliches Bumpmapping ausführen -----
procedure Bump_Do(Target: TBitmap; XLight, YLight: Integer);
var
iX, iY: Integer;
sLine: PLine;
iR1, iT1: Integer;
iR, iT: Integer;
z: Integer;
begin
//Alle Zeile (bis auf oben und unten)
for iY := 1 to TargetBMP.Height - 2 do
begin
//Scanline holen
sLine := TargetBMP.ScanLine[iY];
//Startposition im Quell-Array
z := iY * TargetBMP.Width;
//Vorberechnung zur Beleuchtung
iT1 := (iY - YLight);
//Und alle Pixel durchwursten
for iX := 1 to TargetBMP.Width - 2 do
begin
//Position im Array aktualisieren
Inc(z);
//Steigung in unserem Punkt bestimmen
iT := iT1 - (SourceArray[z + TargetBMP.Width] -
SourceArray[z - TargetBMP.Width]);
iR := (iX - XLight) - (SourceArray[z + 1] - SourceArray[z - 1]);
//Absolut machen
if (iR then iR := -iR;
if (iT then iT := -iT;
//Wie sieht die Steigung aus ?
iR1 := iR + iT;
if (iR1 then
begin
//Hohe steigung, Farbe holen
sLine[iX] := ColorArray[iR1];
end
else
begin
//Ansonsten schwarz
sLine[iX] := Black;
end;
end;
end;
//Ergebnis übergeben
Target.Assign(TargetBMP);
end;
// ----- Bumpmapping initialisieren -----
procedure Bump_Init(SourceBitMap: TBitmap; r: Single = 3; g: Single = 3.6;
b: Single = 4);
begin
//Zielbitmap erzeugen
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;
// ----- Bumpmapping beenden -----
procedure Bump_Flush();
begin
//Speicher freimachen
TargetBMP.Free;
SetLength(ColorArray, 0);
end;
end.