📄 main.pas
字号:
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 + -