Disco Background Fader

[Madboy]

Option Explicit
 
Dim r As Byte, g As Byte, b As Byte, d(3) As Byte, flag As Byte
 
Private Sub Form_Load()
    Randomize
    r = 255: g = 255: b = 255: flag = 0
 
End Sub
 
Function Ran(ByVal a As Byte, ByVal c As Byte)
    
    If ((Rnd > 0.667 Or c = 0) And c < 255) Then
        c = c + 1
        d(a) = 2
    ElseIf ((Rnd <= 0.5 Or c = 255) And c > 0) Then
        c = c - 1
        d(a) = 1
    Else
        d(a) = 0
    End If
 
    Ran = c
    
End Function
 
Function DoIt(ByVal a As Byte, ByVal c As Byte)
    If ((d(a) = 2 And c < 255) Or c = 0) Then
        c = c + 1
        d(a) = 2
    Else
        If ((d(a) = 1 And c) Or c = 255) Then
            c = c - 1
            d(a) = 1
        End If
        
        If a = 3 Then
            If (d(1) + d(2) + d(3) = 0) Then flag = 1
        End If
    End If
 
    DoIt = c
 
End Function
 
Function Disco()
 
    If flag Then
        r = DoIt(1, r)
        g = DoIt(2, g)
        b = DoIt(3, b)
        flag = flag - 1
    Else
        r = Ran(1, r)
        g = Ran(2, g)
        b = Ran(3, b)
        flag = 50
    End If
    
    Me.BackColor = RGB(r, g, b)
 
End Function
 
Private Sub Timer1_Timer()
Disco
End Sub

NOTE: This was converted from HTML, i think the link to its HTML source was www.wsabstract.com

[Madboy]

Trouble with this is that Labels flicker like mad, even if AutoRedraw is set to True. Anybody know how to stop labels flickering?

Dont say dont use them neither!

[cjqp]

try locking the form (LockWindow API I think), then update it, then unlock.

cjqp

[Madboy]

Too much hassle, just as easy to use locked Textboxes - which dont flicker

[Ishaan]

HI

COULD U PLEASE GUIDE HOW TO USE THE PROG. I ADDED A TIMER BUT ...........


ONIL

ALSO AT
[email protected]
[email protected]

[manavo11]

Did you set an interval for the Timer? 10 ms will do it.

[Ishaan]

THANKS WITH INTERVAL AS 10 ms IT WORKS. ANOTHER QUERY

IN BOTH THE FUNCTIONS Ran AND DoIt HOW DOES, IN THE STARTING a GETS A VALUE 1 AND C = 255?

PLEASE BEAR WITH MY DOUBTS AND HELP

ONIL

[Madboy]

The interval may need changing on the timer, try changing it to 255 - i cant remember the actual value

[Madboy]

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  R,G,B: Byte; //Dim r As Byte, g As Byte, b As Byte
  D,Flag: Byte; //Dim d(3) As Byte, flag As Byte

implementation

{$R *.dfm}

//Function Ran(ByVal a As Byte, ByVal c As Byte)
function Ran(A: Byte; C:Byte): Byte;
begin
  //If ((Rnd > 0.667 Or c = 0) And c < 255) Then
  if (Random >0.667) or (C = 0) and (C <255) then
  begin
    //c = c + 1
    C:= C + 1;
    //d(a) = 2
    A:= 2;
    D:= (A);
  end
  else
  if (Random <=0.5) or (C = 255) and (C >0) then
  begin
    //c = c - 1
    C:= C -1;
    //d(a) = 1
    A:= 1;
    D:= (A);
  end
  else
  begin
    //d(a) = 0
    A:= 0;
    D:= (A);
  end;
  //Ran = c
  Ran:= C;
end;
//End Function

//Function DoIt(ByVal a As Byte, ByVal c As Byte)
function DoIt(A: Byte; C: Byte): Byte;
begin
  //If ((d(a) = 2 And c < 255) Or c = 0) Then
  if (D + A = 2) and (C <255) or (C = 0) then
  begin
    //c = c + 1
    C:= C + 1;
    //d(a) = 2
    A:= 2;
    D:= A;
  end
  else
  //If ((d(a) = 1 And c) Or c = 255) Then
  if (D + A = 1 + C) or (C = 255) then
  begin
    //c = c - 1
    C:= C -1;
    //d(a) = 1
    A:= 1;
    D:= A;
    //If a = 3 Then
    if A = 3 then
    begin
      //If (d(1) + d(2) + d(3) = 0) Then flag = 1
      if (D + 1) + (D + 2) + (D + 3) = 0 then Flag:= 1;
    end;
  end;
  //DoIt = c
  DoIt:= C;
end;
//End Function

//Function Disco()
function Disco: Integer;
begin
  //If Flag Then
  if Flag = -1 then
  begin
    R:= DoIt(1, R); //r = DoIt(1, r)
    G:= DoIt(2, G); //g = DoIt(2, g)
    B:= DoIt(1, B); //b = DoIt(3, b)
    Flag:= Flag -1; //flag = flag - 1
  end
  else
  if Flag = 50 then
  begin
    R:= Ran(1, R); //r = Ran(1, r)
    G:= Ran(2, G); //g = Ran(2, g)
    B:= Ran(3, B); //b = Ran(3, b)
    Flag:= Flag + 50; //flag = 50
  end;
  //Me.BackColor = RGB(r, g, b)
  Form1.Color:= RGB(R,G,B);
end;

//Private Sub Form_Load()
procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer1.Enabled:= True;
  Timer1.Interval:= 10;

  //Randomize;
  Randomize;
  R:= 255; //r = 255
  G:= 255; //g = 255
  B:= 255; //b = 255
  Flag:= 0; //flag = 0
end;

//Private Sub Timer1_Timer()
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  //Disco
  Disco;
end;
//End Sub

end.