home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2.0 - Programmer's Utilities Power Pack / Delphi 2.0 Programmer's Utilities Power Pack.iso / e_to_l / graflite / graflite.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  5.8 KB  |  155 lines
  1. unit Graflite;
  2.  
  3. interface {=== GrafLite Unit ===}
  4.  
  5.   uses
  6.      WinTypes, WinProcs, Controls, Classes, Forms, DsgnIntf, StdCtrls, Graphics;
  7.  
  8.   type
  9.     TActiveLight = ( alRed, alBlue, alGreen, alYellow, alMangenta, alGray, alCyan, alWhite );
  10.     TLightArray = array[ TActiveLight ] of TColor;
  11.  
  12.   type
  13.     TGraphicLight = class( TGraphicControl)
  14.     private
  15.       FActiveLight : TActiveLight;
  16.       FOnOff: Boolean;
  17.       FHeavyLite: Boolean;
  18.     protected
  19.       procedure Paint; override;
  20.     public
  21.       constructor Create(AOwner: TComponent); override;
  22.     published
  23.       property Width default 17;
  24.       property Height default 17;
  25.       procedure SetActiveLight( Value : TActiveLight );
  26.       procedure SetDarkLite( Value : Boolean );
  27.       procedure SetHeavyLite( Value : Boolean );
  28.       property ActiveLight : TActiveLight read FActiveLight
  29.                                           write SetActiveLight;
  30.       property DarkLite: Boolean read FOnOff write SetDarkLite default True;
  31.       property HeavyLite: Boolean read FHeavyLite write SetHeavyLite default True;
  32.       property OnClick;            { Make OnClick event visible }
  33.     end;
  34.  
  35.   procedure Register;
  36.  
  37. implementation {=== GrafLite Unit ===}
  38.  
  39. {$R glite.res}
  40.  
  41.   uses
  42.     Messages;
  43.  
  44.   {===========================}
  45.   {== TGraphicLight Methods ==}
  46.   {===========================}
  47.  
  48.   constructor TGraphicLight.Create( AOwner : TComponent );
  49.   begin
  50.     inherited Create( AOwner );
  51.     FActiveLight := alGreen;           { Set Default Active Light }
  52.     Width := 17;                       { Set Default Width }
  53.     Height := 17;                      { Set Default Height }
  54.     DarkLite := false;               { Set Default OnOff switch }
  55.     FHeavyLite := true;                     { Set Default Lite Type }
  56.   end; {= TGraphicLight.Create =}
  57.  
  58.   procedure TGraphicLight.Paint;
  59.   var BM:TBitmap;
  60.   Dest: TRect;
  61.   begin
  62.   BM:=TBitmap.Create;
  63.   Canvas.Brush.Style := bsClear;
  64.    if not FHeavyLite then
  65.    begin
  66.     if not FOnOff then
  67.     begin
  68.      if FActiveLight=alred then bm.handle:=loadbitmap(hinstance,'RED') else
  69.      if FActiveLight=algreen then bm.handle:=loadbitmap(hinstance,'GREEN')else
  70.      if FActiveLight=alblue then bm.handle:=loadbitmap(hinstance,'BLUE')else
  71.      if FActiveLight=alyellow then bm.handle:=loadbitmap(hinstance,'YELLOW')else
  72.      if FActiveLight=almangenta then bm.handle:=loadbitmap(hinstance,'MANGENTA')else
  73.      if FActiveLight=algray then bm.handle:=loadbitmap(hinstance,'GRAY')else
  74.      if FActiveLight=alcyan then bm.handle:=loadbitmap(hinstance,'CYAN')else
  75.      if FActiveLight=alwhite then bm.handle:=loadbitmap(hinstance,'WHITE')
  76.    end;
  77.  
  78.    if FOnOff then
  79.    begin
  80.     if FActiveLight=alred then bm.handle:=loadbitmap(hinstance,'DARK_RED') else
  81.     if FActiveLight=algreen then bm.handle:=loadbitmap(hinstance,'DARK_GREEN')else
  82.     if FActiveLight=alblue then bm.handle:=loadbitmap(hinstance,'DARK_BLUE')else
  83.     if FActiveLight=alyellow then bm.handle:=loadbitmap(hinstance,'DARK_YELLOW')else
  84.     if FActiveLight=almangenta then bm.handle:=loadbitmap(hinstance,'DARK_MANGENTA')else
  85.     if FActiveLight=algray then bm.handle:=loadbitmap(hinstance,'DARK_GRAY')else
  86.     if FActiveLight=alcyan then bm.handle:=loadbitmap(hinstance,'DARK_CYAN')else
  87.     if FActiveLight=alwhite then bm.handle:=loadbitmap(hinstance,'BLACK');
  88.    end;
  89.    end
  90.    else begin
  91.    if not FOnOff then
  92.    begin
  93.     if FActiveLight=alred then bm.handle:=loadbitmap(hinstance,'RED_LITE') else
  94.     if FActiveLight=algreen then bm.handle:=loadbitmap(hinstance,'GREEN_LITE')else
  95.     if FActiveLight=alblue then bm.handle:=loadbitmap(hinstance,'BLUE_LITE')else
  96.     if FActiveLight=alyellow then bm.handle:=loadbitmap(hinstance,'YELLOW_LITE')else
  97.     if FActiveLight=almangenta then bm.handle:=loadbitmap(hinstance,'MANGENTA_LITE')else
  98.     if FActiveLight=algray then bm.handle:=loadbitmap(hinstance,'GRAY_LITE')else
  99.     if FActiveLight=alcyan then bm.handle:=loadbitmap(hinstance,'CYAN_LITE')else
  100.     if FActiveLight=alwhite then bm.handle:=loadbitmap(hinstance,'WHITE_LITE')
  101.    end;
  102.  
  103.    if FOnOff then
  104.    begin
  105.     if FActiveLight=alred then bm.handle:=loadbitmap(hinstance,'DARK_RED_LITE') else
  106.     if FActiveLight=algreen then bm.handle:=loadbitmap(hinstance,'DARK_GREEN_LITE')else
  107.     if FActiveLight=alblue then bm.handle:=loadbitmap(hinstance,'DARK_BLUE_LITE')else
  108.     if FActiveLight=alyellow then bm.handle:=loadbitmap(hinstance,'DARK_YELLOW_LITE')else
  109.     if FActiveLight=almangenta then bm.handle:=loadbitmap(hinstance,'DARK_MANGENTA_LITE')else
  110.     if FActiveLight=algray then bm.handle:=loadbitmap(hinstance,'DARK_GRAY_LITE')else
  111.     if FActiveLight=alcyan then bm.handle:=loadbitmap(hinstance,'DARK_CYAN_LITE')else
  112.     if FActiveLight=alwhite then bm.handle:=loadbitmap(hinstance,'DARK_WHITE_LITE');
  113.    end;
  114.   end;
  115.   Canvas.Draw(1, 1, BM);
  116.   BM.Free;
  117.   end;
  118.  
  119.   procedure TGraphicLight.SetActiveLight( Value : TActiveLight );
  120.   begin
  121.     if Value <> FActiveLight then
  122.     begin
  123.       FActiveLight := Value;
  124.       Repaint;                  { Repaint with new Active Light }
  125.     end;
  126.   end; {= TGraphicLight.SetActiveLight =}
  127.  
  128.   procedure TGraphicLight.SetDarkLite(Value: Boolean);
  129.   begin
  130.     if Value <> FOnOff then
  131.     begin
  132.       FOnOff := Value;
  133.       Refresh;
  134.     end;
  135.   end; {= TGraphicLight.SetLiteSwitch }
  136.  
  137.   procedure TGraphicLight.SetHeavyLite(Value: Boolean);
  138.   begin
  139.     if Value <> FHeavyLite then
  140.     begin
  141.       FHeavyLite := Value;
  142.       Refresh;
  143.     end;
  144.   end; {= TGraphicLight.SetHeavyLite }
  145.  
  146.   {= Register the GraphicLight component with Delphi and place =}
  147.   {= under Shareware tab in component palette.                 =}
  148.   procedure Register;
  149.   begin
  150.     RegisterComponents( 'Shareware', [ TGraphicLight ] );
  151.   end;
  152.  
  153. end. {=== GrafLite Unit ===}
  154.  
  155.