var
Form1: TForm1;
MaxTxtWindth,Y:Integer;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered := True;
Y := Image1.ClientWidth;
MaxTxtWindth :=Image1.Canvas.TextWidth('dg');
Image1.Transparent := True; //可以加个背景
Image1.Canvas.Font.Color:=clRed;
Timer1.Interval := 30;
Timer1.Enabled := True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
i:Integer;
TxtLinePosY:Integer;
MyStr:WideString;
TemStr:String;
begin
Image1.Canvas.FillRect(Image1.ClientRect);
TxtLinePosY:= Y;
mystr:=edit2.Text;
for i:=1 to Length(MyStr) do
begin
Inc(TxtLinePosY,MaxTxtWindth);
TemStr:=MyStr[i];
if Ord(TemStr[1]) > 128 then
begin
MaxTxtWindth:=Image1.Canvas.TextWidth('aa');
end
else
MaxTxtWindth:=Image1.Canvas.TextWidth('a');
if (TxtLinePosY < -MaxTxtWindth)or(TxtLinePosY > Image1.ClientWidth) then
Continue
else
begin
Image1.Canvas.TextOut(TxtLinePosY,0,mystr[i]);
end;
end;
Dec(Y);
if Y < -Length(MyStr)* MaxTxtWindth then
Y := Image1.ClientWidth;
end;