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.