u_mainfrm.~pas

给一个企业做的产品展示系统,很好的展示了产品的各种功能

unit U_MainFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, StdCtrls, WinSkinData, SkinCaption, SUIButton,
  RzLabel,U_VideoFrm, MPlayer, RzPanel, SUIURLLabel, OleCtrls,
  SHDocVw, ComCtrls, RzTreeVw, RzSplit, ImgList, RzStatus, RxGIF, RzTabs,
  Grids, DBGridEh, DB, ADODB,U_FilterFrm,DBGridEhFindDlgs;

type
  TMainFrm = class(TForm)
    pnlTop: TPanel;
    imgBanner: TImage;
    igLeftTree: TImageList;
    Panel1: TPanel;
    pnlLeft: TPanel;
    Panel3: TPanel;
    pnlClient: TRzPanel;
    Bevel1: TBevel;
    RzPanel1: TRzPanel;
    pnlTree: TPanel;
    tvLeftTree: TRzTreeView;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    pgcRight: TRzPageControl;
    TabSheet1: TRzTabSheet;
    TabSheet2: TRzTabSheet;
    adoProduct: TADOQuery;
    adoProductType: TWideStringField;
    adoProductModel: TWideStringField;
    adoProductSize: TWideStringField;
    adoProductTouchType: TWideStringField;
    adoProductTempBound: TWideStringField;
    adoProductLibrationBound: TWideStringField;
    adoProductLoadCurrentBound: TWideStringField;
    adoProductTouchLoad: TWideStringField;
    adoProductPDFPath: TWideStringField;
    adoProductImgPath: TStringField;
    dsProduct: TDataSource;
    pnlLeftBottom: TPanel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    RzPanel2: TRzPanel;
    pnlImgBg: TPanel;
    imgPhoto: TImage;
    wbPreview: TWebBrowser;
    pgcProduct: TRzPageControl;
    RzTabSheet1: TRzTabSheet;
    Panel6: TPanel;
    WebBrowser1: TWebBrowser;
    Panel4: TPanel;
    dbgProduct: TDBGridEh;
    RzTabSheet2: TRzTabSheet;
    Panel2: TPanel;
    wbPreview2: TWebBrowser;
    adoProductRemark: TStringField;
    mpPlayer: TMediaPlayer;
    TabSheet3: TRzTabSheet;
    pgcDoc: TRzPageControl;
    RzTabSheet4: TRzTabSheet;
    Panel5: TPanel;
    WebBrowser2: TWebBrowser;
    Panel7: TPanel;
    dgbDoc: TDBGridEh;
    RzTabSheet5: TRzTabSheet;
    Panel8: TPanel;
    wbPreview3: TWebBrowser;
    adoDocument: TADOQuery;
    dsDocument: TDataSource;
    adoDocumentDocName: TStringField;
    adoDocumentDocID: TStringField;
    lbClose: TLabel;
    TabSheet4: TRzTabSheet;
    pnlBg: TPanel;
    mpPlayer4: TMediaPlayer;
    pnlVideo: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure tvLeftTreeClick(Sender: TObject);
    procedure Label3Click(Sender: TObject);
    procedure tvLeftTreeChange(Sender: TObject; Node: TTreeNode);
    procedure adoProductAfterScroll(DataSet: TDataSet);
    procedure dbgProductDrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumnEh; State: TGridDrawState);
    procedure dbgProductDblClick(Sender: TObject);
    procedure pgcProductChange(Sender: TObject);
    procedure pgcProductChanging(Sender: TObject; NewIndex: Integer;
      var AllowChange: Boolean);
    procedure dgbDocDblClick(Sender: TObject);
    procedure adoDocumentAfterScroll(DataSet: TDataSet);
    procedure pgcDocChange(Sender: TObject);
    procedure pgcDocChanging(Sender: TObject; NewIndex: Integer;
      var AllowChange: Boolean);
    procedure lbCloseClick(Sender: TObject);
  private
    FAppPath,
    FPDFPath, DocPath: String;
    procedure InstallPDFReader;
    procedure GetAllProducts;
    procedure GetDocList;
    procedure GetProductByType(const ID: Integer);
    procedure ShowPDF(const PDFPath: String);
    procedure PlayVideo;
  public
    procedure FilterProduct(const Number: String);
  end;

var
  MainFrm: TMainFrm;

implementation

uses U_DataModule;

{$R *.dfm}

procedure TMainFrm.FormCreate(Sender: TObject);
var
 HtmlPath: String;
