K
kelvin-lee
Unregistered / Unconfirmed
GUEST, unregistred user!
unit CsPipeLine;
interface
uses
Windows, Messages, SysUtils,extctrls, Classes, Graphics, Controls, Forms, Dialogs,CsHead;
type
TCsPipeLine = class(TGraphicControl)
private
{ Private declarations }
FIndex:Integer ;
FNumber:Integer;
FDirection:TDirection;
FIncrease:TYesNo ;
FRuning:TYesNo ;
FSpeed:Integer;
FfColor:TColor ;
FbColor:TColor ;
Ftimer1:TTimer;
procedure SetfColor(Value:TColor);
procedure SetbColor(Value:TColor);
procedure SetIncrease(Value:TYesNo );
procedure SetRuning(Value:TYesNo );
procedure SetDirection(Value:TDirection );
procedure SetSpeed(Value:Integer );
procedure SetNumber(Value:Integer);
procedure PaintBackground(var AnImage:TBitmap);
procedure PaintAsBar(var AnImage:TBitmap; const PaintRect:TRect);
protected
procedure Paint; //virtual;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure StyleChanged(Sender:TObject);
published
property DragCursor;
property DragMode;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property PopupMenu ;
property ShowHint ;
property Color ;
property Visible ;
property Height;
property Width;
property Direction:TDirection read FDirection write SetDirection nodefault;
property Increase:TYesNo read FIncrease write SetIncrease nodefault;
property Runing:TYesNo read FRuning write SetRuning nodefault;
property Number:Integer read FNumber write SetNumber nodefault;
property Speed:Integer read FSpeed write SetSpeed nodefault;
property ForeColor:TColor read FfColor write SetfColor nodefault;
property BackColor:TColor read FbColor write SetbColor nodefault;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('CS Controls', [TCsPipeLine]);
end;
constructor TCsPipeLine.Create(AOwner: TComponent);
begin
// TGraphicControl
inherited Create(AOwner);
ControlStyle := ControlStyle+[csOpaque,csFramed ,csReplicatable]; {???}
FIndex:=0;
FDirection:=Horizontal;
FIncrease:=Yes;
FRuning:=No;
FNumber:=3;
FSpeed:=100;
FfColor:=clBlue;
FbColor:=clGreen;
Width:=165;
Height:=65;
Ftimer1:=TTimer.create(AOwner) ;
Ftimer1.Enabled:=false;
Ftimer1.Interval:=FSpeed;
Ftimer1.OnTimer:=StyleChanged;
end;
destructor TCsPipeLine.Destroy;
begin
Ftimer1.Free;
inherited Destroy;
end;
procedure TCsPipeLine.StyleChanged(Sender:TObject);
begin
if FIncrease=Yes then
begin
inc(FIndex);
if FDirection=Horizontal then
if FIndex>Width/FNumber then
FIndex:=0;
if FDirection=Vertical then
if FIndex>Height/FNumber then
FIndex:=0;
end;
if FIncrease=No then
begin
dec(FIndex);
if (FDirection=Horizontal) then
if (FIndex<0) then
FIndex:=Width div FNumber;
if (FDirection=Vertical) then
if (FIndex<0) then
FIndex:=Height div FNumber;
end;
Invalidate;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetDirection(Value:TDirection );
begin
if (FDirection<>Value) then
begin
FDirection:=Value;
Invalidate;
end;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetIncrease( Value:TYesNo);
begin
if (FIncrease<>Value) then
begin
FIncrease:=Value;
end;
Invalidate;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetRuning(Value:TYesNo ) ;
begin
if (FRuning<>Value) then
begin
FRuning:=Value;
if (FRuning=Yes) then
Ftimer1.Enabled:=true
else
Ftimer1.Enabled:=false;
end;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetNumber(Value:Integer) ;
begin
if (FNumber<>Value) then
begin
FNumber:=Value;
Invalidate;
end;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetSpeed(Value:Integer ) ;
var aa :boolean;
begin
if (FSpeed<>Value) then
begin
FSpeed:=Value;
aa:=Ftimer1.Enabled;
Ftimer1.Enabled:=false;
Ftimer1.Interval:=FSpeed;
Ftimer1.Enabled:=aa;
end;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetfColor(Value:TColor ) ;
begin
if (Value <> FfColor) then
begin
FfColor := Value;
Invalidate;
end;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetbColor(Value:TColor ) ;
begin
if (Value <> FbColor) then
begin
FbColor := Value;
Invalidate;
end;
end;
//-----------------------------------------------------
procedure TCsPipeLine.Paint;
var TheImage:TBitmap ;
OverlayImage :TBltBitmap;
PaintTRect:TRect;
begin
TheImage:=TBitmap.Create;
OverlayImage:=TBltBitmap.Create;
TheImage.Height := Height;
TheImage.Width := Width;
PaintBackground(TheImage);
PaintTRect := ClientRect;
OverlayImage.MakeLike(TheImage);
PaintBackground(Tbitmap(OverlayImage));
PaintAsBar(TBitmap(OverlayImage), PaintTRect);
TheImage.Canvas.CopyMode := cmSrcInvert;
TheImage.Canvas.Draw(0, 0, OverlayImage);
TheImage.Canvas.CopyMode := cmSrcCopy;
Canvas.CopyMode := cmSrcCopy;
Canvas.Draw(0, 0, TheImage);
end;
//---------------------------------------------------------------------------
procedure TCsPipeLine.PaintBackground(var AnImage:TBitmap ) ;
var ARect: TRect;
begin
AnImage.Canvas.CopyMode:= cmBlackness;
ARect := Rect(0, 0, Width, Height);
AnImage.Canvas.CopyRect(ARect, AnImage.Canvas, ARect);
AnImage.Canvas.CopyMode := cmSrcCopy;
end;
//-----------------------------------------------------------------------
procedure TCsPipeLine.PaintAsBar(var AnImage:TBitmap; const PaintRect :TRect) ;
var PRect: TRect;
i,x1,x2,y1,y2,W,H:integer;
begin
W:=PaintRect.Right-PaintRect.Left;
H:=PaintRect.Bottom-PaintRect.Top;
AnImage.Canvas.Brush.Color:=FbColor;
AnImage.Canvas.FillRect(PaintRect);
if (FDirection=Horizontal) then
begin
AnImage.Canvas.Brush.Color:=FfColor;
for i:=0 to FNumber-1 do
begin
x1:=FIndex+2*i*(W) div (2*FNumber);
y1:=(H) div 3;
x2:=x1+(W)div(2*FNumber);
y2:=(H)*2 div 3;
PRect.Left:=x1;
PRect.Top:=y1;
PRect.Right:=x2;
PRect.Bottom:=y2;
AnImage.Canvas.FillRect(PRect);
if (x2>W) then
begin
PRect.Left:=0;
PRect.Top:=y1;
PRect.Right:=x2-W;
PRect.Bottom:=y2;
AnImage.Canvas.FillRect(PRect);
end;
end;
end
else
begin
AnImage.Canvas.Brush.Color:=FfColor;
for i:=0 to FNumber-1 do
begin
y1:=FIndex+2*i*(H) div(2*FNumber);
x1:=(W)div 3;
y2:=y1+(H)div(2*FNumber);
x2:=(W)*2 div 3;
PRect.Left:=x1;
PRect.Top:=y1;
PRect.Right:=x2;
PRect.Bottom:=y2;
AnImage.Canvas.FillRect(PRect);
if (y2>H) then
begin
PRect.Left:=x1;
PRect.Top:=0;
PRect.Right:=x2;
PRect.Bottom:=y2-H;
AnImage.Canvas.FillRect(PRect);
end;
end;
end;
end;
end.
interface
uses
Windows, Messages, SysUtils,extctrls, Classes, Graphics, Controls, Forms, Dialogs,CsHead;
type
TCsPipeLine = class(TGraphicControl)
private
{ Private declarations }
FIndex:Integer ;
FNumber:Integer;
FDirection:TDirection;
FIncrease:TYesNo ;
FRuning:TYesNo ;
FSpeed:Integer;
FfColor:TColor ;
FbColor:TColor ;
Ftimer1:TTimer;
procedure SetfColor(Value:TColor);
procedure SetbColor(Value:TColor);
procedure SetIncrease(Value:TYesNo );
procedure SetRuning(Value:TYesNo );
procedure SetDirection(Value:TDirection );
procedure SetSpeed(Value:Integer );
procedure SetNumber(Value:Integer);
procedure PaintBackground(var AnImage:TBitmap);
procedure PaintAsBar(var AnImage:TBitmap; const PaintRect:TRect);
protected
procedure Paint; //virtual;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure StyleChanged(Sender:TObject);
published
property DragCursor;
property DragMode;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property PopupMenu ;
property ShowHint ;
property Color ;
property Visible ;
property Height;
property Width;
property Direction:TDirection read FDirection write SetDirection nodefault;
property Increase:TYesNo read FIncrease write SetIncrease nodefault;
property Runing:TYesNo read FRuning write SetRuning nodefault;
property Number:Integer read FNumber write SetNumber nodefault;
property Speed:Integer read FSpeed write SetSpeed nodefault;
property ForeColor:TColor read FfColor write SetfColor nodefault;
property BackColor:TColor read FbColor write SetbColor nodefault;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('CS Controls', [TCsPipeLine]);
end;
constructor TCsPipeLine.Create(AOwner: TComponent);
begin
// TGraphicControl
inherited Create(AOwner);
ControlStyle := ControlStyle+[csOpaque,csFramed ,csReplicatable]; {???}
FIndex:=0;
FDirection:=Horizontal;
FIncrease:=Yes;
FRuning:=No;
FNumber:=3;
FSpeed:=100;
FfColor:=clBlue;
FbColor:=clGreen;
Width:=165;
Height:=65;
Ftimer1:=TTimer.create(AOwner) ;
Ftimer1.Enabled:=false;
Ftimer1.Interval:=FSpeed;
Ftimer1.OnTimer:=StyleChanged;
end;
destructor TCsPipeLine.Destroy;
begin
Ftimer1.Free;
inherited Destroy;
end;
procedure TCsPipeLine.StyleChanged(Sender:TObject);
begin
if FIncrease=Yes then
begin
inc(FIndex);
if FDirection=Horizontal then
if FIndex>Width/FNumber then
FIndex:=0;
if FDirection=Vertical then
if FIndex>Height/FNumber then
FIndex:=0;
end;
if FIncrease=No then
begin
dec(FIndex);
if (FDirection=Horizontal) then
if (FIndex<0) then
FIndex:=Width div FNumber;
if (FDirection=Vertical) then
if (FIndex<0) then
FIndex:=Height div FNumber;
end;
Invalidate;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetDirection(Value:TDirection );
begin
if (FDirection<>Value) then
begin
FDirection:=Value;
Invalidate;
end;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetIncrease( Value:TYesNo);
begin
if (FIncrease<>Value) then
begin
FIncrease:=Value;
end;
Invalidate;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetRuning(Value:TYesNo ) ;
begin
if (FRuning<>Value) then
begin
FRuning:=Value;
if (FRuning=Yes) then
Ftimer1.Enabled:=true
else
Ftimer1.Enabled:=false;
end;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetNumber(Value:Integer) ;
begin
if (FNumber<>Value) then
begin
FNumber:=Value;
Invalidate;
end;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetSpeed(Value:Integer ) ;
var aa :boolean;
begin
if (FSpeed<>Value) then
begin
FSpeed:=Value;
aa:=Ftimer1.Enabled;
Ftimer1.Enabled:=false;
Ftimer1.Interval:=FSpeed;
Ftimer1.Enabled:=aa;
end;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetfColor(Value:TColor ) ;
begin
if (Value <> FfColor) then
begin
FfColor := Value;
Invalidate;
end;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetbColor(Value:TColor ) ;
begin
if (Value <> FbColor) then
begin
FbColor := Value;
Invalidate;
end;
end;
//-----------------------------------------------------
procedure TCsPipeLine.Paint;
var TheImage:TBitmap ;
OverlayImage :TBltBitmap;
PaintTRect:TRect;
begin
TheImage:=TBitmap.Create;
OverlayImage:=TBltBitmap.Create;
TheImage.Height := Height;
TheImage.Width := Width;
PaintBackground(TheImage);
PaintTRect := ClientRect;
OverlayImage.MakeLike(TheImage);
PaintBackground(Tbitmap(OverlayImage));
PaintAsBar(TBitmap(OverlayImage), PaintTRect);
TheImage.Canvas.CopyMode := cmSrcInvert;
TheImage.Canvas.Draw(0, 0, OverlayImage);
TheImage.Canvas.CopyMode := cmSrcCopy;
Canvas.CopyMode := cmSrcCopy;
Canvas.Draw(0, 0, TheImage);
end;
//---------------------------------------------------------------------------
procedure TCsPipeLine.PaintBackground(var AnImage:TBitmap ) ;
var ARect: TRect;
begin
AnImage.Canvas.CopyMode:= cmBlackness;
ARect := Rect(0, 0, Width, Height);
AnImage.Canvas.CopyRect(ARect, AnImage.Canvas, ARect);
AnImage.Canvas.CopyMode := cmSrcCopy;
end;
//-----------------------------------------------------------------------
procedure TCsPipeLine.PaintAsBar(var AnImage:TBitmap; const PaintRect :TRect) ;
var PRect: TRect;
i,x1,x2,y1,y2,W,H:integer;
begin
W:=PaintRect.Right-PaintRect.Left;
H:=PaintRect.Bottom-PaintRect.Top;
AnImage.Canvas.Brush.Color:=FbColor;
AnImage.Canvas.FillRect(PaintRect);
if (FDirection=Horizontal) then
begin
AnImage.Canvas.Brush.Color:=FfColor;
for i:=0 to FNumber-1 do
begin
x1:=FIndex+2*i*(W) div (2*FNumber);
y1:=(H) div 3;
x2:=x1+(W)div(2*FNumber);
y2:=(H)*2 div 3;
PRect.Left:=x1;
PRect.Top:=y1;
PRect.Right:=x2;
PRect.Bottom:=y2;
AnImage.Canvas.FillRect(PRect);
if (x2>W) then
begin
PRect.Left:=0;
PRect.Top:=y1;
PRect.Right:=x2-W;
PRect.Bottom:=y2;
AnImage.Canvas.FillRect(PRect);
end;
end;
end
else
begin
AnImage.Canvas.Brush.Color:=FfColor;
for i:=0 to FNumber-1 do
begin
y1:=FIndex+2*i*(H) div(2*FNumber);
x1:=(W)div 3;
y2:=y1+(H)div(2*FNumber);
x2:=(W)*2 div 3;
PRect.Left:=x1;
PRect.Top:=y1;
PRect.Right:=x2;
PRect.Bottom:=y2;
AnImage.Canvas.FillRect(PRect);
if (y2>H) then
begin
PRect.Left:=x1;
PRect.Top:=0;
PRect.Right:=x2;
PRect.Bottom:=y2-H;
AnImage.Canvas.FillRect(PRect);
end;
end;
end;
end;
end.