extractresult.~pas

专家抽取系统1.0 是用Delphi6.0 开发的一款用于招投标,评审过程中从专家库中抽取专家的软件。可以将抽取结果导入到Excel或Word文档中

unit ExtractResult;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, DB, ADODB, Mask, DBCtrls, ExtCtrls,ComObj,
  ImgList, ToolWin, ComCtrls, Buttons, DateUtils, IdTrivialFTPBase;

type
  TfrmExtractResult = class(TForm)
    ADOQryResult: TADOQuery;
    ADOQryResultID: TWideStringField;
    ADOQryResultDSDesigner6: TWideStringField;
    ADOQryResultID2: TWideStringField;
    ADOQryResultDSDesigner: TWideStringField;
    ADOQryResultDSDesigner4: TWideStringField;
    ADOQryResultDSDesigner3: TWideStringField;
    ADOQryResultDSDesigner5: TWideStringField;
    ADOQryResultDSDesigner7: TWideStringField;
    ADOQryResultDSDesigner8: TWideStringField;
    DataSource2: TDataSource;
    DBGridResult: TDBGrid;
    Label1: TLabel;
    Label2: TLabel;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    DateTimePicker1: TDateTimePicker;
    DateTimePicker2: TDateTimePicker;
    btnToWord: TButton;
    btnToExcel: TButton;
    ToolBar1: TToolBar;
    ToolButton3: TToolButton;
    BitBtnSave: TBitBtn;
    BitBtnCancel: TBitBtn;
    ADOQryPro: TADOQuery;
    DataSource1: TDataSource;
    ADOQryProDSDesigner2: TWideStringField;
    ADOQryProDSDesigner3: TWideStringField;
    ADOQryProDSDesigner4: TDateTimeField;
    Label3: TLabel;
    ADOQryProDetail: TADOQuery;
    btnAdd: TButton;
    ADOQryProDSDesigner: TWideStringField;
    DataSource3: TDataSource;
    ADOQryProDetailDSDesigner: TWideStringField;
    ADOQryProDetailID: TWideStringField;
    ADOQryProDetailID2: TWideStringField;
    ADOQryProDetailDSDesigner2: TWideStringField;
    ADOQryProDetailDSDesigner3: TWideStringField;
    ADOQryProDetailDSDesigner4: TWideStringField;
    ADOQryProDetailDSDesigner5: TWideStringField;
    ADOQryProDetailDSDesigner6: TWideStringField;
    ADOQryProDetailDSDesigner7: TWideStringField;
    ADOQryProDetailDSDesigner8: TWideStringField;
    ADOQryResultDSDesigner2: TWideStringField;
    ADOQryProDSDesigner5: TWideStringField;
    ADOQryProDSDesigner6: TDateTimeField;
    EditProID: TEdit;
    EditProName: TEdit;
    ComBoxAddr: TComboBox;
    procedure btnToWordClick(Sender: TObject);
    procedure btnToExcelClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure BitBtnCancelClick(Sender: TObject);
    procedure BitBtnSaveClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmExtractResult: TfrmExtractResult;
  sProID: string;

implementation

uses Main;

{$R *.dfm}

function patchZero(const s :string): string;
begin
  case length(s) of
    1: result:='0' + s;
    2: result:=s;
  end;
end;

procedure GoToWord(db_GRID: TDBGRID; q2: TADOQuery; f1: string); //从DBGRID导数据到Word
var
  i, j: integer;
  WordApp, WordDoc, WordParagraph, WordRange, WordTable: variant;
  SltRec, SltCol: integer;
begin
  if not (q2.Active) then //数据集没有打开就返回
  begin
    ShowMessage('导出的数据集没有打开！');
    Exit;
  end;

  try
    WordApp := CreateOleObject('word.Application');
    WordApp.Visible:=True;
    WordDoc := WordApp.documents.Add;
//    wordapp.application.visible:=true;
    WordParagraph := WordApp.activedocument.paragraphs.Add;
    WordRange := WordParagraph.range;
  except
    ShowMessage('请确认WORD安装正确！');
    WordDoc.close;
    WordApp.Quit;
    WordApp := Unassigned; //释放VARIANT变量
    Exit;
  end;

  try
    SltRec := q2.recordcount;
    SltCol := db_GRID.Columns.Count;
    //在新建文档中增加表格，指定表格的行数与列数
    WordTable := WordApp.activedocument.tables.Add(WordRange, SltRec + 1, SltCol);
    //插入表格的标题行
    i := 1;
    for j := 1 to db_GRID.Columns.Count do
    begin
      if db_GRID.Columns[j-1].Visible then
        WordTable.Cell(i, j).range.InsertAfter(db_GRID.Columns[j-1].Title.Caption);
    end;
    //插入表格的内容行
    i := 2;
    q2.First;
    while not q2.Eof do
    begin
      for j := 1 to db_GRID.Columns.Count do
      begin
        if db_GRID.Columns[j-1].Visible then
          WordTable.Cell(i, j).range.InsertAfter(q2.fieldbyname(db_GRID.Columns[j-1].FieldName).AsString);
      end;
      i := i + 1;
      q2.next;
    end;
    q2.First;
