📄 main.pas

📁 小型库存管理,希望有帮助,小型库存管理,希望有帮助
💻 PAS
📖 第 1 页 / 共 2 页
字号:
12 下一页
unit MAIN;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
  StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls, StdActns,
  ActnList, ToolWin, ImgList, DB, ADODB,MsgU, Grids, DBGrids;

type
  TfrmMain = class(TForm)
    MainMenu1: TMainMenu;
    Window1: TMenuItem;
    Help1: TMenuItem;
    WindowCascadeItem: TMenuItem;
    WindowTileItem: TMenuItem;
    WindowArrangeItem: TMenuItem;
    HelpAboutItem: TMenuItem;
    OpenDialog: TOpenDialog;
    mSystem: TMenuItem;
    WindowMinimizeItem: TMenuItem;
    ActionList1: TActionList;
    WindowCascade1: TWindowCascade;
    WindowTileHorizontal1: TWindowTileHorizontal;
    WindowArrangeAll1: TWindowArrange;
    WindowMinimizeAll1: TWindowMinimizeAll;
    HelpAbout1: TAction;
    WindowTileVertical1: TWindowTileVertical;
    WindowTileItem2: TMenuItem;
    ToolBar2: TToolBar;
    tLoginOut: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ImageList1: TImageList;
    mReg: TMenuItem;
    StatusBar: TStatusBar;
    mEmployee: TMenuItem;
    mCustPara: TMenuItem;
    mUserMenu: TMenuItem;
    tLogin: TToolButton;
    mUser: TMenuItem;
    QrySQL: TADOQuery;
    mQuery: TMenuItem;
    N2: TMenuItem;
    mBase: TMenuItem;
    mSupplier: TMenuItem;
    mCust: TMenuItem;
    N6: TMenuItem;
    mClass: TMenuItem;
    mItem: TMenuItem;
    Y1: TMenuItem;
    mReceive: TMenuItem;
    mReturn: TMenuItem;
    N8: TMenuItem;
    mSale: TMenuItem;
    mSaleReturn: TMenuItem;
    C1: TMenuItem;
    mBegStock: TMenuItem;
    N12: TMenuItem;
    mLost: TMenuItem;
    mCheckStock: TMenuItem;
    N4: TMenuItem;
    mMonth: TMenuItem;
    mQryMonth: TMenuItem;
    btnZip: TToolButton;
    ToolButton1: TToolButton;
    mQryStock: TMenuItem;
    mAllStock: TMenuItem;
    procedure HelpAbout1Execute(Sender: TObject);
    procedure tLoginClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure mUserClick(Sender: TObject);
    procedure mUserMenuClick(Sender: TObject);
    procedure tLoginOutClick(Sender: TObject);
    procedure mCustParaClick(Sender: TObject);
    procedure mRegClick(Sender: TObject);
    procedure mReceiveClick(Sender: TObject);
    procedure mEmployeeClick(Sender: TObject);
    procedure mSupplierClick(Sender: TObject);
    procedure mCustClick(Sender: TObject);
    procedure mClassClick(Sender: TObject);
    procedure mItemClick(Sender: TObject);
    procedure mReturnClick(Sender: TObject);
    procedure mSaleClick(Sender: TObject);
    procedure mSaleReturnClick(Sender: TObject);
    procedure btnZipClick(Sender: TObject);
    procedure mBegStockClick(Sender: TObject);
    procedure mLostClick(Sender: TObject);
    procedure mQryStockClick(Sender: TObject);
    procedure mMonthClick(Sender: TObject);
    procedure mCheckStockClick(Sender: TObject);
    procedure mAllStockClick(Sender: TObject);
    procedure mQryMonthClick(Sender: TObject);
  private
    { Private declarations }
    FormIndex :integer ;
    strCaption :string ;
    strUser,strUserName,strCustName :string ;
    MenuList,MenuCaptionList :TStringList ;
    Function FindForm(FormName:Integer):Integer;
    function CheckMenu(strMenu:string):boolean; //权限检测
    procedure GetMenuInfo; //取的当前菜单信息
    procedure ChildTellMain(var Msg: TMessage); message wm_ChildTellMain; {与子窗体通讯}
    procedure CloseAllForm ; //关闭所有窗口
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

