home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 March / Chip_1999-03_cd.bin / zkuste / delphi / D234 / AR_COMPS.ZIP / CCLabel.pas < prev    next >
Pascal/Delphi Source File  |  1999-01-24  |  4KB  |  153 lines
  1. {##############################################################################
  2.  # Name:           TCCLabel - Cycle Color Label                               #
  3.  # Author:         Adrian Roberto Barbosa                                     #
  4.  # Created:        19/01/1999                                                 #
  5.  # UpDated:        20/01/1999                                                 #
  6.  # Version:        1.1 alphabetagamma...                                      #
  7.  # Description:    This is a simple component derivated from a TLabel that    #
  8.  #                 cycles their color using the RGB colors.                   #
  9.  #                 It has only two "new" properties: Active & Interval:       #
  10.  #                    Active initiate or stops cycle, and                     #
  11.  #                    Interval sets the speed of the cycle. It's all!         #
  12.  # Revisions:      1.0 beta                                 Date: 11/11/1998  #
  13.  #                 1.1                                      Date: 11/12/1998  #
  14.  #                 1.2                                      Date: 12/02/1998  #
  15.  # Delphi:         Delphi 2 (tested) or later (developed in Delphi 4)         #
  16.  # Copyright:      None!!! It's free, so comments are welcome...              #
  17.  # Contact:        adrianrb@netsite.com.br OR adrianrb@base.com.br            #
  18.  ##############################################################################}
  19. unit CCLabel;
  20.  
  21. interface
  22.  
  23. uses
  24.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  25.   StdCtrls, ExtCtrls;
  26.  
  27. type
  28.   TCCLabel = class(TLabel)
  29.   private
  30.     { Private declarations }
  31.     Timer: TTimer;
  32.     fInterval: Integer;
  33.     fActive: Boolean;
  34.   protected
  35.     { Protected declarations }
  36.     procedure SetInterval(Value: Integer);
  37.     procedure SetActive(Value: Boolean);
  38.   public
  39.     { Public declarations }
  40.     constructor Create(AOwner: TComponent);override;
  41.     destructor Destroy;
  42.     procedure AtTime(Sender: TObject);
  43.   published
  44.     { Published declarations }
  45.     property Active: Boolean read fActive write SetActive;
  46.     property Interval: Integer read fInterval write SetInterval;
  47.   end;
  48.  
  49. procedure Register;
  50.  
  51. implementation
  52.  
  53. var RedCount, GreenCount, BlueCount: Integer;
  54.     RedDir, GreenDir, BlueDir: Boolean;
  55.  
  56. procedure Register;
  57. begin
  58.   RegisterComponents('Samples', [TCCLabel]);
  59. end;
  60.  
  61. constructor TCCLabel.Create(AOwner: TComponent);
  62. begin
  63.   inherited Create(AOwner);
  64.   Timer := TTimer.Create(Self);
  65.   Randomize;
  66.   Font.Size := 26;
  67.   fInterval := 100;
  68.   RedCount := Random(255);
  69.   GreenCount := Random(255);
  70.   BlueCount := Random(255);
  71.   RedDir := Boolean(Random(2));
  72.   GreenDir := Boolean(Random(2));
  73.   BlueDir := Boolean(Random(2));
  74. end;
  75.  
  76. destructor TCCLabel.Destroy;
  77. begin
  78.   Timer.Free;
  79. end;
  80.  
  81. procedure TCCLabel.SetActive(Value: Boolean);
  82. begin
  83.   fActive := Value;
  84.   if Value then
  85.     Timer.Enabled := True
  86.   else
  87.     Timer.Enabled := False;
  88.   SetInterval(fInterval);
  89. end;
  90.  
  91. procedure TCCLabel.SetInterval(Value: Integer);
  92. begin
  93.   if Value > 0 then
  94.     begin
  95.       fInterval := Value;
  96.       if fActive then
  97.         begin
  98.           Timer.Interval := fInterval;
  99.           Timer.OnTimer := AtTime;
  100.         end;
  101.     end;
  102. end;
  103.  
  104. procedure TCCLabel.AtTime(Sender: TObject);
  105. begin
  106.   if RedDir then
  107.     Inc(RedCount,2)
  108.   else
  109.     Dec(RedCount,2);
  110.   if GreenDir then
  111.     Inc(GreenCount,1)
  112.   else
  113.     Dec(GreenCount,1);
  114.   if BlueDir then
  115.     Inc(BlueCount,3)
  116.   else
  117.     Dec(BlueCount,3);
  118.  
  119.   if RedCount <= 0 then
  120.     begin
  121.       RedCount := 0;
  122.       RedDir := True;
  123.     end;
  124.   if RedCount >= 255 then
  125.     begin
  126.       RedCount := 255;
  127.       RedDir := False;
  128.     end;
  129.   if GreenCount <= 0 then
  130.     begin
  131.       GreenCount := 0;
  132.       GreenDir := True;
  133.     end;
  134.   if GreenCount >= 255 then
  135.     begin
  136.       GreenCount := 255;
  137.       GreenDir := False;
  138.     end;
  139.   if BlueCount <= 0 then
  140.     begin
  141.       BlueCount := 0;
  142.       BlueDir := True;
  143.     end;
  144.   if BlueCount >= 255 then
  145.     begin
  146.       BlueCount := 255;
  147.       BlueDir := False;
  148.     end;
  149.  
  150.   Font.Color := RGB(RedCount,GreenCount,BlueCount);
  151. end;
  152.  
  153. end.