超难!300分求!向上滚动平滑字幕(可加图像,实时读取数据)解决方案! (300分)

  • 主题发起人 主题发起人 siow
  • 开始时间 开始时间
用Image的Canvas中可以,使用时注意一定要把Image的stretch属性设为True;
使用Timer来控制文本速度,
Canvas.Textout(x,y,'要滚动的文本')

如果是一个文本的话可以在Timer中做个循环,
至于首尾连接的则要知道文本的高度,计算一下数,做一个跳出Timer的条件,然后重新开始
Canvas.TextHeight('文字'):计算文字的高度
 
各位老大!请不要把这个问题看成小儿科,要是那么简单我也不会加上超难!请看我的示例!请看清我的要求!http://my.2ccc.com/siow/temp.zip
 
图片可以 Image.Canvas.Draw(x,y,Graphic);
 
siow:我发给你的Email没收到吗?
 
在一个Panel上放你要显示的东西,控制上下移动就可以了。不过稍微有点闪。
 
to:zdwwf
已收到并回复
 
也给我一份吧
runout_he@sina.com
 
zdwwf的代码:
procedure TForm1.Timer1Timer(Sender: TObject);
var
i,textYPos:integer;
begin
BitMap.Canvas.Copyrect(rect(0,0,iWidth,iHeight-iCurYPos),
BitMap_t.Canvas ,rect(0,iCurYPos,iWidth,iHeight));
BitMap.Canvas.Copyrect(rect(0,iHeight-iCurYPos,iWidth,iHeight),
BitMap_t.Canvas ,rect(0,0,iWidth,iCurYPos));

PaintBox1.Canvas.Copyrect(rect(0,0,iWidth,iHeight),
BitMap.Canvas ,rect(0,0,iWidth,iHeight));

//文字单独处理,这样的话就可以与图片无关
PaintBox1.Canvas.Brush.Style:=bsClear; //透明
PaintBox1.Canvas.Font.Size:=12;
for i:=0 to sl.Count-1 do
begin
textYPos:= (iHeight-iCurYPos) + i*20 -30;
textYPos := textYPos mod PaintBox1.Height;
PaintBox1.Canvas.Textout(0, textYPos, sl.strings);
end;

Inc(iCurYPos,iStep);
if iCurYPos>iHeight then iCurYPos:=0;

//PaintBox1.Refresh;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
iCurYPos := 0;
iStep := 1;
iWidth := image1.Picture.Width + image2.Picture.Width;
iHeight := image1.Picture.Height + image2.Picture.Height;


sl:=TStringList.Create;
sl.Add('滚屏演示');
sl.Add('2003.11.25');
sl.Add('改动烦请:zdwwf#21cn.com');
sl.Add('欢迎交流');
sl.Add('');

BitMap:=TBitMap.Create;
BitMap.Width:= iWidth ;
BitMap.Height:= iHeight;

BitMap_t:=TBitMap.Create;
BitMap_t.Width:= iWidth ;
BitMap_t.Height:= iHeight;

//合并两张图
BitMap_t.Canvas.Copyrect(rect(0,0,image1.Picture.Width,image1.Picture.Height),
Image1.Canvas ,rect(0,0,image1.Picture.Width,image1.Picture.Height));
BitMap_t.Canvas.Copyrect(rect(0,image1.Picture.Height,image1.Picture.Width,image1.Picture.Height+image2.Picture.Height),
Image2.Canvas ,rect(0,0,image1.Picture.Width,image2.Picture.Height));
end;
 
zdwwf的代码有几点不足:1.闪烁太历害。2.实时增加数据不符合要求。
 
经考虑,首尾相接循环显示完全没必要,既然是实时增加数据,哪有机会到尾?更准确一点说是实时增加并且平滑显示,不能像 memo1.Lines.Add()时那样。
 
这里有个简单的实现,
但是如果添加太多的内容会占用较多的资源,
可以考虑及时删除不可见的对象

http://www1.51-51.com/pub/FlatMove.rar
仅供借鉴,本来打算添加万行文本,可是慢的要死,
只添了100行
 
siow,ezero:邮件已发,请查收!
为了满足siow的要求,细化了一个代码:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, Db, ADODB, Grids, DBGrids, StdCtrls;

