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

📄 main.pas

📁 Nicesoft ERP 是新一代智能型 ERP 系统
💻 PAS
📖 第 1 页 / 共 4 页
字号:
    procedure SLContractPriceExecute(Sender: TObject);
    procedure FNCashInExecute(Sender: TObject);
    procedure FNCashOutExecute(Sender: TObject);
    procedure OAEMailExecute(Sender: TObject);
    procedure DAProviderActionExecute(Sender: TObject);
    procedure OAClientcRelationExecute(Sender: TObject);
    procedure OACompanyNewsExecute(Sender: TObject);
    procedure OAClientkRelationExecute(Sender: TObject);
    procedure PCPurchaseActionExecute(Sender: TObject);
    procedure YDpowerActionExecute(Sender: TObject);
    procedure YDPlanActionExecute(Sender: TObject);
    procedure YDPrepareActionExecute(Sender: TObject);
    procedure YDForecastPLExecute(Sender: TObject);
    procedure SLGoodsOutBActionExecute(Sender: TObject);
    procedure PCGoodsInBackExecute(Sender: TObject);
    procedure PCPurchaseBackExecute(Sender: TObject);
    procedure PCPurchsePriceExecute(Sender: TObject);
    procedure SLSaleFruitListActionExecute(Sender: TObject);
    procedure SLSalePriceExecute(Sender: TObject);
    procedure SLSaleSpecailExecute(Sender: TObject);
    procedure FNClearSLactionExecute(Sender: TObject);
    procedure FNClearPCActionExecute(Sender: TObject);
    procedure PCCotractPriceExecute(Sender: TObject);
    procedure ReportMenuItemClick(Sender: TObject);
    procedure MyReportsCustomizeActionExecute(Sender: TObject);
    procedure StockChangeExecute(Sender: TObject);
    procedure STActualStockExecute(Sender: TObject);
    procedure FNActuialCashExecute(Sender: TObject);
    procedure FNCashOutInExecute(Sender: TObject);
    procedure FNCashFlowExecute(Sender: TObject);
    procedure FNRunExpenseExecute(Sender: TObject);
    procedure FNReceiptPayableExecute(Sender: TObject);
    procedure FNReceiptPayableEExecute(Sender: TObject);
    procedure FNProfitLossExecute(Sender: TObject);
    procedure FNBalanceSheetExecute(Sender: TObject);
    procedure STGoodsOutCostExecute(Sender: TObject);
    procedure STGoodsCountOffExecute(Sender: TObject);
    procedure MSClearTestDataExecute(Sender: TObject);
    procedure SRJobsActionExecute(Sender: TObject);
    procedure SRJobsPriceExecute(Sender: TObject);
    procedure SRWorkQuantityExecute(Sender: TObject);
    procedure SRSalaryAnalyzeExecute(Sender: TObject);
    procedure PCCreditActionExecute(Sender: TObject);
    procedure SLCreditActionExecute(Sender: TObject);
    procedure YDBOMBackExecute(Sender: TObject);
    procedure YDGoodsCostExecute(Sender: TObject);
    procedure SRBaseSalaryExecute(Sender: TObject);
    procedure YDStockInWorkExecute(Sender: TObject);
    procedure YDPurchasePlanExecute(Sender: TObject);
    procedure FileSystemIniExecute(Sender: TObject);
    procedure PCPurchaseFruitActionExecute(Sender: TObject);
    procedure SRWorktimeActionExecute(Sender: TObject);
    procedure SRWorkScheduleActionExecute(Sender: TObject);
    procedure SRWorkRestActionExecute(Sender: TObject);
    procedure SLSaleClientActionExecute(Sender: TObject);
    procedure SRWorkTimeCntExecute(Sender: TObject);
    procedure SLSaleChainListExecute(Sender: TObject);
    procedure FileDataBackupExecute(Sender: TObject);
    procedure SRLeaveReptExecute(Sender: TObject);
    procedure FADepreciationExecute(Sender: TObject);
    procedure FAAssetAddActionExecute(Sender: TObject);
    procedure FAAssetReptExecute(Sender: TObject);
    procedure FAAssetReduceExecute(Sender: TObject);
    procedure FAAssetRepairExecute(Sender: TObject);
    procedure FAAssetRePlanExecute(Sender: TObject);
    procedure FAAssetChangeExecute(Sender: TObject);
    procedure FAAssetPlanReptExecute(Sender: TObject);
    procedure YDDailyReportExecute(Sender: TObject);
    procedure YDStatisticReportExecute(Sender: TObject);
    procedure FNAccountAgeActionExecute(Sender: TObject);
    procedure SLSaleForecastExecute(Sender: TObject);
    procedure SLSaleStatisticExecute(Sender: TObject);
    procedure PCpurchaseStatisticExecute(Sender: TObject);
    procedure PCPurchaseForecastExecute(Sender: TObject);
    procedure FileDataRestoreExecute(Sender: TObject);
    procedure FileShowHelpDocExecute(Sender: TObject);
    procedure FilePasswordChangeActionExecute(Sender: TObject);
    procedure DAMaterialClassActionExecute(Sender: TObject);
    procedure DAMaterialActionExecute(Sender: TObject);
    procedure DAProjectActionExecute(Sender: TObject);
    procedure EGMaterialInActionExecute(Sender: TObject);
    procedure EGMaterialOutActionExecute(Sender: TObject);
    procedure EGMaterialInSTTActionExecute(Sender: TObject);
    procedure EGMaterialOutSTTActionExecute(Sender: TObject);
    procedure FileClearBusDataExecute(Sender: TObject);
    procedure EGMaterialBalanceExecute(Sender: TObject);
    procedure EGMaterialChangeActExecute(Sender: TObject);
    procedure EGProjectExpenseActionExecute(Sender: TObject);
    procedure EGProExpenseActionExecute(Sender: TObject);
    procedure EGProjectCostActionExecute(Sender: TObject);
    procedure DAProjectClassActExecute(Sender: TObject);
    procedure FNCredenceActionExecute(Sender: TObject);
  private
    { Private declarations }
    FOutlookBar: TOutlookBar;
    //设置OutlookBar页面
    procedure SetOutlookBarPage;
    procedure OutlookBarItemClick(Sender: TObject; AItem: TOutlookBarItem);
    procedure OutlookBarPageChange(Sender: TObject);
    procedure OutlookBarMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DoEnterAsTab(var Msg: TMsg; var Handled: Boolean);
    procedure MyReportMenuItemClick(Sender: TObject);
    procedure RebuildReportMenu;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

