rollingnewsfrm.pas

《Delphi实例开发教程》源代码包说明

unit RollingNewsFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, CheckLst, ComCtrls, ExtCtrls, Buttons,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP;
type

  //定义百度搜索类
  TBaiduSite = class(TThread)
 //   procedure BaiduSite1 ;
//    procedure ThreadSiteDone1(Sender: TObject);
  protected
   procedure Execute; override;
  public
    constructor Create;
  end;




type
    news = record
      head:string;
      link:string;
    end;
var
 rollnews:array of news;
type
  TfrmRollingNews = class(TForm)
    clbNewsType: TCheckListBox;
    GroupBox1: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    tbRollPace: TTrackBar;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    cbbNewsNum: TComboBox;
    GroupBox3: TGroupBox;
    sbCancel: TSpeedButton;
    sbOK: TSpeedButton;
    tmNewsSearch: TTimer;
    IdhttpRollNews: TIdHTTP;
    tmRollNews: TTimer;
    sbClose: TSpeedButton;
    GroupBox4: TGroupBox;
    Label5: TLabel;
    cbbNewsRefresh: TComboBox;
    lblHint: TLabel;
    procedure tmNewsSearchTimer(Sender: TObject);
    procedure sbOKClick(Sender: TObject);
    procedure sbCancelClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure tmRollNewsTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure NewsSearch();
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmRollingNews: TfrmRollingNews;newsnum,Roll:integer;
  timerrun1,timerrun2:boolean;
  BaiduSite:TBaiduSite;

implementation

uses MainFrm;

{$R *.dfm}
  //构造每个搜索类线程
constructor TBaiduSite.Create;
begin
  FreeOnTerminate:=True;
  //OnTerminate:=ThreadSiteDone;
  inherited Create(False);
end;

//定义每个线程的执行操作
procedure TBaiduSite.Execute;
begin
  //BaiduSite;
  frmRollingNews.newsSearch();
end;

procedure TfrmRollingNews.tmNewsSearchTimer(Sender: TObject);
begin
BaiduSite:=TBaiduSite.Create;
end;
procedure TfrmRollingNews.NewsSearch();
var str,line,head,link,time,genre:string;
    i,j,k:integer;
begin
    with frmMain.AdoqSetting do
    begin
      close;
      sql.Clear;
      sql.Add('delete from rollnews');
      execsql;
    end;
  line:='1';
  str:=idhttpRollNews.Get('http://news.sina.com.cn/news1000/index.shtml');
  str:=GetStrBetween(str,'<!--新闻开始-->','<!--新闻结束-->');
  for i:=0 to 69 do
  begin
    line:=GetStrBetween(str,'<li>','</li>');
    if line='' then break;
    str:=Copy(str,Pos(line,str)+length(line),Length(str));
    genre:=GetStrBetween(line,'[',']');
    link:=GetStrBetween(line,'<a href="','" TARGET=_blank>');
    head:=GetStrBetween(line,'TARGET=_blank>','</a>');
    time:=GetStrBetween(line,'COLOR=#6666cc> (',')</FONT>')+':00';
    time:=DelSubStr('/',time);
    insert('-',time,5);
    insert('-',time,8);
    with frmMain.AdoqSetting do
    begin
      close;
      sql.Clear;
      sql.Add('select * from rollnews');
      open;
      for j:=0 to 14 do
      if (clbNewsType.Checked[j]=true)and(genre=clbNewsType.Items.Strings[j]) then
      begin
        insert;
        fieldbyname('genre').AsString:=genre;
        fieldbyname('link').AsString:=link;
        fieldbyname('head').AsString:=head;
        fieldbyname('datetime').AsDateTime:=strtodatetime(time);
        post;
        continue;
      end;
    end;
  end;
   with frmMain.AdoqSetting do
    begin
      close;
      sql.Clear;
      sql.Add('select * from rollnews where genre is not null order by datetime Desc');
      open;
      if recordcount<3 then exit;
      //newsnum:=10;
      if recordcount<cbbNewsNum.ItemIndex+3 then
       newsnum:=recordcount
      else newsnum:=cbbNewsNum.ItemIndex+3;
      setlength(rollnews,newsnum);
      first;
      k:=0;
      while not eof do
      begin
        rollnews[k].head:='['+fieldbyname('genre').AsString+']'
                              +fieldbyname('head').AsString+'--新浪'
                              +' ('+fieldbyname('datetime').AsString+')';
        rollnews[k].link:= fieldbyname('link').AsString;
        k:=k+1;
        if k>=Newsnum then break;
        next;
      end;
    RollOrder:=0; Roll:=0;
    frmMain.lblRoll1.Caption:=rollnews[RollOrder].head;
    frmMain.lblRoll1.Hint:=rollnews[RollOrder].link;
    frmMain.lblRoll2.Caption:=rollnews[RollOrder+1].head;
    frmMain.lblRoll2.Hint:=rollnews[RollOrder+1].link;
    frmMain.lblRoll3.Caption:=rollnews[RollOrder+2].head;
    frmMain.lblRoll3.Hint:=rollnews[RollOrder+2].link;
    frmMain.lblRoll1.Left:=50;
    frmMain.lblRoll2.Left:=50;
    frmMain.lblRoll3.Left:=50;
    frmMain.pnlRollNews.Caption:='';
    tmRollNews.Enabled:=true;
    end;
end;

