unit6.pas

一个很小的个人通讯录管理程序,ACCESS数据,要装XP控件,内符

unit Unit6;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, CheckLst, Buttons, ExtCtrls, DB, Grids, DBGrids,
  ADODB,Excel2000;

type
  TfSearch = class(TForm)
    pnlsearch: TPanel;
    btnSearch: TBitBtn;
    btnExit: TBitBtn;
    grpbxQry: TGroupBox;
    ClQrySlt: TCheckListBox;
    grpbxZh: TGroupBox;
    rbtnAnd: TRadioButton;
    rbtnOr: TRadioButton;
    btnPrt: TBitBtn;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit8: TEdit;
    Edit9: TEdit;
    Panel1: TPanel;
    Splitter1: TSplitter;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    btnExport: TBitBtn;
    procedure btnSearchClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure DBGrid1DblClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnPrtClick(Sender: TObject);
    procedure btnExportClick(Sender: TObject);
  private
    //定义一个私有过程，用来实现将数据库表的数据导出到指定的Excel文件中
    procedure WriteExcel(Adq: TADOQuery; sName, Title: string);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fSearch: TfSearch;

implementation

uses Unit2, Unit4, Unit7;

{$R *.dfm}

//查询
procedure TfSearch.btnSearchClick(Sender: TObject);
var
  sqlstr,borh : string;
begin
  //判断ADO数据控件qSearch的状态
  if datasource1.DataSet.State<>dsBrowse then
  begin
    MessageDlg('正在操作数据，不能查询！', mtInformation,[mbOk], 0);
    exit;
  end;
  //设置连接字符
  if rbtnAnd.Checked then
  begin
    //若为AND,则默认全选
    sqlstr := 'a.GroupID > 0 ';
    borh := 'And'
  end
  else
  begin
    //若为OR，则默认无记录
    borh := 'or';
    sqlstr := 'a.GroupID <= 0 ';
  end;
  //根据选择条件，设置查询语句
  if ClQrySlt.Checked[0] then
    sqlstr := sqlstr + borh + ' b.GroupName Like ''%' + edit1.Text + '%'' ';
  if ClQrySlt.Checked[1] then
    sqlstr := sqlstr + borh + ' a.Name_Cn Like ''%' + edit2.Text + '%'' ';
  if ClQrySlt.Checked[2] then
    sqlstr := sqlstr + borh + ' a.Corp Like ''%' + edit3.Text + '%'' ';
  if ClQrySlt.Checked[3] then
    sqlstr := sqlstr + borh + ' a.OfficePhone Like ''%' + edit4.Text + '%'' ';
  if ClQrySlt.Checked[4] then
    sqlstr := sqlstr + borh + ' a.HomePhone Like ''%' + edit5.Text + '%'' ';
  if ClQrySlt.Checked[5] then
    sqlstr := sqlstr + borh + ' a.MobilePhone Like ''%' + edit6.Text + '%'' ';
  if ClQrySlt.Checked[6] then
    sqlstr := sqlstr + borh + ' a.Email Like ''%' + edit7.Text + '%'' ';
  if ClQrySlt.Checked[7] then
    sqlstr := sqlstr + borh + ' a.OICQ Like ''%' + edit8.Text + '%'' ';
  if ClQrySlt.Checked[8] then
    sqlstr := sqlstr + borh + ' a.MSN Like ''%' + edit9.Text + '%'' ';
  try
    with DM.qSearch do
    begin
      if active then
        close;
      sql.Clear;
      //执行查询语句
      sql.Add('select a.*,b.GroupName from LinkMan a,Grouptbl b ');
      sql.Add(' where a.groupid=b.groupid and ' + sqlstr);
      open;
      if Recordcount<= 0 then
      begin
        ShowMessage('记录数为空，请重新查询！');
        if active then
          close;
        sql.Clear;
        //如果查询结果为空，则显示所有名片信息
        sql.Add('select a.*,b.GroupName from LinkMan a,Grouptbl b where a.groupid=b.groupid');
        open;
      end;
    end;
  except
    ShowMessage('查询数据库出错，请检查服务器！');
  end;
end;

procedure TfSearch.FormCreate(Sender: TObject);
begin
  try
    with DM.qSearch do
    begin
      if active then
        close;
      sql.Clear;
      sql.Add('select a.*,b.GroupName from LinkMan a,Grouptbl b ');
      sql.Add(' where a.groupid=b.groupid ');
      open;
    end;
  except
    ShowMessage('查询数据库出错，请检查服务器！');
  end;
end;

