{ вы знаете что такое карта высот? можно создать супер эффект на простом Canvas к сожалению мой код моргает при перерисовке, но вы уж поковыряйтесь.... :) } unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, ExtDlgs, math, ComCtrls, ShellApi; type TForm1 = class(TForm) Image1: TImage; OpenDialog1: TOpenDialog; Timer1: TTimer; PageControl1: TPageControl; Specular: TTabSheet; sRed: TEdit; Label1: TLabel; ScrollBar1: TScrollBar; Label2: TLabel; sGreen: TEdit; ScrollBar2: TScrollBar; ScrollBar3: TScrollBar; sBlue: TEdit; Label3: TLabel; Label4: TLabel; Edit1: TEdit; ScrollBar4: TScrollBar; Diffuse: TTabSheet; Ambient: TTabSheet; Label5: TLabel; Label6: TLabel; Label7: TLabel; dGreen: TEdit; dBlue: TEdit; dRed: TEdit; ScrollBar5: TScrollBar; ScrollBar6: TScrollBar; ScrollBar7: TScrollBar; Label8: TLabel; Label9: TLabel; Label10: TLabel; aBlue: TEdit; aGreen: TEdit; aRed: TEdit; ScrollBar8: TScrollBar; ScrollBar9: TScrollBar; ScrollBar10: TScrollBar; Label11: TLabel; Label12: TLabel; Edit2: TEdit; Label13: TLabel; procedure FormCreate(Sender: TObject); procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure ScrollBarChange(Sender: TObject); procedure Label11Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); private { Private declarations } public { Public declarations } end; type normal = record x: integer; y: integer; end; type rgb32 = record b: byte; g: byte; r: byte; t: byte; end; type rgb24 = record r: integer; g: integer; b: integer; end; var Form1: TForm1; bumpimage: tbitmap; current_X, Current_Y: integer; var Bump_Map: array[0..255, 0..255] of normal; Environment_map: array[0..255, 0..255] of integer; Palette: array[0..256] of rgb24; implementation {$R *.DFM} procedure TForm1.FormCreate(Sender: TObject); type image_array = array[0..255, 0..255] of byte; var x, y: integer; Buffer: image_array; bump_file: file of image_array; ny2, nx, nz: double; c: integer; ca, cap: double; begin assignfile(bump_File, 'bump.raw'); reset(Bump_File); Read(Bump_File, buffer); for y := 1 to 254 do begin for x := 1 to 254 do begin Bump_Map[x, y].x := buffer[y + 1, x] - buffer[y + 1, x + 2]; bump_map[x, y].y := buffer[y, x + 1] - buffer[y + 2, x + 1]; end; end; closefile(bump_File); for y := -128 to 127 do begin nY2 := y / 128; nY2 := nY2 * nY2; for X := -128 to 127 do begin nX := X / 128; nz := 1 - SQRT(nX * nX + nY2); c := trunc(nz * 255); if c < = 0 then c := 0; Environment_Map[x + 128, y + 128] := c; end; end; nx := pi / 2; ny2 := nx / 256; for y := 0 to 255 do begin ca := cos(nx); cap := power(ca, 35); nx := nx - ny2; palette[y].r := trunc((128 * ca) + (235 * cap)); if palette[y].r > 255 then palette[y].r := 255; palette[y].G := trunc((128 * ca) + (245 * cap)); if palette[y].g > 255 then palette[y].g := 255; palette[y].B := trunc(5 + (170 * ca) + (255 * cap)); ; if palette[y].b > 255 then palette[y].b := 255; end; bumpimage := TBitmap.create; bumpimage.width := 255; bumpimage.height := 255; bumpimage.PixelFormat := pf32bit; Image1.Picture.Bitmap := bumpimage; image1mousemove(self, [], 128, 128); application.ProcessMessages; end; procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin Current_X := x; Current_Y := y; end; procedure TForm1.Timer1Timer(Sender: TObject); var x, y, x2, y2, y3: integer; Scan: ^Scanline; bx, by: longint; c: byte; begin x := Current_X; y := Current_Y; for y2 := 0 to 253 do begin scan := image1.Picture.Bitmap.ScanLine[y2]; y3 := 128 + y2 - y; for x2 := 0 to 253 do begin bx := bump_Map[x2, y2].x + 128 + x2 - x; by := bump_Map[x2, y2].y + y3; if (bx < 255) and (bx > 0) and (by < 255) and (by > 0) then begin c := Environment_Map[bx, by]; scan^[x2].r := palette[c].r; scan^[x2].g := palette[c].g; scan^[x2].b := palette[c].b; end else begin scan^[x2].r := palette[0].r; scan^[x2].g := palette[0].g; scan^[x2].b := palette[0].b; end; {image1.Canvas.Pixels[x,y] := rgb(r,g,b);} end; end; image1.Refresh; end; procedure TForm1.ScrollBarChange(Sender: TObject); var ny2, nx: double; c: integer; ca, cap: double; begin sRed.Text := inttostr(scrollbar1.position); sGreen.Text := inttostr(scrollbar2.position); sBlue.Text := inttostr(scrollbar3.position); edit1.Text := inttostr(scrollbar4.position); dRed.Text := inttostr(scrollbar5.position); dGreen.Text := inttostr(scrollbar6.position); dBlue.Text := inttostr(scrollbar7.position); aRed.Text := inttostr(scrollbar8.position); aGreen.Text := inttostr(scrollbar9.position); aBlue.Text := inttostr(scrollbar10.position); nx := pi / 2; ny2 := nx / 256; for C := 0 to 255 do begin ca := cos(nx); cap := power(ca, scrollbar4.position); nx := nx - ny2; palette[c].r := trunc(scrollbar8.position + (scrollbar5.position * ca) + (scrollbar1.position * cap)); if palette[c].r > 255 then palette[c].r := 255; palette[c].G := trunc(scrollbar9.position + (scrollbar6.position * ca) + (scrollbar2.position * cap)); if palette[c].g > 255 then palette[c].g := 255; palette[c].B := trunc(scrollbar10.position + (scrollbar7.position * ca) + (scrollbar3.position * cap)); ; if palette[c].b > 255 then palette[c].b := 255; end; image1mousemove(self, [], Current_X, Current_Y); application.ProcessMessages; end; procedure TForm1.Label11Click(Sender: TObject); begin ShellExecute(handle, 'open', 'http://wkweb5.cableinet.co.uk/daniel.davies/', nil, nil, SW_SHOWNORMAL); end; end.