Текущий архив: 2003.09.22;
Скачать: CL | DM;

Вниз

Не для слабонервных.   Найти похожие ветки 

← →
MBo ©   (2003-09-02 16:27) [0]

Запустите и подвигайте головой к- и от- монитора ;)


const
Size = 300;
type
TArrB = array[0..Size - 1, 0..Size - 1] of Byte;

TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
public
procedure ShowIt(var A: TArrB; X, Y: Integer);
end;

var
Form1: TForm1;
Src: TArrB;
ct: array[Byte] of TRGBQuad;

implementation

{$R *.DFM}

procedure TForm1.ShowIt(var A: TArrB; X, Y: Integer);
var
b: TBitmap;
i: Integer;
begin
b := TBitmap.Create;
b.Width := size;
b.Height := size;
b.PixelFormat := pf8bit;
for i := 0 to 255 do
with ct[i] do begin
rgbBlue := i;
rgbGreen := i;
rgbRed := i;
rgbReserved := 0;
end;
SetDibColorTable(b.Canvas.Handle, 0, $100, ct);
SetBitmapBits(b.Handle, Sqr(Size), @A);
Canvas.Draw(x, y, b);
b.free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
ix, iy: Integer;
begin
for ix := 0 to Size - 1 do
for iy := 0 to Size - 1 do
Src[ix, iy] := Round(128 + 127 * Sin((Sqr(ix - Size div 2) +
Sqr(iy - Size div 2)) / 400));
ShowIt(Src, 0, 0);
end;



---

← →
panov ©   (2003-09-02 16:33) [1]

жуткая весчь...

---

← →
NickBat ©   (2003-09-02 16:34) [2]

Н-да. Занятно...

---

← →
stone ©   (2003-09-02 16:38) [3]

не понял, ну кружочки...

---

← →
Reindeer Moss Eater ©   (2003-09-02 16:45) [4]

А можно код, что бы головой не надо было двигать?
:)

---

← →
TButton ©   (2003-09-02 16:49) [5]

занимательно. запустил. форма. кнопка... красота... сам придумал или кто подсказал?

---

← →
han_malign ©   (2003-09-02 16:49) [6]

Ложное восприятие перспективы...

---

← →
Юрий Федоров ©   (2003-09-02 16:49) [7]

И никакого пива не надо ....

---

← →
nikkie ©   (2003-09-02 16:49) [8]

>А можно код, что бы головой не надо было двигать?
а у тебя драйвер подставки монитора установлен?

---

← →
Крот ©   (2003-09-02 16:50) [9]

"Зашибись, баклан!" (с) "Бивис и Батхед" :-)

---

← →
Е-Моё имя ©   (2003-09-02 16:59) [10]

ууууууу шайтан!

---

← →
jack128 ©   (2003-09-02 17:06) [11]

> не понял, ну кружочки...

Дык, головой работать надо ;-))

---

← →
horse ©   (2003-09-02 17:58) [12]

Тест на трезвость :))

---

← →
MVova ©   (2003-09-02 19:37) [13]

> Reindeer Moss Eater © (02.09.03 16:45) [4]


procedure TForm1.Button1Click(Sender: TObject);
var
ix, iy: Integer;
I : Integer;
J : Integer;
DJ : Integer;
begin
J := 400;
DJ := 5;
for I := 1 to 100 do
begin
if (J > 420)or(J<350) then
DJ := DJ * -1;
Inc(J,DJ);
for ix := 0 to Size - 1 do
for iy := 0 to Size - 1 do
Src[ix, iy] := Round(128 + 127 * Sin((Sqr(ix - Size div 2) +
Sqr(iy - Size div 2)) / J));
ShowIt(Src, 0, 0);
end;
end;

---

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

Текущий архив: 2003.09.22;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.041 c