[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]

    {
    After I got the new Swag-snippets and saw how to make components for
    Delphi, I just made this one for fun.

    You all still remember Knight Rider with his car, KITT... Well, at the
    front the car had a scanner... I made it as a component...

    All properties are as obvious as can be (I think) so that shouldn't be a
    problem. Just install it as normal (Don't forget to make a bitmap for
    it!)

    Remember, it's just for fun. Use it when scanning something or waiting
    for something...

    Author: Martijn Tonies
    Date    : 10-28-1996

    E-mail: M.Tonies@hsbos.nl

    {---8<------------------------------------------------------------------------}

    unit UKITScan;

    interface

    uses
    	SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
    	Forms, Dialogs, ExtCtrls;

    const
    	MaxLeds = 100;

    type
    	TScanColor = (scBlue,scGreen,scRed,scYellow);
    	TScanMode  = (smLeftToRight,smRightToLeft,smBoth);

    	TKITScanner = class(TGraphicControl)
    	private
    		FBevelInner:    TPanelBevel;
    		FBevelOuter:    TPanelBevel;
    		FBevelWidth:    Byte;
    		FHowManyLeds: Byte;
    		FOutColor:      TColor;
    		FOnColor:       TColor;
    		FScanColor:     TScanColor;
    		FScanSpeed:     Integer;
    		FScanning:      Boolean;
    		FScanMode:      TScanMode;
    		FLedsColors:    array [1..MaxLeds] of TScanColor;

    		LedPos:             Byte;
    		LedWay:             Boolean;
    		Border:             Byte;
    		LedH,LedW:      Integer;
    		LedX:               array [1..MaxLeds] of Integer;
    		ScanTimer:      TTimer;
    		procedure DoScan(Sender: TObject);
    		procedure Draw;
    		procedure DrawBevel(Rect: TRect);
    		procedure DrawLeds;
    		procedure SetBevelInner(Value: TPanelBevel);
    		procedure SetBevelOuter(Value: TPanelBevel);
    		procedure SetBevelWidth(Value: Byte);
    		procedure SetHowManyLeds(Value: Byte);
    		procedure SetScanColor(Value: TScanColor);
    		procedure SetScanMode(Value: TScanMode);
    		procedure SetScanning(Value: Boolean);
    		procedure SetScanSpeed(Value: Integer);
    		procedure UpdateBorder;
    		procedure UpdatePos;
    		{ Private declarations }
    	protected

    		{ Protected declarations }
    	public
    		constructor Create(AOwner: TComponent); override;
    		destructor Destroy; override;
    		procedure Paint; override;
    		{ Public declarations }
    	published
    		property Align;
    		property BevelInner: TPanelBevel read FBevelInner write SetBevelInner default bvNone;
    		property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvRaised;
    		property BevelWidth: Byte read FBevelWidth write SetBevelWidth default 1;
    		property Color;
    		property Cursor;
    		property Enabled;
    		property HowManyLeds: Byte read FHowManyLeds write SetHowManyLeds default 7;
    		property ScanColor: TScanColor read FScanColor write SetScanColor default scRed;
    		property ScanMode: TScanMode read FScanMode write SetScanMode default smBoth;
    		property Scanning: Boolean read FScanning write SetScanning default False;
    		property ScanSpeed: Integer read FScanSpeed write SetScanSpeed default 100;
    		property ShowHint;
    		property Visible;
    		{ Published declarations }
    	end;

    procedure Register;

    implementation
    {==============================================================================}
    {Private functions and procedures}
    procedure TKITScanner.Draw;
    var R: TRect;
    begin
    	R:=GetClientRect;
    	UpdateBorder;
    	Drawbevel(R);

    	InflateRect(R,-Border,-Border);
    	Canvas.Brush.Style:=bsSolid;
    	Canvas.Brush.Color:=Color;
    	Canvas.FillRect(R);

    	DrawLeds;
    end;
    {------------------}
    procedure TKITScanner.DrawBevel(Rect: TRect);
    var
    	TopColor: TColor;
    	BottomColor: TColor;

    	procedure SetColors(Bevel: TPanelBevel);
    	begin
    		if Bevel=bvLowered
    		then TopColor:=clBtnShadow
    		else TopColor:=clBtnHighlight;
    		if Bevel=bvLowered
    		then BottomColor:=clBtnHighlight
    		else BottomColor:=clBtnShadow;
    	end;

    begin
    	if FBevelOuter<>bvNone
    	then begin
    				 SetColors(FBevelOuter);
    				 Frame3D(Canvas,Rect,TopColor,BottomColor,FBevelWidth);
    			 end;
    	if FBevelInner<>bvNone
    	then begin
    				 SetColors(FBevelInner);
    				 Frame3D(Canvas,Rect,TopColor,BottomColor,FBevelWidth);
    			 end;
    end;
    {------------------}
    procedure TKITScanner.SetBevelInner(Value: TPanelBevel);
    begin
    	if Value<>FBevelInner
    	then begin
    				 FBevelInner:=Value;
    				 Draw;
    			 end;
    end;
    procedure TKITScanner.SetBevelOuter(Value: TPanelBevel);
    begin
    	if Value<>FBevelOuter
    	then begin
    				 FBevelOuter:=Value;
    				 Draw;
    			 end;
    end;
    procedure TKITScanner.SetBevelWidth(Value: Byte);
    begin
    	if Value<>FBevelWidth
    	then begin
    				 FBevelWidth:=Value;
    				 Draw;
    			 end;
    end;
    procedure TKITScanner.UpdateBorder;
    begin
    	Border:=0;
    	if FBevelInner<>bvNone
    	then Border:=FBevelWidth;
    	if FBevelOuter<>bvNone
    	then Inc(Border,FBevelWidth);
    end;
    {------------------}
    procedure TKITScanner.SetHowManyLeds(Value: Byte);
    begin
    	if Value=0
    	then Value:=1;
    	if Value>MaxLeds
    	then Value:=MaxLeds;
    	if FHowManyLeds<>Value
    	then begin
    				 FHowManyLeds:=Value;
    				 Draw;
    			 end;
    end;
    {------------------}
    procedure TKITScanner.SetScanMode(Value: TScanMode);
    begin
    	if Value<>FScanMode
    	then FScanMode:=Value;
    end;
    {------------------}
    procedure TKITScanner.SetScanSpeed(Value: Integer);
    begin
    	if Value<>FScanSpeed
    	then FScanSpeed:=Value;
    	if FScanning and Assigned(ScanTimer)
    	then ScanTimer.Interval:=FScanSpeed;
    end;
    {------------------}
    procedure TKITScanner.SetScanColor(Value: TScanColor);
    begin
    	if Value<>FScanColor
    	then begin
    				 FScanColor:=Value;
    				 Draw;
    			 end;
    end;
    {------------------}
    procedure TKITScanner.SetScanning(Value: Boolean);
    begin
    	if Value<>FScanning
    	then begin
    				 FScanning:=Value;
    				 if FScanning
    				 then begin
    								ScanTimer:=TTimer.Create(Self);
    								ScanTimer.Interval:=FScanSpeed;
    								ScanTimer.OnTimer:=DoScan;
    								ScanTimer.Enabled:=True;
    							end
    				 else if Assigned(ScanTimer)
    							then begin
    										 ScanTimer.Free;
    										 ScanTimer:=nil;
    									 end;
    			 end;
    end;
    {------------------}
    procedure TKITScanner.DrawLeds;
    var n:Integer;
    begin
    	LedH:=Height-Border-Border-2;
    	if LedH<1
    	then begin
    				 Height:=3+Border+Border;
    				 Draw;
    			 end;
    	LedW:=(Width-Border-Border-1-FHowManyLeds) div FHowManyLeds;
    	if LedW<1
    	then begin
    				 Width:=Border+Border+1+FHowManyleds*(2);
    				 Draw;
    			 end;
    	if (Width<>(Border+Border+1+FHowManyLeds*(1+LedW))) and
    	((Align=alLeft) or (Align=alRight) or (Align=alNone))
    	then begin
    				 Width:=Border+Border+1+FHowManyLeds*(1+LedW);
    				 Draw;
    			 end;
    	case FScanColor of
    		scBlue      : begin
    									FOutColor:=clNavy;
    									FOnColor:=clBlue;
    								end;
    		scGreen     : begin
    									FOnColor:=clLime;
    									FOutColor:=clGreen;
    								end;
    		scRed       : begin
    									FOutColor:=clMaroon;
    									FOnColor:=clRed;
    								end;
    		scYellow    : begin
    									FOutColor:=clOlive;
    									FOnColor:=clYellow;
    								end;
    	end;

    	Canvas.Brush.Color:=FOutColor;
    	Ledx[1]:=Border+1;
    	n:=2;
    	while n<=FHowManyLeds
    	do begin
    			 Ledx[n]:=Ledx[n-1]+1+LedW;
    			 Inc(n);
    		 end;
    	for n:=1 to FHowManyLeds
    	do Canvas.FillRect(Rect(Ledx[n],Border+1,Ledx[n]+LedW,Height-Border-1));
    end;
    {------------------}
    procedure TKITScanner.UpdatePos;
    begin
    	case FScanMode of
    		smBoth              : if LedWay
    										then if LedPos>FHowManyLeds
    												 then LedWay:=not LedWay
    												 else Inc(LedPos,1)
    										else if LedPos<1
    												 then LedWay:=not LedWay
    												 else Dec(LedPos,1);
    		smLeftToRight : begin
    											LedWay:=True;
    											if LedPos>FHowManyLeds
    											then LedPos:=0
    											else Inc(LedPos,1);
    										end;
    		smRightToLeft : begin
    											LedWay:=False;
    											if LedPos<1
    											then LedPos:=FHowManyLeds+1
    											else Dec(LedPos,1);
    										end;
    	end;
    end;

    procedure TKITScanner.DoScan;
    var n: Byte;
    begin
    	Canvas.Brush.Color:=FOutColor;
    	for n:=1 to FHowManyLeds
    	do Canvas.FillRect(Rect(Ledx[n],Border+1,Ledx[n]+LedW,Height-Border-1));
    	UpdatePos;
    	Canvas.Brush.Color:=FOnColor;
    	if (LedPos>=1) and (LedPos<=FHowManyLeds)
    	then Canvas.FillRect(Rect(Ledx[LedPos],Border+1,Ledx[LedPos]+LedW,Height-Border-1));
    end;
    {==============================================================================}
    {Protected functions and procedures}

    {==============================================================================}
    {Public functions and procedures}
    constructor TKITScanner.Create(AOwner: TComponent);
    begin
    	inherited Create(AOwner);

    	FBevelInner:=bvNone;
    	FBevelOuter:=bvRaised;
    	FBevelWidth:=1;
    	FHowManyLeds:=7;
    	FScanColor:=scRed;
    	FScanSpeed:=100;
    	FScanMode:=smBoth;

    	LedPos:=1;
    	LedWay:=True;

    	Width:=82;
    	Height:=12;
    end;

    destructor TKITScanner.Destroy;
    begin
    	if FScanning
    	then SetScanning(False);
    	inherited Destroy;
    end;

    procedure TKITScanner.Paint;
    begin
    	Draw;
    end;
    {==============================================================================}
    procedure Register;
    begin
    	RegisterComponents('Samples', [TKITScanner]);
    end;

    end.

[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]