아래 소스는 책보고 한건데여...여기서 TransParents를 더 추가해서

(움직이는 메모 텍스트에여...)

바탕화면두 투명하게 할려구 하는데 잘 안되네여..

고수님들의 조언 부탁드리구여....



고칠부분은 맨 밑부분쯤에 있어여...(기타 다른 부분도 손바주시면 고맙구여..)





//////////////////////////

unit moveText;



interface



uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ExtCtrls, FlatUtilitys,

// WinProcs, WinTypes,

StdCtrls,

WPRTFInp,

WPReader, WPDefs, Clipbrd, WPObj, WPRead2, WPWrite2,

WPwrtRTF, WPrtfTXT, WPRtfIo, WPFinder,

WPRtfPA, WPWinCTR, WPPrint;





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;

FTransparent: Boolean; //

procedure SetTransparent (const Value: Boolean); //

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;



// procedure Paint; override; //



{ 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;

property Transparent: Boolean read FTransparent write SetTransparent default false;

{ 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;



procedure TCustomMoveText.SetTransparent(const Value: Boolean);

begin

//***** 이 부분을 채워 주세요..

end;



end.