begin
  {try
    VideoFrm := TVideoFrm.Create(Self);
    VideoFrm.ShowModal;
  finally
    FreeAndNil(VideoFrm);
  end; //}
  FAppPath := ExtractFilePath(application.ExeName);
  pgcRight.HideAllTabs;
  pgcRight.ActivePageIndex := 0;
  tvLeftTree.TopItem.Expanded := True;
  tvLeftTree.TopItem.getNextSibling.Expanded := True;
  if FileExists('Banner.jpg') then
    imgBanner.Picture.LoadFromFile('banner.jpg');
  try
   HtmlPath := ExtractFilePath(application.ExeName) + 'html\about.html';
   Screen.Cursor := crHourGlass;
   application.ProcessMessages;
   wbPreview.Stop;
   application.ProcessMessages;
   wbPreview.Navigate(HtmlPath);
   if FileExists(ExtractFilePath(application.ExeName) + 'Video\bgmusic.mp3') then
   begin
     mpPlayer.FileName := ExtractFilePath(application.ExeName) + 'Video\bgmusic.mp3';
     mpPlayer.Open;
    // mpPlayer.Play;
   end;
  finally
   Screen.Cursor := crDefault;
  end;
end;

procedure TMainFrm.InstallPDFReader;
var
  InstallFilePath: String;
begin
 try
   application.ProcessMessages;
   Screen.Cursor := crHourGlass;
   InstallFilePath := ExtractFilePath(application.ExeName) + 'Reader\AdbeRdr70_chs_full.exe';
   if not FileExists(InstallFilePath) then
   begin
     Application.MessageBox('没有找到安装文件！','提示',mb_OK + mb_IconWarning);
     Exit;
   end;
   WinExec(pchar(InstallFilePath),SW_SHOWNOACTIVATE);
 finally
   Screen.Cursor := crDefault;
 end;
end;

procedure TMainFrm.tvLeftTreeClick(Sender: TObject);
begin
  if (Sender as TRzTreeView).Selected.Text = '退出浏览' then
  begin
    if application.MessageBox('您确定要退出吗?','提示信息',mb_YesNo + mb_IconQuestion) = mrYes then
       application.Terminate;
  end;
end;

procedure TMainFrm.Label3Click(Sender: TObject);
begin
  if application.MessageBox('您确定要安装 Adobe Reader 7.0 吗?','确定安装',mb_YesNo + mb_IconQuestion) = mrYes then
     InstallPDFReader;
end;

procedure TMainFrm.tvLeftTreeChange(Sender: TObject; Node: TTreeNode);
var
  HtmlPath,
  pNumber: String;
begin
  if mpPlayer4.FileName <> '' then
     mpPlayer4.Stop;
  case Node.ImageIndex of
  0: begin
       pgcRight.ActivePageIndex := 0;
       if (FilterFrm <> nil) and FilterFrm.Showing then FilterFrm.Close;
       if (DBGridEhFindDlg <> nil) and DBGridEhFindDlg.Showing then DBGridEhFindDlg.Close;
       pnlLeftBottom.Visible := False;
       HtmlPath := ExtractFilePath(application.ExeName) + 'html\about.html';
       Screen.Cursor := crHourGlass;
       application.ProcessMessages;
       wbPreview.Stop;
       application.ProcessMessages;
       wbPreview.Navigate(HtmlPath);
       Screen.Cursor := crDefault;
     end;
  1..5 : begin
           pgcRight.ActivePageIndex := 1;
           if pgcProduct.ActivePageIndex > 0 then
              pgcProduct.ActivePageIndex := 0;
           pnlLeftBottom.Visible := True;
           case Node.ImageIndex of
           1 : GetAllProducts;
           2,3,4,5: GetProductByType(Node.ImageIndex);
           end;
         end;
  6: begin
       if (DBGridEhFindDlg <> nil) and DBGridEhFindDlg.Showing then DBGridEhFindDlg.Close;  
       if pgcRight.ActivePageIndex <> 1 then
          pgcRight.ActivePageIndex := 1;
       if not adoProduct.Active then
          GetAllProducts;
       ShowFilterDlg;
     end;
  8: begin
       if (FilterFrm <> nil) and FilterFrm.Showing then FilterFrm.Close;
       if pgcRight.ActivePageIndex <> 1 then
          pgcRight.ActivePageIndex := 1;
       if not adoProduct.Active then
          GetAllProducts;
       ExecuteDBGridEhFindDialogProc(dbgProduct, '', '', nil, False);
     end;
  9: begin
       if (FilterFrm <> nil) and FilterFrm.Showing then FilterFrm.Close;
       if (DBGridEhFindDlg <> nil) and DBGridEhFindDlg.Showing then DBGridEhFindDlg.Close;
       pgcRight.ActivePageIndex := 0;
       pnlLeftBottom.Visible := False;
       HtmlPath := ExtractFilePath(application.ExeName) + 'html\connect.html';
       Screen.Cursor := crHourGlass;
       application.ProcessMessages;
       wbPreview.Stop;
       application.ProcessMessages;
       wbPreview.Navigate(HtmlPath);
       Screen.Cursor := crDefault;
     end;
   10: begin
        if (FilterFrm <> nil) and FilterFrm.Showing then FilterFrm.Close;
        if (DBGridEhFindDlg <> nil) and DBGridEhFindDlg.Showing then DBGridEhFindDlg.Close;
        if not adoDocument.Active then
           GetDocList;
        pgcRight.ActivePageIndex := 2;
        pgcDoc.ActivePageIndex := 0;
     end;
   12: begin
         if (FilterFrm <> nil) and FilterFrm.Showing then FilterFrm.Close;
         if (DBGridEhFindDlg <> nil) and DBGridEhFindDlg.Showing then DBGridEhFindDlg.Close;
         pgcRight.ActivePageIndex := 3;
         pnlVideo.Left := (pnlBg.Width - pnlVideo.Width) div 2;
         pnlVideo.Top  := (pnlBg.Height - pnlVideo.Height) div 2;
         PlayVideo;
       end;
   11: begin
         if (FilterFrm <> nil) and FilterFrm.Showing then FilterFrm.Close;
         if (DBGridEhFindDlg <> nil) and DBGridEhFindDlg.Showing then DBGridEhFindDlg.Close;
         pgcRight.ActivePageIndex := 0;
         pnlLeftBottom.Visible := False;
         HtmlPath := ExtractFilePath(application.ExeName) + 'html\qyry.html';
         Screen.Cursor := crHourGlass;
         application.ProcessMessages;
         wbPreview.Stop;
         application.ProcessMessages;
         wbPreview.Navigate(HtmlPath);
         Screen.Cursor := crDefault;
       end;
  end;
end;

procedure TMainFrm.GetAllProducts;
var
  strSQL: String;
begin
  strSQL := 'Select * From Product Order by PType,Model';
  adoProduct.Recordset := DataDM.ExecuteWithResult(strSQL);
  adoProduct.First;
end;

procedure TMainFrm.GetProductByType(const ID: Integer);
var
  FType,
  strSQL: String;
begin
  case ID of
  2: FType := 'DC';
  3: FType := 'CB';
  4: FType := 'YS';
  5: FType := 'JC';
  end;
  strSQL := 'Select * From Product Where PType = ''' + FType + ''' Order by PType,Model';
  adoProduct.Recordset := DataDM.ExecuteWithResult(strSQL);
end;

procedure TMainFrm.ShowPDF(const PDFPath: String);
begin
 try
   Screen.Cursor := crHourGlass;
   application.ProcessMessages;
   wbPreview2.Stop;
   application.ProcessMessages;
   wbPreview2.Navigate(PDFPath);
 finally
   Screen.Cursor := crDefault;
 end;
end;

procedure TMainFrm.adoProductAfterScroll(DataSet: TDataSet);
var
  ImgPath: String;
begin
  FPDFPath := FAppPath + 'PDF\' + DataSet.FieldValues['PDFPath'];
  ImgPath := FAppPath + 'Images\' + DataSet.FieldValues['ImgPath'];

  if FileExists(ImgPath) then
  begin
    imgPhoto.Picture.LoadFromFile(ImgPath);
    imgPhoto.Left := (pnlImgBg.Width - imgPhoto.Width) div 2;
    imgPhoto.Top := 4;
  end;
end;

procedure TMainFrm.dbgProductDrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumnEh;
  State: TGridDrawState);
begin
    with dbgProduct do
    begin
      if (TDBGridEh(Sender).DataSource.DataSet.RecNo mod 2) = 0 then
      begin
        Canvas.Brush.Color := $00F2DED5;
        Canvas.Brush.Style := bsSolid;
        Canvas.FillRect(rect);
        DefaultDrawColumnCell(Rect,DataCol,Column,State);
      end;
    end;
end;

procedure TMainFrm.FilterProduct(const Number: String);
var
  strSQL: String;
begin
  strSQL := 'Select * From Product Where Model like ''%' + Number + '%'' Order by PType,Model';
  adoProduct.Recordset := DataDM.ExecuteWithResult(strSQL);
  if pgcProduct.ActivePageIndex > 0 then
    pgcProduct.ActivePageIndex := 0;
end;

procedure TMainFrm.dbgProductDblClick(Sender: TObject);
begin
  if adoProduct.IsEmpty then Exit;
  if not FileExists(FPDFPath) then
  begin
    Application.MessageBox(PChar('产品详细资料文件：' + FPDFPath + '不存在！'),'提示',mb_OK + mb_IconWarning);
    Exit;
  end;
  application.ProcessMessages;
  pgcProduct.ActivePageIndex := 1;
  ShowPDF(FPDFPath); //}
end;

procedure TMainFrm.pgcProductChange(Sender: TObject);
begin
  if pgcProduct.ActivePageIndex = 1 then
  begin
    if (FilterFrm <> nil) and FilterFrm.Showing then
       FilterFrm.Close;
      application.ProcessMessages;
      ShowPDF(FPDFPath);
  end;  //}
end;

procedure TMainFrm.pgcProductChanging(Sender: TObject; NewIndex: Integer;
  var AllowChange: Boolean);
begin
  if NewIndex = 1 then
  begin
    if not FileExists(FPDFPath) then
    begin
      Application.MessageBox(PChar('产品详细资料文件：' + FPDFPath + '不存在！'),'提示',mb_OK + mb_IconWarning);
      AllowChange := False;
      Exit;
    end;
  end;
end;

procedure TMainFrm.dgbDocDblClick(Sender: TObject);
begin
  if adoDocument.IsEmpty then Exit;
  if not FileExists(DocPath) then
  begin
    Application.MessageBox(PChar('文档 ' + DocPath + ' 不存在！'),'提示',mb_OK + mb_IconWarning);
    Exit;
  end;
  application.ProcessMessages;
   try
     Screen.Cursor := crHourGlass;
     application.ProcessMessages;
     pgcDoc.ActivePageIndex := 1;
     wbPreview3.Stop;
     application.ProcessMessages;
     wbPreview3.Navigate(DocPath);
   finally
     Screen.Cursor := crDefault;
   end;
end;

procedure TMainFrm.adoDocumentAfterScroll(DataSet: TDataSet);
begin
  DocPath := FAppPath + 'Html\' + DataSet.FieldValues['DocName'] + '.html';
end;

procedure TMainFrm.GetDocList;
var
  strSQL: String;
begin
  strSQL := 'Select * From Documents Order by DocID';
  adoDocument.Recordset := DataDM.ExecuteWithResult(strSQL);
  adoDocument.First;
end;

procedure TMainFrm.pgcDocChange(Sender: TObject);
begin
  if pgcDoc.ActivePageIndex = 1 then
  begin
    if (FilterFrm <> nil) and FilterFrm.Showing then
       FilterFrm.Close;
      application.ProcessMessages;
    try
      Screen.Cursor := crHourGlass;
      application.ProcessMessages;
      pgcDoc.ActivePageIndex := 1;
      wbPreview3.Stop;
      application.ProcessMessages;
      wbPreview3.Navigate(DocPath);
    finally
      Screen.Cursor := crDefault;
    end;
  end;
end;

procedure TMainFrm.pgcDocChanging(Sender: TObject; NewIndex: Integer;
  var AllowChange: Boolean);
begin
  if NewIndex = 1 then
  begin
    if not FileExists(DocPath) then
    begin
      Application.MessageBox(PChar('文档 ' + DocPath + ' 不存在！'),'提示',mb_OK + mb_IconWarning);
      AllowChange := False;
      Exit;
    end;
  end;
end;

procedure TMainFrm.lbCloseClick(Sender: TObject);
begin
  if lbClose.Caption = '关闭背景音乐' then
  begin
     lbClose.Caption := '打开背景音乐';
     mpPlayer.Pause;
  end else
  if lbClose.Caption = '打开背景音乐' then
  begin
     lbClose.Caption := '关闭背景音乐';
     mpPlayer.Play;
  end;
end;

procedure TMainFrm.PlayVideo;
var
  VideoPath: String;
begin
  mpPlayer.Pause;
  mpPlayer4.FileName := ExtractFilePath(application.ExeName) + 'Video\891.avi';
  mpPlayer4.Open;
  mpPlayer4.Play;
  mpPlayer4.DisplayRect := pnlVideo.ClientRect;
end;

end.