home *** CD-ROM | disk | FTP | other *** search
- {======================================================================
- TSCLED 1.0
- Dec 29, 2001
-
- by Safak Cinar
- scinar@shaw.ca
- http://members.shaw.ca/safak/
-
- Based on the component TDynaLED 1.0 by Samson Fu
- ======================================================================}
-
- Unit SCLED;
-
- Interface
-
- Uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- ExtCtrls, Math;
-
- Type
-
- TSCLEDStyle = (sclsSquare, sclsRound);
- TSCClipMode = (sccmText, sccmDisplay);
- TSCVerticalAlignment = (scvaTop, scvaCenter, scvaBottom);
- TSCHorizontalAlignment = (schaLeft, schaCenter, schaRight);
-
- TSCLED = Class(TGraphicControl)
- Private
- FBuffer: TBitmap;
-
- FForeColor: TColor;
- FBackColor: TColor;
-
- FLEDSize: Byte;
- FLEDDistance: Byte;
- FLEDStyle: TSCLEDStyle;
-
- FLines: TStringList;
- FOffsetX, FOffsetY: Integer;
- FClipMode: TSCClipMode;
-
- FAlignmentH: TSCHorizontalAlignment;
- FAlignmentV: TSCVerticalAlignment;
-
- FFilterTimer : TTimer;
- FFilterStyle : Integer;
- FFilterSteps : Integer;
- FFilterP1,FFilterP2,FFilterP3:Integer;
-
- FOnStop: TNotifyEvent;
- FOnAfterDrawText : TNotifyEvent;
- FOnCustomDraw: TNotifyEvent;
-
- FBitmapW,FBitmapH : Integer;
- FAnim1,FAnim2 : Single;
- FAutosize: Boolean;
-
- Procedure SetForeColor(const value: TColor);
- Procedure SetBackColor(const value: TColor);
- Procedure SetLEDSize(const value: Byte);
- Procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
- Procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
- Procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
- Procedure SetLines(const Value: TStringList);
- Procedure LinesChanged (Sender: TObject);
- Procedure DoResize(Sender: TObject);
- Procedure SetLEDDistance(const Value: Byte);
- Procedure SetOffsetX(const Value: Integer);
- Procedure SetOffsetY(const Value: Integer);
- Procedure ReDrawText;
- Procedure SetLEDStyle(const Value: TSCLEDStyle);
- Procedure SetClipMode(const Value: TSCClipMode);
- Procedure SetOnAfterDrawText(const Value: TNotifyEvent);
- procedure SetAlignmentH(const Value: TSCHorizontalAlignment);
- procedure SetAlignmentV(const Value: TSCVerticalAlignment);
- Function GetLEDAt(u,v:Integer):Boolean;
- Procedure DoFilterTimer (Sender: TObject);
- procedure SetOnCustomDraw(const Value: TNotifyEvent);
- function GetLEDCountX: Integer;
- function GetLEDCountY: Integer;
- procedure SetLEDCountX(const Value: Integer);
- procedure SetLEDCountY(const Value: Integer);
- Procedure PreProcessAnimation;
- procedure SetAutosize(const Value: Boolean);
- Protected
- Procedure ReDrawLED; virtual;
- Procedure Paint; override;
- Public
- Bitmap: TBitmap;
- Constructor Create(AOwner: TComponent); override;
- Destructor Destroy; override;
- Procedure BitmapChanged;
- Procedure Animate(Style,Interval,Steps:Integer;P1,P2,P3:Integer);
- Procedure StopAnimate;
- Published
- Property Lines:TStringList Read FLines Write SetLines;
- Property ForeColor: TColor read FForeColor write SetForeColor default clLime;
- Property BackColor: TColor read FBackColor write SetBackColor default clGreen;
- Property LEDSize: Byte read FLEDSize write SetLEDSize Default 2;
- Property LEDDistance: Byte Read FLEDDistance Write SetLEDDistance Default 1;
- Property OffsetX : Integer read FOffsetX write SetOffsetX default 0;
- Property OffsetY : Integer read FOffsetY write SetOffsetY default 0;
- Property LEDCountX : Integer Read GetLEDCountX Write SetLEDCountX;
- Property LEDCountY : Integer Read GetLEDCountY Write SetLEDCountY;
- Property LEDStyle : TSCLEDStyle Read FLEDStyle write SetLEDStyle default sclsSquare;
- Property ClipMode : TSCClipMode Read FClipMode write SetClipMode default sccmText;
- Property AlignmentH : TSCHorizontalAlignment Read FAlignmentH Write SetAlignmentH;
- Property AlignmentV : TSCVerticalAlignment Read FAlignmentV Write SetAlignmentV;
- Property OnAfterDrawText : TNotifyEvent Read FOnAfterDrawText write SetOnAfterDrawText;
- Property OnCustomDraw : TNotifyEvent Read FOnCustomDraw write SetOnCustomDraw;
- Property OnStop : TNotifyEvent Read FOnStop Write FOnStop;
- Property AutoSize : Boolean Read FAutosize Write SetAutosize Default True;
- Property Caption;
- Property Color;
- Property Font;
- Property ParentFont;
- Property ParentColor;
- Property Align;
- Property Anchors;
- Property Constraints;
- Property DragCursor;
- Property DragKind;
- Property DragMode;
- Property Enabled;
- Property ParentShowHint;
- Property PopupMenu;
- Property ShowHint;
- Property Visible;
- Property OnClick;
- Property OnContextPopup;
- Property OnDblClick;
- Property OnDragDrop;
- Property OnDragOver;
- Property OnEndDock;
- Property OnEndDrag;
- Property OnMouseDown;
- Property OnMouseMove;
- Property OnMouseUp;
- Property OnStartDock;
- Property OnStartDrag;
- End;
-
- Procedure Register;
-
- Implementation
-
- {$R SCLED.DCR}
-
- {==============================================================================
- }
- constructor TSCLED.Create(AOwner: TComponent);
- Begin
- Inherited;
- ControlStyle := ControlStyle + [csOpaque];
-
- Width:=160;
- Height:=40;
-
- FAlignmentH:=schaCenter;
- FAlignmentV:=scvaCenter;
- FFilterStyle:=0;
- FAutoSize:=True;
-
- FForeColor:= clLime;
- FBackColor:= clGreen;
- FLEDSize:= 2;
- FLEDDistance:= 1;
- FOffsetX:=0;
- FOffsetY:=0;
- FLEDStyle:=sclsSquare;
-
- FLines:=TStringList.Create;
- FLines.OnChange:=LinesChanged;
-
- FOnStop:=NIL;
-
- FBuffer:= TBitmap.Create;
- FBuffer.HandleType:= bmDIB;
-
- Bitmap:= TBitmap.Create;
- Bitmap.PixelFormat:= pf1Bit;
- Bitmap.Monochrome:= True;
- Bitmap.HandleType:= bmDIB;
-
- OnResize:=DoResize;
-
- FFilterTimer := TTimer.Create(NIL);
- FFilterTimer.Enabled:=False;
- FFilterTimer.OnTimer:=DoFilterTimer;
-
- DoResize(Self);
- ReDrawLED;
- Invalidate;
- End;
-
- {==============================================================================
- }
- destructor TSCLED.Destroy;
- Begin
- Bitmap.Free;
- FBuffer.Free;
- FLines.Free;
- FFilterTimer.Free;
- Inherited;
- End;
-
- {==============================================================================
- }
- Procedure TSCLED.ReDrawText;
- Var
- R : TRect;
- A : Integer;
- S : String;
- Y : Integer;
- Begin
- Bitmap.Assign(nil);
- Bitmap.Canvas.Brush.Color:= clBlack;
- Bitmap.Canvas.Font.Color:= clWhite;
- If Assigned(FOnCustomDraw) Then
- Begin
- Bitmap.Width:=GetLEDCountX;
- Bitmap.Height:=GetLEDCountY;
- FBitmapW:=Bitmap.Width;
- FBitmapH:=Bitmap.Height;
- FOnCustomDraw(Self);
- Exit;
- End;
- Case FAlignmentH Of
- schaLeft : A:=DT_LEFT;
- schaCenter : A:=DT_CENTER;
- schaRight : A:=DT_RIGHT;
- End;
- If Lines.Count=0 Then
- S:=Caption
- Else
- Begin
- S:=Lines.Text;
- If Length(S)>2 Then SetLength(S,Length(S)-2);
- End;
- R:= Rect(0,0,0,0);
- DrawTextEx(Bitmap.Canvas.Handle, PChar(S), -1, R, A Or DT_NOCLIP or DT_NOPREFIX or DT_CALCRECT, nil);
- Case FClipMode Of
- sccmText :
- Begin
- Bitmap.Width:=R.Right-R.Left;
- Bitmap.Height:=R.Bottom-R.Top;
- End;
- sccmDisplay :
- Begin
- Case FAlignmentV Of
- scvaTop : Y:=0;
- scvaCenter : Y:=(GetLEDCountY-(R.Bottom-R.Top)) Div 2;
- scvaBottom : Y:=(GetLEDCountY-(R.Bottom-R.Top));
- End;
- Bitmap.Width:=GetLEDCountX;
- Bitmap.Height:=GetLEDCountY;
- R:= Rect(0,Y,Bitmap.Width,Bitmap.Height+Y);
- End;
- End;
- FBitmapW:=Bitmap.Width;
- FBitmapH:=Bitmap.Height;
- DrawTextEx(Bitmap.Canvas.Handle, PChar(S), -1, R, A Or DT_NOCLIP or DT_NOPREFIX, nil);
- If Assigned(FOnAfterDrawText) Then FOnAfterDrawText(Self);
- End;
-
- {==============================================================================
- }
- Function MidColor(A,B:TColor):TColor;
- Var
- R1,G1,B1, R2,G2,B2, R0,G0,B0 : Byte;
- Begin
- R1 := (A And $000000FF);
- G1 := (A And $0000FF00) SHR 8;
- B1 := (A And $00FF0000) SHR 16;
-
- R2 := (B And $000000FF);
- G2 := (B And $0000FF00) SHR 8;
- B2 := (B And $00FF0000) SHR 16;
-
- R0 := (R1+R2) Div 2;
- G0 := (G1+G2) Div 2;
- B0 := (B1+B2) Div 2;
-
- Result:=B0 SHL 16 + G0 SHL 8 + R0;
-
- End;
-
- {==============================================================================
- }
- Procedure TSCLED.ReDrawLED;
- Var
- X, Y, U, V : Integer;
- R : TRect;
- K : Integer;
- AOffX,AOffY : Integer;
- CB,CF : TColor;
- Begin
-
- CB:= MidColor(FBackColor,Color);
- CF:= MidColor(FForeColor,FBackColor);
-
- K:=FLEDSize+FLEDDistance;
-
- If (FBuffer.Width<>Width) Or (FBuffer.Height<>Height) Then
- Begin
- FBuffer.Assign(nil);
- FBuffer.Width:= Width;
- FBuffer.Height:= Height;
- End;
-
- FBuffer.Canvas.Brush.Color:= Color;
- FBuffer.Canvas.FillRect(Rect(0,0,FBuffer.Width,FBuffer.Height));
-
- Case FAlignmentH Of
- schaLeft : AOffX:=0;
- schaCenter : AOffX:=(GetLEDCountX-FBitmapW) Div 2;
- schaRight : AOffX:=(GetLEDCountX-FBitmapW);
- End;
- Case FAlignmentV Of
- scvaTop : AOffY:=0;
- scvaCenter : AOffY:=(GetLEDCountY-FBitmapH) Div 2;
- scvaBottom : AOffY:=(GetLEDCountY-FBitmapH);
- End;
-
- PreProcessAnimation;
-
- Case FLEDSize Of
- 1 :
- Begin
- For x:=0 to GetLEDCountX-1 do
- Begin
- For y:=0 to GetLEDCountY-1 do
- Begin
- u:=x-FOffsetX-AOffX; v:=y-FOffsety-AOffY;
- If GetLEDAt(u,v) Then
- FBuffer.Canvas.Pixels[x*K+FLEDDistance,y*K+FLEDDistance]:=FForeColor
- Else
- FBuffer.Canvas.Pixels[x*K+FLEDDistance,y*K+FLEDDistance]:=FBackColor;
- End; // For Y
- End; // For X
- End; // Case FLEDSize 1
- 2 :
- Begin
- For x:=0 to GetLEDCountX-1 do
- Begin
- For y:=0 to GetLEDCountY-1 do
- Begin
- R:= Rect(x*K+FLEDDistance,y*K+FLEDDistance,(x+1)*K,(y+1)*K);
- u:=x-FOffsetX-AOffX; v:=y-FOffsety-AOffY;
- If GetLEDAt(u,v) Then FBuffer.Canvas.Brush.Color:= FForeColor Else FBuffer.Canvas.Brush.Color:= FBackColor;
- FBuffer.Canvas.FillRect(R);
- End; //For Y
- End; //For X
- End; // Case FLEDSize 2
- 3 :
- Begin
- For x:=0 to GetLEDCountX-1 do
- Begin
- For y:=0 to GetLEDCountY-1 do
- Begin
- u:=x-FOffsetX-AOffX; v:=y-FOffsety-AOffY;
- Case FLEDStyle of
- sclsSquare : Begin
- If GetLEDAt(u,v) Then FBuffer.Canvas.Brush.Color:= FForeColor Else FBuffer.Canvas.Brush.Color:= FBackColor;
- R:= Rect(x*K+FLEDDistance,y*K+FLEDDistance,(x+1)*K,(y+1)*K);
- FBuffer.Canvas.FillRect(R);
- End;
- sclsRound : Begin
- If GetLEDAt(u,v) Then
- Begin
- u:=x*K+FLEDDistance; v:=y*K+FLEDDistance;
- With FBuffer.Canvas Do
- Begin
- Pixels[u,v]:=CF; Pixels[u+2,v]:=CF; Pixels[u,v+2]:=CF; Pixels[u+2,v+2]:=CF;
- Pen.Color:=FForeColor;
- MoveTo(u+1,v); LineTo(u+1,v+3); MoveTo(u,v+1); LineTo(u+3,v+1);
- End;
- End
- Else
- Begin
- u:=x*K+FLEDDistance; v:=y*K+FLEDDistance;
- With FBuffer.Canvas Do
- Begin
- Pixels[u,v]:=CB; Pixels[u+2,v]:=CB; Pixels[u,v+2]:=CB; Pixels[u+2,v+2]:=CB;
- Pen.Color:=FBackColor;
- MoveTo(u+1,v); LineTo(u+1,v+3); MoveTo(u,v+1); LineTo(u+3,v+1);
- End; //with
- End; //else
- End; //case FLEDStyle sclsRound
- End; // Case FLEDStyle
- End; //For Y
- End; //For X
- End; //Case FLEDSize 3
- Else
- Begin
- For x:=0 to GetLEDCountX-1 do
- Begin
- For y:=0 to GetLEDCountY-1 do
- Begin
- R:= Rect(x*K+FLEDDistance,y*K+FLEDDistance,(x+1)*K,(y+1)*K);
- u:=x-FOffsetX-AOffX; v:=y-FOffsety-AOffY;
- If GetLEDAt(u,v) Then FBuffer.Canvas.Brush.Color:= FForeColor Else FBuffer.Canvas.Brush.Color:= FBackColor;
- Case FLEDStyle of
- sclsSquare : FBuffer.Canvas.FillRect(R);
- sclsRound : Begin
- FBuffer.Canvas.Pen.Color:=FBuffer.Canvas.Brush.Color;
- FBuffer.Canvas.Ellipse(R);
- End;
- End; // Case FLEDStyle
- End; //For Y
- End; //For X
- End; //Case FLEDSize Else
- End; //Case FLEDSize
-
- End;
-
- {==============================================================================
- }
- Procedure TSCLED.SetForeColor(const value: TColor);
- Begin
- If FForeColor<>Value then
- Begin
- FForeColor:= Value;
- ReDrawLED;
- Invalidate;
- End;
- End;
-
- {==============================================================================
- }
- Procedure TSCLED.SetBackColor(const value: TColor);
- Begin
- If FBackColor<>Value then
- Begin
- FBackColor:= Value;
- ReDrawLED;
- Invalidate;
- End;
- End;
-
- {==============================================================================
- }
- Procedure TSCLED.SetLEDSize(Const value: Byte);
- Begin
- If (FLEDSize<>Value) And (Value>0) then
- Begin
- If FAutoSize Then
- Begin
- Width:=GetLEDCountX*(Value+FLEDDistance)+FLEDDistance;
- Height:=GetLEDCountY*(Value+FLEDDistance)+FLEDDistance;
- End;
- FLEDSize:= Value;
- ReDrawText;
- ReDrawLED;
- Invalidate;
- End;
- End;
-
- {==============================================================================
- }
- Procedure TSCLED.SetLEDDistance(Const Value: Byte);
- Begin
- If (Value<>FLEDDistance) Then
- Begin
- If FAutoSize Then
- Begin
- Width:=GetLEDCountX*(FLEDSize+Value)+FLEDDistance;
- Height:=GetLEDCountY*(FLEDSize+Value)+FLEDDistance;
- End;
- FLEDDistance := Value;
- ReDrawText;
- ReDrawLED;
- Invalidate;
- End;
- End;
-
- {==============================================================================
- }
- procedure TSCLED.CMTextChanged(var Message: TMessage);
- Begin
- ReDrawText;
- ReDrawLED;
- Invalidate;
- End;
-
- {==============================================================================
- }
- procedure TSCLED.CMFontChanged(var Message: TMessage);
- Begin
- Bitmap.Canvas.Font.Assign(Font);
- ReDrawText;
- ReDrawLED;
- Invalidate;
- End;
-
- {==============================================================================
- }
- procedure TSCLED.CMColorChanged(var Message: TMessage);
- Begin
- ReDrawLED;
- Invalidate;
- End;
-
- {==============================================================================
- }
- procedure TSCLED.Paint;
- Begin
- Canvas.Draw(0,0,FBuffer);
- End;
-
- {==============================================================================
- }
- procedure Register;
- begin
- RegisterComponents('SAFAK', [TSCLED]);
- end;
-
- {==============================================================================
- }
- Procedure TSCLED.SetLines(const Value: TStringList);
- Begin
- FLines.Text:=Value.Text;
- ReDrawText;
- ReDrawLED;
- Invalidate;
- End;
-
- {==============================================================================
- }
- procedure TSCLED.LinesChanged(Sender: TObject);
- begin
- ReDrawText;
- ReDrawLED;
- Invalidate;
- end;
-
- {==============================================================================
- }
- procedure TSCLED.DoResize(Sender: TObject);
- begin
- ReDrawText;
- ReDrawLED;
- Invalidate;
- end;
-
- {==============================================================================
- }
- procedure TSCLED.SetOffsetX(const Value: Integer);
- begin
- If (FOffsetX<>Value) Then
- Begin
- FOffsetX := Value;
- ReDrawLED;
- Invalidate;
- End;
- end;
-
- {==============================================================================
- }
- procedure TSCLED.SetOffsetY(const Value: Integer);
- begin
- If (FOffsetY<>Value) Then
- Begin
- FOffsetY := Value;
- ReDrawLED;
- Invalidate;
- End;
- end;
-
- {==============================================================================
- }
- procedure TSCLED.SetLEDStyle(const Value: TSCLEDStyle);
- begin
- If (Value<>FLEDStyle) Then
- Begin
- FLEDStyle := Value;
- ReDrawLED;
- Invalidate;
- End;
- End;
-
- {==============================================================================
- }
- procedure TSCLED.BitmapChanged;
- begin
- ReDrawLED;
- Invalidate;
- end;
-
- {==============================================================================
- }
- procedure TSCLED.SetClipMode(const Value: TSCClipMode);
- begin
- If Value<>FClipMode Then
- Begin
- FClipMode := Value;
- ReDrawText;
- ReDrawLED;
- Invalidate;
- End;
- end;
-
- {==============================================================================
- }
- procedure TSCLED.SetOnAfterDrawText(const Value: TNotifyEvent);
- begin
- FOnAfterDrawText := Value;
- ReDrawText;
- ReDrawLED;
- Invalidate;
- end;
-
- {==============================================================================
- }
- procedure TSCLED.SetAlignmentH(const Value: TSCHorizontalAlignment);
- begin
- If Value<>FAlignmentH Then
- Begin
- FAlignmentH := Value;
- ReDrawText;
- ReDrawLED;
- Invalidate;
- End;
- End;
-
- {==============================================================================
- }
- procedure TSCLED.SetAlignmentV(const Value: TSCVerticalAlignment);
- begin
- If (Value<>FAlignmentV) Then
- Begin
- FAlignmentV := Value;
- ReDrawText;
- ReDrawLED;
- Invalidate;
- End;
- end;
-
- {==============================================================================
- }
- Procedure TSCLED.StopAnimate;
- Begin
- If Not FFilterTimer.Enabled Then Exit;
- FFilterTimer.Enabled:=False;
- FFilterStyle:=0;
- ReDrawLED;
- Invalidate;
- If Assigned(FOnStop) Then FOnStop(Self);
- End;
-
- {==============================================================================
- }
- Procedure TSCLED.PreProcessAnimation;
- Begin
- Case FFilterStyle Of
- 4,
- 5,
- 6,
- 7 : FAnim1:=Cos((FFilterTimer.Tag*FFilterP1 Mod 360)*Pi/180);
- 8 : FAnim1:=Abs(Cos((FFilterTimer.Tag*FFilterP1 Mod 360)*Pi/180));
- 9 : Begin
- FAnim1:=Cos((FFilterTimer.Tag*FFilterP1 Mod 360)*Pi/180);
- FAnim2:=Sin((FFilterTimer.Tag*FFilterP1 Mod 360)*Pi/180);
- End;
- End;
- End;
-
- {==============================================================================
- }
- Function TSCLED.GetLEDAt(u,v:Integer):Boolean;
- Var
- Inside : Boolean;
- N : Integer;
- Begin
- Case FFilterStyle Of
- 0 : Begin // Normal
- Inside:=(u>=0) And (u<FBitmapW) And (v>=0) And (v<FBitmapH);
- If Inside Then Result:=Bitmap.Canvas.Pixels[u,v]=clWhite Else Result:=False;
- End;
- 1 : Begin // Blink FG
- Inside:=(u>=0) And (u<FBitmapW) And (v>=0) And (v<FBitmapH);
- Case FFilterTimer.Tag Mod 2 Of
- 0 : Result:=False;
- 1 : If Inside Then Result:=Bitmap.Canvas.Pixels[u,v]=clWhite Else Result:=False;
- End;
- End;
- 2 : Begin // Blink BG
- Inside:=(u>=0) And (u<FBitmapW) And (v>=0) And (v<FBitmapH);
- Case FFilterTimer.Tag Mod 2 Of
- 0 : Result:=True;
- 1 : If Inside Then Result:=Bitmap.Canvas.Pixels[u,v]=clWhite Else Result:=False;
- End;
- End;
- 3 : Begin // Blink FG/BG
- Inside:=(u>=0) And (u<FBitmapW) And (v>=0) And (v<FBitmapH);
- Case FFilterTimer.Tag Mod 2 Of
- 0 : If Inside Then Result:=Bitmap.Canvas.Pixels[u,v]<>clWhite Else Result:=True;
- 1 : If Inside Then Result:=Bitmap.Canvas.Pixels[u,v]=clWhite Else Result:=False;
- End;
- End;
- 4 : Begin // Stretch X
- u:=Round(FFilterP2+(u-FFilterP2)*FAnim1);
- Inside:=(u>=0) And (u<FBitmapW) And (v>=0) And (v<FBitmapH);
- If Inside Then
- Result:=Bitmap.Canvas.Pixels[u,v]=clWhite
- Else
- Result:=False;
- End;
- 5 : Begin // Stretch Y
- v:=Round(FFilterP2+(v-FFilterP2)*FAnim1);
- Inside:=(u>=0) And (u<FBitmapW) And (v>=0) And (v<FBitmapH);
- If Inside Then
- Result:=Bitmap.Canvas.Pixels[u,v]=clWhite
- Else
- Result:=False;
- End;
- 6 : Begin // Rotate Y
- If Abs(FAnim1)<1E-8 Then
- Begin
- Result:=False;
- Exit;
- End;
- u:=Round(FFilterP2+(u-FFilterP2)/FAnim1);
- Inside:=(u>=0) And (u<FBitmapW) And (v>=0) And (v<FBitmapH);
- If Inside Then
- Result:=Bitmap.Canvas.Pixels[u,v]=clWhite
- Else
- Result:=False;
- End;
- 7 : Begin // Rotate X
- If Abs(FAnim1)<1E-8 Then
- Begin
- Result:=False;
- Exit;
- End;
- v:=Round(FFilterP2+(v-FFilterP2)/FAnim1);
- Inside:=(u>=0) And (u<FBitmapW) And (v>=0) And (v<FBitmapH);
- If Inside Then
- Result:=Bitmap.Canvas.Pixels[u,v]=clWhite
- Else
- Result:=False;
- End;
- 8 : Begin // Pulse
- If Abs(FAnim1)<1E-8 Then
- Begin
- Result:=False;
- Exit;
- End;
- u:=Round(FFilterP2+(u-FFilterP2)/FAnim1);
- v:=Round(FFilterP3+(v-FFilterP3)/FAnim1);
- Inside:=(u>=0) And (u<FBitmapW) And (v>=0) And (v<FBitmapH);
- If Inside Then
- Result:=Bitmap.Canvas.Pixels[u,v]=clWhite
- Else
- Result:=False;
- End;
- 9 : Begin // Rotate
- u:=u-FFilterP2;
- v:=v-FFilterP3;
- N:=Round(u*FAnim1+v*FAnim2);
- v:=FFilterP3+Round(-u*FAnim2+v*FAnim1);
- u:=FFilterP2+N;
- Inside:=(u>=0) And (u<FBitmapW) And (v>=0) And (v<FBitmapH);
- If Inside Then Result:=Bitmap.Canvas.Pixels[u,v]=clWhite Else Result:=False;
- End;
- 10 : Begin // Scroll X
- u:=(u+FFilterP1*FFilterTimer.Tag) Mod FFilterP2; If u<0 Then u:=u+FFilterP2;
- Inside:=(u>=0) And (u<FBitmapW) And (v>=0) And (v<FBitmapH);
- If Inside Then Result:=Bitmap.Canvas.Pixels[u,v]=clWhite Else Result:=False;
- End;
- 11 : Begin // Scroll Y
- v:=(v+FFilterP1*FFilterTimer.Tag) Mod FFilterP2; If v<0 Then v:=v+FFilterP2;
- Inside:=(u>=0) And (u<FBitmapW) And (v>=0) And (v<FBitmapH);
- If Inside Then Result:=Bitmap.Canvas.Pixels[u,v]=clWhite Else Result:=False;
- End;
- 12 : Begin //Wipe X
- Inside:=(u>=0) And (u<FBitmapW) And (v>=0) And (v<FBitmapH);
- If Inside Then Result:=Bitmap.Canvas.Pixels[u,v]=clWhite Else Result:=False;
- N:=FFilterTimer.Tag*FFilterP1;
- If (N Div FBitmapW) Mod 2 = 0 Then
- Begin
- N:=N Mod FBitmapW;
- If N>u Then Result:=Not Result;
- End
- Else
- Begin
- N:=N Mod FBitmapW;
- If N<u Then Result:=Not Result;
- End;
- End;
- 13 : Begin //Wipe Y
- Inside:=(u>=0) And (u<FBitmapW) And (v>=0) And (v<FBitmapH);
- If Inside Then Result:=Bitmap.Canvas.Pixels[u,v]=clWhite Else Result:=False;
- N:=FFilterTimer.Tag*FFilterP1;
- If (N Div FBitmapH) Mod 2 = 0 Then
- Begin
- N:=N Mod FBitmapH;
- If N>v Then Result:=Not Result;
- End
- Else
- Begin
- N:=N Mod FBitmapH;
- If N<v Then Result:=Not Result;
- End;
- End;
- End;
- End;
-
- {==============================================================================
- }
- procedure TSCLED.Animate(Style,Interval,Steps: Integer; P1,P2,P3: Integer);
- begin
- If Style=0 Then
- Begin
- StopAnimate;
- Exit;
- End;
- If (Style<0) Or (Style>100) Then Exit;
- If Interval<1 Then Exit;
- If Steps<1 Then Exit;
- StopAnimate;
- FFilterTimer.Interval:=Interval;
- FFilterTimer.Tag:=0;
- FFilterStyle:=Style;
- FFilterSteps:=Steps;
- FFilterP1:=P1;
- FFilterP2:=P2;
- FFilterP3:=P3;
- FFilterTimer.Enabled:=True;
- End;
-
- {==============================================================================
- }
- procedure TSCLED.DoFilterTimer(Sender: TObject);
- begin
- FFilterTimer.Tag:=FFilterTimer.Tag+1;
- If FFilterTimer.Tag>FFilterSteps Then
- Begin
- StopAnimate;
- Exit;
- End;
- ReDrawLED;
- Invalidate;
- end;
-
- {==============================================================================
- }
- procedure TSCLED.SetOnCustomDraw(const Value: TNotifyEvent);
- begin
- FOnCustomDraw := Value;
- ReDrawText;
- ReDrawLED;
- Invalidate;
- end;
-
- {==============================================================================
- }
- function TSCLED.GetLEDCountX: Integer;
- begin
- Result:=Width Div (FLEDSize+FLEDDistance);
- end;
-
- {==============================================================================
- }
- function TSCLED.GetLEDCountY: Integer;
- begin
- Result:=Height Div (FLEDSize+FLEDDistance);
- end;
-
- {==============================================================================
- }
- procedure TSCLED.SetLEDCountX(const Value: Integer);
- begin
- If (Value<>GetLEDCountX) And (Value>0) Then
- Begin
- If FAutoSize Then
- Begin
- Width:=Value*(FLEDSize+FLEDDistance)+FLEDDistance;
- ReDrawText;
- ReDrawLED;
- Invalidate;
- End;
- End;
- End;
-
- {==============================================================================
- }
- procedure TSCLED.SetLEDCountY(const Value: Integer);
- begin
- If (Value<>GetLEDCountY) And (Value>0) Then
- Begin
- If FAutoSize Then
- Begin
- Height:=Value*(FLEDSize+FLEDDistance)+FLEDDistance;
- ReDrawText;
- ReDrawLED;
- Invalidate;
- End;
- End;
- end;
-
- {==============================================================================
- }
- procedure TSCLED.SetAutosize(const Value: Boolean);
- begin
- If Value<>FAutosize Then
- Begin
- FAutosize := Value;
- If FAutoSize Then
- Begin
- Width:=GetLEDCountX*(FLEDSize+FLEDDistance)+FLEDDistance;
- Height:=GetLEDCountY*(FLEDSize+FLEDDistance)+FLEDDistance;
- End;
- End;
- End;
-
- {==============================================================================
- }
- end.
-