DP Tool Club 26/CD_ASCQ_26_1295.iso/vrac/graflite.zip/GRAFLITE.PAS

Pascal/Delphi Source File | 1995-05-20 | 6KB | 155 lines

unit Graflite;

interface {=== GrafLite Unit ===}

  uses
     WinTypes, WinProcs, Controls, Classes, Forms, DsgnIntf, StdCtrls, Graphics;

  type
    TActiveLight = ( alRed, alBlue, alGreen, alYellow, alMangenta, alGray, alCyan, alWhite );
    TLightArray = array[ TActiveLight ] of TColor;

  type
    TGraphicLight = class( TGraphicControl)
    private
      FActiveLight : TActiveLight;
      FOnOff: Boolean;
      FHeavyLite: Boolean;
    protected
      procedure Paint; override;
    public
      constructor Create(AOwner: TComponent); override;
    published
      property Width default 17;
      property Height default 17;
      procedure SetActiveLight( Value : TActiveLight );
      procedure SetDarkLite( Value : Boolean );
      procedure SetHeavyLite( Value : Boolean );
      property ActiveLight : TActiveLight read FActiveLight
                                          write SetActiveLight;
      property DarkLite: Boolean read FOnOff write SetDarkLite default True;
      property HeavyLite: Boolean read FHeavyLite write SetHeavyLite default True;
      property OnClick;            { Make OnClick event visible }
    end;

  procedure Register;

implementation {=== GrafLite Unit ===}

{$R glite.res}

  uses
    Messages;

  {===========================}
  {== TGraphicLight Methods ==}
  {===========================}

  constructor TGraphicLight.Create( AOwner : TComponent );
  begin
    inherited Create( AOwner );
    FActiveLight := alGreen;           { Set Default Active Light }
    Width := 17;                       { Set Default Width }
    Height := 17;                      { Set Default Height }
    DarkLite := false;               { Set Default OnOff switch }
    FHeavyLite := true;                     { Set Default Lite Type }
  end; {= TGraphicLight.Create =}

  procedure TGraphicLight.Paint;
  var BM:TBitmap;
  Dest: TRect;
  begin
  BM:=TBitmap.Create;
  Canvas.Brush.Style := bsClear;
   if not FHeavyLite then
   begin
    if not FOnOff then
    begin
     if FActiveLight=alred then bm.handle:=loadbitmap(hinstance,'RED') else
     if FActiveLight=algreen then bm.handle:=loadbitmap(hinstance,'GREEN')else
     if FActiveLight=alblue then bm.handle:=loadbitmap(hinstance,'BLUE')else
     if FActiveLight=alyellow then bm.handle:=loadbitmap(hinstance,'YELLOW')else
     if FActiveLight=almangenta then bm.handle:=loadbitmap(hinstance,'MANGENTA')else
     if FActiveLight=algray then bm.handle:=loadbitmap(hinstance,'GRAY')else
     if FActiveLight=alcyan then bm.handle:=loadbitmap(hinstance,'CYAN')else
     if FActiveLight=alwhite then bm.handle:=loadbitmap(hinstance,'WHITE')
   end;

   if FOnOff then
   begin
    if FActiveLight=alred then bm.handle:=loadbitmap(hinstance,'DARK_RED') else
    if FActiveLight=algreen then bm.handle:=loadbitmap(hinstance,'DARK_GREEN')else
    if FActiveLight=alblue then bm.handle:=loadbitmap(hinstance,'DARK_BLUE')else
    if FActiveLight=alyellow then bm.handle:=loadbitmap(hinstance,'DARK_YELLOW')else
    if FActiveLight=almangenta then bm.handle:=loadbitmap(hinstance,'DARK_MANGENTA')else
    if FActiveLight=algray then bm.handle:=loadbitmap(hinstance,'DARK_GRAY')else
    if FActiveLight=alcyan then bm.handle:=loadbitmap(hinstance,'DARK_CYAN')else
    if FActiveLight=alwhite then bm.handle:=loadbitmap(hinstance,'BLACK');
   end;
   end
   else begin
   if not FOnOff then
   begin
    if FActiveLight=alred then bm.handle:=loadbitmap(hinstance,'RED_LITE') else
    if FActiveLight=algreen then bm.handle:=loadbitmap(hinstance,'GREEN_LITE')else
    if FActiveLight=alblue then bm.handle:=loadbitmap(hinstance,'BLUE_LITE')else
    if FActiveLight=alyellow then bm.handle:=loadbitmap(hinstance,'YELLOW_LITE')else
    if FActiveLight=almangenta then bm.handle:=loadbitmap(hinstance,'MANGENTA_LITE')else
    if FActiveLight=algray then bm.handle:=loadbitmap(hinstance,'GRAY_LITE')else
    if FActiveLight=alcyan then bm.handle:=loadbitmap(hinstance,'CYAN_LITE')else
    if FActiveLight=alwhite then bm.handle:=loadbitmap(hinstance,'WHITE_LITE')
   end;

   if FOnOff then
   begin
    if FActiveLight=alred then bm.handle:=loadbitmap(hinstance,'DARK_RED_LITE') else
    if FActiveLight=algreen then bm.handle:=loadbitmap(hinstance,'DARK_GREEN_LITE')else
    if FActiveLight=alblue then bm.handle:=loadbitmap(hinstance,'DARK_BLUE_LITE')else
    if FActiveLight=alyellow then bm.handle:=loadbitmap(hinstance,'DARK_YELLOW_LITE')else
    if FActiveLight=almangenta then bm.handle:=loadbitmap(hinstance,'DARK_MANGENTA_LITE')else
    if FActiveLight=algray then bm.handle:=loadbitmap(hinstance,'DARK_GRAY_LITE')else
    if FActiveLight=alcyan then bm.handle:=loadbitmap(hinstance,'DARK_CYAN_LITE')else
    if FActiveLight=alwhite then bm.handle:=loadbitmap(hinstance,'DARK_WHITE_LITE');
   end;
  end;
  Canvas.Draw(1, 1, BM);
  BM.Free;
  end;

  procedure TGraphicLight.SetActiveLight( Value : TActiveLight );
  begin
    if Value <> FActiveLight then
    begin
      FActiveLight := Value;
      Repaint;                  { Repaint with new Active Light }
    end;
  end; {= TGraphicLight.SetActiveLight =}

  procedure TGraphicLight.SetDarkLite(Value: Boolean);
  begin
    if Value <> FOnOff then
    begin
      FOnOff := Value;
      Refresh;
    end;
  end; {= TGraphicLight.SetLiteSwitch }

  procedure TGraphicLight.SetHeavyLite(Value: Boolean);
  begin
    if Value <> FHeavyLite then
    begin
      FHeavyLite := Value;
      Refresh;
    end;
  end; {= TGraphicLight.SetHeavyLite }

  {= Register the GraphicLight component with Delphi and place =}
  {= under Shareware tab in component palette.                 =}
  procedure Register;
  begin
    RegisterComponents( 'Shareware', [ TGraphicLight ] );
  end;

end. {=== GrafLite Unit ===}