//    WordApp.activedocument.saveas(f1);
//    WordApp.activedocument.close;
  except
    ShowMessage('不能正确操作Word文件。可能是该文件已被其他程序打开,或系统错误。');
    WordDoc.close;
    WordApp.Quit;
    WordApp := Unassigned; //释放VARIANT变量
    Exit;
  end;
end;

procedure GoToExcel(db_GRID: TDBGRID; q2: TADOQuery; f1: string);
var
  EclApp, WorkBook: variant; //声明为OLE Automation 对象
  i,j: integer;
//  xlsFilename, FilePath: string;
  range: variant;
begin
  if not (q2.Active) then //数据集没有打开就返回
  begin
    ShowMessage('导出的数据集没有打开！');
    Exit;
  end;

  try
  //创建OLE对象Excel Application与 WorkBook
    EclApp := CreateOleObject('Excel.Application');
    EclApp.Visible:=True;
    WorkBook := EclApp.workBooks.Add;
//    WorkBook := CreateOleObject('Excel.Sheet');
  except
    ShowMessage('您的机器里未安装Microsoft Excel。');
    WorkBook.close;
    EclApp.Quit;   //退出Excel Application
    EclApp := Unassigned;  //释放VARIANT变量
    Exit;
  end;

  try
     //在Excel表的第一行建立标题
      i := 1;
      for j := 1 to db_GRID.Columns.Count do
      begin
        if db_GRID.Columns[j-1].Visible then
          eclApp.Cells(i, j) := db_GRID.Columns[j-1].Title.Caption;
      end;
    //插入表格的内容行
    i := 2;
    j :=1;
    q2.First;
    while not q2.Eof do
    begin
      for j := 1 to db_GRID.Columns.Count do
      begin
        if db_GRID.Columns[j-1].Visible then
          eclApp.Cells(i, j) := q2.fieldbyname(db_GRID.Columns[j-1].FieldName).AsString;
      end;
      i := i + 1;
      q2.next;
    end;
    q2.First;

      range := eclApp.range[eclApp.Cells[1, 1], eclApp.Cells[i - 1, j -1]]; //选定表格
      range.select;
      range.borders.linestyle := 1; //置边框线可见  1
      range.HorizontalAlignment := 2; // 文本水平居中方式
      range.VerticalAlignment := 2; //文本垂直居中方式
      range.WrapText := true; //文本自动换行
      range.Font.Name := '宋体'; //字体

//      FilePath := ExtractFilePath(Application.ExeName);
//      xlsFilename := f1;
//      WorkBook.saveas(FilePath + xlsFilename);

  except
    ShowMessage('不能正确操作Excel文件。可能是该文件已被其他程序打开,或系统错误。');
    WorkBook.close;
    EclApp.Quit;   //退出Excel Application
    EclApp := Unassigned;  //释放VARIANT变量
    Exit;
  end;
end;

procedure TfrmExtractResult.btnToWordClick(Sender: TObject);
var
  fileName: string;
begin
  fileName := DateToStr(Date) + '电脑抽取南昌市建筑艺术委员会专家名单';
  GoToWord(DBGridResult,ADOQryResult,fileName);
end;

procedure TfrmExtractResult.btnToExcelClick(Sender: TObject);
var
  fileName: string;
begin
  fileName := DateToStr(Date) + '电脑抽取南昌市建筑艺术委员会专家名单';
  GoToExcel(DBGridResult,ADOQryResult,fileName);
end;

procedure TfrmExtractResult.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TfrmExtractResult.FormCreate(Sender: TObject);
begin
  //打开主表数据集，
  with ADOQryPro do begin
    Connection:=frmMain.ADOConnection1;
    Close;
    SQL.Clear;
    SQL.Add('select * from ExtractPro where 项目编号 like :ProID Order by 项目编号 asc');
    Parameters.ParamByName('ProID').Value := sProID;
    Prepared :=true;
    Open;   //select语句需用Open方法执行
  end;
  //打开从表数据集，
  with ADOQryProDetail do begin
    Connection:=frmMain.ADOConnection1;
    Close;
    SQL.Clear;
    SQL.Add('select * from ProDetail where 项目编号 like :ProID Order by 专家ID asc');
    Parameters.ParamByName('ProID').Value := sProID;
    Prepared :=true;
    Open;   //select语句需用Open方法执行
  end;

  //初始化DatTimePicker
