main.~pas

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

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ComCtrls, ToolWin, ExtCtrls, StdCtrls, DB,
  ADODB, Grids, DBGrids, DateUtils, ImgList;
//FileCtrl, 
type
  TfrmMain = class(TForm)
    MainMenu1: TMainMenu;
    mSys: TMenuItem;
    E1: TMenuItem;
    R1: TMenuItem;
    H1: TMenuItem;
    mSysExit: TMenuItem;
    mExtract1: TMenuItem;
    StatusBar1: TStatusBar;
    Splitter1: TSplitter;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    ListView1: TListView;
    ImageList1: TImageList;
    ADOTblGroup: TADOTable;
    ADOConnection1: TADOConnection;
    ADOQryExpert: TADOQuery;
    mExpertAdd: TMenuItem;
    mExpertUpdate: TMenuItem;
    mExpertDel: TMenuItem;
    ADOQryExpertID: TWideStringField;
    ADOQryExpertDSDesigner: TWideStringField;
    ADOQryExpertDSDesigner2: TWideStringField;
    ADOQryExpertDSDesigner3: TWideStringField;
    ADOQryExpertDSDesigner4: TDateTimeField;
    ADOQryExpertDSDesigner5: TWideStringField;
    ADOQryExpertDSDesigner6: TWideStringField;
    ADOQryExpertDSDesigner7: TWideStringField;
    ADOQryExpertDSDesigner8: TWideStringField;
    ADOQryExpertDSDesigner9: TWideStringField;
    ADOQryExpertDSDesigner10: TWideStringField;
    ADOQryExpertDSDesigner11: TBooleanField;
    ADOQryExpertID2: TWideStringField;
    mGroupAdd: TMenuItem;
    mGroupUpdate: TMenuItem;
    N5: TMenuItem;
    ADOQryCount: TADOQuery;
    DataSource2: TDataSource;
    tmrCurrent: TTimer;
    imgLstTBar24: TImageList;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    imglstTBar20: TImageList;
    mGroupDel: TMenuItem;
    ImageList2: TImageList;
    N1: TMenuItem;
    mHisExtractPro: TMenuItem;
    procedure mExtract1Click(Sender: TObject);
    procedure mSysExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure mExpertAddClick(Sender: TObject);
    procedure mExpertUpdateClick(Sender: TObject);
    procedure mExpertDelClick(Sender: TObject);
    procedure mGroupAddClick(Sender: TObject);
    procedure mGroupUpdateClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure tmrCurrentTimer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCanResize(Sender: TObject; var NewWidth,
      NewHeight: Integer; var Resize: Boolean);
    procedure mGroupDelClick(Sender: TObject);
    procedure mHisExtractProClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  {全局变量}
  frmMain: TfrmMain;
  sGGroupId, sGGroupName: string;
  gGroupCount: integer;
  ArrGroupId: array of string;
  gImgindex: integer;  //组图片的index
const
  cWeekCn: array[1..7] of string =
  ('星期天', '星期一', '星期二', '星期三', '星期四', '星期五', '星期六');

implementation

uses Extract1,ExpertAdd, ExpertUpdate, GroupAdd, GroupUpdate, HisExtractPro;

{$R *.dfm}

procedure TfrmMain.mExtract1Click(Sender: TObject);
begin
  frmExtract1 :=TfrmExtract1.Create(Application);
  frmExtract1.ShowModal;
end;

procedure TfrmMain.mSysExitClick(Sender: TObject);
begin
  close;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
{程序说明：连接数据库，打开ADOTblGroup,}
var
  ConnStr,DBPath:String;        //保存连接字符串和数据库路径
  ListItem: TListItem;
  i,SqlCount: integer;
begin
  try
    DBPath:=ExtractFilePath(Application.ExeName)+'Data\ExtractDB.mdb';
    ConnStr:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+
        DBPath+';Persist Security Info=False';
//    connStr:='Provider=Microsoft.Jet.OLEDB.4.0;' + 'Data Source=' +
//      DBPath+'\MeData.mdb;Persist Security Info=False;'+
//    'Jet OLEDB:Database Password=123456'; //数据库密码

    ADOConnection1.Close; //要改变它的属性前要关闭连接！
    ADOConnection1.ConnectionString:=ConnStr;     //指定连接串
    ADOconnection1.LoginPrompt:=False;  //不显示默认的登录对话框
    ADOConnection1.Open   //打开连接
  except
    on E:Exception do
    begin
      ShowMessage('出错！'+e.Message);  //显示出错信息
      frmMain.Close;    //退出程序算了
    end;
  end;

  ADOTblGroup.Connection :=ADOConnection1;
  ADOTblGroup.Close;
  ADOTblGroup.TableName:='ExpertGroup';  //数据表名称
  ADOTblGroup.Open;       //打开数据库表
  //计算组的数目
  with ADOQryCount do begin
    Connection :=ADOConnection1;
    Close;
    SQL.Clear;
    SQL.Add('select count(*) from ExpertGroup ');
    Prepared :=true;
    Open;   //select语句需用Open方法执行
  end;
  SqlCount :=0;
  ADOQryCount.First;
  while not ADOQryCount.Eof do
  begin
    SqlCount :=ADOQryCount.Fields[0].Value;
    ADOQryCount.Next;
  end;

  SetLength(ArrGroupId, SqlCount);  //设置动态数组的大小
  //向ListView1 添加代表组的Listitem
