Форум: "Основная";
Текущий архив: 2004.11.21;
Скачать: [xml.tar.bz2];

Вниз

Bumpmapping   Найти похожие ветки 

← →
<<BEAST>>   (2004-11-04 17:06) [0]

Подскажите как сделать bumpmapping или где можно взять какиенибудь статьи,исходники bumpmapping.

---

← →
Rouse_ ©   (2004-11-04 20:25) [1]

http://delphigfx.mastak.ru/

---

← →
Stexen   (2004-11-05 00:26) [2]

FastLib-отличный бампмапинг!

---

← →
<<BEAST>>   (2004-11-06 20:52) [3]

Мне нужен какойто пример, я видел bumpmapping на С++, хотел сделать чтото похожее но плучилось совсем нето, пытался из C++ переделать в Delphi но в том исходнике было слишком много ошибок.

---

← →
Andy BitOff ©   (2004-11-06 23:34) [4]

На тебе модуль, надеюсь разберешся, что кинуть на форму. В каталоге с программой должна быть bmp"шка.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,  ExtCtrls, Spin, Menus, StdCtrls;

type
TWordArray = array[0..65535] of Word;
PWordArray = ^TWordArray;

TScanLineArray = array[0..1024] of PWordArray;
PScanLineArray = ^TScanLineArray;

