main.pas

招投标软件代码,很有应用价值,请大家参考下哦,不明白的地方给我留言

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, mxOutlookBarPro, Menus, StdCtrls, Buttons, ExtCtrls, OleCtrls,
  CELL50Lib_TLB, ImgList, DB, ADODB,shellapi;

type
  Tf_main = class(TForm)
    MainMenu1: TMainMenu;
    N2: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    Panel1: TPanel;
    sb_Show: TSpeedButton;
    lb_Qi: TLabel;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    Splitter1: TSplitter;
    mxOutlookBarPro: TmxOutlookBarPro;
    MainImageList: TImageList;
    procedure GetMxToolMenu;
    procedure N9Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure sb_ShowClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure mxBtnDBClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N16Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  f_main: Tf_main;

implementation

uses
  u_log,unit_public,DataAccessCommonShell,SystemObject,datamodule,unit_condb;

{$R *.dfm}

procedure tf_main.mxBtnDBClick(Sender: TObject);
var
  xData: PMenuData;
  mxBtn: TmxButton;
begin
  if Sender is TmxButton then
  begin
    mxBtn := TmxButton(Sender);
    xData := PMenuData(mxBtn.Data);
    if IsWindow(xData.Handle) then
      BringWindowToTop(xData.Handle)
    else
      if xData.MethodParam <> '' then
        xData.Handle := ShowChildForm(xData.MethodParam);
  end;
end;

procedure tf_main.GetMxToolMenu;
var
  MenuList, ChildList: TList;
  mxHeader: TmxHeader;
  mxBtn: TmxButton;
  i, j: Integer;
begin
  mxOutLookBarPro.ClearHeaders;
  mxOutlookBarPro.ViewStyle := vsOutLook;
  MenuList := TList.Create;
  ChildList := TList.Create;
  //从数据库加载功能导航菜单
  //加载父菜单
  DACShellGetParentMenu(menulist,userInfor.user_id);
  for i:=0 to Menulist.Count-1 do
  begin
    mxHeader := mxOutlookBarPro.AddHeader;
    mxHeader.Name := PMenuData(MenuList[i]).MenuCode;
    mxHeader.Caption := PMenuData(MenuList[i]).MenuName;
    mxHeader.Data := PMenuData(MenuList[i]);
    mxHeader.Background.Color := $00FEE9EC;
    mxHeader.Images.Normal := MainImageList;
    ChildList.Clear;
    //加载子菜单
    DACShellGetChildMenu(PMenuData(MenuList[i]).MenuCode,ChildList,userInfor.user_id);
    for j:=0 to childlist.Count-1 do
    begin
     mxBtn := mxOutlookBarPro.Headers[i].AddButton;
     mxBtn.Caption := PMenuData(ChildList[j]).MenuName;
     mxBtn.Name := PMenuData(ChildList[j]).MenuCode;
     mxBtn.Data := PMenuData(ChildList[j]);
     mxBtn.ImageIndex :=StrToInt(PMenuData(ChildList[j]).BackGround);
     mxBtn.OnClick := mxBtnDBClick;
    end;
  end;
  FreeAndNil(ChildList);
  FreeAndNil(MenuList);
end;

procedure Tf_main.N9Click(Sender: TObject);
begin
  if ActiveMDIChild <> nil then
    ActiveMDIChild.Close;
end;

procedure Tf_main.N8Click(Sender: TObject);
begin
  if ActiveMDIChild <> nil then
    ActiveMDIChild.WindowState := wsMinimized;
end;

procedure Tf_main.N7Click(Sender: TObject);
begin
  if ActiveMDIChild<>nil then
     ActiveMDIChild.WindowState:=wsMaximized;
end;

procedure Tf_main.sb_ShowClick(Sender: TObject);
begin
  Splitter1.Visible := not Splitter1.Visible;
  mxOutlookBarPro.Visible := not mxOutlookBarPro.Visible;
end;

procedure Tf_main.FormShow(Sender: TObject);
var
  adoquery:tadoquery;