//  ListView1.LargeImages:=Imagelist1;
  Randomize;
  gImgindex :=Random(3);   //产生0~2的随机数
  i :=0;
  ADOTblGroup.First;
  while not ADOTblGroup.Eof do
  begin
      with ListView1 do
      begin
        Listitem :=Items.add;
        Listitem.caption := VarToStr(ADOTblGroup.FieldValues['组名']);
        Listitem.Imageindex := gImgindex;
        //向GroupId数组添加新的组ID
        ArrGroupId[i] := ADOTblGroup.FieldByName('组ID').AsString;
      end;
      i :=i+1;
    ADOTblGroup.Next;
  end;
  ADOTblGroup.First;

  if not ADOTblGroup.Eof then
  begin
{
   //显示第一个专家组对应的专家成员信息
    with ADOQryExpert do begin
      Connection :=ADOConnection1;
      Close;
      SQL.Clear;
      SQL.Add('select * from Expert where 组ID like :GroupID Order by 组ID asc,专家ID asc');
      Parameters.ParamByName('GroupID').Value := sGGroupId;
      Prepared :=true;
      Open;   //select语句需用Open方法执行
    end;
    }
    sGGroupId :=ADOTblGroup.FieldValues['组ID'];
    sGGroupName :=ADOTblGroup.FieldValues['组名'];
    ListView1.Items[0].Focused :=true;
    ListView1.Items[0].Selected:=true;
  end;
  StatusBar1.Panels[0].Text :='共 ' + varToStr(SqlCount) +' 组';
  StatusBar1.Panels[3].Text :=DateToStr(Now)+ ' ' +cWeekCn[DayOfWeek(Now)];
  StatusBar1.Panels[4].Text :=copy(timeToStr(Time),1,length(timeToStr(Time))-3);
  StatusBar1.Panels[6].Text :='作者：万小虎';
  
  GGroupCount :=SqlCount;
  //初始化ListView1的属性
  ListView1.Width :=120;
  ListView1.HideSelection :=False;

  frmMain.Width :=800;
  frmMain.Height:=600;
  frmMain.Position :=poScreenCenter;
  frmMain.WindowState:=wsNormal;

end;

procedure TfrmMain.ListView1SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
var
  SqlCount: Integer;
  GroupID: String;
begin
  if Selected =False then exit;

  dbgrid1.DataSource :=nil;
  SqlCount :=0;
  GroupID :=ArrGroupID[Item.Index];
  ADOTblGroup.Locate('组ID',GroupID,[loCaseInsensitive]);

  //显示专家组对应的专家成员信息
  with ADOQryExpert do begin
    Close;
    SQL.Clear;
    SQL.Add('select * from Expert where 组ID like :GroupID Order by 组ID asc,专家ID asc');
    Parameters.ParamByName('GroupID').Value := GroupID;
    Prepared :=true;
    Open;   //select语句需用Open方法执行
  end;
  //计算该组的专家总人数
  ADOQryExpert.First;
  while not ADOQryExpert.Eof do
  begin
    SqlCount := SqlCount + 1;
    ADOQryExpert.Next;
  end;
  ADOQryExpert.First;

  StatusBar1.Panels[1].Text :='[' + Item.Caption + ']' + ' 共 ' + varToStr(SqlCount) +' 人';
  sGGroupId :=ADOTblGroup.FieldValues['组ID'];
  sGGroupName :=ADOTblGroup.FieldValues['组名'];

  dbgrid1.DataSource :=DataSource1;
end;

procedure TfrmMain.mExpertAddClick(Sender: TObject);
begin
  //当前没有专家组，则提示用户，并退出窗体
  if frmMain.ADOTblGroup.Eof then
  begin
    Application.MessageBox('没有选择专家组, 不能增加专家成员!', '信息', MB_OK + MB_ICONINFORMATION);
    exit;
  end;
  frmExpertAdd :=TfrmExpertAdd.Create(Application);
  frmExpertAdd.ShowModal;
end;

procedure TfrmMain.mExpertUpdateClick(Sender: TObject);
begin
  //当前组没有专家成员，则提示用户，并退出窗体
  if frmMain.ADOQryExpert.Eof then
  begin
    Application.MessageBox('没有选择专家成员以供修改', '信息', MB_OK + MB_ICONINFORMATION);
    exit;
  end;
  frmExpertUpdate :=TfrmExpertUpdate.Create(Application);
  frmExpertUpdate.ShowModal;
end;

procedure TfrmMain.mExpertDelClick(Sender: TObject);
var
  ExpertInfo: Pchar;
  sInfo: string;