procedure TfSearch.DBGrid1DblClick(Sender: TObject);
begin
  with DM.qLinkMan do
  begin
    close;
    sql.clear;
    sql.Add('select * from LinkMan where Name_Cn='''+dbgrid1.Fields[1].AsString+'''');
    open;
  end;
  if not assigned(fUserMnt) then
    fUserMnt:=tfUserMnt.Create(application);
  with fUserMnt do
  begin
    Caption:='浏览名片信息';
    DBComboBox1.ItemIndex:=DBComboBox1.Items.IndexOf(DM.qLinkMan.fieldbyname('GroupId').AsString);
    ComboBox1.ItemIndex:=DBComboBox1.ItemIndex;
    btnSav.Visible:=false;
    btnCan.Visible:=false;
    btnOK.Visible:=true;
    DBEdit1.Enabled:=false;
    DBEdit2.Enabled:=false;
    DBEdit3.Enabled:=false;
    DBEdit4.Enabled:=false;
    DBEdit5.Enabled:=false;
    DBEdit6.Enabled:=false;
    DBEdit7.Enabled:=false;
    DBEdit8.Enabled:=false;
    DBEdit9.Enabled:=false;
    DBEdit10.Enabled:=false;
    DBEdit11.Enabled:=false;
    DBEdit12.Enabled:=false;
    DBEdit13.Enabled:=false;
    DBEdit14.Enabled:=false;
    DBEdit15.Enabled:=false;
    DBEdit16.Enabled:=false;
    DBEdit17.Enabled:=false;
    DBEdit18.Enabled:=false;
    DBEdit19.Enabled:=false;
    DBMemo1.Enabled:=false;
    ComboBox1.Enabled:=false;
    DBComboBox2.Enabled:=false;
    DBComboBox3.Enabled:=false;
    ShowModal;
  end;
end;

procedure TfSearch.btnExitClick(Sender: TObject);
begin
  Close;
end;

procedure TfSearch.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  fSearch:=nil;
  action:=cafree;
end;

procedure TfSearch.btnPrtClick(Sender: TObject);
begin
  //调用QuickReport1模块
  if Not Assigned(QuickReport1) then
    QuickReport1:= TQuickReport1.Create(Application);
  //预览
  QuickReport1.preview;
end;

procedure TfSearch.btnExportClick(Sender: TObject);
begin
  if (MessageDlg('将查询结果导出到Excel中，是否继续？',MTWarning,[mbYes,MBNo],0)=MrYes) then
  begin
    btnExport.Enabled:=False;
    //调用WriteExcel，实现将查询后的数据导出到"个人通讯录"Excel文件中
    WriteExcel(DM.qSearch,'个人通讯录','个人通讯录');
    btnExport.Enabled:=True;
  end;
end;

procedure TfSearch.WriteExcel(Adq: TADOQuery; sName, Title: string);
var
  //声明一个Excel程序对象
  ExcelApplication1: TExcelApplication;
  //声明一个Excel工作簿对象
  ExcelWorkbook1: TExcelWorkbook;
  //声明一个Excel工作表对象
  ExcelWorksheet1: TExcelWorksheet;
  //定义导出的Excel文件的文件名
  filename: string;
  i, j: integer; 
begin
  //将导出的Excel文件名赋给filename变量
  filename := concat(extractfilepath(application.exename), sName, '.xls');
  try
    //创建一个Excel程序对象
    ExcelApplication1 := TExcelApplication.Create(Application);
    //创建一个Excel工作簿对象
    ExcelWorkbook1 := TExcelWorkbook.Create(Application);
    //创建一个Excel工作表对象
    ExcelWorksheet1 := TExcelWorksheet.Create(Application);
    //连接Excel程序对象
    ExcelApplication1.Connect;
  except
    Application.Messagebox('Excel没有安装','Hello',MB_ICONERROR + mb_Ok);
    Exit;
  end;
  try
    //在该Excel程序中增加一个空的工作簿
    ExcelApplication1.Workbooks.Add(EmptyParam, 0);
    //将ExcelWorkbook1对象与该空的工作簿连接
    ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
    //将ExcelWorksheet1对象与该空的工作簿的第一个工作表连接
    ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _worksheet);
    //取第一条数据集的记录
    Adq.First;
    //添加记录的各个字段名
    for j := 0 to Adq.Fields.Count - 1 do
    begin
      ExcelWorksheet1.Cells.item[3, j + 1] := Adq.Fields[j].DisplayLabel;
      ExcelWorksheet1.Cells.item[3, j + 1].font.size := '10';
    end;
    //循环不断往工作表中添加数据集的记录值
    for i := 4 to Adq.RecordCount + 3 do
    begin
      for j := 0 to Adq.Fields.Count - 1 do
      begin
        ExcelWorksheet1.Cells.item[i, j + 1] :=Adq.Fields[j].Asstring;
        ExcelWorksheet1.Cells.item[i, j + 1].font.size :='10';
      end;
      Adq.Next;
    end;
    //调整单元格的高度和宽度
    ExcelWorksheet1.Columns.AutoFit;
    //在工作表的第一行添加标题
    ExcelWorksheet1.Cells.item[1, 2] := Title;
    ExcelWorksheet1.Cells.Item[1, 2].font.size :='14';
    //保存该Excel文件
    ExcelWorksheet1.SaveAs(filename);
    //显示导出成功
    Application.Messagebox(pchar('数据成功导出'+filename),'Hello',mb_Ok);
  finally
    //断开Excel程序对象
    ExcelApplication1.Disconnect;
    //退出Excel程序对象
    ExcelApplication1.Quit;
    //释放Excel程序对象
    ExcelApplication1.Free;
    //释放Excel工作簿对象
    ExcelWorksheet1.Free;
    //释放Excel工作表对象
    ExcelWorkbook1.Free;
  end;
end;

end.