词霸的关于Form上的制作人员列表怎样做的?(5分)

  • 主题发起人 主题发起人 webease
  • 开始时间 开始时间
W

webease

Unregistered / Unconfirmed
GUEST, unregistred user!
如题,是不是用timer刷新?嘿嘿,请大家帮忙
 
可以用TIMER 控件来实现!
当然做起来不会很难!
自己做做吧!
 
有现成的控件scrolltext
或在rxlib里有。
 
把全部信息放在一个Panel上,
然后在Timer里定时向上滚:
begin
...
with Paneldo
begin
//向上滚动
Top:=Top-5;
//滚到看不见
if Top+Height<-10 then
//再重新开始
Top:=0;
end;
...
end;

如此而已
 
对了, 以前有过一个问题memo构件向上逐步滚动, 没有答案, 谁能解答, 有分:-)
 
蚯蚓的方法是可以的
我自己做了一个控件,大家看看。
unit AnimateText;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
const defaulttext='SrwAnimateText Version 1.0';
type atAmtType=(atUptoDown,atDowntoUp,atLefttoRight,atRighttoLeft);
type
TAnimateText = class(Tgraphiccontrol)
private
charwidth,charheight:integer;
charnum,rows:integer;
//每行的字数及需要的行数
atTime:TTimer;
begin
x:integer;

FAnimateType:atAmtType;
FText:String;
FInterval:integer;
FActive:boolean;
FStep:integer;
procedure SetText(value:String);
procedure setInterval(value:integer);
procedure setActive(value:boolean);
procedure setstep(value:integer);
procedure setAnimateType(value:atAmtType);
procedure Animated;
procedure Textanimated(sender:TObject);
protected
procedure Paint;override;
public
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
published
property Active:boolean read FActive write SetActive;
property Text:string read Ftext write SetText;
property Interval:integer read Finterval write SetInterval default 100;
property Step:integer read FStep write setStep default 5;
property AnimateType:atAmtType read FAnimateType write setanimateType;
property Font;
property Color;
property Align;
property Enabled;
property Hint;
property Visible;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;

procedure Register;
implementation

Constructor TAnimateText.Create(AOwner:TComponent);
begin
inherited Create(AOwner);

atTime:=TTimer.Create(self);
atTime.Enabled:=false;
atTime.OnTimer:=TextAnimated;
begin
x:=0;
SetText(defaultText);
Setinterval(200);
SetStep(2);
end;

procedure TAnimateText.Paint;
var temp:integer;
begin
canvas.font:=font;
charwidth:=canvas.TextWidth('aaaaaaaaaa') div 10;
charheight:=canvas.TextHeight('jjjjjjjjjj')+1;
charnum:=(width-4) div charwidth;
//每行的字数
rows:=Length(Ftext) div charnum+1;
//需要多少行
if FActive then
begin
Animated;
exit;
end;

setbkmode(canvas.handle,transparent);
//透明的
for temp:=1 to rowsdo
begin
canvas.TextOut(2,2+(temp-1)*charheight,copy(FText,charnum*(temp-1)+1,charnum));
end;

end;

procedure TAnimateText.setstep(value:integer);
begin
if value<>FStep then
begin
FStep:=value;
invalidate;
end;
end;

procedure TAnimateText.SetText(value:string);
begin
if value<>FText then
begin
FText:=value;
invalidate;
end;
end;

procedure TAnimateText.setAnimateType(value:atAmtType);
begin
if value<>FAnimateType then
begin
FAnimateType:=value;
invalidate;
end;
end;

procedure TAnimateText.setInterval(value:integer);
begin
if value<>FInterval then
begin
FInterval:=value;
atTime.Interval:=FInterval;
end;
end;

procedure TAnimateText.setActive(value:boolean);
begin
if FActive<>value then
begin
FActive:=value;
atTime.Enabled:=FActive;
invalidate;
end;
end;

procedure TAnimateText.Animated;
var temp:integer;
begin
case FAnimateType of
atUptoDown:begin
begin
x:=begin
x+FStep;
if begin
x>height then
begin
x:=0-rows*charheight;
setbkmode(canvas.handle,transparent);
canvas.pen.Color:=font.Color;
for temp:=1 to rowsdo
begin
canvas.TextOut(2,begin
x+(temp-1)*charheight,copy(FText,charnum*(temp-1)+1,charnum));
end;
end;
atDowntoUp:begin
begin
x:=begin
x-FStep;
if begin
x<0-rows*charheight then
begin
x:=height;
setbkmode(canvas.handle,transparent);
//透明的
for temp:=1 to rowsdo
begin
canvas.TextOut(2,begin
x+(temp-1)*charheight,copy(FText,charnum*(temp-1)+1,charnum));
end;
end;
atRighttoLeft:begin
begin
x:=begin
x-FStep;
if begin
x<0-width then
begin
x:=width;
setbkmode(canvas.handle,transparent);
//透明的
for temp:=1 to rowsdo
begin
canvas.TextOut(begin
x,2+(temp-1)*charheight,copy(FText,charnum*(temp-1)+1,charnum));
end;
end;
atLefttoRight:begin
begin
x:=begin
x+FStep;
if begin
x>width then
begin
x:=0-width;
setbkmode(canvas.handle,transparent);
//透明的
for temp:=1 to rowsdo
begin
canvas.TextOut(begin
x,2+(temp-1)*charheight,copy(FText,charnum*(temp-1)+1,charnum));
end;
end;
end;
{case}
end;

procedure TAnimateText.Textanimated(sender:TObject);
begin
if atTime.Enabled then
invalidate;
end;

destructor TAnimateText.Destroy;
begin
inherited Destroy;
// tempbmp.free;
end;


procedure Register;
begin
RegisterComponents('SrwSoft', [TAnimateText]);
end;

end.
 
如果要平滑而没有闪烁,就要对ScrollBox编程实现
 
cytown:
memo中内容滚动的问题在漳龙论坛上讨论过,
你可以问问cAkk知不知道
 
找到了,
Win32 API:
----------------------------
<B>EM_Scroll</B>:
wParam = (WPARAM) (INT) nScroll;
lParam = 0;
wParam取值及含义:
<B>SB_LineDown</B>:下滚一行
<B>SB_LineUp</B>:上滚一行
<B>SB_PageDown</B>:下翻一页
<B>SB_PageUp</B>:上翻一页
----------------------------
<B>EM_ScrollCaret</B>:
将光标所在位置滚动到可见区域
wParam = 0;
lParam = 0;
先用<B>EM_SetSel消息</B>或<B>SetSel方法</B>设置光标位置
 
谢谢各位帮忙,分少别见怪!
 
很明显,XDict中用的定时器滚动是ScrollBox。
 
时间太久,强制结束。 wjiachun
 
后退
顶部