말그대로 입니다.
움직이는 컴포넌트를 만든후에 바탕색이나..이미지...transparents를 넣고 싶어요...
참 여기서는 추가하는 걸루 하나만 TransParents만 누가 좀 해봐주세요,...
밑에는 소스입니다...
.........................................................
unit moveText;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
type
TAlignment = (taCenter, taLeftJustify, taRightJustify);
TTextStyle = (tsNormal, tsRaised, tsLowered, tsShaddow);
TMoveDirection = (mdStatic, mdRightToLeft, mdLeftToRight, mdTopToBottom, mdBottomToTop);
TCustomMoveText = class(TGraphicControl)
private
FAlignment: TAlignment;
FTextStyle: TTextStyle;
FMoveDirection: TMoveDirection;
FTimer: TTimer;
FItems: TStringList;
FColor: TColor;
FContinuous: Boolean;
FFont: TFont;
FOnBegin, FOnStep, FOnEnd: TNotifyEvent;
FSteps, FSpeed, FDepth, LineHi, FCurrentStep, FTextWidth, FTextHeight, XPos, YPos: integer;
procedure SetAlignment(Value: TAlignment);
procedure SetContinuous(Value: Boolean);
procedure SetItems(Value: TStringList);
procedure DataChanged;
procedure SetTextStyle(Value: TTextStyle);
procedure SetDirection(Value: TMoveDirection);
procedure SetSteps(Value: Integer);
procedure SetSpeed(Value: Integer);
procedure SetColor(Value: TColor);
procedure SetFont(Value: TFont);
procedure SetDepth(Value: Integer);
procedure SetSizeParams;
procedure FontChanged(Sender: Tobject);
procedure DoTextOut(ACanvas: TCanvas; X, Y: Integer; AText: string);
{ Private declarations }
protected
procedure Paint; override;
procedure TimerTick(Sender: TObject);
property Alignment: TAlignment read FAlignment write SetAlignment;
property Depth: Integer read FDepth write SetDepth default 1;
property MoveDirection: TMoveDirection read FMoveDirection write SetDirection default mdRightToLeft;
property Items: TStringList read FItems write SetItems;
property OnBegin: TNotifyEvent read FOnBegin write FOnBegin;
property OnStep: TNotifyEvent read FOnStep write FOnStep;
property OnEnd: TNotifyEvent read FOnEnd write FOnEnd;
{ Protected declarations }
public
Property CurrentStep: Integer read FCurrentStep;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ReverseDirection;
procedure MoveStart(StartingStep: Integer);
procedure MoveStop;
{ Public declarations }
published
property TextStyle: TTextStyle read FTextStyle write SetTextStyle default tsNormal;
property Steps: Integer read FSteps write SetSteps default 66;
property Speed: Integer read FSpeed write SetSpeed default 200;
property Color: TColor read FColor write SetColor default clBtnFace;
property Continuous: Boolean read FContinuous write SetContinuous;
property Font: TFont read FFont Write SetFont;
{ Published declarations }
end;
TMoveText = class(TCustomMoveText)
published
property Align;
property Alignment;
property Font;
property MoveDirection;
property ShowHint;
property Speed;
property Steps;
property Visible;
property OnBegin;
property OnStep;
property Color;
property Depth;
property Items;
property TextStyle;
property ParentShowHint;
// property TransParent;
end;
///////////////////////////////////////
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TmoveText]);
end;
constructor TCustomMoveText.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle :=ControlStyle - [csOpaque];
FItems := TStringList.Create;
FItems.Add('텍스트를 움직입니다.');
Width:=200;
Height:=20;
FColor:=clBtnFace;
FSteps:=80;
FCurrentStep:=0;
FDepth:=1;
FContinuous:=true;
FTextStyle:=tsNormal;
Falignment:=taCenter;
FFont:=TFont.Create;
with FFont do
begin
name:='굴림체';
Size:=10;
Color:=clBlack;
end;
FFont.OnChange :=FontChanged;
FTimer:=TTimer.Create(Self);
FSpeed:=100;
With FTimer do
begin
Enabled:=false;
OnTimer:=TimerTick;
Interval:=FSpeed;
end;
FMoveDirection := mdRightToLeft;
SetDirection(FMoveDirection);
end;
destructor TCustomMoveText.Destroy;
begin
FItems.Free;
FTimer.free;
FFont.Free;
inherited Destroy;
end;
procedure TCustomMoveText.SetItems(Value: TStringList);
begin
if FItems <> Value then
begin
FItems.Assign(Value);
DataChanged;
end;
end;
procedure TCustomMoveText.DoTextOut(ACanvas: TCanvas; X, Y: Integer; AText: string);
var
TextAdjustment:integer;
begin
with ACanvas do
begin
Font:= FFont;
Brush.Style := bsClear;
if FAlignment = taCenter then
TextAdjustment := Round((FTextWidth/2)-(TextWidth(AText)/2))
else if Falignment = taRightJustify then
TextAdjustment := Round(FTextWidth - TextWidth(AText))
else TextAdjustment:=0;
case FTextStyle of
tsRaised: begin
Font.Color :=clBtnHighlight;
TextOut(X-FDepth+TextAdjustment, Y-FDepth, AText);
Font.Color :=clBtnShadow;
TextOut(X+FDepth+TextAdjustment, Y+FDepth, AText);
end;
tsLowered: begin
Font.Color :=clBtnShadow;
TextOut(X-FDepth+TextAdjustment, Y-FDepth, AText);
Font.Color :=clBtnHighlight;
TextOut(X+FDepth+TextAdjustment, Y+FDepth, AText);
end;
tsShaddow: begin
Font.Color :=clBtnShadow;
TextOut(X+FDepth+TextAdjustment, Y+FDepth, AText);
end;
end;
Font.Color :=FFont.Color;
TextOut(X+TextAdjustment, Y, AText);
end;
end;
procedure TCustomMoveText.Paint;
var
TmpBmp: TBitMap;
StartXPos, StartYPos, I:integer;
PercentDone: Double;
begin
SetSizeParams;
TmpBmp:=TBitMap.Create;
try
TmpBmp.Width :=Width;
TmpBmp.Height :=Height;
with TmpBmp.Canvas do
begin
Font := FFont;
Brush.Color := FColor;
Brush.Style := bsSolid;
FillRect(ClipRect);
end;
if FTextWidth >= Width then
XPos:=0
else
XPos:=(Width-FTextWidth) div 2;
if FTextHeight >=Height then
YPos:=0
else
YPos:=(Height-FTextHeight) div 2;
if csDesigning in ComponentState then
PercentDone :=0.5
else
PercentDone:=FCurrentStep/FSteps;
case FMoveDirection of
mdRightToLeft: begin
StartYPos:=YPos;
StartXPos:=Round((FTextWidth + Width)*(1-PercentDone))-FTextWidth;
end;
mdLeftToRight: begin
StartYPos:=YPos;
StartXPos:=Round((FTextWidth + Width)*PercentDone)-FTextWidth;
end;
mdBottomToTop: begin
StartXPos:=YPos;
StartYPos:=Round((FTextHeight + Height)*(1-PercentDone))-FTextHeight;
end;
mdTopToBottom: begin
StartXPos:=YPos;
StartYPos:=Round((FTextHeight + Height)*PercentDone)-FTextHeight;
end;
else
begin
StartXPos:=XPos;
StartYPos:=YPos;
end
end;
I:=0;
while I < FItems.Count do
begin
DoTextOut(TmpBmp.canvas, StartXPos, StartYPos, FItems.Strings[I]);
Inc(StartYPos, LineHi);
Inc(I);
end;
canvas.Draw(0,0,TmpBmp);
Finally
TmpBmp.free;
end;
end;
procedure TCustomMoveText.SetSizeParams;
var
S: String;
I, SWidth: Integer;
Metrics: TTextMetric;
begin
with Canvas do
begin
Font:=FFont;
GetTextMetrics(Handle,Metrics);
LineHi:=Metrics.tmHeight + Metrics.tmInternalLeading;
if FTextStyle in [tsRaised, tsLowered] then
LineHi:=LineHi+2*FDepth
else if FTextStyle in [tsShaddow] then
LineHi := LineHi + FDepth;
end;
FTextWidth :=0;
I:=0;
while I < FItems.Count do
begin
S:=FItems.Strings[I];
SWidth:=Canvas.TextWidth(S);
if FTextStyle in [tsRaised, tsLowered] then
SWidth :=SWidth + 2 *FDepth
else if FTextStyle in [tsShaddow] then
SWidth :=SWidth+FDepth;
if FTextWidth < SWidth then
FTextWidth:=SWidth;
Inc(I);
end;
FTextHeight:=LineHi*FItems.Count;
if FTextHeight >= Width then
XPos:=0
else
XPos := (Width-FTextWidth) div 2;
if FTextHeight >=Height then
YPos:=0
else
YPos := (Height - FTextHeight) div 2;
end;
procedure TCustomMoveText.SetContinuous(Value: Boolean);
begin
if FContinuous <> Value then
begin
FContinuous := Value;
if FMoveDirection <> mdStatic then
MoveStart(FCurrentStep);
end;
end;
procedure TCustomMoveText.SetSteps(Value: Integer);
begin
if FSteps <> Value then
begin
FSteps:=Value;
if csDesigning in ComponentState then
Invalidate;
end;
end;
procedure TCustomMoveText.SetSpeed(Value: Integer);
begin
if FSpeed <> Value then
begin
if Value > 1000 then Value :=1000
else if Value < 1 then Value :=1;
FSpeed:=Value;
if FTimer <> nil then FTimer.Interval := FSpeed;
end;
end;
procedure TCustomMoveText.SetColor(Value: TColor);
begin
if FColor <> Value then
begin
FColor :=Value;
DataChanged;
end;
end;
procedure TCustomMoveText.FontChanged(Sender: TObject);
begin
DataChanged;
end;
procedure TCustomMoveText.SetFont(Value: TFont);
begin
if FFont <> Value then
begin
FFont.Assign(Value);
DataChanged;
end;
end;
procedure TCustomMoveText.MoveStop;
begin
FTimer.Enabled :=false;
end;
procedure TCustomMoveText.ReverseDirection;
begin
if FMoveDirection=mdStatic then Exit;
FCurrentStep := FSteps - FCurrentStep;
case FMoveDirection of
mdLeftToRight: FMoveDirection := mdRightToLeft;
mdRightToLeft: FMoveDirection := mdLeftToRight;
mdTopToBottom: FMoveDirection := mdBottomToTop;
mdBottomToTop: FMoveDirection := mdTopToBottom;
end;
end;
procedure TCustomMoveText.TimerTick(Sender: TObject);
begin
if not FTimer.Enabled then Exit;
if (FCurrentStep=0) and Assigned(FOnBegin) then
FOnBegin(Self);
Inc(FCurrentStep);
Paint;
if Assigned(FOnStep) then
FOnStep(Self);
if FCurrentStep > FSteps then
begin
FTimer.Enabled :=false;
if Assigned(FOnEnd) then
FOnEnd(Self);
FCurrentStep :=0;
if FContinuous then
MoveStart(FCurrentStep);
end;
end;
procedure TCustomMoveText.DataChanged;
begin
SetSizeParams;
Invalidate;
end;
procedure TCustomMoveText.SetTextStyle(Value: TTextStyle);
begin
if FTextStyle <> Value then
begin
FTextStyle := Value;
DataChanged;
end;
end;
procedure TCustomMoveText.SetDirection(Value: TMoveDirection);
begin
if FMoveDirection <> Value then
FMoveDirection := Value;
if FMoveDirection = mdStatic then
MoveStop
else
MoveStart(FCurrentStep);
end;
procedure TCustomMoveText.SetAlignment(Value: Talignment);
begin
if FAlignment <> Value then
begin
Falignment:=Value;
DataChanged;
end;
end;
procedure TCustomMoveText.SetDepth(Value: Integer);
begin
if FDepth <> Value then
begin
FDepth := Value;
DataChanged;
end;
end;
procedure TCustomMoveText.MoveStart(StartingStep: Integer);
begin
if FTimer.Enabled then Exit;
if (StartingStep >= 0) and (StartingStep <= FSteps) then
FCurrentStep := StartingStep;
FTimer.Enabled :=true;
end;
end.
...............................................................
여기까지가 소스 입니다.. 잘 부탁드려용...