Create Bumpmap on Bitmap

Hier ist ein gutes Beispiel, wie man einen Bumpmap Effekt auf ein Bitmap rechnen lassen kann.

Um bei der Kompilierung nicht einen Crash zu verursachen, solltet ihr entweder vorher ein Bitmap in das Image laden oder den Timer deaktivieren und beim Laden des Bitmaps wieder aktivieren.

Der Effekt ist sehr schön und kann sehr gut modifiziert werden.

Der Timer sollte auf 39 fps gestellt werden.

Unit Bumpmapping.pas

unit Bumpmapping;

interface

uses Windows, Graphics;

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;

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ß

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];

    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);

  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
  //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 < 0) then iR := -iR;
      if (iT < 0) then iT := -iT;

      //Wie sieht die Steigung aus ?
      iR1 := iR + iT;
      if (iR1 < 129) 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;

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;

procedure Bump_Flush();
begin
  //Speicher freimachen
  TargetBMP.Free;
  SetLength(ColorArray, 0);
end;

end.

Unit1 :

uses Bumpmapping

var
  Form1: TForm1;
  XPos: Single;
  YPos: Single;
  
//

procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer1.Enabled := false;
  DoubleBuffered := true;
  Bump_Init(Image1.Picture.Bitmap, 2,3,4);
end;

// Der Timer muss deaktiviert werden und beim laden wieder aktiviert werden 39 (fps)
procedure TForm1.Timer1Timer(Sender: TObject);

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;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Bump_Flush();
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then begin
    try
    Timer1.Enabled := true;
    Image1.Picture.Bitmap.LoadFromFile(OpenDialog1.FileName);
    Bump_Init(Image1.Picture.Bitmap, 2,3,4);
   finally
   end;
  end;
end;