uses WSUtils,  MSBrCurrency, MSOption,
  WSSecurity, CommonDM, DABrAreas, MSBrDepartment,   DABrClient, DABrGoods, DAAttributeBr, FNBrAccounts, DABrAccountCode,
  MSBrLogin,
  DABrGoodsClasses, MSBrPostion, DAAttributeEdit, About,
  MSBrUnits, DABrExpenseClass,
  DABrPOClear, SLBrSalePrice,

  {hcw:} DABrClientkRelation, DABrClientcRelation,
  SLBrCredit, DABillType, PCBrCredit,
  MSPermissions, MSPeriod,
  MSBrPostionClass, MSBrRoles, DABrLinkMenIDCard,
  PCBrContract, SLBrContract, OABrJobRecords, OABrJobRecordsMng,
  OABrJobArrange, SLBrSaleGift, FNBrExpense, STBrCountOff,
  DABrmanufacturer,
  OABrCompanyNews, YDBrPW, YDBrProductPlan, YDBrBalanceOf,
  YDBrExpressBalance, SLBrSaleS,FNBrClearSL,
  SLBrSaleB, SLBrOrder, SLBrGoodsOut,
  PCBrContractPrice, PCBrPurchasePrice, SLBrDiscount, RpCustomize,
  SLBrGoodsOutB, PCBrOrder, PCBrPurchase, PCBrPurchaseB, PCBrGoodsIn,
  FNBrClearPC, PCBrGoodsInB, SLBrContractPrice, STStockChange, FNBrCashIn,
  FNBrCashOut, YDBrGoodsIn, YDBrGoodsOut, FNBrCashOutIn,
  STBrGoodsOutIn, FNActualCash, FNCashFlow, FNExpenseRep,
  FNReceiptPayable, FNReceiptPayableE, FNProfitLoss, FNBalanceSheet,
  SLBrSale, STBrGoodsCountOff, STBrGoodsOutCost, SRBrJobPrice,
  SRBrWorkQuantity, SRBrBaseSalary, YDBrFormula, YDBrPurchasePlan,
  YDBOMBack, YDStockInWork, SLSaleFruitList, PCPurchaseFruitList,
  SRBrWorkTime, SRBrWorkSchedule, SREdWorkRest, SRBrWorkRest,
  SLBrSaleClient, SRBrWorkTimeCnt, SLSaleChainList, SRSalaryAnalyze,
  FABrAssetAdd, FABrDepreciation, FNAssetRept, MSBrEmployee,
  FABrAssetReduce, FABrAssetRepair, FABrAssetRePlan, FAAssetChange,
  FAAssetPlanRept, YDDailyReport, YDStatisticReport, MSBrUserNew, SRBrJobs,
  FNAccountAge, SLSaleForeCast, SLSaleStatistic, PCPurchaseStatistic,
  PCPurchaseForeCast ,MSDataRestore, MSEdUserPassWord,
  DAMaterialClassBrowse, DAMaterialBrowse, DAProjectBrowse, EGBrMaterialIn,
  EGBrMaterialOut, EGMaterialInStatistic, EGMaterialOutStatistic,
  EGBrExpense, EGMaterialBalance, EGExpenseStatistic,EGProjectCostSTT,
  DABrWarehouse, STActualStock, DABrProject, DABrProjectClass,
  EGMaterialChange, EGExpenseStatisticEgm, DASubject, FNBrCredence,
  FNExpenseSttc;

