mainfrm.pas

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

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, DB, DBTables, ComCtrls, StdCtrls, CheckLst,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
  ExtCtrls, ShellAPI, Grids, DBGrids, ADODB, Menus;

const
  MY_MESSAGE=WM_USER+100;

type
  TfrmMain = class(TForm)
    sbCustomSearch: TSpeedButton;
    qryDisplay1: TQuery;
    dsDisplay: TDataSource;
    sbSetting: TSpeedButton;
    sbViewInfo: TSpeedButton;
    qryCheck1: TQuery;
    dsCheck: TDataSource;
    dssearch: TDataSource;
    qrySearch1: TQuery;
    qryCustom1: TQuery;
    dsCustom: TDataSource;
    qryInfo1: TQuery;
    dsInfo: TDataSource;
    daSetting: TDataSource;
    qrySetting1: TQuery;
    qrySiteSearch1: TQuery;
    dsSiteSearch: TDataSource;
    dsTemp: TDataSource;
    qryTemp1: TQuery;
    pnlRollNews: TPanel;
    lblRoll1: TLabel;
    lblRoll2: TLabel;
    lblRoll3: TLabel;
    sbRollNews: TSpeedButton;
    tmRollColor: TTimer;
    IdhttpHTTP: TIdHTTP;
    AdoqDisplay: TADOQuery;
    AdoqCheck: TADOQuery;
    AdoqSetting: TADOQuery;
    AdoqSiteSearch: TADOQuery;
    AdoqSearch: TADOQuery;
    AdoqInfo: TADOQuery;
    AdoqCustom: TADOQuery;
    AdoqTemp: TADOQuery;
    AdocnDate: TADOConnection;
    imgUI: TImage;
    pmIconMenu: TPopupMenu;
    pmiRevert: TMenuItem;
    pmiExit: TMenuItem;
    sbMinimize: TSpeedButton;
    sbExit: TSpeedButton;
    tmRollNews: TTimer;
    sbHelp: TSpeedButton;
    procedure HideAppInTaskBar(Sender: TObject);
    procedure RestoreApplication(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CloseAllForm;
    procedure sbCustomSearchClick(Sender: TObject);
    procedure MyExecSQL(Query: TAdoQuery; SQLString: string);
    procedure RestoreList(Sender: TObject; num: integer);
    procedure GetList(Sender: TObject; var num: integer);
    procedure TransferTable(FromTable,ToTable,ID:string);
    procedure sbSettingClick(Sender: TObject);
    procedure sbViewInfoClick(Sender: TObject);
    procedure sbSiteSearchClick(Sender: TObject);
    procedure lblRoll3Click(Sender: TObject);
    procedure tmRollColorTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure sbMinimiseClick(Sender: TObject);
    procedure imgUIMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pmiExitClick(Sender: TObject);
    procedure pmiRevertClick(Sender: TObject);
    procedure sbExitClick(Sender: TObject);
    procedure sbMinimizeClick(Sender: TObject);
    procedure sbRollNewsClick(Sender: TObject);
    procedure lblRoll3MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure lblRoll3MouseLeave(Sender: TObject);
    procedure sbHelpClick(Sender: TObject);
  private
    { Private declarations } 
    procedure OnIconNotify(var Message:Tmessage);
    Message MY_MESSAGE;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  RollOrder: integer;
  TimeLimitMax,TimeLimitMin: Integer;
  WebtypeAmount,EngineAmount: Integer;
  NotifyIconData: TNotifyIconData;

function GetStrBetween(S: string; PrevStr,RearStr: string):string;
function DelSubStr(Substr: string; S: string):string;

implementation

uses SiteSearchFrm, MaintainFrm, CustomSearchFrm, SettingFrm, ViewInfoFrm,
  RollingNewsFrm;

{$R *.dfm}

procedure TfrmMain.HideAppInTaskBar(Sender: TObject);
begin                                      
  frmMain.Hide;
  ShowWindow(Application.Handle,SW_HIDE);
end;

procedure TfrmMain.RestoreApplication(Sender: TObject);
begin
//  frmMain.Show;
end;

//定义图标事件
procedure TfrmMain.OnIconNotify(var Message:TMessage);
var
  MousePoint: TPoint; //鼠标点击位置
begin
  inherited;

  //用鼠标左键点击图标
  if Message.LParam = WM_LBUTTONUP then
  begin

    //窗体显示时则隐藏
    if frmMain.Showing then
    begin
      Application.Minimize;
    end
    //窗体隐藏时则显示
    else
    begin
      pmiRevertClick(nil);
    end;
  end;
  //用鼠标右键点击图标
  if Message.LParam = WM_RBUTTONUP then
  begin
    GetCursorPos(MousePoint); //获取光标位置
    pmIconMenu.Popup(MousePoint.X, MousePoint.Y); //在光标位置弹出菜单
  end;
end;

//十进制数还原成二进制，再根据二进制的1和0对应还原列表中的内容
procedure TfrmMain.RestoreList(sender: TObject; num: integer);
var
  m,i,count:integer;
begin
  count:=(sender as TChecklistbox).Items.Count;
  m:=num;
  for i:=count-1 downto 0 do
  begin
    if (m mod 2)=1 then
      (sender as TChecklistbox).Checked[i]:=true
    else (sender as TChecklistbox).Checked[i]:=false;
    m:=m div 2;
  end;
end;

//把列表中的内容转换成二进制的1和0，再把二进制数变成十进制数
procedure TfrmMain.GetList(Sender: TObject; var num: integer);//Var 是参数地址传递
var
  m,i,count:integer;
begin
  m:=0;
  count:=(sender as TChecklistbox).Items.Count;
  for i:=0 to count-1 do
    if (sender as TChecklistbox).Checked[i]=true then m:=m*2+1
    else m:=m*2;
  num:=m;  
end;

//根据SQLString字符串执行SQL语句
procedure TfrmMain.MyExecSQL(Query: TADOQuery; SQLString: string);
begin
  with Query do
  begin
    SQL.Clear;
    SQL.Add(SQLString);
    Open;
  end;
end;

//获取在S中第一个夹在PrevStr和RearStr中间的子字符串
function GetStrBetween(S: string; PrevStr,RearStr: string):string;
var
  PSLength,Index,Count:Integer;
  tmpString:string;
begin
  //如果在S中找不到PrevStr或者RearStr，返回空字符串
  if (Pos(PrevStr,S)=0) or (Pos(RearStr,S)=0) then
  begin
    Result:='';
    Exit;
  end;

  PSLength:=Length(PrevStr);
  //找到PrevStr后面的字符串的位置
  Index:=Pos(PrevStr,S)+PSLength;
  //截取PrevStr后面的所有字符串
  tmpString:=Copy(S,Index,Length(S));
  //如果在PrevStr后面没有RearStr，返回空字符串
  if Pos(RearStr,tmpString)=0 then
  begin
    Result:='';
    Exit;
  end;
  //得到要返回的字符串的长度
  Count:=Pos(RearStr,tmpString)-1;

  Result:=Copy(S,Index,Count);
end;


//删除S中的所有Substr子字符串
function DelSubStr(Substr: string; S: string):string;
var
  SubstrLength,SLength:Integer;
  PrevStr,RearStr:string;
begin
  SubstrLength:=Length(Substr);
  SLength:=Length(S);
  //删除过程
  while Pos(Substr,S)>0 do
  begin
    //找出Substr前面的所有子字符串
    PrevStr:=Copy(S,1,Pos(Substr,S)-1);
    //找出Substr后面的所有子字符串
    RearStr:=Copy(S,Pos(Substr,S)+SubstrLength,SLength);
    //前后相加，就得出删除掉了夹在中间的Substr后的子字符串
    S:=PrevStr+RearStr;
  end;
  Result:=S;
end;

//把数据从一个数据库中转到另外一个数据库
procedure TfrmMain.TransferTable(FromTable,ToTable,ID:string);
var
  SQLString:string;
  qryFrom,qryTo:TADOQuery;
begin

  //初始化query
 { qryFrom:=TQuery.Create(nil);
  qryFrom.DatabaseName:=extractfilepath(application.ExeName)+'database';
  qryFrom.RequestLive:=True;

  qryTo:=TQuery.Create(nil);
  qryTo.DatabaseName:=extractfilepath(application.ExeName)+'database';
  qryTo.RequestLive:=True;}
  qryFrom:=TADOQuery.Create(nil);
  qryFrom.Connection:=frmMain.AdocnDate;
  qryTo:=TADOQuery.Create(nil);
  qryto.Connection:=frmMain.AdocnDate;

  with qryFrom do
  begin
    //选出源表的所有记录
    MyExecSQL(qryFrom,'select * from '+FromTable+' where ID='+QuotedStr(ID)); //quote是加上双引号
    qryFrom.Active:=true;
    while not Eof do
    begin
      with qryTo do
      begin
        //选出目标表中不同地址的所有记录
        SQLString:='select * from '+ToTable+' where link='+QuotedStr(qryfrom.fieldbyname('link').AsString)
                  +' and ID='+QuotedStr(ID);
        MyExecSQL(qryTo,SQLString);
        Edit;
        //记录传递
        qryTo.FieldByName('ID').AsString:=ID;
        qryTo.FieldByName('Head').AsString:=qryFrom.FieldByName('Head').AsString;
        qryTo.FieldByName('Datetime').AsDateTime:=qryFrom.FieldByName('Datetime').AsDateTime;
        qryTo.FieldByName('Type').AsString:=qryFrom.FieldByName('Type').AsString;
        qryTo.FieldByName('Source').AsString:=qryFrom.FieldByName('Source').AsString;
        qryTo.FieldByName('Link').AsString:=qryFrom.FieldByName('Link').AsString;
        qryTo.FieldByName('Content').AsString:=qryFrom.FieldByName('Content').AsString;
        qryTo.FieldByName('Systime').AsDateTime:=qryFrom.FieldByName('Systime').AsDateTime;
        //插入记录
        qryTo.Insert;
      end;
      Next;
    end;
  end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  //hr :  THandle;
  Sem  : THandle;
begin
   //判断是否已经有一个实例在运行，是则退出
   Sem := CreateSemaphore(nil,0,1,'PROGRAM_NAME');
   if ((Sem <> 0) and (GetLastError = ERROR_ALREADY_EXISTS)) then
   begin 
     CloseHandle( Sem );
     ShowMessage('程序正在运行！');
     Application.Terminate;
     Exit;
   end;

  //最小化窗体时隐藏
  Application.OnMinimize:=frmMain.HideAppInTaskBar;

  AdocnDate.Connected:=false;
  {AdocnDate.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;'
          +'Data Source='+extractfilepath(application.ExeName)+'database\date.mdb;'
          +'Persist Security Info=False';}
  AdocnDate.Connected:=true;
  frmMain.Left:=Trunc((Screen.Width-frmMain.Width)/2);
  frmMain.Top:=1;

  //设定超时限制范围
  TimeLimitMin:=1;
  TimeLimitMax:=10;

  //设定网站类型和引擎数量
  WebtypeAmount:=4;
  EngineAmount:=5;

//  hr:=CreateEllipticRgn(0,0,width,height);//定义椭圆窗口(win API函数)
//  setwindowrgn(handle,hr,true); //设置椭圆窗口
  RollOrder:=1;

  //qryDisplay.DatabaseName:=extractfilepath(application.ExeName)+'database';
  //qryDisplay.Active:=true;
  AdoqDisplay.Connection:=AdocnDate;
  AdoqDisplay.Active:=true;

  //qryCheck.DatabaseName:=extractfilepath(application.ExeName)+'database';
  //qryCheck.Active:=true;
  AdoqCheck.Connection:=AdocnDate;
  AdoqCheck.Active:=true;

  //qrySearch.DatabaseName:=extractfilepath(application.ExeName)+'database';
  //qrySearch.Active:=true;
  AdoqSearch.Connection:=AdocnDate;
  AdoqSearch.Active:=true;

  //qryCustom.DatabaseName:=extractfilepath(application.ExeName)+'database';
  //qryCustom.Active:=true;
  AdoqCustom.Connection:=AdocnDate;
  AdoqCustom.Active:=true;

  //qryInfo.DatabaseName:=extractfilepath(application.ExeName)+'database';
 // qryInfo.Active:=true;
  AdoqInfo.Connection:=AdocnDate;
  AdoqInfo.Active:=true;

 // qrySiteSearch.DatabaseName:=extractfilepath(application.ExeName)+'database';
 // qrySiteSearch.Active:=true;
  AdoqSiteSearch.Connection:=AdocnDate;

  //qrySetting.DatabaseName:=extractfilepath(application.ExeName)+'database';
  //qrySetting.Active:=true;
  AdoqSetting.Connection:=AdocnDate;
  AdoqSetting.Active:=true;

  //qryTemp.DatabaseName:=extractfilepath(application.ExeName)+'database';
 // qryTemp.Active:=true;
  AdoqTemp.Connection:=AdocnDate;
  AdoqTemp.Active:=true;

  //设置系统状态栏
  NotifyIconData.cbSize:=SizeOf(NotifyIconData);
  NotifyIconData.Wnd:=Handle;
  NotifyIconData.hIcon:=Application.Icon.Handle;
  NotifyIconData.uFlags:=NIF_ICON or NIF_TIP or NIF_MESSAGE;;
  NotifyIconData.uID:=1000;
  NotifyIconData.szTip:='频道播放器';
  NotifyIconData.uCallbackMessage:=MY_MESSAGE;
  Shell_NotifyIcon(NIM_ADD,@NotifyIconData);
end;

procedure TfrmMain.CloseAllForm;
begin
  if frmCustomSearch.Showing then
    frmCustomSearch.Close;
  if frmViewInfo.Showing then
    frmViewInfo.Close;
 // if frmSiteSearch.Showing then
   // frmSiteSearch.Close;
end;

procedure TfrmMain.sbCustomSearchClick(Sender: TObject);
begin
  CloseAllForm;
  frmCustomSearch.show;
end;

procedure TfrmMain.sbSettingClick(Sender: TObject);
begin
  frmSetting.show;
end;

procedure TfrmMain.sbViewInfoClick(Sender: TObject);
begin
  CloseAllForm;
  frmViewInfo.show;
end;

procedure TfrmMain.sbSiteSearchClick(Sender: TObject);
begin
  CloseAllForm;
  frmSiteSearch.Show;
end;

procedure TfrmMain.sbRollNewsClick(Sender: TObject);
begin
  frmRollingNews.showmodal;
end;

procedure TfrmMain.lblRoll3Click(Sender: TObject);
var
  Connection:string;
  Handle:HWND;
begin
  Connection:=(sender as tlabel).Hint;
  ShellExecute(Handle,nil,pchar(Connection),nil,nil,SW_SHOWNORMAL);
end;

procedure TfrmMain.tmRollColorTimer(Sender: TObject);
begin
  tmRollColor.Tag:=tmRollColor.Tag+1;
  case (tmRollColor.Tag mod 3) of
   0:  pnlRollNews.Font.Color:=clBlue;
   1:  pnlRollNews.Font.Color:=clRed;
   2:  pnlRollNews.Font.Color:=clSilver;
  end;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if not(CustomSearchFrm.Finished) then
    frmCustomSearch.sbStop.Click;
//  with qrySearch do
  with frmMain.AdoqSearch do
  begin
    SQL.Clear;
    SQL.Add('delete from temp');
    ExecSQL;
  end;

  //取消系统状态栏图标
  Shell_NotifyIcon(NIM_DELETE,@NotifyIconData);
end;

procedure TfrmMain.sbMinimiseClick(Sender: TObject);
begin
  frmMain.WindowState:=wsMinimized;
end;

procedure TfrmMain.imgUIMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  Perform(WM_SYSCOMMAND, $F012, 0);
end;

procedure TfrmMain.pmiExitClick(Sender: TObject);
begin
  frmMain.Close;
end;

procedure TfrmMain.pmiRevertClick(Sender: TObject);
begin
  frmMain.Show;       
  Application.Restore;
  Application.BringToFront;
end;

procedure TfrmMain.sbExitClick(Sender: TObject);
begin
  frmMain.Close;
end;

procedure TfrmMain.sbMinimizeClick(Sender: TObject);
begin
  Application.Minimize;
end;

procedure TfrmMain.lblRoll3MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  frmRollingNews.tmRollNews.Enabled:=false;
end;

procedure TfrmMain.lblRoll3MouseLeave(Sender: TObject);
begin
  frmRollingNews.tmRollNews.Enabled:=true;
end;

procedure TfrmMain.sbHelpClick(Sender: TObject);
begin
  ShellExecute(HANDLE,'open','Help\帮助.chm','-s','',SW_ShowNormal);
end;

end.