黑色浮雕化图形和光照效果

produce a simple bumpmapping

Autor: Sven Lorenz  

Homepage: http://www.Sven-of-Nine.de

unit Unit1;

interface

uses

 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

 Dialogs, ExtCtrls;

type

 TForm1 = class(TForm)

   Timer1: TTimer;

   Image1: TImage;

   procedure FormCreate(Sender: TObject);

   procedure FormClose(Sender: TObject; var Action: TCloseAction);

   procedure Timer1Timer(Sender: TObject);

 private

   { Private declarations }

 public

   { Public declarations }

 end;

var

 Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

var

 XPos: Single = 0.1;

 YPos: Single = 0.3;

procedure TForm1.FormCreate(Sender: TObject);

begin

 Image1.Picture.LoadFromFile('C:\windows\acd wallpaper.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);

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;

end.

---------------------------------------

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

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

// ----- 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.