extract1.pas

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

unit Extract1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, DB, ADODB, Mask, DBCtrls, ExtCtrls,ComObj;

type
  TfrmExtract1 = class(TForm)
    DBGrid1: TDBGrid;
    Button1: TButton;
    Button2: TButton;
    DataSource1: TDataSource;
    ADOTable1: TADOTable;
    ADOQuery1: TADOQuery;
    DataSource2: TDataSource;
    ADOTable1GroupID: TWideStringField;
    ADOTable1GroupName: TWideStringField;
    ADOTable1Count: TIntegerField;    
    ADOTable1ExtractCount: TIntegerField;
    Label1: TLabel;
    ADOQuery1ID: TWideStringField;
    ADOQuery1ID2: TWideStringField;
    ADOQuery1DSDesigner: TWideStringField;
    ADOQuery1DSDesigner4: TWideStringField;
    ADOQuery1DSDesigner7: TWideStringField;
    ADOQuery1DSDesigner8: TWideStringField;
    Button3: TButton;
    ADOQuery2: TADOQuery;
    DataSource3: TDataSource;
    DBGrid3: TDBGrid;
    ADOQuery2ID: TWideStringField;
    ADOQuery2DSDesigner: TBooleanField;
    ADOQuery2ID2: TWideStringField;
    ADOQuery2DSDesigner2: TWideStringField;
    ADOQuery2DSDesigner3: TWideStringField;
    ADOQuery2DSDesigner5: TWideStringField;
    ADOQuery2DSDesigner8: TWideStringField;
    ADOQuery2DSDesigner9: TWideStringField;
    ADOQuery1DSDesigner3: TWideStringField;
    ADOQuery1DSDesigner5: TWideStringField;
    ADOQuery2DSDesigner4: TWideStringField;
    ADOQuery2DSDesigner6: TWideStringField;
    ADOQuery2DSDesigner7: TWideStringField;
    ADOQuery1DSDesigner6: TWideStringField;
    btnCancel: TButton;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button4Click(Sender: TObject);
    procedure DBGrid3DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure DBGrid3ColEnter(Sender: TObject);
    procedure DBGrid3ColExit(Sender: TObject);
    procedure DBGrid3CellClick(Column: TColumn);
    procedure DBGrid3KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ADOTable1ExtractCountChange(Sender: TField);
    procedure DBGrid1ColEnter(Sender: TObject);
    procedure DBGrid1ColExit(Sender: TObject);
    procedure DBGrid1Exit(Sender: TObject);
    procedure btnExportClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnExtractClick(Sender: TObject);

  private
    { Private declarations }
    //OriginalOptions: TDBGridOptions;
    Procedure SaveBoolean;  //创建私有过程, 用于鼠标点击或敲打空格键时改变布尔值
  public
    { Public declarations }
  end;

var
  frmExtract1: TfrmExtract1;
  GsSearch : string;
implementation

uses Main,Extract1Rep, ExtractResult;
 
{$R *.dfm}

// 抽取函数，返回一个含抽取结果的数组
function ExtractFunc(const m_count, e_count:integer; var TArray :array of integer): string;
var
  x,i :integer;
  st :string;
begin
  if e_count <=0 then exit;
  //如果e_count > m_count将出现死循环，于是判断并跳出循环
  if e_count > m_count then
  begin
    Application.MessageBox('抽取数目不能大于抽取总数. ', '提示信息', MB_OK);
    exit;
  end;
  i:=1;
  st:='';
  while i<=e_count do
  begin
    Randomize;
    x :=Random(m_count)+1;   //产生1~m_count的随机数
    //如果抽取到的随机数x是以前没有抽取到的,则把它保存到st中，用逗号分割
    if ansipos( Quotedstr(inttostr(x)) + ',', st) <= 0 then
    begin
      st :=st + Quotedstr(inttostr(x)) + ',' ;
      TArray[i-1] :=x;
      i :=i+1;
    end;
  end;
  result :=st;

end;

procedure TfrmExtract1.FormCreate(Sender: TObject);
{程序说明：打开ADOTable1,打开ADOQuery2 }
var
//  ConnStr,DBPath:String;        //保存连接字符串和数据库路径
  SGroupId: String;