procedure TMainForm.DoEnterAsTab(var Msg: TMsg; var Handled: Boolean);
{在整个程序中,
Enter键使用作Tab键
//胡建平}
begin
  if Msg.Message = WM_KEYDOWN then
  begin
    if Msg.wParam = VK_RETURN then
      Keybd_event(VK_TAB, 0, 0, 0);
  end;
end;

//设置OutlookBar页面

procedure TMainForm.SetOutlookBarPage;
  function FindPage(const PageName: string): TOutlookBarPage;
  var
    I: Integer;
  begin
    for I := 0 to FOutlookBar.Pages.Count - 1 do
      if SameText(FOutlookBar.Pages[I].Caption, PageName) then
      begin
        Result := FOutlookBar.Pages[I];
        Exit;
      end;
    Result := nil;
  end;
var
  I: Integer;
  Page: TOutlookBarPage;
begin
  FOutlookBar := TOutlookBar.Create(Self);
  with FOutLookBar do
  begin
    Parent := pnlLeft;
    Align := alClient;
    Flat := True;
   // Color:=$00555555;
    ShowHint := true;
    Hint := '单击鼠标右键切换图标大小';
    Font.Charset := GB2312_CHARSET;
    Font.Color := clBlack;
    Font.Height := -12;
    Font.Name := '宋体';
    Font.Style := [];

    LargeImages := LargeImageList;
    SmallImages := SmallImageList;
    OnItemClick := OutlookBarItemClick;
    OnPageChange := OutlookBarPageChange;
    OnMouseDown := OutlookBarMouseDown;
    for I := 0 to ActionList.ActionCount - 1 do
      if ActionList[I].Tag and 1 = 1 then //tActionList.Tag>0则加入到OutlookBar页中
      begin
        Page := FindPage(ActionList[I].Category);
        if Page = nil then
        begin
          Page := Pages.Add;
          Page.Caption := ActionList[I].Category;
          // 下面一句用来控制某一页显示为小图标,请根据情况使用
          // if Page.Caption = ? then Page.IconStyle := isSmall;
          Page.IconStyle := isSmall;
//          if Page.Caption = '销售管理' then Page.IconStyle := isSmall;
        end;
        with Page.Items.Insert(nil, Page.Items.Count) do
        begin
          if ActionList[I] is TCustomAction then
          begin
            ImageIndex := TCustomAction(ActionList[I]).ImageIndex;
            Caption := TCustomAction(ActionList[I]).Caption;
          end;
          Data := ActionList.Actions[I];
        end;
      end;
  end;
end;

procedure TMainForm.OutlookBarMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
//单击鼠标右键切换图标大小
//胡建平
//2002-11-09
  if Button = mbRight then
  begin
    if (Sender as TOutlookBar).Pages[(Sender as TOutlookBar).PageIndex].IconStyle = isSmall then
      (Sender as TOutlookBar).Pages[(Sender as TOutlookBar).PageIndex].IconStyle := isLarge
    else
      (Sender as TOutlookBar).Pages[(Sender as TOutlookBar).PageIndex].IconStyle := isSmall;
  end;
  FOutlookBar.Refresh;
end;

procedure TMainForm.OutlookBarPageChange(Sender: TObject);
//胡建平
//2002-11-09
var
  vPage: string;
begin
  try
    vPage := (Sender as TOutlookBar).Pages[(Sender as TOutlookBar).PageIndex].Caption;
    NavigateExecute(vPage);
  except
  end;
end;

procedure TMainForm.OutlookBarItemClick(Sender: TObject;
  AItem: TOutlookBarItem);
begin
  if (Guarder.UserName = '系统管理员') then
    TBasicAction(AItem.Data).Execute
  else if Guarder.HasRight(AItem.Caption) then
    TBasicAction(AItem.Data).Execute
  else showmessage('你没有此功能权限,无法使用此功能!请与系统管理员联系!');
end;


procedure TMainForm.FormCreate(Sender: TObject);
begin
  SetOutlookBarPage;
  Application.OnMessage := DoEnterAsTab;
  RebuildReportMenu;
end;

procedure TMainForm.MSPeriodActionExecute(Sender: TObject);
begin
//管理期间
  PeriodDlg;
end;

procedure TMainForm.MSPermissionsActionExecute(Sender: TObject);
begin
//权限登记
  ManagePermissionsDlg;
end;

procedure TMainForm.MSloginActionExecute(Sender: TObject);
begin
  //登陆管理
  FindShowForm(TMSBrLoginForm, '');
end;

procedure TMainForm.FormShow(Sender: TObject);
var year,month,day :word;
    Datestr :string;
begin
//  Application.Title :=Application.Title
{$IFDEF NICE}
  Caption :=' '+Trim(Guarder.CompanyUserName)+
      ' (ERP)     操作员:'+Guarder.UserName;
{$ELSE}
  Caption := '';
{$ENDIF}
  with FindShowForm(TNavigatorForm, '') do
  begin
    Top := 0;
    Left := 0;
    Width := 640;
    Height := 480;
  end;
  if pos('东莞市益农饲料有限公司',GetCompanyName)<=0 then
  begin
    showmessage(' 产品没有授权,不能使用,请与供应商联系!');
    Application.Terminate;
  end;

  DecodeDate(Date-31,year, month, day);
  DateStr :=Datetostr(Date);
  if (pos('-',Datetostr(Date))<=4) then
     showmessage('本系统要求日期格式:"yyyy-mm-dd"; 而当前格式:"'
         +DateStr+'" '+#13+#13
         +',请在"开始->设置->控制面板->区域选项->日期" 中修改格式。');
  with UseTest do
  begin
    close;
    sql.Text :=' select top 1 * from MSPeriod ';
    open;
    if UseTest.IsEmpty then
    begin
      close;
      if month<10 then sql.Text :=' insert into  MSPeriod ( Name,RECORDSTATE)'+
         ' VALUES ( '+Quotedstr(inttostr(year)+'-0'+inttostr(month))+' , '+QUOTEDSTR('删除')+ ' )'
         else  sql.Text :=' insert into  MSPeriod ( Name)'+
         ' VALUES ( '+Quotedstr(inttostr(year)+'-'+inttostr(month))+' , '+QUOTEDSTR('删除')+' )';
      ExecSql;
    end;
    close;
  end;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  aqrTemp: TADOQuery;
begin
  aqrTemp := TADOQuery.Create(nil);
  with aqrTemp do
  begin
    Connection := CommonData.acnConnection;
    Close;
    sql.Text := 'update MSlogin set LogoutTime=getDate() ' +
      ' where LoginTime=(select max(LoginTime) from MSlogin where UserID=' + inttostr(Guarder.UserID) +
      ') and UserID=' + inttostr(Guarder.UserID);
    ExecSql;
  end;
end;

procedure TMainForm.FileExitActionExecute(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.FileLogonActionExecute(Sender: TObject);
begin
  Guarder.Close;
  Guarder.Open;
  self.Caption :='  '+Trim(Guarder.CompanyUserName)+
      ' 管理系统(ERP)     操作员:'+Guarder.UserName;
end;

procedure TMainForm.MSUserActionExecute(Sender: TObject);
begin
  //用户定义
//  FindShowForm(TMSBrRolesForm, '');
  FindShowForm(TMSBrUserNewForm, '');
end;

procedure TMainForm.NavigatorActionExecute(Sender: TObject);
begin
  //导航
  FindShowForm(TNavigatorForm, '');
end;

procedure TMainForm.btnOutlookBarClick(Sender: TObject);
begin
  VertSplitter.Visible := btnOutlookBar.Down;
  pnlLeft.Visible := btnOutlookBar.Down;
end;

procedure TMainForm.SpeedButton3Click(Sender: TObject);
begin
  btnOutlookBar.Down := false;
  VertSplitter.Visible := btnOutlookBar.Down;
  pnlLeft.Visible := btnOutlookBar.Down;
end;

procedure TMainForm.HelpAboutActionExecute(Sender: TObject);
begin
//关于
  ShowAbout;
end;

procedure TMainForm.SLContractActionExecute(Sender: TObject);
begin
//销售合同
  FindShowForm(TSLBrContractForm, '');
end;

procedure TMainForm.SLSaleActionExecute(Sender: TObject);
begin
  //销售开单
  FindShowForm(TSLBrSaleForm, '');
end;

procedure TMainForm.SLSaleBackActionExecute(Sender: TObject);
begin
  //销售退货
  FindShowForm(TSLBrSaleBForm, '');
end;

procedure TMainForm.SLGoodsOutActionExecute(Sender: TObject);
begin
//销售出库
  FindShowForm(TSLBrGoodsOutForm, '');
end;

procedure TMainForm.SLOrderActionExecute(Sender: TObject);
begin
//销售订单
  FindShowForm(TSLBrOrderForm, '');
end;

procedure TMainForm.SLClearActionExecute(Sender: TObject);
begin
//销售结算
//  FindShowForm(TSLBrClearBillForm, '');   FNBrClearForm: ;
end;

procedure TMainForm.DAClientActionExecute(Sender: TObject);
begin
//客户资料
  findshowform(TDAClientBrowseForm, '');
end;

procedure TMainForm.DAGoodsActionExecute(Sender: TObject);
begin
//商品资料
  findshowform(TDAGoodsBrowseForm, '');
end;

procedure TMainForm.DASTWarehouseExecute(Sender: TObject);
begin
//仓库资料
  findshowform(TDABrWarehouseForm, '');
end;

⌨️ 快捷键说明

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