TForm1 = class(TForm)
 Image1: TImage;
 SpinButton1: TSpinButton;
   Timer1: TTimer;
 procedure FormCreate(Sender: TObject);
 procedure FormClose(Sender: TObject; var Action: TCloseAction);
 procedure FormResize(Sender: TObject);
 procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
 procedure SpinButton1DownClick(Sender: TObject);
 procedure SpinButton1UpClick(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
private
 Loader: TBitmap; // LOADER CONTAINS THE BUMPMAP BITMAP
 OffScreen : TBitmap; // HOLDS THE BITMAP THAT IS PAINTED ON SCREEN AFTERWARDS
 OffScreen2: TBitmap; // OFFSCREEN2 HOLDS THE STRECHED BUMPMAP BITMAP
 EnvironmentMap : array[0..255, 0..255] of byte; // BALL COLORS
 ColorMap : array[0..255] of Word; // FIRE PALETTE
 SizeX, SizeY : Integer; // CURRENT SIZE OF CLIENTAREA
 // SCANLINES FOR FASTER ACCESS TO THE PIXELS
 ScanLineSRCArray: array[0..1024] of PByteArray; // SRC IS 8 BIT GRAYSCALE BUMPMAP
 ScanLineDESTArray: TScanLineArray; // DEST IS 16 BIT (WORD)
 LIGHT_RAD: Single; RR,GG,BB: 0..16;
 Delta, Old, Move: TPoint;
       bDoAutoMove: Boolean;
       
 procedure CreateEnvironmentMap; // MAKE THE ENVIROMENTMAP AND THE PALETTE
 procedure Bumpmap( lightx, lighty : SmallInt); // MAKE THE BUMPERMAP
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Bumpmap(lightx, lighty: SmallInt);
var
x, y : SmallInt;
nx, ny : SmallInt;
begin
// The overgiven Pos is the top left corner, get center by adding 128, 128
LightX := LightX + 256;
LightY := LightY + 256;

for y := 1 to SizeY - 2 do
 for x := 1 to SizeX - 2 do begin
  nx := ScanLineSRCArray[y]^[x-1] - ScanLineSRCArray[y]^[x+1];
  ny := ScanLineSRCArray[y-1]^[x] - ScanLineSRCArray[y+1]^[x];

  nx := nx - (x - lightx);
  ny := ny - (y - lighty);

  if nx > 255  then nx := 255 // Check ranges 255 is never reached though
  else if nx < 0    then nx := 0;
  if ny > 255 then ny := 255
           else if ny < 0    then ny := 0;
  ScanLineDESTArray[y]^[x] := ColorMap[ Environmentmap[ nx, ny ] ];
 end;
end;

procedure TForm1.CreateEnvironmentMap;
var
i, x , y : integer;
nX, nY, nZ : real;
   Help: integer;

function RGB15Bit( R,G,B: Byte): Word;
begin
 Result := R shl 10 or G shl 5 or B;
   end;
begin
// Calc lighting envmap
Caption := "Calculating Envmap";

for y := 0 to 255 do
    for x := 0 to 255 do begin
  nX := ( x - 128 ) / 128;
  nY := ( y - 128 ) / 128;

  // CIRCLE FUNCTION
  nZ := LIGHT_RAD - sqrt( nX * nX + nY * nY);

  if nz < 0 then nZ := 0;

  // Phong illumination model = ambient + dif*dot + dot^2 * spec
  // where ambient =0 , dif = 191 and spec = 128
  Help := Round (nz * 191 + nz * nz * 128);
  if Help > 255 then Help := 255;
  environmentmap[ x, y ] := Help;
 end;
// Calc Pallete we want to use
Caption := "Calculating Pallete";
// we"ve got 5/5/5 Palette means 31/31/31 is white
// 0 to 63 doesn"t fit 5 bit so DIV 2 = SHR 1
for i := 0 to 62 do ColorMap[i]    := RGB15Bit((i shr 1),0,0);
for i := 63 to 126 do ColorMap[i]  := RGB15Bit(31,(i-63) shr 1,0);
for i := 127 to 255 do ColorMap[i] := RGB15Bit(31, 31, (i-128) shr 2); // I DIV 4 = I SHR 2

Caption := "LIGHT_RAD = "+FloatToStr(LIGHT_RAD);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
y: Integer;
begin
bDoAutoMove:= False;
   
SizeX := 320;
SizeY := 200;

OffScreen := TBitmap.Create;
OffScreen.Width := ClientWidth;
OffScreen.Height := ClientHeight;
OffScreen.PixelFormat := pf15bit;

OffScreen2 := TBitmap.Create;
OffScreen2.LoadFromFile("bumpmap.bmp");
OffScreen2.PixelFormat := pf8bit;

Loader := TBitmap.Create;
Loader.LoadFromFile("bumpmap.bmp");
Loader.PixelFormat := pf24bit;

for y := 0 to SizeY - 1 do begin
 ScanLineSRCArray [y] := OffScreen2.ScanLine[y];
 ScanLineDESTArray[y] := OffScreen.ScanLine[y];
end;

   //Default values ::
if LIGHT_RAD= 0 then LIGHT_RAD:= 1;
if (RR=0) and (GG=0) and (BB=0) then
 begin RR:=10; BB:=5; GG:=0; end;

CreateEnvironmentMap;
Caption := "INTRO";
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
OffScreen.Free;
OffScreen2.Free;
Loader.Free;
end;

procedure TForm1.FormResize(Sender: TObject);
var
y: Integer;
begin
SizeX := ClientWidth;
SizeY := ClientHeight;

// RELOAD (METALLICA) THE OFFSCREEN2 TO FIT THE NEW SIZE
OffScreen2.Height := SizeY;
OffScreen2.Width := SizeX;
OffScreen2.Canvas.StretchDraw(Rect(0,0,SizeX, SizeY), Loader); // what about "stretchblt" ??

OffScreen.Height := SizeY;
OffScreen.Width  := SizeX;

for y := 0 to SizeY - 1 do begin
 ScanLineSRCArray [y] := OffScreen2.ScanLine[y];
 ScanLineDESTArray[y] := OffScreen.ScanLine[y];
end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
const Lim= 10; // Speed Limit ;)
begin
bDoAutoMove:= False;
Move.X:= X; Move.Y:= Y;

BumpMap( X-128, Y-128 );
// Now Copy the OffScreen Image to the Main Form Canvas
Canvas.Draw( 0, 0, Offscreen); // what about "bitblt" ??

//////////////////////////////////////////////49035
Delta.X:= X-Old.X; Delta.Y:= Y-Old.Y; // A Simple Calculation For DeltaX & DeltaY Of Mouse Cursor...
   // We don"t need to high-speed moving...
if Delta.X>Lim then Delta.X:= Lim;
if Delta.Y>Lim then Delta.Y:= Lim;
if Delta.X<-Lim then Delta.X:= -Lim;
if Delta.Y<-Lim then Delta.Y:= -Lim;
Old.X:= X; Old.Y:=Y; // Saves The Last Point Of Cursor...
end;

procedure TForm1.SpinButton1DownClick(Sender: TObject);
begin
LIGHT_RAD:=LIGHT_RAD-0.05;
CreateEnvironmentMap;
end;

procedure TForm1.SpinButton1UpClick(Sender: TObject);
begin
LIGHT_RAD:=LIGHT_RAD+0.05;
CreateEnvironmentMap;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if bDoAutoMove= False then
   begin
 bDoAutoMove:= True;
    Exit;
   end;

   // Calculates The New Position.
Move.X:= Move.X+ Delta.X;
Move.Y:= Move.Y+ Delta.Y;

   // The Limits Of Moving (I Like To Use Client Area).
   // Just we need to flip the Deltas...
if (Move.X>ClientWidth) or (Move.X<0) then Delta.X:= Delta.X* -1;
if (Move.Y>ClientHeight) or (Move.Y<0) then Delta.Y:= Delta.Y* -1;

BumpMap( Move.X-128, Move.Y-128);
// Now Copy the OffScreen Image to the Main Form Canvas
Canvas.Draw( 0, 0, Offscreen); // what about "bitblt" ??
end;

end.


---

← →
Comp ©   (2004-11-07 01:33) [5]

>  [4] Andy BitOff ©   (06.11.04 23:34)


Круто.

Молодец!

Это ты сам до такого догадался или содрал у кого?

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2004.11.21;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.034 c