whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1548)

Database (90)
Files (137)
Forms (107)
Graphic (116)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Math (76)
Misc (127)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (268)
VCL (243)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

16 Visitors Online


 
... produce a simple bumpmapping?
Autor: Sven Lorenz
Homepage: http://www.Sven-of-Nine.de
[ Print tip ]  

Tip Rating (14):  
     


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


 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners