Unit AnimThread.pas
unit AnimThread;
interface
uses Windows, Classes, SysUtils, Forms, Graphics, Dialogs, Math;
type
TAnimThread = class(TThread)
private
procedure CentralControl;
public
constructor Create(CreateSuspended:boolean);
protected
procedure Execute; override;
end;
implementation
uses Main;
constructor TAnimThread.Create(CreateSuspended:boolean);
begin
inherited Create(CreateSuspended);
FreeOnTerminate := False;
Priority:=tpTimeCritical;
end;
procedure TAnimThread.CentralControl;
begin
if (Suspended) or (Pause) then Exit;
if not Blacked then
begin
Form1.FillBitmap(0, 0, 0);
Blacked := True;
end;
Form1.ManageAnimationSet;
UpTime := UpTime + 0.004 * random(100);
if UpTime >= 1 then
begin
UpTime := 0;
Inc(Time);
if Time > 10000000 then Time := 0;
if (aCircle in Animations) then Form1.MakeCircleAnimation(10);
if (aRotatingArcCW in Animations) then Form1.MakeRotatingArcCWAnimation(10);
if (aRotatingLineCW in Animations) then Form1.MakeRotatingLineCWAnimation(3);
if (aWeirdLine in Animations) then Form1.MakeWeirdLineAnimation(3);
end;
Form1.Blur;
Form1.Draw;
end;
procedure TAnimThread.Execute;
begin
repeat
sleep(1);
Application.ProcessMessages;
Form1.FPS;
if FramesPerSecond <> 0 then Form1.Caption := '[' + IntToStr(FramesPerSecond) + ' FPS]'
else Form1.Caption := '[Start Up]';
Synchronize(CentralControl);
until Terminated;
end;
end.
Unit1 :
uses AnimThread
const
asBottom=90;
asLeft=180;
asRight=0;
asTop=270;
RadConst=Pi/180;
DegConst=180/Pi;
Sinus: array [0..359] of Extended =
(0, 0.0174524064372835, 0.034899496702501, 0.0523359562429438, 0.0697564737441253, 0.0871557427476582, 0.104528463267653, 0.121869343405147, 0.139173100960065, 0.156434465040231
, 0.17364817766693, 0.190808995376545, 0.207911690817759, 0.224951054343865, 0.241921895599668, 0.258819045102521, 0.275637355816999, 0.292371704722737, 0.309016994374947, 0.325568154457157
, 0.342020143325669, 0.3583679495453, 0.374606593415912, 0.390731128489274, 0.4067366430758, 0.422618261740699, 0.438371146789077, 0.453990499739547, 0.469471562785891, 0.484809620246337
, 0.5, 0.515038074910054, 0.529919264233205, 0.544639035015027, 0.559192903470747, 0.573576436351046, 0.587785252292473, 0.601815023152048, 0.615661475325658, 0.629320391049837
, 0.642787609686539, 0.656059028990507, 0.669130606358858, 0.681998360062499, 0.694658370458997, 0.707106781186548, 0.719339800338651, 0.73135370161917, 0.743144825477394, 0.754709580222772
, 0.766044443118978, 0.777145961456971, 0.788010753606722, 0.798635510047293, 0.809016994374947, 0.819152044288992, 0.829037572555042, 0.838670567945424, 0.848048096156426, 0.857167300702112
, 0.866025403784439, 0.874619707139396, 0.882947592858927, 0.891006524188368, 0.898794046299167, 0.90630778703665, 0.913545457642601, 0.92050485345244, 0.927183854566787, 0.933580426497202
, 0.939692620785908, 0.945518575599317, 0.951056516295154, 0.956304755963035, 0.961261695938319, 0.965925826289068, 0.970295726275996, 0.974370064785235, 0.978147600733806, 0.981627183447664
, 0.984807753012208, 0.987688340595138, 0.99026806874157, 0.992546151641322, 0.994521895368273, 0.996194698091746, 0.997564050259824, 0.998629534754574, 0.999390827019096, 0.999847695156391
, 1, 0.999847695156391, 0.999390827019096, 0.998629534754574, 0.997564050259824, 0.996194698091746, 0.994521895368273, 0.992546151641322, 0.99026806874157, 0.987688340595138
, 0.984807753012208, 0.981627183447664, 0.978147600733806, 0.974370064785235, 0.970295726275996, 0.965925826289068, 0.961261695938319, 0.956304755963035, 0.951056516295154, 0.945518575599317
, 0.939692620785908, 0.933580426497202, 0.927183854566787, 0.92050485345244, 0.913545457642601, 0.90630778703665, 0.898794046299167, 0.891006524188368, 0.882947592858927, 0.874619707139396
, 0.866025403784439, 0.857167300702112, 0.848048096156426, 0.838670567945424, 0.829037572555042, 0.819152044288992, 0.809016994374947, 0.798635510047293, 0.788010753606722, 0.777145961456971
, 0.766044443118978, 0.754709580222772, 0.743144825477394, 0.73135370161917, 0.719339800338651, 0.707106781186548, 0.694658370458997, 0.681998360062499, 0.669130606358858, 0.656059028990507
, 0.642787609686539, 0.629320391049837, 0.615661475325658, 0.601815023152048, 0.587785252292473, 0.573576436351046, 0.559192903470747, 0.544639035015027, 0.529919264233205, 0.515038074910054
, 0.5, 0.484809620246337, 0.469471562785891, 0.453990499739547, 0.438371146789077, 0.422618261740699, 0.4067366430758, 0.390731128489274, 0.374606593415912, 0.3583679495453
, 0.342020143325669, 0.325568154457157, 0.309016994374947, 0.292371704722737, 0.275637355816999, 0.258819045102521, 0.241921895599668, 0.224951054343865, 0.207911690817759, 0.190808995376545
, 0.17364817766693, 0.156434465040231, 0.139173100960065, 0.121869343405147, 0.104528463267653, 0.0871557427476582, 0.0697564737441253, 0.0523359562429438, 0.034899496702501, 0.0174524064372835
, -5.42101086242752E-20, -0.0174524064372835, -0.034899496702501, -0.0523359562429438, -0.0697564737441253, -0.0871557427476582, -0.104528463267653, -0.121869343405147, -0.139173100960065, -0.156434465040231
, -0.17364817766693, -0.190808995376545, -0.207911690817759, -0.224951054343865, -0.241921895599668, -0.258819045102521, -0.275637355816999, -0.292371704722737, -0.309016994374947, -0.325568154457157
, -0.342020143325669, -0.3583679495453, -0.374606593415912, -0.390731128489274, -0.4067366430758, -0.422618261740699, -0.438371146789077, -0.453990499739547, -0.469471562785891, -0.484809620246337
, -0.5, -0.515038074910054, -0.529919264233205, -0.544639035015027, -0.559192903470747, -0.573576436351046, -0.587785252292473, -0.601815023152048, -0.615661475325658, -0.629320391049837
, -0.642787609686539, -0.656059028990507, -0.669130606358858, -0.681998360062499, -0.694658370458997, -0.707106781186548, -0.719339800338651, -0.73135370161917, -0.743144825477394, -0.754709580222772
, -0.766044443118978, -0.777145961456971, -0.788010753606722, -0.798635510047293, -0.809016994374947, -0.819152044288992, -0.829037572555042, -0.838670567945424, -0.848048096156426, -0.857167300702112
, -0.866025403784439, -0.874619707139396, -0.882947592858927, -0.891006524188368, -0.898794046299167, -0.90630778703665, -0.913545457642601, -0.92050485345244, -0.927183854566787, -0.933580426497202
, -0.939692620785908, -0.945518575599317, -0.951056516295154, -0.956304755963035, -0.961261695938319, -0.965925826289068, -0.970295726275996, -0.974370064785235, -0.978147600733806, -0.981627183447664
, -0.984807753012208, -0.987688340595138, -0.99026806874157, -0.992546151641322, -0.994521895368273, -0.996194698091746, -0.997564050259824, -0.998629534754574, -0.999390827019096, -0.999847695156391
, -1, -0.999847695156391, -0.999390827019096, -0.998629534754574, -0.997564050259824, -0.996194698091746, -0.994521895368273, -0.992546151641322, -0.99026806874157, -0.987688340595138
, -0.984807753012208, -0.981627183447664, -0.978147600733806, -0.974370064785235, -0.970295726275996, -0.965925826289068, -0.961261695938319, -0.956304755963035, -0.951056516295154, -0.945518575599317
, -0.939692620785908, -0.933580426497202, -0.927183854566787, -0.92050485345244, -0.913545457642601, -0.90630778703665, -0.898794046299167, -0.891006524188368, -0.882947592858927, -0.874619707139396
, -0.866025403784439, -0.857167300702112, -0.848048096156426, -0.838670567945424, -0.829037572555042, -0.819152044288992, -0.809016994374947, -0.798635510047293, -0.788010753606722, -0.777145961456971
, -0.766044443118978, -0.754709580222772, -0.743144825477394, -0.73135370161917, -0.719339800338651, -0.707106781186548, -0.694658370458997, -0.681998360062499, -0.669130606358858, -0.656059028990507
, -0.642787609686539, -0.629320391049837, -0.615661475325658, -0.601815023152048, -0.587785252292473, -0.573576436351046, -0.559192903470747, -0.544639035015027, -0.529919264233205, -0.515038074910054
, -0.5, -0.484809620246337, -0.469471562785891, -0.453990499739547, -0.438371146789077, -0.422618261740699, -0.4067366430758, -0.390731128489274, -0.374606593415912, -0.3583679495453
, -0.342020143325669, -0.325568154457157, -0.309016994374947, -0.292371704722737, -0.275637355816999, -0.258819045102521, -0.241921895599668, -0.224951054343865, -0.207911690817759, -0.190808995376545
, -0.17364817766693, -0.156434465040231, -0.139173100960065, -0.121869343405147, -0.104528463267653, -0.0871557427476582, -0.0697564737441253, -0.0523359562429438, -0.034899496702501, -0.0174524064372835);
Cosinus: array [0..359] of Extended =
(1, 0.999847695156391, 0.999390827019096, 0.998629534754574, 0.997564050259824, 0.996194698091746, 0.994521895368273, 0.992546151641322, 0.99026806874157, 0.987688340595138
, 0.984807753012208, 0.981627183447664, 0.978147600733806, 0.974370064785235, 0.970295726275996, 0.965925826289068, 0.961261695938319, 0.956304755963035, 0.951056516295154, 0.945518575599317
, 0.939692620785908, 0.933580426497202, 0.927183854566787, 0.92050485345244, 0.913545457642601, 0.90630778703665, 0.898794046299167, 0.891006524188368, 0.882947592858927, 0.874619707139396
, 0.866025403784439, 0.857167300702112, 0.848048096156426, 0.838670567945424, 0.829037572555042, 0.819152044288992, 0.809016994374947, 0.798635510047293, 0.788010753606722, 0.777145961456971
, 0.766044443118978, 0.754709580222772, 0.743144825477394, 0.73135370161917, 0.719339800338651, 0.707106781186548, 0.694658370458997, 0.681998360062499, 0.669130606358858, 0.656059028990507
, 0.642787609686539, 0.629320391049837, 0.615661475325658, 0.601815023152048, 0.587785252292473, 0.573576436351046, 0.559192903470747, 0.544639035015027, 0.529919264233205, 0.515038074910054
, 0.5, 0.484809620246337, 0.469471562785891, 0.453990499739547, 0.438371146789077, 0.422618261740699, 0.4067366430758, 0.390731128489274, 0.374606593415912, 0.3583679495453
, 0.342020143325669, 0.325568154457157, 0.309016994374947, 0.292371704722737, 0.275637355816999, 0.258819045102521, 0.241921895599668, 0.224951054343865, 0.207911690817759, 0.190808995376545
, 0.17364817766693, 0.156434465040231, 0.139173100960065, 0.121869343405147, 0.104528463267653, 0.0871557427476582, 0.0697564737441253, 0.0523359562429438, 0.034899496702501, 0.0174524064372835
, -2.71050543121376E-20, -0.0174524064372835, -0.034899496702501, -0.0523359562429438, -0.0697564737441253, -0.0871557427476582, -0.104528463267653, -0.121869343405147, -0.139173100960065, -0.156434465040231
, -0.17364817766693, -0.190808995376545, -0.207911690817759, -0.224951054343865, -0.241921895599668, -0.258819045102521, -0.275637355816999, -0.292371704722737, -0.309016994374947, -0.325568154457157
, -0.342020143325669, -0.3583679495453, -0.374606593415912, -0.390731128489274, -0.4067366430758, -0.422618261740699, -0.438371146789077, -0.453990499739547, -0.469471562785891, -0.484809620246337
, -0.5, -0.515038074910054, -0.529919264233205, -0.544639035015027, -0.559192903470747, -0.573576436351046, -0.587785252292473, -0.601815023152048, -0.615661475325658, -0.629320391049837
, -0.642787609686539, -0.656059028990507, -0.669130606358858, -0.681998360062499, -0.694658370458997, -0.707106781186548, -0.719339800338651, -0.73135370161917, -0.743144825477394, -0.754709580222772
, -0.766044443118978, -0.777145961456971, -0.788010753606722, -0.798635510047293, -0.809016994374947, -0.819152044288992, -0.829037572555042, -0.838670567945424, -0.848048096156426, -0.857167300702112
, -0.866025403784439, -0.874619707139396, -0.882947592858927, -0.891006524188368, -0.898794046299167, -0.90630778703665, -0.913545457642601, -0.92050485345244, -0.927183854566787, -0.933580426497202
, -0.939692620785908, -0.945518575599317, -0.951056516295154, -0.956304755963035, -0.961261695938319, -0.965925826289068, -0.970295726275996, -0.974370064785235, -0.978147600733806, -0.981627183447664
, -0.984807753012208, -0.987688340595138, -0.99026806874157, -0.992546151641322, -0.994521895368273, -0.996194698091746, -0.997564050259824, -0.998629534754574, -0.999390827019096, -0.999847695156391
, -1, -0.999847695156391, -0.999390827019096, -0.998629534754574, -0.997564050259824, -0.996194698091746, -0.994521895368273, -0.992546151641322, -0.99026806874157, -0.987688340595138
, -0.984807753012208, -0.981627183447664, -0.978147600733806, -0.974370064785235, -0.970295726275996, -0.965925826289068, -0.961261695938319, -0.956304755963035, -0.951056516295154, -0.945518575599317
, -0.939692620785908, -0.933580426497202, -0.927183854566787, -0.92050485345244, -0.913545457642601, -0.90630778703665, -0.898794046299167, -0.891006524188368, -0.882947592858927, -0.874619707139396
, -0.866025403784439, -0.857167300702112, -0.848048096156426, -0.838670567945424, -0.829037572555042, -0.819152044288992, -0.809016994374947, -0.798635510047293, -0.788010753606722, -0.777145961456971
, -0.766044443118978, -0.754709580222772, -0.743144825477394, -0.73135370161917, -0.719339800338651, -0.707106781186548, -0.694658370458997, -0.681998360062499, -0.669130606358858, -0.656059028990507
, -0.642787609686539, -0.629320391049837, -0.615661475325658, -0.601815023152048, -0.587785252292473, -0.573576436351046, -0.559192903470747, -0.544639035015027, -0.529919264233205, -0.515038074910054
, -0.5, -0.484809620246337, -0.469471562785891, -0.453990499739547, -0.438371146789077, -0.422618261740699, -0.4067366430758, -0.390731128489274, -0.374606593415912, -0.3583679495453
, -0.342020143325669, -0.325568154457157, -0.309016994374947, -0.292371704722737, -0.275637355816999, -0.258819045102521, -0.241921895599668, -0.224951054343865, -0.207911690817759, -0.190808995376545
, -0.17364817766693, -0.156434465040231, -0.139173100960065, -0.121869343405147, -0.104528463267653, -0.0871557427476582, -0.0697564737441253, -0.0523359562429438, -0.034899496702501, -0.0174524064372835
, 1.89735380184963E-19, 0.0174524064372835, 0.034899496702501, 0.0523359562429438, 0.0697564737441253, 0.0871557427476582, 0.104528463267653, 0.121869343405147, 0.139173100960065, 0.156434465040231
, 0.17364817766693, 0.190808995376545, 0.207911690817759, 0.224951054343865, 0.241921895599668, 0.258819045102521, 0.275637355816999, 0.292371704722737, 0.309016994374947, 0.325568154457157
, 0.342020143325669, 0.3583679495453, 0.374606593415912, 0.390731128489274, 0.4067366430758, 0.422618261740699, 0.438371146789077, 0.453990499739547, 0.469471562785891, 0.484809620246337
, 0.5, 0.515038074910054, 0.529919264233205, 0.544639035015027, 0.559192903470747, 0.573576436351046, 0.587785252292473, 0.601815023152048, 0.615661475325658, 0.629320391049837
, 0.642787609686539, 0.656059028990507, 0.669130606358858, 0.681998360062499, 0.694658370458997, 0.707106781186548, 0.719339800338651, 0.73135370161917, 0.743144825477394, 0.754709580222772
, 0.766044443118978, 0.777145961456971, 0.788010753606722, 0.798635510047293, 0.809016994374947, 0.819152044288992, 0.829037572555042, 0.838670567945424, 0.848048096156426, 0.857167300702112
, 0.866025403784439, 0.874619707139396, 0.882947592858927, 0.891006524188368, 0.898794046299167, 0.90630778703665, 0.913545457642601, 0.92050485345244, 0.927183854566787, 0.933580426497202
, 0.939692620785908, 0.945518575599317, 0.951056516295154, 0.956304755963035, 0.961261695938319, 0.965925826289068, 0.970295726275996, 0.974370064785235, 0.978147600733806, 0.981627183447664
, 0.984807753012208, 0.987688340595138, 0.99026806874157, 0.992546151641322, 0.994521895368273, 0.996194698091746, 0.997564050259824, 0.998629534754574, 0.999390827019096, 0.999847695156391);
AnimCount=4;
type
TRGB=record
R, G, B: Extended;
end;
THSV=record
H, S, V: Extended;
end;
TAnimation=(aCircle, aRotatingArcCW, aRotatingLineCW, aWeirdLine);
TAnimations=set of TAnimation;
TAnimParams=record
RGB: TRGB;
HSV: THSV;
Angle: Integer;
end;
TRGBARRAY=array [0..512] of TRGBQUAD;
PRGBARRAY=^TRGBARRAY;
public
{ Public declarations }
procedure InitLines;
procedure Draw;
procedure FillBitmap(R, G, B: Byte);
function AsByte(X: Integer): Byte;
procedure SetPixel(X, Y: Cardinal; R, G, B: Byte);
function GetPixel(X, Y: Integer): TRGBQUAD;
function ScaleTo(X: Extended; Scale: Extended): Extended; overload;
function ScaleTo(X: Int64; Scale: Int64): Int64; overload;
procedure IncColor(Animation: TAnimation);
procedure ManageAnimationSet;
procedure PlaceRandomPixel(R, G, B: Byte);
procedure Blur;
procedure CreateCircle(R, G, B: Byte; Radius: Extended; Center: TPoint);
procedure CreateArc(R, G, B: Byte; Radius: Extended; Center: TPoint; ArcValue: Integer; ArcStart: Integer);
procedure CreateLine(R, G, B: Byte; M, N: TPoint; Width: Extended);
procedure MakeCircleAnimation(CircleWidth: Integer);
procedure MakeRotatingArcCWAnimation(ArcWidth: Integer);
procedure MakeRotatingLineCWAnimation(LineWidth: Integer);
procedure MakeWeirdLineAnimation(LineWidth: Integer);
procedure FPS;
end;
var
Form1: TForm1;
ANIMWIDTH, ANIMHEIGHT: Integer;
IMGCENTER: TPoint;
Thrd: TAnimThread;
Lines: array of PRGBARRAY;
Bmp: TBitmap;
Time: Int64;
BlurInc: Cardinal;
UpTime: Double;
AnimParams: array [TAnimation] of TAnimParams;
Animations: TAnimations;
LastT: Integer;
FPSCount: Integer;
FramesPerSecond: Integer;
Pause: Boolean;
Blacked: Boolean;
//
procedure TForm1.FPS;
var
T: Integer;
begin
T := GetTickCount;
if T-LastT >= 1000 then
begin
FramesPerSecond := FPSCount;
LastT := T;
fpsCount := 0;
end
else Inc(FPSCount);
end;
PROCEDURE RGBToHSV (CONST RGB: TRGB; VAR HSV: THSV);
VAR
Delta: Extended;
Min : Extended;
BEGIN
Min := MinValue( [RGB.R, RGB.G, RGB.B] );
HSV.V := MaxValue( [RGB.R, RGB.G, RGB.B] );
Delta := HSV.V - Min;
IF HSV.V = 0.0
THEN HSV.S := 0
ELSE HSV.S := Delta / HSV.V;
IF HSV.S = 0.0
THEN HSV.H := NaN
ELSE BEGIN
IF RGB.R = HSV.V
THEN
HSV.H := 60.0 * (RGB.G - RGB.B) / Delta
ELSE
IF RGB.G = HSV.V
THEN
HSV.H := 120.0 + 60.0 * (RGB.B - RGB.R) / Delta
ELSE
IF RGB.B = HSV.V
THEN
HSV.H := 240.0 + 60.0 * (RGB.R - RGB.G) / Delta;
IF HSV.H < 0.0
THEN HSV.H := HSV.H + 360.0
END
END;
PROCEDURE HSVtoRGB (CONST HSV: THSV; VAR RGB: TRGB);
VAR
f : Extended;
i : INTEGER;
hTemp: Extended;
p,q,t: Extended;
BEGIN
IF HSV.S = 0.0
THEN BEGIN
IF IsNaN(HSV.H)
THEN BEGIN
RGB.R := HSV.V;
RGB.G := HSV.V;
RGB.B := HSV.V
END
ELSE Exit;
END
ELSE BEGIN
IF HSV.H = 360.0
THEN hTemp := 0.0
ELSE hTemp := HSV.H;
hTemp := hTemp / 60;
i := TRUNC(hTemp);
f := hTemp - i;
p := HSV.V * (1.0 - HSV.S);
q := HSV.V * (1.0 - (HSV.S * f));
t := HSV.V * (1.0 - (HSV.S * (1.0 - f)));
CASE i OF
0: BEGIN RGB.R := HSV.V; RGB.G := t; RGB.B := p END;
1: BEGIN RGB.R := q; RGB.G := HSV.V; RGB.B := p END;
2: BEGIN RGB.R := p; RGB.G := HSV.V; RGB.B := t END;
3: BEGIN RGB.R := p; RGB.G := q; RGB.B := HSV.V END;
4: BEGIN RGB.R := t; RGB.G := p; RGB.B := HSV.V END;
5: BEGIN RGB.R := HSV.V; RGB.G := p; RGB.B := q END
END
END
END;
function Rad(Deg: Extended): Extended;
begin
Result := Deg * RadConst;
end;
function Deg(Rad: Extended): Extended;
begin
Result := Rad * DegConst;
end;
procedure TForm1.FormCreate(Sender: TObject);
Var
I: Integer;
HSV: THSV;
Res: TPoint;
Temp: TBitmap;
begin
if MessageDlg('High quality?', mtConfirmation, [mbYes, mbNo], 0) = mrYes
then DoubleBuffered := True
else DoubleBuffered := False;
case MessageDlg('Quelle résolution ?' + chr(13) + chr(13)
+ 'Click OK to set resolution at 512x512.' + chr(13)
+ 'Click Yes to set resolution at 256x256.' + chr(13)
+ 'Click No to set resolution at 128x128.' + chr(13)
, mtConfirmation, [mbOK, mbYes, mbNo], 0) of
mrOK: Res := Point(512, 512);
mrYes: Res := Point(256, 256);
mrNo: Res := Point(128, 128);
end;
ANIMWIDTH := Res.X - 1;
ANIMHEIGHT := Res.Y - 1;
IMGCENTER := Point(ANIMWIDTH div 2, ANIMHEIGHT div 2);
SetLength(Lines, ANIMHEIGHT - 1);
ClientWidth := ANIMWIDTH;
ClientHeight := ANIMHEIGHT;
Temp := TBitmap.Create;
Temp.PixelFormat := pf1Bit;
Temp.Width := ANIMWIDTH + 1;
Temp.Height := ANIMHEIGHT + 1;
Temp.PixelFormat := pf1Bit;
Image1.Picture.Bitmap.Assign(Temp);
Image1.Picture.Bitmap.PixelFormat := pf1Bit;
Temp.Free;
sleep(100);
Application.ProcessMessages;
BlurInc := 0;
randomize;
Animations := [aCircle, aRotatingArcCW, aRotatingLineCW, aWeirdLine];
for I := 0 to AnimCount - 1 do
begin
AnimParams[TAnimation(I)].Angle := 0;
AnimParams[TAnimation(I)].RGB.R := random(192) + 64;
AnimParams[TAnimation(I)].RGB.G := random(192) + 64;
AnimParams[TAnimation(I)].RGB.B := random(192) + 64;
RGBTOHSV(AnimParams[TAnimation(I)].RGB, HSV);
AnimParams[TAnimation(I)].HSV := HSV;
end;
Time := 0;
UpTime := 0.0;
Image1.Picture.Bitmap.PixelFormat := pf32Bit;
Bmp := TBitmap.Create;
Bmp.Width := ANIMWIDTH;
Bmp.Height := ANIMHEIGHT;
Bmp.PixelFormat := pf32Bit;
InitLines;
FillBitmap(0, 0, 0);
Draw;
Thrd.Resume;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Thrd.Suspend;
Bmp.Free;
end;
procedure TForm1.ManageAnimationSet;
Var
A, B: Integer;
AnimSrc, AnimDest: TAnimation;
begin
A := random(300);
if A <> 7 then Exit;
A := random(AnimCount);
B := random(AnimCount);
AnimSrc := TAnimation(A);
AnimDest := TAnimation(B);
Animations := Animations - [AnimSrc];
Animations := Animations + [AnimDest];
if Animations = [] then Animations := Animations + [TAnimation(random(AnimCount))];
end;
procedure TForm1.InitLines;
var
I: Integer;
begin
for I := 0 to ANIMHEIGHT - 1 do
Lines[I] := Bmp.ScanLine[I];
end;
procedure TForm1.Draw;
begin
Image1.Canvas.Draw(0, 0, Bmp);
end;
procedure TForm1.FillBitmap(R, G, B: Byte);
var
I, J: Integer;
begin
for I := 0 to ANIMHEIGHT - 1 do
for J := 0 to ANIMWIDTH - 1 do
SetPixel(J, I, R, G, B);
end;
procedure TForm1.SetPixel(X, Y: Cardinal; R, G, B: Byte);
begin
try
if Thrd.Suspended then Exit;
Lines[Y][X].rgbBlue := B;
Lines[Y][X].rgbGreen := G;
Lines[Y][X].rgbRed := R;
Lines[Y][X].rgbReserved := 0;
except
end;
end;
function TForm1.GetPixel(X, Y: Integer): TRGBQUAD;
begin
try
if not Thrd.Suspended then Result := Lines[Y, X];
except
end;
end;
function TForm1.AsByte(X: Integer): Byte;
begin
if X < 0 then X := 0;
if X > 255 then X := 255;
Result := X;
end;
procedure TForm1.Blur;
var
I, J: Integer;
R, G, B: Cardinal;
begin
asm INC BlurInc end;
if BlurInc > 1000000 then BlurInc := 0;
for I := 0 to ANIMHEIGHT - 2 do
begin
case Odd(BlurInc) of
False: if Odd(I) then Continue;
True: if not Odd(I) then Continue;
end;
for J := 0 to ANIMWIDTH - 2 do
begin
R := (GetPixel(J, I).rgbRed + GetPixel(J + 1, I).rgbRed + GetPixel(J, I + 1).rgbRed + GetPixel(J + 1, I + 1).rgbRed) div 4;
G := (GetPixel(J, I).rgbGreen + GetPixel(J + 1, I).rgbGreen + GetPixel(J, I + 1).rgbGreen + GetPixel(J + 1, I + 1).rgbGreen) div 4;
B := (GetPixel(J, I).rgbBlue + GetPixel(J + 1, I).rgbBlue + GetPixel(J, I + 1).rgbBlue + GetPixel(J + 1, I + 1).rgbBlue) div 4;
SetPixel(J, I, AsByte(R), AsByte(G), AsByte(B));
SetPixel(J + 1, I, AsByte(R), AsByte(G), AsByte(B));
SetPixel(J, I + 1, AsByte(R), AsByte(G), AsByte(B));
SetPixel(J + 1, I + 1, AsByte(R), AsByte(G), AsByte(B));
end;
end;
end;
procedure TForm1.PlaceRandomPixel(R, G, B: Byte);
begin
SetPixel(random(ANIMWIDTH), random(ANIMHEIGHT), R, G, B);
end;
function TForm1.ScaleTo(X: Extended; Scale: Extended): Extended;
begin
X := Abs(X);
while X >= Scale do X := X - 360;
Result := X;
end;
function TForm1.ScaleTo(X: Int64; Scale: Int64): Int64;
begin
X := Abs(X);
while X >= Scale do X := X - 360;
Result := X;
end;
procedure TForm1.IncColor(Animation: TAnimation);
Var
ARGB: TRGB;
begin
with AnimParams[Animation] do
begin
HSV.H := HSV.H + 1;
HSV.H := ScaleTo(HSV.H, 360);
HSVTORGB(HSV, ARGB);
RGB := ARGB;
end;
end;
procedure TForm1.CreateCircle(R, G, B: Byte; Radius: Extended; Center: TPoint);
Var
A: Integer;
S, C: Integer;
begin
for A := 0 to 359 do
begin
S := Round(Sinus[A] * Radius);
C := Round(Cosinus[A] * Radius);
SetPixel(Center.X + C, Center.Y + S, R, G, B);
end;
end;
procedure TForm1.CreateArc(R, G, B: Byte; Radius: Extended; Center: TPoint; ArcValue: Integer; ArcStart: Integer);
Var
Start, A, Angle: Integer;
S, C: Integer;
begin
ArcValue := ScaleTo(ArcValue, 360);
ArcStart := ScaleTo(ArcStart, 360);
Start := ArcStart;
case ArcStart of
asTop: Start := 270;
asRight: Start := 0;
asBottom: Start := 90;
asLeft: Start := 180;
end;
for A := Start to Start + ArcValue do
begin
Angle := A;
Angle := ScaleTo(Angle, 360);
S := Round(Sinus[Angle] * Radius);
C := Round(Cosinus[Angle] * Radius);
SetPixel(Center.X + C, Center.Y + S, R, G, B);
end;
end;
procedure TForm1.CreateLine(R, G, B: Byte; M, N: TPoint; Width: Extended);
const
EPSILON=0.00000000001;
Var
A, Bf: Extended;
I, J: Integer;
begin
if M.X = N.X then Exit;
A := (N.Y - M.Y) / ((N.X - M.X) + EPSILON);
Bf := -(A * N.X - N.Y);
for I := 0 to ANIMHEIGHT - 1 do
for J := 0 to ANIMWIDTH - 1 do
begin
if Abs(((A * J) + Bf) - I) <= Width then SetPixel(J, I, R, G, B);
end;
end;
procedure TForm1.MakeCircleAnimation(CircleWidth: Integer);
Var
R, G, B, I: Integer;
begin
IncColor(aCircle);
with AnimParams[aCircle] do
begin
R := Round(RGB.R);
G := Round(RGB.G);
B := Round(RGB.B);
end;
for I := 1 to CircleWidth do
CreateCircle(R, G, B, (ANIMWIDTH div 2) - (I - 1), IMGCENTER);
end;
procedure TForm1.MakeRotatingArcCWAnimation(ArcWidth: Integer);
Var
R, G, B, I: Integer;
begin
IncColor(aRotatingArcCW);
with AnimParams[aRotatingArcCW] do
begin
R := Round(RGB.R);
G := Round(RGB.G);
B := Round(RGB.B);
Inc(Angle, 10);
Angle := ScaleTo(Angle, 360);
end;
for I := 1 to ArcWidth do
CreateArc(R, G, B, (ANIMWIDTH div 3) - (I - 1), IMGCENTER, AnimParams[aRotatingArcCW].Angle, AnimParams[aRotatingArcCW].Angle + randomrange(135, 225));
end;
procedure TForm1.MakeRotatingLineCWAnimation(LineWidth: Integer);
Var
R, G, B: Integer;
X, Y: Integer;
begin
IncColor(aRotatingLineCW);
with AnimParams[aRotatingLineCW] do
begin
R := Round(RGB.R);
G := Round(RGB.G);
B := Round(RGB.B);
Inc(Angle, 10);
Angle := ScaleTo(Angle, 360);
X := Round(IMGCENTER.X + Deg(Cosinus[Angle]));
Y := Round(IMGCENTER.Y + Deg(Sinus[Angle]));
end;
CreateLine(R, G, B, Point(X, Y), Point(ANIMWIDTH - X, ANIMHEIGHT - Y), LineWidth);
end;
procedure TForm1.MakeWeirdLineAnimation(LineWidth: Integer);
Var
R, G, B: Integer;
X, Y: Integer;
begin
IncColor(aWeirdLine);
with AnimParams[aWeirdLine] do
begin
R := Round(RGB.R);
G := Round(RGB.G);
B := Round(RGB.B);
Inc(Angle, 10);
Angle := ScaleTo(Angle, 360);
X := Round(IMGCENTER.X + Deg(Cosinus[Angle]));
Y := Round(IMGCENTER.Y + Deg(Sinus[Angle]));
end;
CreateLine(R, G, B, Point(X, Y), Point(ANIMWIDTH - X, ANIMHEIGHT - X), LineWidth);
end;
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_SPACE then Pause := not Pause;
end;
initialization
Thrd := TAnimThread.Create(True);
finalization
Thrd.Free;
Keine Kommentare:
Kommentar veröffentlichen