begin
  ADOTable1.Close;
  ADOTable1.Connection:=frmMain.ADOConnection1;
  ADOTable1.TableName:='ExpertGroup';  //数据表名称！
  ADOTable1.Open;       //打开数据库表

  //浏览ExpertGroup表
  ADOTable1.First;
  while not ADOTable1.Eof do
  begin
    SGroupId :=ADOTable1.FieldValues['组ID'];
    //计算每组的总人数
    with ADOQuery2 do begin
      Connection :=frmMain.ADOConnection1;
      Close;
      SQL.Clear;
      SQL.Add('select * from Expert where 组ID= :GroupID and 状态= :Status order by 组ID asc,专家ID asc');
      Parameters.ParamByName('GroupID').Value := SGroupId;
      Parameters.ParamByName('Status').Value := '正常';
      Prepared :=true;
      Open;   //select语句需用Open方法执行
    end;
    //修改ExpertGroup 的总人数，抽选人数
    ADOTable1.Edit;
    ADOTable1.FieldValues['总人数'] :=ADOQuery2.RecordCount;
    ADOTable1.FieldValues['抽选人数'] :=0;
    ADOTable1.Post;
    ADOTable1.Next;
  end;
  ADOTable1.First;

  with ADOQuery2 do begin
      Connection :=frmMain.ADOConnection1;
      Close;
      SQL.Clear;
      SQL.Add('select * from Expert where 状态= :Status order by 组ID asc,专家ID asc');
      Parameters.ParamByName('Status').Value := '正常';
      Prepared :=true;
      Open;   //select语句需用Open方法执行
  end;
  //选择全部专家
  ADOQuery2.First;
  while not ADOQuery2.Eof do
  begin
    ADOQuery2.Edit;
    ADOQuery2.FieldValues['选中'] :=true;
    ADOQuery2.Post;
    ADOQuery2.Next;
  end;
  ADOQuery2.First;
  btnCancel.Caption :='取消全部选中';

  Button4Click(Parent);
  button3.Enabled :=false;


end;


procedure TfrmExtract1.Button1Click(Sender: TObject);
var
  sGroupId, sSearch, sReturn :string;
  iOptioncount,IExtracount :integer;
  tempArray1: array of integer;
  i :integer;
begin

  sReturn :='';
  sSearch :='';
  GsSearch :='';

  //浏览ExpertGroup表
  ADOTable1.First;
  while not ADOTable1.Eof do
  begin
    SGroupId :=ADOTable1.FieldValues['组ID'];
    IOptioncount :=ADOTable1.FieldValues['总人数'];
    IExtracount :=ADOTable1.FieldValues['抽选人数'];
    if IExtracount <=0 then
    begin
      ADOTable1.Next;
      continue; // 抽选人数为0，则跳出本次循环
    end;

    if IExtracount > IOptioncount then
    begin
      Application.MessageBox('抽选人数不能大于总人数, 请重新输入. ', '提示信息', MB_OK);
      exit;
    end;
    //计算出每组选中的专家总人数
    with ADOQuery1 do begin
      Close;
      Connection :=frmMain.ADOConnection1;
      SQL.Clear;
      SQL.Add('select * from Expert where 组ID like :GroupID and 选中= True and 状态= :Status Order by 组ID asc,专家ID asc');
      Parameters.ParamByName('GroupID').Value := SGroupId;
      Parameters.ParamByName('Status').Value := '正常';
      Prepared :=true;
      Open;   //select语句需用Open方法执行
    end;

    if IExtracount > ADOQuery1.RecordCount then
    begin
      Application.MessageBox('抽选人数不能大于该组选中的专家总人数, 请重新输入. ', '提示信息', MB_OK);
      exit;
    end;
    setlength(TempArray1,IExtracount);  //根据抽选人数为数组分配内存空间
    //调用抽取函数, ADOQuery1.RecordCount是有效的专家总人数
    sReturn :=ExtractFunc(ADOQuery1.RecordCount,IExtracount,TempArray1);

    for i :=low(TempArray1) to high(TempArray1) do
    begin
      ADOQuery1.first;
      ADOQuery1.MoveBy(TempArray1[i]-1);
      //构造查询字符串
      sSearch :=sSearch + ''''+ ADOQuery1.FieldValues['专家ID'] + ''',';
      GsSearch := GsSearch + '专家ID = ' + QuotedStr(ADOQuery1.FieldValues['专家ID']) + ' OR ';
    end;
    ADOTable1.Next;
  end;
  ADOTable1.First;   //完成浏览ExpertGroup表

  tempArray1 :=nil;  //释放临时数组内存空间
  if sSearch = '' then //如果没有构造查询字符串，则构造
  begin
    sSearch :='''' + '''';
    GsSearch :='专家ID = ' + QuotedStr('')
  end
  else begin
    sSearch :=copy(sSearch,1,length(sSearch)-1);  //去掉结尾的逗号
    GsSearch :=copy(GsSearch,1,length(GsSearch)-3);  //去掉结尾的OR
  end;
  sSearch := 'select * from Expert where 专家ID in (' + sSearch + ') ' +
    ' Order by 组ID asc,专家ID asc';

  //创建抽取结果窗口
  frmExtractResult :=TfrmExtractResult.Create(Application);
  with frmExtractResult.ADOQryResult do begin
      Close;
      SQL.Clear;
      SQL.Add(sSearch);
      Prepared :=true;
      Open;   //select语句需用Open方法执行
  end;
  frmExtractResult.ShowModal;

  frmExtract1Rep :=TfrmExtract1Rep.Create(Application);
  with frmExtract1Rep.ADOTable1 do begin
    Close;
    Connection:=frmMain.ADOConnection1;
    TableName:='Expert';  //数据表名称！
    Filtered := False;
    Filter :=GsSearch ;
    Filtered :=true;
    Open;       //打开数据库表
  end;

  button3.Enabled :=true;

end;


procedure TfrmExtract1.Button2Click(Sender: TObject);
begin
  close;
end;

procedure TfrmExtract1.Button3Click(Sender: TObject);
begin
  frmExtract1Rep.QuickRep1.Preview;
end;