uses FMDBU,FMLoginU,about,uRegCount,
     FMSupplierU,FMCustomerU,FMClassU,FMItemU,
     FMUserU,FMUserMenuU,FMCustParaU,
     FMTsReceiveU,FMTsReturnU,FMTsSaleU,FMTsSaleReturnU,
     FMTsBegstockU,FMTsLostU,FMTsCheckstockU,
     FMQryReceiveU,FMQryStockU ,FMQryAllStockU,
     FMEmployeeU,FMQryMonthU,FMQryMonthDataU;


{接受子窗体的消息:操作菜单}
procedure TfrmMain.ChildTellMain(var Msg: TMessage);
var
  strMsg:string ;
begin
  strMsg :=''; //接受信息
  case Msg.wParam of
    _PassAString: strMsg :=StrPas(pchar(msg.lParam));
  end;
  Msg.Result := _OK;
end ;

{判断当前窗体是否存在}
Function TfrmMain.FindForm(FormName:Integer):Integer;
var
   I:Integer;
begin
   Result := -1;
   for I := 0 to Screen.CustomFormCount - 1 do
   begin
    if Screen.CustomForms[i].Tag<>FormName then continue ;
    result :=I;
   end;
end;

procedure TfrmMain.CloseAllForm ;
var
  I :integer ;
begin
  for I := 0 to Screen.CustomFormCount - 1 do
   begin
    if Screen.CustomForms[i].Tag>0 then 
       Screen.CustomForms[i].Release ; 
   end;
end ;

{权限检测}
function TfrmMain.CheckMenu(strMenu:string):boolean;
begin
  result :=true ;
  if LowerCase(strUser)='system' then exit ;
  if strUser='' then
   begin
     MessageBox(handle,PChar('请您先登录本系统.'),'提示',MB_OK+MB_ICONWARNING);
     result :=false ;
     exit ;
   end ;
  QrySQL.Active :=false ;
  QrySQL.SQL.Text :='select count(*) from ts_UserMenu where fUserNo='+#39+strUser+#39+' and fMenuNo='+#39+strMenu+#39;
  QrySQL.Active :=true ;
  if QrySQL.Fields[0].AsInteger =0 then
   begin
     MessageBox(handle,PChar('您没有使用该程序的权限.'),'提示',MB_OK+MB_ICONWARNING);
     result :=false ;
   end ;
end ;

{取的当前菜单信息}
procedure TfrmMain.GetMenuInfo;
var
  i :integer ;
  procedure AddMenu(SubMenuItem :TMenuItem );
   var
     j :integer ;
     strCaption :string ;
   begin
       for j :=0 to SubMenuItem.Count -1 do
        begin
          if SubMenuItem.Items[j].Tag=1  then
           begin
             strCaption :=SubMenuItem.Items[j].Caption ;
             MenuCaptionList.Add(strCaption);
             MenuList.Add(SubMenuItem.Items[j].Name) ;
           end
          else
          AddMenu(SubMenuItem.Items[j]) ;
       end ;
   end ;
begin
 MenuCaptionList :=TStringList.Create ;
 MenuList :=TStringList.Create ;

 for i := 0 to MainMenu1.Items.Count -1 do
  begin
    if MainMenu1.Items[i].Tag =0 then
       AddMenu(MainMenu1.Items[i]) ;
  end ;
end ;