begin
  //当前组没有专家成员，则提示用户，并退出窗体
  if frmMain.ADOQryExpert.Eof then
  begin
    Application.MessageBox('没有选择专家成员以供删除', '信息', MB_OK + MB_ICONINFORMATION);
    exit;
  end;
  sInfo:= ADOQryExpert.FieldValues['姓名'];
  sInfo:= '删除专家 [' + sInfo + '] 后将不可恢复，确实要删除吗？';
  ExpertInfo :=PChar(sInfo);
  if Application.MessageBox(ExpertInfo, '删除', MB_YESNO + MB_DEFBUTTON2 + MB_ICONQUESTION) = IDYES then
    ADOQryExpert.Delete;
end;

procedure TfrmMain.mGroupAddClick(Sender: TObject);
begin
  frmGroupAdd :=TfrmGroupAdd.Create(Application);
  frmGroupAdd.ShowModal;
end;

procedure TfrmMain.mGroupUpdateClick(Sender: TObject);
begin
  //当前没有专家组，则提示用户，并退出窗体
  if frmMain.ADOTblGroup.Eof then
  begin
    Application.MessageBox('没有选择专家组以供修改', '信息', MB_OK + MB_ICONINFORMATION);
    exit;
  end;
  frmGroupUpdate :=TfrmGroupUpdate.Create(Application);
  frmGroupUpdate.ShowModal;
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
  frmMain.Caption :='专家抽取系统 1.0';
  ListView1.ReadOnly :=True;

end;

procedure TfrmMain.tmrCurrentTimer(Sender: TObject);
begin
  StatusBar1.Panels[4].Text :=copy(timeToStr(Time),1,length(timeToStr(Time))-3);
end;

procedure TfrmMain.FormActivate(Sender: TObject);
begin
  frmMain.WindowState:=wsMaximized;
end;

procedure TfrmMain.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
  if (NewWidth <400) or (NewHeight <300) then
  begin
    Resize :=false;
  end;
end;

procedure TfrmMain.mGroupDelClick(Sender: TObject);
var
  ExpertInfo: Pchar;
  sInfo: string;
  SqlCount, i: integer;
begin
  //当前没有专家组，则提示用户，并退出窗体
  if frmMain.ADOTblGroup.Eof then
  begin
    Application.MessageBox('没有选择专家组以供删除', '信息', MB_OK + MB_ICONINFORMATION);
    exit;
  end;

 //计算组成员的数目
  with ADOQryCount do begin
    Connection :=ADOConnection1;
    Close;
    SQL.Clear;
    SQL.Add('select count(*) from Expert where 组ID= :GroupID ');
    Parameters.ParamByName('GroupID').Value := sGGroupId;
    Prepared :=true;
    Open;   //select语句需用Open方法执行
  end;
  SqlCount :=0;
  ADOQryCount.First;
  while not ADOQryCount.Eof do
  begin
    SqlCount :=ADOQryCount.Fields[0].Value;
    ADOQryCount.Next;
  end;
  if SqlCount >0 then
  begin
    Application.MessageBox('专家组内存在专家成员, 该组不能被删除', '信息', MB_OK + MB_ICONINFORMATION);
    exit;
  end;

  sInfo:= ADOTblGroup.FieldValues['组名'];
  sInfo:= '删除组 [' + sInfo + '] 后将不可恢复，确实要删除吗？';
  ExpertInfo :=PChar(sInfo);
  if Application.MessageBox(ExpertInfo, '删除', MB_YESNO + MB_DEFBUTTON2 + MB_ICONQUESTION) = IDYES then
  begin
    ADOTblGroup.Delete;
    //刷新主界面的专家组表
    frmMain.ADOTblGroup.Active :=false;
    frmMain.ADOTblGroup.Active :=True;
    frmMain.ADOTblGroup.First;

    //移动数组元素
    for i := ListView1.ItemFocused.Index+1 to high(ArrGroupId) do
    begin
      ArrGroupId[i-1] :=ArrGroupId[i];
    end;
    GGroupCount :=GGroupCount-1;
    SetLength(ArrGroupId, GGroupCount);  //设置动态数组的大小
    //向主界面的Listview删除Item
    ListView1.ItemFocused.Delete;
    ListView1.Arrange(arAlignTop);

    if not frmMain.ADOTblGroup.Eof then
    begin
      sGGroupId :=frmMain.ADOTblGroup.FieldValues['组ID'];
      sGGroupName :=frmMain.ADOTblGroup.FieldValues['组名'];
      frmMain.ListView1.Items[0].Focused :=true;
      frmMain.ListView1.Items[0].Selected:=true;
    end
    else begin
      sGGroupId :='';
      sGGroupName :='';
    end;
    frmMain.StatusBar1.Panels[0].Text :='共 ' + varToStr(GGroupCount) +' 组';
  end;

end;

procedure TfrmMain.mHisExtractProClick(Sender: TObject);
begin
  frmHisExtractPro :=TfrmHisExtractPro.Create(Application);
  frmHisExtractPro.ShowModal;
end;

end.