displayfrm.pas

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

unit DisplayFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, Menus, Shellapi, DisplayFra,
  OleCtrls, SHDocVw;

type
  TfrmDisplay = class(TForm)
    pnlDisplay: TPanel;
    pnlButton: TPanel;
    sbLastPage: TSpeedButton;
    sbFirstPage: TSpeedButton;
    sbPageUp: TSpeedButton;
    sbPageDown: TSpeedButton;
    pmHeadMenu: TPopupMenu;
    pmiDefaultBrowse: TMenuItem;
    pmiIEBrowse: TMenuItem;
    pmiSaveAs: TMenuItem;
    fraDisplay: TfraDisplay;
    Label1: TLabel;
    edtPage: TEdit;
    Label2: TLabel;
    lblPageAmount: TLabel;
    wbOpenPage: TWebBrowser;
    procedure Display;
    procedure Clear;
    procedure Rewind;
    procedure FormCreate(Sender: TObject);
    procedure ShowPage;
    procedure sbPageUpClick(Sender: TObject);
    procedure sbPageDownClick(Sender: TObject);
    procedure sbFirstPageClick(Sender: TObject);
    procedure sbLastPageClick(Sender: TObject);
    procedure pmiDefaultBrowseClick(Sender: TObject);
    procedure pmiIEBrowseClick(Sender: TObject);
    procedure pnlListMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure pmiSaveAsClick(Sender: TObject);
    procedure edtPageKeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TItem = class(TLabel)
  private
    ItemIndex: Integer;
    procedure Click(Sender: TObject);
    procedure MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
    procedure MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  end;

var
  frmDisplay: TfrmDisplay;
  lblItem: array of array of TItem;
  Page: Integer;

implementation

uses MainFrm, BrowserFrm;

var
  PageAmount: Integer;
  Index: Integer;

{$R *.dfm}

//显示项目
procedure TfrmDisplay.Display;
var
  i,j:Integer;
begin
  Clear;

//  with frmMain.qryDisplay do
  with frmMain.AdoqDisplay do
  begin
    //无记录可显示
    if RecordCount=0 then
      Exit;

    //设置页数
    PageAmount:=RecordCount div 20;
    if (RecordCount mod 20)<>0 then
      PageAmount:=PageAmount+1;
      
  end;

  //页数显示
  label1.Visible:=True;
  label2.Visible:=True;
  edtPage.Visible:=True;
  lblPageAmount.Visible:=True;

  ShowPage;
end;

//清空项目，按钮不可用,页数不显示
procedure TfrmDisplay.Clear;
var
  i,j:Integer;
begin
  for i:=0 to 19 do
    for j:=0 to 4 do
      lblItem[i][j].Caption:='';

  sbLastPage.Enabled:=False;
  sbFirstPage.Enabled:=False;
  sbPageUp.Enabled:=False;
  sbPageDown.Enabled:=False;
                
  //页数不显示
  label1.Visible:=False;
  label2.Visible:=False;
  edtPage.Visible:=False;
  lblPageAmount.Visible:=False;
end;

//重新设置为第一页
procedure TfrmDisplay.Rewind;
begin
  Page:=1;
end;

//设定标题链接
procedure TItem.Click(Sender: TObject);
var
  URl:string;
begin
  //定位链接
//  with frmMain.qryDisplay do
  with frmMain.AdoqDisplay do
  begin
    RecNo:=Index;
    URL:=Fieldbyname('Link').AsString;
  end;
  //浏览
  with frmBrowser do
  begin
    Show;
    wbBrowser.Navigate(URL);
    BringToFront;
  end;
  //设定ID和URL
//  BrowserFrm.ID:=frmMain.qryDisplay.Fieldbyname('ID').AsString;
  BrowserFrm.ID:=frmMain.AdoqDisplay.Fieldbyname('ID').AsString;
  BrowserFrm.URL:=URL;
end;

//设定鼠标放上事件
procedure TItem.MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  Index:=ItemIndex;
  Cursor:=crHandPoint;
  Font.Color:=clRed;
end;

//设定鼠标按下事件
procedure TItem.MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button=mbRight then
    Index:=ItemIndex;
end;

procedure TfrmDisplay.FormCreate(Sender: TObject);
var
  i,j:Integer;
begin

  //初始化显示的项目
  SetLength(lblItem,20,5);
  Page:=1;
  PageAmount:=1;
  for i:=0 to 19 do
  begin
    for j:=0 to 4 do
    begin
      lblItem[i][j]:=TItem.Create(nil);
      lblItem[i][j].Parent:=fraDisplay;
//      lblItem[i][j].Transparent:=True;
      lblItem[i][j].Top:=i*24+30;
    end;

      //序号左边位置
      lblItem[i][0].Left:=10;
      //标题左边位置
      lblItem[i][1].Left:=50;
      //标题字体属性
      lblItem[i][1].Font.Name:='宋体';
      lblItem[i][1].Font.Size:=9;
      lblItem[i][1].Font.Color:=clBlue;
      lblItem[i][1].Font.Style:=lblItem[i][1].Font.Style+[fsUnderline];
      //时间左边位置
      lblItem[i][2].Left:=430;
      //类型左边位置
      lblItem[i][3].Left:=530;
      //类型字体属性
      lblItem[i][3].Font.Name:='宋体';
      lblItem[i][3].Font.Size:=9;
      //来源左边位置
      lblItem[i][4].Left:=580;
      //来源字体属性
      lblItem[i][4].Font.Name:='宋体';
      lblItem[i][4].Font.Size:=9;
  end;
end;

//显示页 
procedure TfrmDisplay.ShowPage;
var
  i:Integer;
