Disco Background Fader

VB Code:

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

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!:p

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

cjqp

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

HI

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


ONIL

ALSO AT
[email protected]
[email protected]

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

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

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

Code:

---

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.

---