⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 仓库管理系统 仓库管理系统
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit MAIN;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
  StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls, StdActns,
  ActnList, ToolWin, ImgList, XPMenu, DB, ADODB, ActnMan, ActnCtrls,
  ActnMenus, CustomizeDlg, shellapi;

type
  TMainForm = class(TForm)
    mmMainMenu: TMainMenu;
    Window1: TMenuItem;
    hlp_top: TMenuItem;
    WindowCascadeItem: TMenuItem;
    WindowTileItem: TMenuItem;
    WindowArrangeItem: TMenuItem;
    hlp_topic: TMenuItem;
    OpenDialog: TOpenDialog;
    WindowMinimizeItem: TMenuItem;
    ActionList1: TActionList;
    EditCut1: TEditCut;
    EditCopy1: TEditCopy;
    EditPaste1: TEditPaste;
    FileNew1: TAction;
    FileSave1: TAction;
    FileExit1: TAction;
    FileOpen1: TAction;
    FileSaveAs1: TAction;
    WindowCascade1: TWindowCascade;
    WindowTileHorizontal1: TWindowTileHorizontal;
    WindowArrangeAll1: TWindowArrange;
    WindowMinimizeAll1: TWindowMinimizeAll;
    HelpAbout1: TAction;
    FileClose1: TWindowClose;
    WindowTileVertical1: TWindowTileVertical;
    WindowTileItem2: TMenuItem;
    sys_top: TMenuItem;
    sys_branch: TMenuItem;
    sys_manneger: TMenuItem;
    sys_cpwd: TMenuItem;
    N5: TMenuItem;
    sys_default: TMenuItem;
    N7: TMenuItem;
    sys_run: TMenuItem;
    N9: TMenuItem;
    sys_repass: TMenuItem;
    N11: TMenuItem;
    sys_exit: TMenuItem;
    mgood_top: TMenuItem;
    mgood_label: TMenuItem;
    mgood_spec: TMenuItem;
    mgoods_find: TMenuItem;
    N17: TMenuItem;
    mgood_price: TMenuItem;
    mstore_top: TMenuItem;
    mgood_stoin: TMenuItem;
    mgood_stoout: TMenuItem;
    mgood_check: TMenuItem;
    mgood_loss: TMenuItem;
    N24: TMenuItem;
    mgood_fstoin: TMenuItem;
    mgood_fstoout: TMenuItem;
    mgood_search: TMenuItem;
    N28: TMenuItem;
    mstore_pdreport: TMenuItem;
    mgood_conver: TMenuItem;
    N31: TMenuItem;
    mstore_set: TMenuItem;
    msale_top: TMenuItem;
    msale_front: TMenuItem;
    N35: TMenuItem;
    msale_style: TMenuItem;
    msale_detail: TMenuItem;
    msale_saleno: TMenuItem;
    msale_saler: TMenuItem;
    msale_in: TMenuItem;
    msale_time: TMenuItem;
    N42: TMenuItem;
    msale_month: TMenuItem;
    N44: TMenuItem;
    msale_extend: TMenuItem;
    msale_set: TMenuItem;
    mman_top: TMenuItem;
    mman_change: TMenuItem;
    mman_man: TMenuItem;
    mman_search: TMenuItem;
    m_assistant: TMenuItem;
    m_dress: TMenuItem;
    mass_sdress: TMenuItem;
    mrepair_top: TMenuItem;
    mrepair_back: TMenuItem;
    N56: TMenuItem;
    mrepair_delsale: TMenuItem;
    mrepair_delst: TMenuItem;
    N59: TMenuItem;
    mreair_start: TMenuItem;
    mrepair_update: TMenuItem;
    mdata_top: TMenuItem;
    mdata_recsend: TMenuItem;
    N64: TMenuItem;
    mdata_deal: TMenuItem;
    N66: TMenuItem;
    mdata_tran: TMenuItem;
    N68: TMenuItem;
    hlp_internet: TMenuItem;
    N70: TMenuItem;
    hlp_about: TMenuItem;
    Image1: TImage;
    ADOTable1: TADOTable;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    Too: TToolButton;
    ToolButton6: TToolButton;
    ImageList1: TImageList;
    ToolButton5: TToolButton;
    ToolButton8: TToolButton;
    ToolButton7: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    StatusBar1: TStatusBar;
    XPMenu1: TXPMenu;
    N1: TMenuItem;
    mrepair_day: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure sys_branchClick(Sender: TObject);
    procedure mman_manClick(Sender: TObject);
    procedure mman_searchClick(Sender: TObject);
    procedure sys_runClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure msale_styleClick(Sender: TObject);
    procedure msale_salenoClick(Sender: TObject);
    procedure msale_salerClick(Sender: TObject);
    procedure mgood_searchClick(Sender: TObject);
    procedure sys_mannegerClick(Sender: TObject);
    procedure sys_cpwdClick(Sender: TObject);
    procedure sys_defaultClick(Sender: TObject);
    procedure sys_repassClick(Sender: TObject);
    procedure sys_exitClick(Sender: TObject);
    procedure mgood_labelClick(Sender: TObject);
    procedure mgood_specClick(Sender: TObject);
    procedure mgoods_findClick(Sender: TObject);
    procedure mgood_priceClick(Sender: TObject);
    procedure mgood_stoinClick(Sender: TObject);
    procedure mgood_stooutClick(Sender: TObject);
    procedure mgood_checkClick(Sender: TObject);
    procedure mgood_lossClick(Sender: TObject);
    procedure mgood_fstoinClick(Sender: TObject);
    procedure mgood_fstooutClick(Sender: TObject);
    procedure mstore_pdreportClick(Sender: TObject);
    procedure mgood_converClick(Sender: TObject);
    procedure mstore_setClick(Sender: TObject);
    procedure msale_extendClick(Sender: TObject);
    procedure msale_frontClick(Sender: TObject);
    procedure msale_detailClick(Sender: TObject);
    procedure msale_inClick(Sender: TObject);
    procedure msale_timeClick(Sender: TObject);
    procedure msale_monthClick(Sender: TObject);
    procedure msale_setClick(Sender: TObject);
    procedure mman_changeClick(Sender: TObject);
    procedure m_dressClick(Sender: TObject);
    procedure mass_sdressClick(Sender: TObject);
    procedure mrepair_backClick(Sender: TObject);
    procedure mrepair_delsaleClick(Sender: TObject);
    procedure mrepair_delstClick(Sender: TObject);
    procedure mreair_startClick(Sender: TObject);
    procedure mrepair_updateClick(Sender: TObject);
    procedure mdata_recsendClick(Sender: TObject);
    procedure mdata_dealClick(Sender: TObject);
    procedure mdata_tranClick(Sender: TObject);
    procedure hlp_internetClick(Sender: TObject);
    procedure hlp_aboutClick(Sender: TObject);
    procedure mrepair_dayClick(Sender: TObject);
  private
    { Private declarations }
    FClientInstance : TFarProc;
    FPrevClientProc : TFarProc;
    procedure ClientWndProc(var Message: TMessage);
    procedure FindMenuItems(Item: TMenuItem);//Node: TTreeNode;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;
  fst:string;  