procedure TfrmRollingNews.sbOKClick(Sender: TObject);
var Num:integer;
begin
  frmMain.GetList(clbNewsType,Num);
  with frmMain.AdoqSetting do
    begin
      close;
      sql.Clear;
      sql.Add('select * from setting ');
      open;
      edit;
      fieldbyname('NewsType').AsInteger:=Num;
      fieldbyname('Rollpace').AsInteger:=tbRollpace.Position;
      fieldbyname('Newsnum').AsInteger:=cbbNewsNum.ItemIndex+3;
      fieldbyname('NewsRefresh').AsInteger:=cbbNewsRefresh.ItemIndex+2;
      fieldbyname('RollNews').AsBoolean:=true;
      post;
    end;
  frmMain.lblRoll1.Visible:=false;
  frmMain.lblRoll2.Visible:=false;
  frmMain.lblRoll3.Visible:=false;
  frmMain.pnlRollNews.Caption:='请稍候,正在更新新闻...';
  frmMain.Refresh;
  frmRollingNews.Hide;
  tmRollNews.Interval:=tbRollpace.Position*25;
  tmNewsSearchTimer(nil);
  tmNewsSearch.Enabled:=true;
  close;
end;

procedure TfrmRollingNews.sbCancelClick(Sender: TObject);
begin
  tmNewsSearch.Enabled:=timerrun1;
  tmRollNews.Enabled:=timerrun2;
  close;
end;

procedure TfrmRollingNews.FormShow(Sender: TObject);
var Num:integer;
begin
  timerrun1:=tmNewsSearch.Enabled;
  timerrun2:=tmRollNews.Enabled;
  tmNewsSearch.Enabled:=false;
  tmRollNews.Enabled:=false;
  with frmMain.AdoqSetting do
    begin
      Close;
      Sql.Clear;
      Sql.Add('select * from setting');
      open;
      tbRollPace.Position:=fieldbyname('Rollpace').AsInteger;
      cbbNewsNum.ItemIndex:=fieldbyname('Newsnum').AsInteger-3;
      Num:=fieldbyname('NewsType').AsInteger;
      frmMain.RestoreList(clbNewsType,num);
      cbbNewsRefresh.ItemIndex:=fieldbyname('NewsRefresh').AsInteger-2;
    end;
end;

procedure TfrmRollingNews.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin

  //frmMain.tmRollNews.Enabled:=true;
end;

procedure TfrmRollingNews.tmRollNewsTimer(Sender: TObject);
begin
  frmMain.lblRoll1.Visible:=true;
  frmMain.lblRoll2.Visible:=true;
  frmMain.lblRoll3.Visible:=true;
  case (RollOrder mod 3)  of
  0:
  begin
    frmMain.lblRoll1.Left:=frmMain.lblRoll1.Left-5;
    frmMain.lblRoll2.Left:=frmMain.lblRoll1.Left+frmMain.lblRoll1.Width+10;
    frmMain.lblRoll3.Left:=frmMain.lblRoll2.Left+frmMain.lblRoll2.Width+10;
    if frmMain.lblRoll1.Left+frmMain.lblRoll1.Width<0 then
      begin
        frmMain.lblRoll1.Caption:=rollnews[(Roll+3) mod newsnum].head;
        frmMain.lblRoll1.Hint:=rollnews[(Roll+3) mod newsnum].link;
        RollOrder:=1;
        roll:=(roll+1) mod newsnum;
      end;
    //if RollOrder>=newsnum then RollOrder:=0;
  end;
  1:
  begin
    frmMain.lblRoll2.Left:=frmMain.lblRoll2.Left-5;
    frmMain.lblRoll3.Left:=frmMain.lblRoll2.Left+frmMain.lblRoll2.Width+10;
    frmMain.lblRoll1.Left:=frmMain.lblRoll3.Left+frmMain.lblRoll3.Width+10;
    if frmMain.lblRoll2.Left+frmMain.lblRoll2.Width<0 then
      begin
        frmMain.lblRoll2.Caption:=rollnews[(Roll+3) mod newsnum].head;
        frmMain.lblRoll2.Hint:=rollnews[(Roll+3) mod newsnum].link;
        RollOrder:=2;
        roll:=(roll+1) mod newsnum;
      end;
   // if RollOrder>=newsnum then RollOrder:=0;  }
  end;
  2:
  begin
    frmMain.lblRoll3.Left:=frmMain.lblRoll3.Left-5;
    frmMain.lblRoll1.Left:=frmMain.lblRoll3.Left+frmMain.lblRoll3.Width+10;
    frmMain.lblRoll2.Left:=frmMain.lblRoll1.Left+frmMain.lblRoll1.Width+10;
    if frmMain.lblRoll3.Left+frmMain.lblRoll3.Width<0 then
      begin
        frmMain.lblRoll3.Caption:=rollnews[(Roll+3) mod newsnum].head;
        frmMain.lblRoll3.Hint:=rollnews[(Roll+3) mod newsnum].link;
        RollOrder:=0;
        roll:=(roll+1) mod newsnum;
      end;
   // if RollOrder>=newsnum then RollOrder:=0; }
  end;
 end;
end;

procedure TfrmRollingNews.FormCreate(Sender: TObject);
var Num:integer;
begin
  with frmMain.AdoqSetting do
    begin
      Close;
      Sql.Clear;
      Sql.Add('select * from setting');
      open;
      tbRollPace.Position:=fieldbyname('Rollpace').AsInteger;
      tmRollNews.Interval:=tbRollPace.Position*25;
      cbbNewsNum.ItemIndex:=fieldbyname('Newsnum').AsInteger-3;
      Num:=fieldbyname('NewsType').AsInteger;
      frmMain.RestoreList(clbNewsType,num);
      cbbNewsRefresh.ItemIndex:=fieldbyname('NewsRefresh').AsInteger-2;
      frmRollingNews.tmNewsSearch.Enabled:=fieldbyname('RollNews').AsBoolean;
    end;
  if frmRollingNews.tmNewsSearch.Enabled=true then tmNewsSearchTimer(nil);
end;

end.