begin
//  with frmMain.qryDisplay do
  with frmMain.AdoqDisplay do
  begin
    RecNo:=(Page-1)*20+1;
    for i:=0 to 19 do
    begin
     // Next;
      //有记录则显示
      if not(Eof) then
      begin
        lblItem[i][0].Caption:=inttostr(RecNo);
        lblItem[i][1].Caption:=Fieldbyname('Head').AsString;
        //设定标题长度不超过60个字符
        if Length(lblItem[i][1].Text)>60 then
          lblItem[i][1].Text:=Copy(lblItem[i][1].Text,1,60);
        //标题鼠标放上属性
        lblItem[i][1].OnMouseMove:=lblItem[i][1].MouseMove;
        //标题鼠标按下属性
        lblItem[i][1].OnMouseDown:=lblItem[i][1].MouseDown;
        //标题点击属性
        lblItem[i][1].OnClick:=lblItem[i][1].Click;
        //标题提示
        lblItem[i][1].Hint:=Fieldbyname('Content').AsString;
        lblItem[i][1].ShowHint:=True;
        //标题右键菜单
        lblItem[i][1].PopupMenu:=pmHeadMenu;
        //序号
        lblItem[i][1].ItemIndex:=RecNo;

        lblItem[i][2].Caption:=Fieldbyname('Datetime').AsString;
        lblItem[i][3].Caption:=Fieldbyname('Type').AsString;
        lblItem[i][4].Caption:=Fieldbyname('Source').AsString;
      end
      //无记录则清空
      else
      begin
        lblItem[i][0].Caption:='';
        lblItem[i][1].Caption:='';
        //标题鼠标放上属性
        lblItem[i][1].OnMouseMove:=nil;
        lblItem[i][1].OnClick:=nil;
        //标题宽度
        lblItem[i][1].Width:=0;
        lblItem[i][1].Hint:='';
        lblItem[i][1].ShowHint:=False;
        //标题右键菜单
        lblItem[i][1].PopupMenu:=nil;
        lblItem[i][2].Caption:='';
        lblItem[i][3].Caption:='';
        lblItem[i][4].Caption:='';
      end;
      Next;
    end;

    //是否有上一页
    if Page>1 then
    begin
      sbPageUp.Enabled:=True;
      sbFirstPage.Enabled:=True;
    end
    else
    begin
      sbPageUp.Enabled:=False;
      sbFirstPage.Enabled:=False;
    end;

    //是否有下一页
    if Page<PageAmount then
    begin
      sbPageDown.Enabled:=True;
      sbLastPage.Enabled:=True;
    end
    else
    begin
      sbPageDown.Enabled:=False;
      sbLastPage.Enabled:=False;
    end;

  end;

  edtPage.Text:=IntToStr(Page);
  lblPageAmount.Caption:='共'+IntToStr(PageAmount)+'页';

end;
 
//上一页
procedure TfrmDisplay.sbPageUpClick(Sender: TObject);
begin        
//  frmMain.qryDisplay.First;
  frmMain.AdoqDisplay.First;
  Page:=Page-1;
  ShowPage;
end;

//下一页
procedure TfrmDisplay.sbPageDownClick(Sender: TObject);
begin
 // frmMain.qryDisplay.First;
  frmMain.AdoqDisplay.First;
  Page:=Page+1;
  ShowPage;
end;
    
//第一页
procedure TfrmDisplay.sbFirstPageClick(Sender: TObject);
begin
//  frmMain.qryDisplay.First;
  frmMain.AdoqDisplay.First;
  Page:=1;
  ShowPage;
end;

//最后一页
procedure TfrmDisplay.sbLastPageClick(Sender: TObject);
begin
//  with frmMain.qryDisplay do
  with frmMain.AdoqDisplay do
  begin
    First;
    Page:=RecordCount div 20;
    if (RecordCount mod 20)<>0 then
    Page:=Page+1;
  end;
  ShowPage;
end;

//右键默认浏览
procedure TfrmDisplay.pmiDefaultBrowseClick(Sender: TObject);
begin
  lblItem[Index-1][1].Click(nil);
end;

//右键IE浏览
procedure TfrmDisplay.pmiIEBrowseClick(Sender: TObject);
var
  Connect:string;
  Handle:HWND;
  Flags:OleVariant;
begin
//  with frmMain.qryDisplay do
  with frmMain.AdoqDisplay do
  begin
    RecNo:=Index;
    Connect:=Fieldbyname('Link').AsString;
  end;
  Flags:=navOpenInNewWindow+navNoHistory+navNoWriteToCache;
  wbOpenPage.Navigate(Connect,Flags);
end;

//在面板上移动鼠标时还原标题颜色
procedure TfrmDisplay.pnlListMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  i:Integer;
begin
  for i:=0 to 19 do
    lblItem[i][1].Font.Color:=clBlue;
end;

//右键另存为
procedure TfrmDisplay.pmiSaveAsClick(Sender: TObject);
begin
//  with frmMain.qryDisplay do
  with frmMain.AdoqDisplay do
  begin
    RecNo:=Index;
   frmBrowser.edtURL.Text:=Fieldbyname('Link').AsString;
    frmBrowser.sbSaveAsFileClick(nil);
  end;
end;

procedure TfrmDisplay.edtPageKeyPress(Sender: TObject; var Key: Char);
var
  num:Integer;
begin
  //用户输入回车则翻页
  if Key=#13 then
  begin
    try
      num:=StrToInt(edtPage.Text);
      if (num>0) and (num<=PageAmount) then
      begin
        Page:=StrToInt(edtPage.Text);
        ShowPage;
      end
      else
        edtPage.Text:=IntToStr(Page);
    except
      edtPage.Text:=IntToStr(Page);
    end;
  end;
end;

end.