//  DateTimePicker1.ShowCheckbox :=true;
//  DateTimePicker1.Checked :=false;
  DateTimePicker1.Date :=Date;
  DateTimePicker2.Time :=Time;
  EditProID.Enabled :=false;

  btnAddClick(btnAdd);
end;

procedure TfrmExtractResult.btnAddClick(Sender: TObject);
var
  sYear :string;
begin
  //产生项目编号
  sYear := IntToStr(YearOf(now));
  EditProID.Text :=copy(sYear,3,length(sYear)) +
    patchZero(IntToStr(MonthOf(now))) + patchZero(IntToStr(DayOf(Now))) +
    patchZero(IntToStr(HourOf(now))) + patchZero(IntToStr(MinuteOf(now))) +
    patchZero(IntToStr(SecondOf(now)));

end;

procedure TfrmExtractResult.BitBtnCancelClick(Sender: TObject);
begin
  close;
end;

procedure TfrmExtractResult.BitBtnSaveClick(Sender: TObject);
begin
  frmMain.ADOConnection1.BeginTrans;
    with ADOQryPro do begin
      Connection:=frmMain.ADOConnection1;
      Close;
      SQL.Clear;
      SQL.Add('Insert into ExtractPro(项目编号,项目名称,确认,评标地点,评标时间,抽签人,抽签时间)');
      SQL.Add('values(:ProId, :ProName, :Confirm, :AccessAddr, :AccessTime, :Operator, :ExtractTime)');
      Parameters.ParamByName('ProId').Value := EditProID.Text;
      Parameters.ParamByName('ProName').Value := EditProName.Text;
      Parameters.ParamByName('Confirm').Value := false;
      Parameters.ParamByName('AccessAddr').Value :=ComBoxAddr.Text; 
      Parameters.ParamByName('AccessTime').Value :=strToDateTime(DateToStr(DateTimePicker1.Date) + ' '+ TimeToStr(DateTimePicker2.Time));
      Parameters.ParamByName('Operator').Value := 'wxh';
      Parameters.ParamByName('ExtractTime').Value := Now;
      Prepared :=true;
      ExecSQL;
    end;
  //浏览抽取结果
  ADOQryResult.First;
  if ADOQryResult.Eof then
  begin
    frmMain.ADOConnection1.RollbackTrans;
    Application.MessageBox('抽取结果没有包含专家，项目不能保存!', '信息', MB_OK + MB_ICONINFORMATION);
  end
  else
  begin
  while not ADOQryResult.Eof do
  begin
    with ADOQryProDetail do begin
      Connection:=frmMain.ADOConnection1;
      Close;
      SQL.Clear;

      SQL.Add('Insert into ProDetail(项目编号,专家ID,组ID,姓名,性别,手机,电话,职务,职称,单位名称,是否补抽)');
      SQL.Add('values(:ProId, :ExpertId, :GroupId, :Name, :Sex, :Mobile, :Phone, :Headship, :Title, :Inc, False)');
      Parameters.ParamByName('ProId').Value := EditProID.Text;
      Parameters.ParamByName('ExpertId').Value := ADOQryResult.FieldValues['专家ID'];
      Parameters.ParamByName('GroupId').Value := ADOQryResult.FieldValues['组ID'];
      Parameters.ParamByName('Name').Value := ADOQryResult.FieldValues['姓名'];
      Parameters.ParamByName('Sex').Value := ADOQryResult.FieldValues['性别'];
      Parameters.ParamByName('Mobile').Value := ADOQryResult.FieldValues['手机'];
      Parameters.ParamByName('Phone').Value := ADOQryResult.FieldValues['电话'];
      Parameters.ParamByName('Headship').Value := ADOQryResult.FieldValues['职务'];
      Parameters.ParamByName('Title').Value := ADOQryResult.FieldValues['职称'];
      Parameters.ParamByName('Inc').Value := ADOQryResult.FieldValues['单位名称'];
      Prepared :=true;
      ExecSQL;
    end;
    ADOQryResult.Next;
  end;
  ADOQryResult.First;   //完成浏览抽取结果
  frmMain.ADOConnection1.CommitTrans;
  BitBtnSave.Enabled :=false;
  Application.MessageBox('项目已成功保存!', '信息', MB_OK + MB_ICONINFORMATION);
  end;
end;

end.