u_browsefrm.~pas

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

unit U_BrowseFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,U_DataModule, RzTabs, RzStatus, RzPanel, ExtCtrls, ComCtrls,
  RzTreeVw, RzGroupBar, Grids, DBGridEh, StdCtrls, RzSplit, DB, ADODB,
  OleCtrls, SHDocVw, Buttons,DBGridEhFindDlgs, RzBHints,
  U_FilterFrm;

type
  TBrowseFrm = class(TForm)
    Panel2: TPanel;
    adoProduct: TADOQuery;
    adoProductType: TWideStringField;
    adoProductModel: TWideStringField;
    adoProductSize: TWideStringField;
    adoProductTouchType: TWideStringField;
    adoProductTempBound: TWideStringField;
    adoProductLibrationBound: TWideStringField;
    adoProductLoadCurrentBound: TWideStringField;
    adoProductTouchLoad: TWideStringField;
    adoProductPDFPath: TWideStringField;
    adoProductImgPath: TStringField;
    dsProduct: TDataSource;
    Panel1: TPanel;
    Panel3: TPanel;
    Panel7: TPanel;
    Panel6: TPanel;
    sizeTop: TRzSizePanel;
    Panel4: TPanel;
    Panel5: TPanel;
    dbgProduct: TDBGridEh;
    RzPanel1: TRzPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Panel8: TPanel;
    Button4: TButton;
    RzPanel2: TRzPanel;
    pnlImgBg: TPanel;
    imgPhoto: TImage;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    pnlHint: TPanel;
    ScrollBox: TScrollBox;
    wbPreview: TWebBrowser;
    BitBtn4: TBitBtn;
    BitBtn3: TBitBtn;
    procedure dbgProductDrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumnEh; State: TGridDrawState);
    procedure dbgProductDblClick(Sender: TObject);
    procedure adoProductAfterScroll(DataSet: TDataSet);
    procedure FormPaint(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
  private
    FAppPath,
    FPDFPath: String;
    procedure GetAllProducts;
    procedure GetProductByType(const PType: String);
    procedure ShowPDF(const PDFPath: String);
  public
    constructor Create(AOwner: TComponent);
    procedure FilterProduct(const Number: String);
  end;

var
  BrowseFrm: TBrowseFrm;

implementation

{$R *.dfm}

{ TBrowseFrm }

constructor TBrowseFrm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAppPath := ExtractFilePath(application.ExeName);
  GetAllProducts;
  wbPreview.Visible := False;
end;

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

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

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

procedure TBrowseFrm.dbgProductDblClick(Sender: TObject);
begin
  if not FileExists(FPDFPath) then
  begin
    Application.MessageBox(PChar('产品详细资料文件：' + FPDFPath + '不存在！'),'提示',mb_OK + mb_IconWarning);
    Exit;
  end;
  if not ScrollBox.Visible then
     ScrollBox.Visible := True;
  ShowPDF(FPDFPath);
end;

procedure TBrowseFrm.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 TBrowseFrm.FormPaint(Sender: TObject);
begin
  pnlImgBg.Color := clWhite;
end;

procedure TBrowseFrm.BitBtn1Click(Sender: TObject);
var
  pNumber: String;
begin
  //ExecuteDBGridEhFindDialogProc(dbgProduct, '', '', nil, False);
 // GetProductNumber(pNumber);
end;

procedure TBrowseFrm.GetProductByType(const PType: String);
var
  strSQL: String;
begin
  strSQL := 'Select * From Product Where PType = ''' + PType + ''' Order by PType,Model';
  adoProduct.Recordset := DataDM.ExecuteWithResult(strSQL);
end;

procedure TBrowseFrm.Button1Click(Sender: TObject);
begin
  GetProductByType((Sender as TButton).Hint);
end;

procedure TBrowseFrm.Button2Click(Sender: TObject);
begin
  GetProductByType((Sender as TButton).Hint);
end;

procedure TBrowseFrm.Button3Click(Sender: TObject);
begin
  GetProductByType((Sender as TButton).Hint);
end;

procedure TBrowseFrm.Button4Click(Sender: TObject);
begin
  GetProductByType((Sender as TButton).Hint);
end;

procedure TBrowseFrm.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);
end;

procedure TBrowseFrm.BitBtn4Click(Sender: TObject);
begin
  ExecuteDBGridEhFindDialogProc(dbgProduct, '', '', nil, False);
end;

procedure TBrowseFrm.BitBtn2Click(Sender: TObject);
begin
  Close;
end;

procedure TBrowseFrm.BitBtn3Click(Sender: TObject);
begin
  if not sizeTop.HotSpotClosed then
     sizeTop.CloseHotSpot
  else sizeTop.RestoreHotSpot;
end;

end.