![]() |
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
snow (schnee) [Delphi, KOL]
karl © (2006-11-02 21:25:00)I found this unit in a forum and would like to adapt it ko kol.
This unit produces snow on a form.
Can you help me please?
Best regards
karl
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, Math, StdCtrls;
type
TSnow = record
Position: TPoint;
Size: Integer;
speedx: Comp;
speedy: Comp;
wind: real;
color: tcolor;
end;
type
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private-Deklarationen }
Snow: array[0..1000] of TSnow;
SnowBmp: TBitmap;
Wind: Real;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
begin
Randomize;
SnowBmp := TBitmap.Create;
SnowBmp.Width:=Width;
SnowBmp.Height:=Height;
for i := Low(Snow) To High(Snow) Do
Begin
Snow[i].Size := 1;
Snow[i].speedx := random(2) - random(2);
Snow[i].speedy := random(5)+1;
While Snow[i].wind = 0 Do
Snow[i].wind := random(2) - random(2);
End;
Wind := random(50);
i := 0;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
SnowBmp.Free;
end;
procedure TForm1.FormResize(Sender: TObject);
var
i: Integer;
begin
Timer1.Enabled := false;
SnowBmp.Width:=Width;
SnowBmp.Height:=Height;
For i := Low(Snow) To High(Snow) Do
Begin
Snow[i].Position := Point(Random(Width), Random(Height));
Snow[i].wind := random(2) - random(2);
End;
Timer1.Enabled := True;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
i, j: Integer;
Newx, Newy: Integer;
begin
wind := wind + random(1) - random(2);
Timer1.Enabled := False;
SnowBmp.Canvas.Pen.Color := clBlack;
SnowBmp.Canvas.Brush.Color := clblack;
SnowBmp.Canvas.FillRect(SnowBmp.Canvas.ClipRect);
for i := Low(Snow) to High(Snow) do
Begin
if Snow[i].Position.y > SnowBmp.Height then
Begin
Snow[i].Position.y := 0;
Snow[i].Position.x := Random(SnowBmp.Width);
Snow[i].speedy := Random(5);
Snow[i].wind := random(2) - random(2);
End;
if Snow[i].Position.x > SnowBmp.Width then
Snow[i].Position.x := 0;
if Snow[i].Position.x < 0 then
Snow[i].Position.x := 0;
if Snow[i].Position.y < 0 then
Begin
Snow[i].Position.y := SnowBmp.Height;
Snow[i].speedy := Random(5) - Random(2);
End;
Snow[i].speedy := Snow[i].speedy + (random(6) / 10) - (random(5) / 10) + 0.01;
if round(Snow[i].speedy) = 0 then
Snow[i].speedy := (random(500) / 541.56471) + 0.01;
Snow[i].Position.y := Snow[i].Position.y + round(Snow[i].speedy);
Newy := Snow[i].Position.y;
if ControlCount > 0 then
for j := 0 to ControlCount - 1 do
if (Snow[i].Position.y >= Controls[j].Top) and
(Snow[i].Position.y <= Controls[j].Top + Controls[j].Height) and
(Snow[i].Position.x >= Controls[j].Left) and
(Snow[i].Position.x <= Controls[j].Left + Controls[j].Width) then
Newy := Controls[j].Top - 2;
Snow[i].wind := Snow[i].wind + random(1) - random(1);
Newx := Snow[i].Position.x + round(Snow[i].speedx) + round(Snow[i].wind * wind);
SnowBmp.Canvas.Pen.Color := clWhite;
SnowBmp.Canvas.Brush.Color := Snow[i].Color;
SnowBmp.Canvas.Ellipse(
Newx - (Snow[i].Size),
Newy-(Snow[i].Size),
Newx+(Snow[i].Size),
Newy+(Snow[i].Size));
end;
Canvas.Draw(0, 0, SnowBmp);
Timer1.Enabled := True;
end;
end.
vampir_infernal (2006-11-03 16:32:00) [1]Не важно, проехали тему.
D[u]fa (2006-11-03 16:22:00) [2]по моему глупость сам сказал... какая разница кто и тем более когда ответил?
vampir_infernal (2006-11-03 16:17:00) [3]Я был о Вас лучшенго мнения. Элементарная дипломатия: когда задают вопрос, и кто-то говорит, что сейчас ответит, можно и подождать, а не показывать, какой Вы специалист и профессионал.
К слову, перевод модуля у меня занял пол часа. Остальное время я пытался выйти в инет и запостить его сюда.
Thaddy (2006-11-03 15:42:00) [4]10 minutes ;) Only 20 minutes in a day?....
vampir_infernal (2006-11-03 12:25:00) [5]sht, I'm late.
Потратил половину рабочего дня впустую.
Спасибо за внимание.
karl (2006-11-03 12:12:00) [6]Thanks a lot Thaddy, it works perfectly.
If possible, could you improve the code so that the snow-flakes settle on the ground which will be in this way recovered by snow.
best regards
karl
Thaddy (2006-11-03 10:16:00) [7]Small bug: Connect DoResize to Form.Resize.
Form.OnResize := DoResize;
Thaddy (2006-11-03 10:14:00) [8]
{
program Snow;
uses
Kol,
Unitsnow in 'Unitsnow.pas';
begin
NewForm1( Form1, nil);
Run(Form1.form);
end.
}
unit Unitsnow;
interface
uses
Windows,
Messages,
Kol;
type
TSnow = record
Position: TPoint;
Size: Integer;
speedx: Comp;
speedy: Comp;
wind: real;
color: tcolor;
end;
PForm1 = ^TForm1;
TForm1 = object(Tobj)
Form: pControl;
Timer: PTimer;
private
Snow: array[0..1000] of TSnow;
SnowBmp: PBitmap;
Wind: Real;
public
procedure DoResize(Sender: PObj);
procedure DoDestroy(sender: PObj);
procedure DoTimer(sender: PObj);
end;
procedure NewForm1(var Result: PForm1; AParent: PControl);
var
Form1: pForm1;
implementation
procedure NewForm1(var Result: PForm1; AParent: PControl);
var
i:integer;
begin
New(Result, Create);
with Result^ do
begin
Form := NewForm(AParent, 'KOLForm').SetSize(600, 400).centeronparent.Tabulate;
Applet := Form;
Form.Add2AutoFree(Result);
Randomize;
SnowBmp := NewDibBitmap(Form.ClientWidth, Form.ClientHeight, pf24bit);
for I := Low(Snow) to High(Snow) do
begin
Snow[I].Size := 1;
Snow[I].speedx := random(2) - random(2);
Snow[I].speedy := random(5) + 1;
while Snow[I].wind = 0 do
Snow[I].wind := random(2) - random(2);
end;
Wind := random(50);
I := 0;
Timer := NewTimer(20);
Timer.OnTimer := DoTimer;
Timer.Enabled := true;
end;
end;
procedure TForm1.DoResize(Sender: PObj);
var
I: Integer;
begin
Timer.Enabled := False;
SnowBmp.Width := Form.ClientWidth;
SnowBmp.Height:= Form.ClientHeight;
for I := Low(Snow) to High(Snow) do
begin
Snow[I].Position := MakePoint(Random(Snowbmp.Width), Random(SnowBmp.Height));
Snow[I].wind := random(2) - random(2);
end;
Timer.Enabled := True;
end;
procedure TForm1.DoDestroy(sender: PObj);
begin
Timer.Enabled := False;
Timer.Free;
Snowbmp.Free;
inherited;
end;
procedure TForm1.DoTimer(sender: PObj);
var
I, J: Integer;
Newx, Newy: Integer;
begin
wind := wind + random(1) - random(2);
Timer.Enabled := False;
SnowBmp.Canvas.Pen.Color := clBlack;
SnowBmp.Canvas.Brush.Color := clblack;
SnowBmp.Canvas.FillRect(SnowBmp.Canvas.ClipRect);
for I := Low(Snow) to High(Snow) do
begin
if Snow[I].Position.y > SnowBmp.Height then
begin
Snow[I].Position.y := 0;
Snow[I].Position.x := Random(SnowBmp.Width);
Snow[I].speedy := Random(5);
Snow[I].wind := random(2) - random(2);
end;
if Snow[I].Position.x > SnowBmp.Width then
Snow[I].Position.x := 0;
if Snow[I].Position.x < 0 then
Snow[I].Position.x := 0;
if Snow[I].Position.y < 0 then
begin
Snow[I].Position.y := SnowBmp.Height;
Snow[I].speedy := Random(5) - Random(2);
end;
Snow[I].speedy := Snow[I].speedy + (random(6) / 10) - (random(5) / 10) + 0.01;
if round(Snow[I].speedy) = 0 then
Snow[I].speedy := (random(500) / 541.56471) + 0.01;
Snow[I].Position.y := Snow[I].Position.y + round(Snow[I].speedy);
Newy := Snow[I].Position.y;
if Form.ChildCount > 0 then
for J := 0 to form.ChildCount - 1 do
if (Snow[I].Position.y >= Form.Children[J].Top) and
(Snow[I].Position.y <= Form.Children[J].Top + Form.Children[J].Height) and
(Snow[I].Position.x >= Form.Children[J].Left) and
(Snow[I].Position.x <= Form.Children[J].Left + Form.Children[J].Width) then
Newy := Form.Children[J].Top - 2;
Snow[I].wind := Snow[I].wind + random(1) - random(1);
Newx := Snow[I].Position.x + round(Snow[I].speedx) + round(Snow[I].wind * wind);
SnowBmp.Canvas.Pen.Color := clWhite;
SnowBmp.Canvas.Brush.Color := Snow[I].Color;
SnowBmp.Canvas.Ellipse(
Newx - (Snow[I].Size),
Newy - (Snow[I].Size),
Newx + (Snow[I].Size),
Newy + (Snow[I].Size));
end;
SnowBmp.draw(Form.canvas.handle,0,0);
Timer.Enabled := True;
end;
end.
vampir_infernal (2006-11-03 09:30:00) [9]please, send unit1.dfm to me via email. It is necessary, because I don't know, what is value of Timet1.Interval, Form1.Width and other.
vampir_infernal (2006-11-03 06:54:00) [10]I'll try to help you