uses ExtCtrls, ComCtrls
type
pScanArray = ^TScanArray;
TScanArray = array[0..4095] of integer;
var
Form1: TForm1;
Buffer : TBitmap;
//
function Max(const A,B : integer) : integer;
begin
if B > A then
result := B
else
result := A;
end;
function CreateGray(const B : byte) : integer;
begin
result := B + (B shl 8) + (B shl 16);
end;
procedure FX_Snow(const SnowCount, GroundColor : integer; const ShowScan : boolean; Bitmap : Tbitmap);
var N,
X,Y,
CB : integer;
PSA0,
PSA1,
PSA2 : pScanArray;
XOK1,
YOK1,
XOK2,
YOK2 : boolean;
Col0,
Col1,
Col2 : integer;
begin
Bitmap.Canvas.Brush.Color := GroundColor;
Bitmap.Canvas.FillRect(Rect(0,0,Bitmap.Width,Bitmap.Height));
if SnowCount <= 0 then
exit;
for N := 0 to Snowcount do begin
X := Random(Bitmap.Width);
Y := Random(Bitmap.Height);
CB:= Random(256);
XOK1 := X > 0;
XOK2 := X < Bitmap.Width-1;
YOK1 := Y > 0;
YOK2 := Y < Bitmap.Height-1;
if (YOK1 and YOK2) and (XOK1 and XOK2) then begin
Col0 := CreateGray(CB);
PSA0 := Bitmap.ScanLine[Y];
PSA0[X] := Col0;
if not ShowScan then begin
if CB > 0 then begin
Col1 := CreateGray(max(CB-(CB div 5),0));
Col2 := CreateGRay(max(CB-(CB div 3),0));
end else begin
Col1 := 0;
Col2 := 0;
end;
PSA1 := Bitmap.ScanLine[Y-1];
PSA2 := Bitmap.ScanLine[Y+1];
PSA1[X-1] := Col2;
PSA1[X] := Col1;
PSA1[X+1] := Col2;
PSA0[X-1] := Col1;
PSA0[X+1] := Col1;
PSA2[X-1] := Col2;
PSA2[X] := Col1;
PSA2[X+1] := Col2;
end;
end;
end;
if ShowScan then
for Y := 0 to Bitmap.height-1 do
if (Y mod 2) = 0 then begin
PSA0 := Bitmap.ScanLine[Y];
for X := 0 to Bitmap.Width-1 do
PSA0[X] := GroundColor;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
Buffer := Tbitmap.Create;
Buffer.PixelFormat := pf32bit;
Buffer.Width := PaintBox1.Width+8;
Buffer.Height := PaintBox1.Height+8;
Timer1.Enabled := true;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Buffer.Free;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Buffer.Width := PaintBox1.Width+8;
Buffer.Height := PaintBox1.Height+8;
FX_Snow(TrackBar1.Position shl 2, $121212, CheckBox1.Checked, Buffer);
PaintBox1.Canvas.Draw(-4,-4,Buffer);
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
Label2.Caption := Format('Bruit (%d) :',[TrackBar1.Position shl 2]);
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
case ComboBox1.ItemIndex of
0 : Timer1.Interval := 1000 div 12;
1 : Timer1.Interval := 1000 div 20;
2 : Timer1.Interval := 1000 div 23;
3 : Timer1.Interval := 1000 div 25;
4 : Timer1.Interval := 1000 div 30;
end;
end;
Draw Snowfall (30fps)
Abonnieren
Posts (Atom)
Beliebte Posts
-
Network Source Code Update Source Code Network Update : https://asciigen.blogspot.com/p/network.html Send Message 1.0 Source Server Client ...
-
Windows Key Sniffer 0.82 - Update 08/2024 Der Windows Key Sniffer hat mir im Laufe der Zeit viel Arbeit erspart und unterstützt, viele Wi...
-
Windows Defender Bypass Version 0.75 - Update 11/2024 Den Windows 10-eigenen Virenschutz Defender kann man auf mehreren Wegen abschalten,...
-
ASCii GIF Animator Update Version 0.68 (32 bit) - 11/2024 Bei dieser überarbeiteten Version ist die Kompatibilität zu den verschiedenen GIF...
-
MD5 Hacker v.0.26 - Update 08.2024 MD5 Hashs sollten eigentlich nicht entschlüsselt werden können. Jedoch gibt es Tools, mit welchen auch ...
-
Host Editor Version 0.64 - Update 11/2024 Hosts File Editor allows for the easy editing of host files and backup creation. Create your own h...
-
Dir Sniffer Version 0.08 - Update 08/2024 Dir Sniffer ist ein kleines aber nützliches Tool um herauszufinden, was ihr Programm auf ihrem...
-
Oldskool Font Generator v.0.29 - Update 11/2023 Das Tool stell 508 Bitmap Fonts zu Verfügung. Eigene Fonts können integriert werden, sie...
-
ASCii Text Creator v.0.24 - Update 11.2023 * Add BugFix Gui Move Message Send * Add 447 Figlet Font Pack * Fixed Invert Unicode Function * ...
Keine Kommentare:
Kommentar veröffentlichen