implementation

{$R *.dfm}

uses  about, dbmRainbowMis, chHeadUnit, dfm_password, f_branch,
  dfm_manrec, f_findman, dfm_tray, f_xsfx, dfm_saler, dfm_ssaleno,
  f_stosearch, dfm_team, dfm_syspwd, f_default, dfm_repass, f_label,
  f_specenter, dfm_sware, dfm_price, f_storein, f_manoeuvre, dfm_sstoin,
  dfm_sstoout, dfm_check, f_loss, dfm_creatbd, dfm_loop, dfm_stoset,
  dfm_saledetail, dfm_saleset, dfm_extend, dfm_money, dfm_time, dfm_smonth,
  f_manchange, f_dress, dfm_dresslis, dfm_bavre, dfm_delstohst, f_update,
  dfm_del, dfm_start, Main_F, dfm_receive, dfm_transpara, dfm_saldate;


procedure TMainForm.FormCreate(Sender: TObject);
begin
  fst := ExtractFilePath(Application.ExeName);
  dmRainbowMIS.tbltmenu.active:=true;
  dmRainbowMIS.Atbltray.Active := true;
  if FileExists(fst+'images\oemlogo.bmp') then
  begin
    image1.Picture.LoadFromFile(fst+'images\oemlogo.bmp');
    FClientInstance := MakeObjectInstance(ClientWndProc);
    FPrevClientProc := Pointer(GetWindowLong(ClientHandle,
                             GWL_WNDPROC));
    SetWindowLong(ClientHandle,
                GWL_WNDPROC, LongInt(FClientInstance));
  end;
  chHeadUnit.entertray(mainform,dmRainbowMIS.Atbltray) ;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  StatusBar1.Panels[1].Text :='现在用户:'+ g_uInfo.fuserid+'  '+g_uInfo.fusername;
  dmRainbowMIS.tbltmenu.indexfieldnames:='cmenuname';
  if g_uInfo.fuserid<>'system' then
    FindMenuItems(mmMainMenu.Items);
  dmRainbowMIS.tbltmenu.active:=false;