begin
 { try
    datamodule1.ADOMainConn.LoginPrompt:=false;
    datamodule1.ADOMainConn.ConnectionString:='FILE NAME=C:\tzb.udl';
    datamodule1.ADOMainConn.Open;
  except
    ShellExecute(Handle,'open','c:\tzb.udl',nil,nil,SW_NORMAL);
  end;}
  new(xmbdgc);
  new(userInfor);
  new(sysvar);
  if not RegDBExist then
  begin
    CreateRegDB;
    ReadDBLogin;
    Frm_ConDB:=tfrm_condb.Create(nil);
    try
      Frm_ConDB.PageControl1.ActivePageIndex:=0;
      Frm_ConDB.PageControl1.Pages[1].TabVisible:=False;
      if Frm_ConDB.ShowModal<>1 then
      begin
        freeandnil(Frm_ConDB);
        application.Terminate;
        exit;
      end;
    finally
      Freeandnil(Frm_ConDB);
    end;
  end
  ELSE
  begin
    ReadDBLogin;
    if not IsADOConnect(datamodule1.ADOMainConn,DBLogin.DBServer,DBLogin.WinNTMode,DBLogin.LoginID,DBLogin.LoginPassword,DBLogin.DBName) then
    begin
      Frm_ConDB:=tfrm_condb.Create(nil);
      try
        Frm_ConDB.PageControl1.ActivePageIndex:=0;
        Frm_ConDB.PageControl1.Pages[1].TabVisible:=False;
        if Frm_ConDB.ShowModal<>1 then
        begin
          freeandnil(Frm_ConDB);
          application.Terminate;
          exit;
        end;
      finally
        Freeandnil(Frm_ConDB);
      end;
    end;
  end;

  xmbdgc.XM_ISBn:='000';
  xmbdgc.BDLX_ID:='0';
  xmbdgc.gCLX_ID:='0';
  getpath;
  F_log:=TF_log.create(nil);
  try
    if f_log.ShowModal<>mrok then
    begin
      freeandnil(F_log);
      application.Terminate;
      exit;
    end;
    //得到用户信息
    adoquery:=tadoquery.Create(application);
    try
      adoquery.Connection:=datamodule1.ADOMainConn;
      adoquery.Close;
      adoquery.SQL.Text:='select * from bid_user where user_id='+quotedstr(trim(f_log.Com_name.Text));
      adoquery.Open;
      userInfor.user_id:=adoquery.fieldbyname('user_id').AsString;
      userInfor.user_type:=adoquery.fieldbyname('user_type').AsInteger;
    finally
      freeandnil(adoquery);
    end;
  finally
    f_log.Free;
  end;

  GetMxToolMenu;
  mxOutlookBarPro.ActiveHeader := mxOutlookBarPro.Header[0];;
end;

procedure Tf_main.FormClose(Sender: TObject; var Action: TCloseAction);
var
  i:integer;
begin
 // for i:=0 to f_main.MDIChildCount-1 do
  //  f_main.MDIChildren[i].Close;
  //dispose(xmbdgc);
  //dispose(userInfor);
end;

procedure Tf_main.N16Click(Sender: TObject);
var
  i:integer;
begin
  for i:=0 to  MDIChildcount-1 do
     MDIChildren[i].WindowState:=wsMinimized;
end;

procedure Tf_main.N17Click(Sender: TObject);
var
  i:Integer;
begin
  for i:=0 to  MDIChildcount-1 do
     MDIChildren[i].Close;
end;

procedure Tf_main.N12Click(Sender: TObject);
begin
  TileMode := tbHorizontal;
  Tile;
end;

procedure Tf_main.N11Click(Sender: TObject);
begin
  Cascade;
end;

procedure Tf_main.N13Click(Sender: TObject);
begin
  TileMode := tbVertical;
  Tile;
end;

procedure Tf_main.N14Click(Sender: TObject);
begin
    ArrangeIcons;
end;

procedure Tf_main.FormDestroy(Sender: TObject);
begin
  dispose(xmbdgc);
  dispose(userInfor);
  dispose(sysvar);
end;

end.