main.pas

详细的ERP设计资料

    procedure PCPurchsePriceExecute(Sender: TObject);
    procedure SLSaleFruitListActExecute(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 STStockChangeExecute(Sender: TObject);
    procedure STStockStatisticsActExecute(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 FNProfitLossActExecute(Sender: TObject);
    procedure FNBalanceSheetExecute(Sender: TObject);
    procedure STPCGoodsInCostActExecute(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 YDBOMBackActionExecute(Sender: TObject);
    procedure YDGoodsCostExecute(Sender: TObject);
    procedure SRBaseSalaryExecute(Sender: TObject);
    procedure YDStockInWorkActExecute(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 YDDailyReportActExecute(Sender: TObject);
    procedure YDStatisticReportExecute(Sender: TObject);
    procedure FNAccountAgeActExecute(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 DAProjectActionExecute(Sender: TObject);
    procedure EGMaterialOutActionExecute(Sender: TObject);
    procedure FileClearBusDataExecute(Sender: TObject);
    procedure EGFNClearEGActionExecute(Sender: TObject);
    procedure EGProjectCostSttActExecute(Sender: TObject);
    procedure DAProjectClassActExecute(Sender: TObject);
    procedure FNCredenceActionExecute(Sender: TObject);
    procedure PayableAccountActExecute(Sender: TObject);
    procedure FNSubjectDetailsCollectActionExecute(Sender: TObject);
    procedure FNCustomizeReportActionExecute(Sender: TObject);
    procedure FNSubjectCollectActionExecute(Sender: TObject);
    procedure FNSubjectDetailsReportActionExecute(Sender: TObject);
    procedure STYDGoodsOutCostActExecute(Sender: TObject);
    procedure STYDGoodsInCostActExecute(Sender: TObject);
    procedure STSLGoodsOutCostActExecute(Sender: TObject);
    procedure STNewStockRepActExecute(Sender: TObject);
    procedure FashionSaleActionExecute(Sender: TObject);
    procedure FashionPurchaseAtcExecute(Sender: TObject);
    procedure FashionRemoveActExecute(Sender: TObject);
    procedure FashionCountOffActExecute(Sender: TObject);
    procedure FashionSaleSttActExecute(Sender: TObject);
    procedure FashionPurchaseSttActExecute(Sender: TObject);
    procedure FashionStockActExecute(Sender: TObject);
    procedure FileBaseDataFDSExecute(Sender: TObject);
    procedure FileBaseDataClothExecute(Sender: TObject);
    procedure FileBaseDataEGExecute(Sender: TObject);
    procedure SLSaleDsctActionExecute(Sender: TObject);
    procedure FNCashExchangeActExecute(Sender: TObject);
    procedure FNCashExchSttActExecute(Sender: TObject);
  private
    { Private declarations }
    FOutlookBar: TOutlookBar;

    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;
    procedure RegisterActions;
  public
    { Public declarations }
    procedure DisableMenuItems(Item: TMenuItem);
  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,

  DABrClientkRelation, DABrClientcRelation,
  SLBrCredit, DABillType, PCBrCredit,
  MSPermissions, MSPeriod,
  MSBrPostionClass, MSBrRoles, DABrLinkMenIDCard,
  PCBrContract, SLBrContract, OABrJobRecords, OABrJobRecordsMng,
  OABrJobArrange, SLBrSaleGift, FNBrExpense,
  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,  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,
  SLSaleForeCast, SLSaleStatistic, PCPurchaseStatistic,
  PCPurchaseForeCast ,MSDataRestore, MSEdUserPassWord,
  DAProjectBrowse, EGExpenseStatistic,
  DABrWarehouse, DABrProject, DABrProjectClass,
  DASubject, FNBrCredence,
  FNExpenseSttc, FNAccountAgePC, FNAccountAgeSL, FNRptSubjectCollect,
  FNRptSubjectDetailCollect, FNRptCustomize, FNRptSubjectDetails,
  STBrPCGoodsInCost, FNBrVouchTran, STActualStock, STNewStockRep,
  STBrSLGoodsOutCost, STBrYDGoodsInCost, EGBrGoodsOut, FNBrClearEG,
  EGProjectStatistic, SLBrSaleCloth, PCBrPurchaseCloth, STBrClothOutIn,
  STBRClothCountOff, SLSaleClothStatistic, PCPurchaseClothStatistic,
  STClothStockRep, STBrYDGoodsOutCost, SLBrSaleDsct, FNBrCashExchange,
  FNCashExchStatistic;

procedure TMainForm.DoEnterAsTab(var Msg: TMsg; var Handled: Boolean);
begin
  if Msg.Message = WM_KEYDOWN then
  begin
    if Msg.wParam = VK_RETURN then
      Keybd_event(VK_TAB, 0, 0, 0);
  end;
end;



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;
    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
      begin
        Page := FindPage(ActionList[I].Category);
        if Page = nil then
        begin
          Page := Pages.Add;
          Page.Caption := ActionList[I].Category;
           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
 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);
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
    TBasicAction(AItem.Data).Execute

end;


procedure TMainForm.FormCreate(Sender: TObject);
begin
  RegisterActions;

  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

{$IFDEF NICE}
  Caption :='  '+Trim(Guarder.CompanyUserName)+
      ' 操作员:'+Guarder.UserName;
{$ELSE}
  Caption := '企业智能管理系统(ERP)';
{$ENDIF}
  with FindShowForm(TNavigatorForm, '') do
  begin
    Top := 0;
    Left := 0;
    Width := 640;
    Height := 480;
  end;
  if pos('',GetCompanyName)<=0 then
  begin
    showmessage(' 产品没有授权,请与供应商联系!'+
    #13+#13+'     专家：');
    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;
  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)+
      '  操作员:'+Guarder.UserName;
  MainForm.DisableMenuItems(MainForm.MainMenu.Items);
end;

procedure TMainForm.MSUserActionExecute(Sender: TObject);
begin

  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.SLGoodsOutActExecute(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;

procedure TMainForm.DASLDiscountExecute(Sender: TObject);
begin
  FindShowForm(TSLBrDiscountForm, '');
end;

procedure TMainForm.DASLSaleGiftExecute(Sender: TObject);
begin
  FIndShowForm(TSLBrSaleGiftForm, '');
end;

procedure TMainForm.DAFNClearModeExecute(Sender: TObject);
begin
  FindShowForm(TDABrPOClearForm, '');
end;

procedure TMainForm.DAFNAccountCodeExecute(Sender: TObject);
begin
  TDASubjectForm.ShowMaintenance;
end;

procedure TMainForm.DAMSCurrencyExecute(Sender: TObject);
begin
  FindShowForm(TMSBrCurrencyForm, '');
end;

procedure TMainForm.DAFNExpenseExecute(Sender: TObject);
begin
  findshowForm(TDABrExpenseClassForm, '')
end;

procedure TMainForm.DAFNAccountsExecute(Sender: TObject);
begin
  FindShowForm(TFNBrAccountsForm, '');
end;

procedure TMainForm.MSUnitsActionExecute(Sender: TObject);
begin
  FindShowForm(TMSBrUnitForm, '');
end;

procedure TMainForm.MSCompanyUserActionExecute(Sender: TObject);
begin
  Application.CreateForm(TMSOptionForm, MSOptionForm);
  MSOptionForm.ShowModal;
  self.Caption :=''+Trim(Guarder.CompanyUserName)+
      '操作员:'+Guarder.UserName;
end;

procedure TMainForm.MSDepartmentActionExecute(Sender: TObject);
begin
  FindShowForm(TMSDepartmentBrowseForm, '');
end;