end;

procedure TMainForm.ClientWndProc(var Message: TMessage);
var
  Dc : hDC;
  Row : Integer;
  Col : Integer;
begin
  with Message do
    case Msg of
      WM_ERASEBKGND:
      begin
        Dc := TWMEraseBkGnd(Message).Dc;
        for Row := 0 to ClientHeight div Image1.Picture.Height do
          for Col := 0 to ClientWidth div Image1.Picture.Width do
            BitBlt(Dc,
               Col * Image1.Picture.Width,
               Row * Image1.Picture.Height,
               Image1.Picture.Width,
               Image1.Picture.Height,
               Image1.Picture.Bitmap.Canvas.Handle,
               0,
               0,
               SRCCOPY);
          Result := 1;
      end;
      else
        Result := CallWindowProc(FPrevClientProc,
                                 ClientHandle,
                                 Msg,
                                 wParam,
                                 lParam);
  end;
end;

procedure Tmainform.FindMenuItems( Item: TMenuItem); //Node: TTreeNode;
var
  nCnt: Integer;
  dv:string;
begin
  dv:=trim(item.Name) ;
    if dmrainbowmis.tbltmenu.Locate('cmenuname',dv,[loPartialKey]) then
    begin
      if pos(vgro+'0',dmRainbowMIS.tbltmenu.fieldbyname('climit').asstring)>0 then
        item.Enabled :=false
      else
        item.Enabled :=true;
      if trim(dmrainbowmis.tbltmenu['cmenuind'])='2' then
        item.Visible :=false;        
    end;
  for nCnt := 0 to Item.Count - 1 do
  begin
     FindMenuItems(Item.Items[nCnt]);
  end;
end;


procedure TMainForm.sys_branchClick(Sender: TObject);
begin
    If  Application.FindComponent('dfmbranch')=Nil Then
    dfmbranch:=Tdfmbranch.Create(Application);
  dfmbranch.Show;
end;

procedure TMainForm.mman_manClick(Sender: TObject);
begin
    If  Application.FindComponent('dfmmanrec')=Nil Then
    dfmmanrec:=Tdfmmanrec.Create(Application);
  dfmmanrec.Show;
end;

procedure TMainForm.mman_searchClick(Sender: TObject);
begin
    If  Application.FindComponent('dfmfindman')=Nil Then
    dfmfindman:=Tdfmfindman.Create(Application);
  dfmfindman.Show;
end;

procedure TMainForm.sys_runClick(Sender: TObject);
begin
    If  Application.FindComponent('dfmtray')=Nil Then
    dfmtray:=Tdfmtray.Create(Application);
  dfmtray.Show;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Application.MessageBox('你确信要退出系统吗?','系统提示',MB_ICONERROR + MB_OKCANCEL)
    = IDOK then

⌨️ 快捷键说明

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