type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
Timer1: TTimer;
Image1: TImage;
ADOQuery1: TADOQuery;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
StaticText1: TStaticText;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
iLine,iWidth,iHeight,iStep,iFoneSize,iFontHeight:integer;
iCurYPos,iTextYPos,iIconWidth:integer;
BitMap:TBitMap;


Function GetData():Boolean;
procedure SetSLInit();
procedure SetSLInRun();
end;
type
rdSL=Record
Str:string;
iPicId:integer;
end;
var
Form1: TForm1;
CurDir:String;
arSl:array of rdSL;
implementation

{$R *.DFM}
Function TForm1.GetData():Boolean;
begin
result:=false;
try
ADOQuery1.Close;
ADOQuery1.Open;
if not ADOQuery1.Eof then result:=true;
except
Timer1.Enabled:=false;
MessageBox(Handle,PChar('数据库未连接上.'),
Pchar('提示'), MB_OK or MB_ICONINFORMATION);
end;
end;

procedure TForm1.SetSLInit();
var
i:integer;
begin
for i:=0 to iLine-1 do
begin
if ADOQuery1.Eof then
if not GetData() then exit;

arSl.Str := ADOQuery1.FieldByName('str').AsString;
arSl.iPicId := ADOQuery1.FieldByName('iPicId').AsInteger;
ADOQuery1.Next;
end;
end;

procedure TForm1.SetSLInRun();
var
i:integer;
begin
for i:=0 to iLine-1-1 do
begin
arSl.Str:=arSl[i+1].Str;
arSl.iPicId:=arSl[i+1].iPicId;
end;
arSl[iLine-1].Str:='';

if ADOQuery1.Eof then
if not GetData() then exit;

arSl[iLine-1].Str:=ADOQuery1.FieldByName('str').AsString;
arSl.iPicId := ADOQuery1.FieldByName('iPicId').AsInteger;
ADOQuery1.Next;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
i,tmpYPos,itmpLine:integer;
begin
BitMap.Canvas.Brush.Style:=bsSolid;
BitMap.Canvas.Brush.Color:=$00B66F43;
BitMap.Canvas.Rectangle(0,0,iWidth,iHeight);

BitMap.Canvas.Font.Color:=clWhite;
BitMap.Canvas.Brush.Style:=bsClear;
for i:=0 to iLine do
begin
tmpYPos:= -itextYPos + i*iFontHeight ;
itmpLine :=i mod iLine ;
BitMap.Canvas.Textout(iIconWidth+3, tmpYPos,arSl[itmpLine].Str);

BitMap.Canvas.Copyrect(rect(0, tmpYPos, iIconWidth, tmpYPos + iIconWidth),
image1.Canvas ,rect(arSl[itmpLine].iPicId*iIconWidth , 0, arSl[itmpLine].iPicId*iIconWidth + iIconWidth ,iIconWidth));
end;

PaintBox1.Canvas.Copyrect(rect(0,0,iWidth,iHeight),
BitMap.Canvas ,rect(0,0,iWidth,iHeight));

Inc(iCurYPos,iStep);
Inc(itextYPos,iStep);
if iCurYPos>iHeight then iCurYPos:=0;
if itextYPos>iFontHeight then
begin
itextYPos:=0;
SetSLInRun();
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
i:integer;
Str:String;
begin
iLine := 10;
iCurYPos := 0 ;
itextYPos := 0 ;
iStep := 1 ;
iFoneSize := 12;
iIconWidth := 27;
CurDir := ExtractFilePath(ParamStr(0));

Str:=Format('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;Persist Security Info=False',[CurDir+'db.mdb']);
ADOQuery1.ConnectionString:=str;
if GetData() then Timer1.Enabled:=true;
SetLength(arSl,iLine);
SetSLInit();

BitMap:=TBitMap.Create;
BitMap.Canvas.Font.Size := iFoneSize;

iFontHeight := BitMap.Canvas.TextHeight('W');
PaintBox1.Height := iFontHeight*(iLine-1);

iWidth := PaintBox1.Width;
iHeight := PaintBox1.Height;

BitMap.Width:= iWidth ;
BitMap.Height:= iHeight;
end;

end.
 
不知这样分公不公平?多多包涵!
^-^
 
多人接受答案了。
 
后退
顶部