{压缩数据库}
procedure TfrmMain.btnZipClick(Sender: TObject);
begin
  if strUser='' then
   begin
     MessageBox(handle,PChar('请您先以超级用户身份登录本系统.'),'提示',MB_OK+MB_ICONWARNING);
     exit ;
   end ;
  if LowerCase(strUser)<>'system' then exit ;
  if messagebox(handle,'确定压缩数据库吗?','确认',MB_OKCANCEL+MB_ICONINFORMATION)<>IDOK then exit;
  CloseAllForm ;
  fmDB.AdoHouse.Connected :=false ; 
  CompactDatabase('stock.mdb','13501884042');
  MessageBox(handle,'压缩完毕.','提示',MB_OK+MB_ICONINFORMATION);
end;


procedure TfrmMain.FormCreate(Sender: TObject);
begin
  StatusBar.Panels[0].Width :=280;
  StatusBar.Panels[0].Text :='客户名称:';
  StatusBar.Panels[1].Width :=200;
  StatusBar.Panels[1].Text :='当前用户:无人登录';
  StatusBar.Panels[2].Width :=50;
  StatusBar.Panels[2].Text :='当前日期:'+FormatDateTime('YYYY'+DateSeparator+'MM'+DateSeparator+'DD',Date());

  GetMenuInfo ;

  if GetCount<>'999' then
     mReg.Visible :=true
  else
     mReg.Visible :=false ;
end;

{关于}
procedure TfrmMain.HelpAbout1Execute(Sender: TObject);
begin
  if Application.FindComponent('AboutBox')=nil then
     AboutBox:=TAboutBox.create(self);
  AboutBox.Show ;
end;

{登出本系统}
procedure TfrmMain.tLoginOutClick(Sender: TObject);
begin
  if messagebox(handle,'确定离开?','确认',MB_OKCANCEL+MB_ICONINFORMATION)<>IDOK then exit;

   strUser  :='' ;
   strUserName :='' ;
   StatusBar.Panels[0].Text :='客户名称:' + strCustName ;
   StatusBar.Panels[1].Text :='当前用户:无人登录';

   CloseAllForm ;
end;

{登陆}
procedure TfrmMain.tLoginClick(Sender: TObject);
begin
 fmDB.AdoHouse.Connected :=false ;
 try
  fmDB.AdoHouse.Connected :=true ;
 except
  Raise Exception.Create('数据库连接失败！');
  exit ;
 end ;
 if Application.FindComponent('FMLogin')=nil then
    FMLogin:=TFMLogin.create(self);
 if FMLogin.ShowModal = mrOk then
 begin
   strUser  :=FMLogin.aUserId ;
   strUserName :=FMLogin.aUserName ;
   strCustName :=FMLogin.aCustName ;
   StatusBar.Panels[0].Text :='客户名称:'+strCustName ;
   StatusBar.Panels[1].Text :='当前用户:'+strUserName;
 end ;
 FMLogin.hide;
 FMLogin.free;
end;

{员工资料}
procedure TfrmMain.mEmployeeClick(Sender: TObject);
begin
  strCaption :=copy(mEmployee.Caption,0,pos('(',mEmployee.Caption)-1) ;
  if not CheckMenu('mEmployee') then exit ;
  FormIndex := FindForm(51);
  if (FormIndex > -1) then
      Screen.CustomForms[FormIndex].Show
  else
   begin
     if Application.FindComponent('FMEmployee')=nil then
        FMEmployee:=TFMEmployee.create(self);
   end ;
  FMEmployee.Caption :=strCaption ;
  FMEmployee.Tag :=51;
end;


{用户维护}
procedure TfrmMain.mUserClick(Sender: TObject);
begin
  strCaption :=copy(mUser.Caption,0,pos('(',mUser.Caption)-1) ;
  if not CheckMenu('mUser') then exit ;
  FormIndex := FindForm(54);
  if (FormIndex > -1) then
      Screen.CustomForms[FormIndex].Show
  else
   begin
     if Application.FindComponent('FMUser')=nil then
        FMUser:=TFMUser.create(self);
   end ;
  FMUser.aUser := strUser ;
  FMUser.Caption :=strCaption ;
  FMUser.Tag :=54;
12 下一页
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -