1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045 |
- unit MainFrm;
- interface
- uses
- // Uses Units Please Try This Category
- // View
- ProjectManagerFme, ProjectFme, ProjectPropertiesFrm, OptionFrm, AboutFrm,
- AuthFrm,
- // Model & Data & Data Control ...
- ProjectData, SupportUnit, Globals, ZhAPI, ExcelImport, ConditionalDefines,
- // Controls & Delphi Default ... (Almost By Add Controls)
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, cxGraphics, JimPages, ComCtrls, dxStatusBar, cxControls, JimTabs,
- dxBar, ImgList, UtilMethods, ZjDbaActns, ActnList, XPStyleActnCtrls, ActnMan,
- dxBarExtItems, sdDB, ExtCtrls, jpeg, StdCtrls, CslLabel, pngimage;
- type
- TMainForm = class(TForm)
- dxBarManager: TdxBarManager;
- Images: TImageList;
- dxsiFile: TdxBarSubItem;
- jtsProjects: TJimTabSet;
- dxStatusBar: TdxStatusBar;
- dxStatusBarContainer2: TdxStatusBarContainerControl;
- ProgressBar: TProgressBar;
- jpsMain: TJimPages;
- jpsMainProjectsManager: TJimPage;
- jpsMainProjects: TJimPage;
- jpsProjects: TJimPages;
- dxsiEdit: TdxBarSubItem;
- dxsiHelp: TdxBarSubItem;
- dxbtnCopy: TdxBarButton;
- dxbtnPaste: TdxBarButton;
- dxbtnCut: TdxBarButton;
- dxbtnInsert: TdxBarButton;
- dxbtnDelete: TdxBarButton;
- dxbtnUpMove: TdxBarButton;
- dxbtnDownMove: TdxBarButton;
- dxbtnUpLevel: TdxBarButton;
- dxbtnDownLevel: TdxBarButton;
- dxbtnAuthorizeDog: TdxBarButton;
- dxbtnAbout: TdxBarButton;
- dxbtnNewProject: TdxBarButton;
- dxbtnOpenProject: TdxBarButton;
- dxbtnDeleteProject: TdxBarButton;
- ActionManager1: TActionManager;
- ZjDbaInsert: TZjDbaInsert;
- ZjDbaDelete: TZjDbaDelete;
- ZjDbaUpMove: TZjDbaUpMove;
- ZjDbaDownMove: TZjDbaDownMove;
- ZjTreeDbaUpLevel: TZjTreeDbaUpLevel;
- ZjTreeDbaDownLevel: TZjTreeDbaDownLevel;
- ZjGridCopy: TZjGridCopy;
- ZjGridPaste: TZjGridPaste;
- ZjGridCut: TZjGridCut;
- ZjGridRemapedPaste: TZjGridRemapedPaste;
- dxpmTabSet: TdxBarPopupMenu;
- dxbtnCloseProject: TdxBarButton;
- actnCloseProject: TAction;
- dxbtnNewPhase: TdxBarButton;
- dxbtnCalculateLedger: TdxBarButton;
- actnNewPhase: TAction;
- dxbtnProjectProperties: TdxBarButton;
- actnProjectProperties: TAction;
- dxbtnSaveProject: TdxBarButton;
- actnSaveProject: TAction;
- dxbtnRemapedPaste: TdxBarButton;
- dxbtnImportExcel: TdxBarButton;
- actnImportExcel: TAction;
- dxbtnNewAudit: TdxBarButton;
- dxbtnCopyBillsBlock: TdxBarButton;
- actnNewAudit: TAction;
- dxbtnFinalAudit: TdxBarButton;
- dxbtnSubmitProject: TdxBarButton;
- dxbtnReceiveProject: TdxBarButton;
- dxbtnReplyProject: TdxBarButton;
- dxbtnAcceptProject: TdxBarButton;
- dxbtnCalculateAll: TdxBarButton;
- dxbtnNewSubProject: TdxBarButton;
- dxbtnNewTender: TdxBarButton;
- dxbtnOptions: TdxBarButton;
- actnOptions: TAction;
- dxbtnCalculatePhasePay: TdxBarButton;
- actnSubmit: TAction;
- actnReply: TAction;
- dxbtnSubmit: TdxBarButton;
- dxbtnReply: TdxBarButton;
- dxbtnFirstLevel: TdxBarButton;
- dxbtnSecondLevel: TdxBarButton;
- dxbtnThirdLevel: TdxBarButton;
- dxbtnFourthLevel: TdxBarButton;
- dxbtnFifthLevel: TdxBarButton;
- dxbtnAllLevel: TdxBarButton;
- dxbtnAllXmj: TdxBarButton;
- dxbtnExportGridToExcel: TdxBarButton;
- dxbtnRefresh: TdxBarButton;
- dxbtnUnlockInfo: TdxBarButton;
- actnUnlockInfo: TAction;
- dxUser: TdxBarSubItem;
- pnlUser: TPanel;
- lblAccount: TLabel;
- lblCompany: TLabel;
- lblRole: TLabel;
- dxLoginCloud: TdxBarButton;
- dxManageAccount: TdxBarButton;
- pnl1: TPanel;
- imgUserImage: TImage;
- lblMail: TLabel;
- dxUserContainer: TdxBarControlContainerItem;
- dxbtnBatchAddChild: TdxBarButton;
- dxbtnBatchAddNext: TdxBarButton;
- dxbtnReorderChildrenCode: TdxBarButton;
- dxbtnImportBillsPrice: TdxBarButton;
- dxsiImportExcel: TdxBarSubItem;
- dxbtnImportDealBills: TdxBarButton;
- actnImportBillsPrice: TAction;
- actnImportDealBills: TAction;
- dxbtnBatchReplaceBillsInfo: TdxBarButton;
- tAutoSave: TTimer;
- dxsiExportExcel: TdxBarSubItem;
- dxbtnExportExcel: TdxBarButton;
- actnExportExcel: TAction;
- dxbtnCurPhase: TdxBarButton;
- dxSync: TdxBarButton;
- dxbtnBatchWritePos_Reason: TdxBarButton;
- dxbtnExportCloudTenderFile: TdxBarButton;
- actnExportCloudTenderFile: TAction;
- dxtbnImportCloudTenderFile: TdxBarButton;
- actnImportCloudTenderFile: TAction;
- dxbtnCheckAndClear: TdxBarButton;
- dxbtnModifyDealBills: TdxBarButton;
- dxbtnLocateBills: TdxBarButton;
- dxbtnOpenBackupFolder: TdxBarButton;
- dxbtnSetBookmark: TdxBarButton;
- dxbtnExportFxBillsExcel: TdxBarButton;
- actnExportFxBillsExcel: TAction;
- dxseBatchInsert: TdxBarSpinEdit;
- actnBatchInsert: TAction;
- dxbtnRename: TdxBarButton;
- dxbtnImportGclBillsToXmj: TdxBarButton;
- dxbtnChangeDealBillsMode: TdxBarButton;
- dxsiExpandTo: TdxBarSubItem;
- dxbtnLocateBookmark: TdxBarButton;
- dxbtnImportPlaneFxBillsToXmj: TdxBarButton;
- dxbtnAllPeg: TdxBarButton;
- dxsiData: TdxBarSubItem;
- dxbtnTenderPartition: TdxBarButton;
- dxbtnSetDealPayPlan: TdxBarButton;
- dxbtnAddDetailGLs: TdxBarButton;
- dxbtnCopyDetailGls: TdxBarButton;
- dxbtnApplyToSameBills: TdxBarButton;
- dxbtnCalculatePriceMargin: TdxBarButton;
- dxbtnFxZJJL: TdxBarButton;
- dxbtnGclZJJL: TdxBarButton;
- dxbtnInsertCol: TdxBarButton;
- dxbtnHidden: TdxBarButton;
- dxbtnCancelHidden: TdxBarButton;
- dxbtnImportDmf: TdxBarButton;
- actnImportDmf: TAction;
- dxbtnCanCalc: TdxBarButton;
- dxbtnWithoutCalcCurPay: TdxBarButton;
- dxbtnSignOnline: TdxBarButton;
- dxbtnExportTpExcel: TdxBarButton;
- dxbtnHelpCenter: TdxBarButton;
- dxbtnLocateMeasureBills: TdxBarButton;
- dxbtnGuest: TdxBarButton;
- dxbtnLocateZJJL: TdxBarButton;
- dxbtnEpure: TdxBarButton;
- dxbtnLocateCompileBills: TdxBarButton;
- dxbtnGclGatherZJJL: TdxBarButton;
- dxbtnExportSumBaseFile: TdxBarButton;
- actnExportSumBaseFile: TAction;
- dxbtnGatherSubTender: TdxBarButton;
- dxbtnExportTenderError: TdxBarButton;
- dxbtnExportAllError: TdxBarButton;
- dxbtnExportStgResultExcel: TdxBarButton;
- dxbtnExportStgResult: TdxBarButton;
- dxbtnImportSubTenderGather: TdxBarButton;
- actnImportSubTenderGather: TAction;
- dxbtnExportBillsJson: TdxBarButton;
- actnExportBillsJson: TAction;
- dxbtnExportBillsPosExcelData: TdxBarButton;
- actnExportBillsPosExcelData: TAction;
- dxbtnDeleteRow: TdxBarButton;
- dxbtnInsertRow: TdxBarButton;
- dxsiGatherSub: TdxBarSubItem;
- dxbtnGatherSubTenderGcl: TdxBarButton;
- dxsiImportSubTenderGather: TdxBarSubItem;
- dxbtnImportSubTenderGatherGcl: TdxBarButton;
- actnImportSubTenderGatherGcl: TAction;
- actnImportSubTenderGatherGclExcel: TAction;
- dxbtnImportSubTenderGatherExcel: TdxBarButton;
- dxbtnExportStdJson: TdxBarButton;
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure jtsProjectsChange(Sender: TObject; NewTab: Integer;
- var AllowChange: Boolean);
- procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- procedure jtsProjectsMouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure actnCloseProjectExecute(Sender: TObject);
- procedure actnCloseProjectUpdate(Sender: TObject);
- procedure actnNewPhaseExecute(Sender: TObject);
- procedure actnProjectPropertiesUpdate(Sender: TObject);
- procedure actnProjectPropertiesExecute(Sender: TObject);
- procedure actnSaveProjectExecute(Sender: TObject);
- procedure actnNewAuditExecute(Sender: TObject);
- procedure actnNewPhaseUpdate(Sender: TObject);
- procedure actnOptionsExecute(Sender: TObject);
- procedure actnImportExcelExecute(Sender: TObject);
- procedure actnReplyExecute(Sender: TObject);
- procedure actnSubmitExecute(Sender: TObject);
- procedure dxBarManagerShowToolbarsPopup(Sender: TdxBarManager;
- PopupItemLinks: TdxBarItemLinks);
- procedure actnSubmitUpdate(Sender: TObject);
- procedure actnImportExcelUpdate(Sender: TObject);
- procedure actnUnlockInfoUpdate(Sender: TObject);
- procedure actnUnlockInfoExecute(Sender: TObject);
- procedure dxbtnAboutClick(Sender: TObject);
- procedure dxLoginCloudClick(Sender: TObject);
- procedure dxManageAccountClick(Sender: TObject);
- procedure dxbtnAuthorizeDogClick(Sender: TObject);
- procedure actnImportBillsPriceExecute(Sender: TObject);
- procedure actnImportDealBillsExecute(Sender: TObject);
- procedure tAutoSaveTimer(Sender: TObject);
- procedure actnExportExcelExecute(Sender: TObject);
- procedure dxSyncClick(Sender: TObject);
- procedure actnExportCloudTenderFileExecute(Sender: TObject);
- procedure actnExportCloudTenderFileUpdate(Sender: TObject);
- procedure actnImportCloudTenderFileExecute(Sender: TObject);
- procedure actnImportCloudTenderFileUpdate(Sender: TObject);
- procedure actnExportFxBillsExcelExecute(Sender: TObject);
- procedure dxseBatchInsertKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- procedure actnReplyUpdate(Sender: TObject);
- procedure dxbtnTenderPartitionClick(Sender: TObject);
- procedure actnImportDmfExecute(Sender: TObject);
- procedure dxbtnHelpCenterClick(Sender: TObject);
- procedure actnExportSumBaseFileExecute(Sender: TObject);
- procedure dxbtnGatherSubTenderClick(Sender: TObject);
- procedure actnImportSubTenderGatherExecute(Sender: TObject);
- procedure actnImportSubTenderGatherUpdate(Sender: TObject);
- procedure actnExportBillsJsonExecute(Sender: TObject);
- procedure actnExportBillsJsonUpdate(Sender: TObject);
- procedure actnExportBillsPosExcelDataExecute(Sender: TObject);
- procedure dxbtnGatherSubTenderGclClick(Sender: TObject);
- procedure actnImportSubTenderGatherGclExecute(Sender: TObject);
- procedure actnImportSubTenderGatherGclExcelExecute(Sender: TObject);
- private
- FProjectManagerFrame: TProjectManagerFrame;
- FProjectFrames: TList;
- procedure UpdateProgressBar(APosition: Integer);
- procedure UpdateProgressHint(const AHint: string);
- function CreateProjectView(ARec: TsdDataRecord): TProjectFrame;
- procedure LocateProjectView(AIndex: Integer);
- procedure DeleteProjectView(AIndex: Integer);
- procedure ResetProcessView(AIndex: Integer);
- procedure ChangeLeftSideGlobalView(AIndex: Integer);
- function GetCurProjectFrame: TProjectFrame;
- procedure OnError(ASender: TObject; AE: Exception);
- procedure ResetAutoSave;
- public
- procedure UpdateProgress(APos: Integer; const AHint: string);
- procedure LocateProject(AProjectID: Integer);
- function HasOpened(AProjectID: Integer): Boolean;
- function OpenProject(ARec: TsdDataRecord): TProjectFrame;
- property CurProjectFrame: TProjectFrame read GetCurProjectFrame;
- property ProjectManagerFrame: TProjectManagerFrame read FProjectManagerFrame;
- end;
- var
- MainForm: TMainForm;
- implementation
- uses
- ProjectProperty, ConstUnit, PHPWebDm, Math, ShellAPI,
- FindUserFrm, ImportExcelHintFrm, ConfigDoc, ExportExcel,
- ProjectCommands, BillsCompileDm, tpMainFrm,
- DealBillsExcelImport, ExcelImport_Bills, DetailExcelImport,
- stgGatherControl, stgSelectFileFrm, stgGclGatherControl, stgGclSelectFileFrm;
- {$R *.dfm}
- {$R MeasureIcons.RES}
- procedure TMainForm.FormCreate(Sender: TObject);
- procedure CreateProjectManagerFrame;
- begin
- FProjectManagerFrame := TProjectManagerFrame.Create(nil);
- AlignControl(FProjectManagerFrame, jpsMainProjectsManager, alClient);
- end;
- procedure SetHintFont;
- begin
- if G_IsCloud then
- begin
- Screen.HintFont.Size := 11;
- Screen.HintFont.Name := 'Microsoft YaHei';
- end
- else
- begin
- Screen.HintFont.Name := 'SmartSimSun';
- Screen.HintFont.Size := 9;
- end;
- end;
- function GetSoftName: string;
- begin
- if _ModuleType = mtCompile then
- Result := '纵横公路工程0号台账软件'
- else if _ModuleType = mtAll then
- Result := '纵横公路工程结算决算计量一体化软件';
- end;
- function GetVersionName: string;
- begin
- Result := '';
- if _IsGuangDong then
- Result := Result + '广东';
- if _ModuleType = mtAll then
- begin
- if _IsDebugView then
- Result := 'Debug'
- else if G_IsTest then
- Result := '测试'
- else if G_IsCloud then
- Result := Result + '云'
- else if _IsEncrypt then
- Result := Result + '专业'
- else
- Result := Result + '学习';
- end;
- if Result <> '' then
- Result := Result + '版';
- end;
- procedure InitialForVersions;
- var
- sPic: string;
- begin
- if G_IsCloud then
- begin
- dxbtnNewProject.Visible := ivNever;
- dxbtnNewSubProject.Visible := ivNever;
- dxbtnReceiveProject.Visible := ivNever;
- dxbtnNewPhase.Visible := ivNever;
- dxUser.Visible := ivAlways;
- dxUser.Caption := PHPWeb.RealName;
- lblAccount.Caption := PHPWeb.RealName;
- lblMail.Caption := Format('(%s)', [PHPWeb.Account]);
- if Trim(PHPWeb.Company) <> '' then
- lblCompany.Caption := PHPWeb.Company
- else
- lblCompany.Caption := '我的单位';
- if Trim(PHPWeb.Role) <> '' then
- lblRole.Caption := PHPWeb.Role
- else
- lblRole.Caption := '我的职称';
- // 每次登录都下载到本地,再从本地读入显示。以保证图片实时更新。
- sPic := PHPWeb.UserPath + '0_' + IntToStr(PHPWeb.UserID) + '.jpg';
- if PHPWeb.DownFile(PHPWeb.UserImageURL, sPic) then
- if FileExists(sPic) then
- imgUserImage.Picture.LoadFromFile(sPic);
- end
- else
- begin
- dxUser.Visible := ivNever;
- dxbtnReceiveProject.Visible := ivAlways;
- end;
- MainForm.Caption := GetSoftName + GetVersionName;
- end;
- begin
- CreateProjectManagerFrame;
- FProjectFrames := TList.Create;
- InitialForVersions;
- SetHintFont;
- ResetAutoSave;
- end;
- procedure TMainForm.UpdateProgress(APos: Integer; const AHint: string);
- begin
- UpdateProgressBar(APos);
- UpdateProgressHint(AHint);
- Application.ProcessMessages;
- end;
- procedure TMainForm.UpdateProgressBar(APosition: Integer);
- begin
- if APosition < ProgressBar.Max then
- ProgressBar.Position := APosition
- else
- ProgressBar.Position := ProgressBar.Min;
- end;
- procedure TMainForm.UpdateProgressHint(const AHint: string);
- begin
- dxStatusBar.Panels[0].Text := AHint;
- end;
- procedure TMainForm.FormDestroy(Sender: TObject);
- begin
- ClearObjects(FProjectFrames);
- FProjectFrames.Free;
- FProjectManagerFrame.Free;
- if DirectoryExists(GetAppTempPath) then
- DeleteFileOrFolder(GetAppTempPath);
- end;
- function TMainForm.OpenProject(ARec: TsdDataRecord): TProjectFrame;
- begin
- if not HasOpened(ARec.ValueByName('ID').AsInteger) then
- Result := CreateProjectView(ARec)
- else
- begin
- LocateProject(ARec.ValueByName('ID').AsInteger);
- Result := CurProjectFrame;
- end;
- end;
- function TMainForm.HasOpened(AProjectID: Integer): Boolean;
- begin
- Result := OpenProjectManager.ProjectIndex(AProjectID) <> -1;
- end;
- procedure TMainForm.LocateProject(AProjectID: Integer);
- begin
- jtsProjects.TabIndex := OpenProjectManager.ProjectIndex(AProjectID) + 1;
- if jpsMain.ActivePage <> jpsMainProjects then
- jpsMain.ActivePage := jpsMainProjects;
- end;
- function TMainForm.CreateProjectView(ARec: TsdDataRecord): TProjectFrame;
- function CreateNewProjectPage: TJimPage;
- begin
- Result := TJimPage.Create(jpsProjects);
- Result.Pages := jpsProjects;
- jpsProjects.ActivePage := Result;
- end;
-
- function CreateNewProjectTab(const ATabName: string; APage: TJimPage): Integer;
- begin
- Result := jtsProjects.Tabs.AddObject(ATabName, APage);
- jtsProjects.TabIndex := Result;
- end;
- function CreateProjectFrame(AProjectData: TProjectData; APage: TJimPage): TProjectFrame;
- var
- ProjectFrame: TProjectFrame;
- begin
- //AProjectData.IsGuest := FProjectManagerFrame.IsGuest;
- ProjectFrame := TProjectFrame.Create(AProjectData);
- FProjectFrames.Add(ProjectFrame);
- ProjectFrame.Parent := APage;
- ProjectFrame.Align := alClient;
- Result := ProjectFrame;
- end;
- var
- jimPage: TJimPage;
- begin
- jpsMain.ActivePage := jpsMainProjects;
- jimPage := CreateNewProjectPage;
- CreateNewProjectTab(ARec.ValueByName('Name').AsString, jimPage);
- Result := CreateProjectFrame(OpenProjectManager.Open(ARec), jimPage);
- ProjectManager.AddOpenTenderBackup(ARec.ValueByName('ID').AsInteger);
- end;
- procedure TMainForm.jtsProjectsChange(Sender: TObject; NewTab: Integer;
- var AllowChange: Boolean);
- begin
- LocateProjectView(NewTab - 1);
- ResetProcessView(NewTab);
- end;
- procedure TMainForm.LocateProjectView(AIndex: Integer);
- begin
- if AIndex >= 0 then
- begin
- jpsMain.ActivePage := jpsMainProjects;
- jpsProjects.ActivePage := TJimPage(jtsProjects.Tabs.Objects[AIndex + 1]);
- OpenProjectManager.CurProjectIndex := AIndex;
- ChangeLeftSideGlobalView(AIndex);
- end
- else
- jpsMain.ActivePage := jpsMainProjectsManager;
- end;
- procedure TMainForm.ChangeLeftSideGlobalView(AIndex: Integer);
- begin
- if (AIndex >= 0) and (AIndex < FProjectFrames.Count) then
- TProjectFrame(FProjectFrames[AIndex]).ResetAssistantView;
- end;
- procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- begin
- try
- OpenProjectManager.SaveAll;
- except
- end;
- end;
- procedure TMainForm.jtsProjectsMouseDown(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- if (Button = mbRight) and (jtsProjects.TabIndex > 0) then
- dxpmTabSet.PopupFromCursorPos;
- end;
- procedure TMainForm.actnCloseProjectExecute(Sender: TObject);
- begin
- OpenProjectManager.CurProjectData.SaveAndCheck;
- DeleteProjectView(jtsProjects.TabIndex - 1);
- LocateProjectView(jtsProjects.TabIndex - 1);
- ResetProcessView(jtsProjects.TabIndex);
- end;
- procedure TMainForm.actnCloseProjectUpdate(Sender: TObject);
- begin
- TAction(Sender).Enabled := jtsProjects.Tabs.Count > 1;
- end;
- procedure TMainForm.DeleteProjectView(AIndex: Integer);
- begin
- TProjectFrame(FProjectFrames[AIndex]).Free;
- FProjectFrames.Delete(AIndex);
- OpenProjectManager.Delete(AIndex);
- jpsProjects.Pages.Delete(AIndex);
- jtsProjects.Tabs.Delete(AIndex + 1);
- end;
- procedure TMainForm.actnNewPhaseExecute(Sender: TObject);
- begin
- TProjectFrame(FProjectFrames[jtsProjects.TabIndex - 1]).CreateNewPhase;
- end;
- procedure TMainForm.actnProjectPropertiesUpdate(Sender: TObject);
- begin
- TAction(Sender).Enabled := jtsProjects.TabIndex > 0;
- end;
- procedure TMainForm.actnProjectPropertiesExecute(Sender: TObject);
- begin
- ModifyProjectProperties(TProjectFrame(FProjectFrames[jtsProjects.TabIndex - 1]));
- end;
- procedure TMainForm.actnSaveProjectExecute(Sender: TObject);
- begin
- OpenProjectManager.CurProjectData.SaveAndCheck;
- end;
- procedure TMainForm.actnNewAuditExecute(Sender: TObject);
- begin
- TProjectFrame(FProjectFrames[jtsProjects.TabIndex - 1]).CreateNewAudit;
- end;
- procedure TMainForm.actnNewPhaseUpdate(Sender: TObject);
- begin
- TAction(Sender).Enabled := (jtsProjects.Tabs.Count > 1) and Assigned(CurProjectFrame);
- if TAction(Sender).Enabled then
- with CurProjectFrame.ProjectData do
- TAction(Sender).Enabled := TAction(Sender).Enabled and (ProjProperties.AuditStatus = -1);
- end;
- function TMainForm.GetCurProjectFrame: TProjectFrame;
- begin
- if jtsProjects.TabIndex > 0 then
- Result := TProjectFrame(FProjectFrames[jtsProjects.TabIndex - 1])
- else
- Result := nil;
- end;
- procedure TMainForm.actnOptionsExecute(Sender: TObject);
- begin
- ModifiedOptions;
- ResetAutoSave;
- end;
- procedure TMainForm.actnImportExcelExecute(Sender: TObject);
- var
- sFileName: string;
- Importor: Tdei_CustomBills;
- bWithLevelCode, bWithoutGclBills: Boolean;
- begin
- if HintAndImportTypeSelect(bWithLevelCode, bWithoutGclBills) then
- begin
- if SelectExcelFile(sFileName) then
- begin
- Importor := Tdei_CustomBills.Create(CurProjectFrame.ProjectData);
- try
- Importor.ImportFile(sFileName, bWithLevelCode, bWithoutGclBills);
- finally
- Importor.Free;
- end;
- end;
- end;
- end;
- procedure TMainForm.ResetProcessView(AIndex: Integer);
- begin
- dxBarManager.Bars[2].Visible := AIndex > 0;
- if G_IsCloud then
- dxBarManager.Bars[2].Visible := False;
- end;
- procedure TMainForm.actnReplyExecute(Sender: TObject); // 批复
- begin
- if not CurProjectFrame.CheckCanReport then Exit;
- Screen.Cursor := crHourGlass;
- try
- CurProjectFrame.ProjectData.SaveAndCheck;
- {$O-}
- // 失败后重复一次
- if not CurProjectFrame.ProjectData.ReplyProject then
- begin
- if not CurProjectFrame.ProjectData.ReplyProject then
- ErrorMessage('批复项目失败!');
- end;
- {$O+}
- finally
- Screen.Cursor := crDefault;
- end;
- end;
- procedure TMainForm.actnSubmitExecute(Sender: TObject); // 上报
- begin
- if not CurProjectFrame.CheckCanReport then Exit;
- Screen.Cursor := crHourGlass;
- try
- CurProjectFrame.ProjectData.SaveAndCheck;
- {$O-}
- // 失败后重复一次
- if not CurProjectFrame.ProjectData.SubmitProject then
- begin
- if not CurProjectFrame.ProjectData.SubmitProject then
- ErrorMessage('上报项目失败!');
- end;
- {$O+}
- finally
- Screen.Cursor := crDefault;
- end;
- end;
- procedure TMainForm.dxBarManagerShowToolbarsPopup(Sender: TdxBarManager;
- PopupItemLinks: TdxBarItemLinks);
- begin
- // 取消菜单栏右键菜单
- PopupItemLinks.Clear;
- end;
- procedure TMainForm.actnSubmitUpdate(Sender: TObject);
- begin
- with CurProjectFrame.ProjectData do
- TAction(Sender).Enabled := (ProjProperties.PhaseCount > 0) and
- ((ProjProperties.AuditStatus >= 0) and (ProjProperties.AuditStatus < iMaxStageCount-1));
- end;
- procedure TMainForm.actnImportExcelUpdate(Sender: TObject);
- begin
- TAction(Sender).Enabled := (jtsProjects.Tabs.Count > 1) and Assigned(CurProjectFrame);
- if TAction(Sender).Enabled then
- with CurProjectFrame.ProjectData do
- TAction(Sender).Enabled := TAction(Sender).Enabled and (PhaseIndex < 1);
- end;
- procedure TMainForm.actnUnlockInfoUpdate(Sender: TObject);
- begin
- TAction(Sender).Enabled := (jtsProjects.Tabs.Count > 1) and Assigned(CurProjectFrame);
- end;
- procedure TMainForm.actnUnlockInfoExecute(Sender: TObject);
- begin
- CurProjectFrame.UnLockData;
- end;
- procedure TMainForm.dxbtnAboutClick(Sender: TObject);
- begin
- ShowAboutForm;
- end;
- procedure TMainForm.dxLoginCloudClick(Sender: TObject);
- begin
- ShellExecute(Application.Handle, nil, PChar(PHPWeb.LoginCloudURL), nil, nil, SW_SHOWNORMAL);
- end;
- procedure TMainForm.dxManageAccountClick(Sender: TObject);
- begin
- ShellExecute(Application.Handle, nil, PChar(PHPWeb.PassportURL), nil, nil, SW_SHOWNORMAL);
- end;
- procedure TMainForm.dxbtnAuthorizeDogClick(Sender: TObject);
- begin
- Authorize;
- end;
- procedure TMainForm.actnImportBillsPriceExecute(Sender: TObject);
- var
- sFileName: string;
- Importor: TBillsPriceExcelImport;
- begin
- if SelectExcelFile(sFileName) then
- begin
- Importor := TBillsPriceExcelImport.Create(CurProjectFrame.ProjectData);
- try
- Importor.ImportFile(sFileName);
- finally
- Importor.Free;
- end;
- end;
- end;
- procedure TMainForm.actnImportDealBillsExecute(Sender: TObject);
- var
- sFileName: string;
- Importor: TDealBillsExcelImport;
- begin
- if SelectExcelFile(sFileName) then
- begin
- Importor := TDealBillsExcelImport.Create(CurProjectFrame.ProjectData);
- try
- Importor.ImportFile(sFileName);
- finally
- Importor.Free;
- end;
- end;
- end;
- procedure TMainForm.tAutoSaveTimer(Sender: TObject);
- begin
- Screen.Cursor := crHourGlass;
- try
- OpenProjectManager.SaveAll;
- finally
- screen.Cursor := crDefault;
- end;
- end;
- procedure TMainForm.ResetAutoSave;
- begin
- with SupportManager.ConfigInfo do
- begin
- tAutoSave.Interval := AutoSaveInterval * 60 * 1000;
- tAutoSave.Enabled := AutoSave;
- end;
- end;
- procedure TMainForm.actnExportExcelExecute(Sender: TObject);
- var
- sFileName: string;
- Exportor: TIDTreeExcelExportor;
- begin
- if SaveExcelFile(sFileName) then
- begin
- Exportor := TIDTreeExcelExportor.Create;
- try
- if SupportManager.ConfigInfo.ExcelWithMis then
- Exportor.DefineCol(@ciLedgerWithMis, Length(ciLedgerWithMis))
- else
- Exportor.DefineCol(@ciLedger, Length(ciLedger));
- Exportor.HasLevelCode := True;
- Exportor.ExportToFile(CurProjectFrame.ProjectData.BillsCompileData.BillsCompileTree, sFileName);
- finally
- Exportor.Free;
- end;
- end;
- end;
- procedure TMainForm.dxSyncClick(Sender: TObject);
- begin
- Screen.Cursor := crHourGlass;
- try
- FProjectManagerFrame.DoBatchReceiveAllOnline;
- finally
- Screen.Cursor := crDefault;
- end;
- end;
- procedure TMainForm.actnExportCloudTenderFileExecute(Sender: TObject);
- var
- sFileName: string;
- Exportor: TTenderExport;
- Rec: TsdDataRecord;
- begin
- // 导出前先保存
- CurProjectFrame.ProjectData.SaveAndCheck;
- // 导出云版专用
- sFileName := SupportManager.ConfigInfo.OutputPath + CurProjectFrame.ProjectData.ProjectName + '.ctf';
- if SaveFile(sFileName, '.ctf') then
- begin
- if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”,是否替换?', [ExtractFileName(sFileName)])) then
- Exit;
- Screen.Cursor := crHourGlass;
- try
- Rec := ProjectManagerFrame.Rec(CurProjectFrame.ProjectData.ProjectID);
- Exportor := TTenderExport.Create(Rec, sFileName);
- try
- Exportor.Execute;
- finally
- Exportor.Free;
- end;
- finally
- Screen.Cursor := crDefault;
- end;
- end;
- end;
- procedure TMainForm.actnExportCloudTenderFileUpdate(Sender: TObject);
- begin
- // 仅打开的项目可以导出云版专用格式,且该项目没有进行计量
- TAction(Sender).Enabled := (jtsProjects.Tabs.Count > 1) and Assigned(CurProjectFrame);
- if TAction(Sender).Enabled then
- TAction(Sender).Enabled := CurProjectFrame.ProjectData.ProjProperties.PhaseCount = 0;
- end;
- procedure TMainForm.actnImportCloudTenderFileExecute(Sender: TObject);
- var
- sFileName: string;
- begin
- if SelectFile(sFileName, '.ctf') then
- begin
- CurProjectFrame.ProjectData.ImportCloudTenderFile(sFileName);
- CurProjectFrame.RefreshColumnDisplay;
- end;
- end;
- procedure TMainForm.actnImportCloudTenderFileUpdate(Sender: TObject);
- begin
- TAction(Sender).Enabled := (jtsProjects.Tabs.Count > 1) and Assigned(CurProjectFrame);
- if TAction(Sender).Enabled then
- TAction(Sender).Enabled := CurProjectFrame.ProjectData.ProjProperties.PhaseCount = 0;
- end;
- procedure TMainForm.actnExportFxBillsExcelExecute(Sender: TObject);
- var
- sFileName: string;
- Exportor: TIDTreeExcelExportor;
- begin
- if SaveExcelFile(sFileName) then
- begin
- Exportor := TIDTreeExcelExportor.Create;
- try
- if SupportManager.ConfigInfo.ExcelWithMis then
- Exportor.DefineCol(@ciFxBillsWithMis, Length(ciFxBillsWithMis))
- else
- Exportor.DefineCol(@ciFxBills, Length(ciFxBills));
- Exportor.ExportToFile(CurProjectFrame.ProjectData.BillsCompileData.BillsCompileTree, sFileName);
- finally
- Exportor.Free;
- end;
- end;
- end;
- procedure TMainForm.dxseBatchInsertKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- var
- i: Integer;
- begin
- if Key = 13 then
- begin
- for i := 1 to dxseBatchInsert.IntValue do
- ZjDbaInsert.ExecuteTarget(CurProjectFrame.BillsCompileFrame.zgBillsCompile);
- end;
- end;
- procedure TMainForm.actnReplyUpdate(Sender: TObject);
- begin
- with CurProjectFrame.ProjectData do
- TAction(Sender).Enabled := (ProjProperties.PhaseCount > 0);
- end;
- procedure TMainForm.dxbtnTenderPartitionClick(Sender: TObject);
- begin
- PartTendersModel;
- end;
- procedure TMainForm.actnImportDmfExecute(Sender: TObject);
- var
- sFileName: string;
- begin
- if SelectFile(sFileName, '.dmf') then
- CurProjectFrame.ProjectData.ImportDmfFile(sFileName);
- end;
- procedure TMainForm.dxbtnHelpCenterClick(Sender: TObject);
- const
- sHelpUrl = 'http://help.smartcost.com.cn/hc/';
- begin
- ShellExecute(Application.Handle, nil, PChar(sHelpUrl), nil, nil, SW_SHOWNORMAL);
- end;
- procedure TMainForm.OnError(ASender: TObject; AE: Exception);
- begin
- MeasureLog.AppendLogTo(AE.Message);
- end;
- procedure TMainForm.actnExportSumBaseFileExecute(Sender: TObject);
- var
- sFileName: string;
- Exportor: TTenderExport;
- Rec: TsdDataRecord;
- begin
- // 导出前先保存
- CurProjectFrame.ProjectData.SaveAndCheck;
- // 导出云版专用
- sFileName := SupportManager.ConfigInfo.OutputPath + CurProjectFrame.ProjectData.ProjectName + '.sbf';
- if SaveFile(sFileName, '.sbf') then
- begin
- if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”,是否替换?', [ExtractFileName(sFileName)])) then
- Exit;
- Screen.Cursor := crHourGlass;
- try
- Rec := ProjectManagerFrame.Rec(CurProjectFrame.ProjectData.ProjectID);
- Exportor := TTenderExport.Create(Rec, sFileName);
- try
- Exportor.Execute;
- finally
- Exportor.Free;
- end;
- finally
- Screen.Cursor := crDefault;
- end;
- end;
- end;
- procedure TMainForm.dxbtnGatherSubTenderClick(Sender: TObject);
- var
- gc: TstgGatherControl;
- begin
- gc := TstgGatherControl.Create;
- Screen.Cursor := crHourGlass;
- try
- if SelectFileForSubTenderGather(gc) then
- gc.Gather;
- finally
- gc.Free;
- Screen.Cursor := crDefault;
- end;
- end;
- procedure TMainForm.actnImportSubTenderGatherExecute(Sender: TObject);
- var
- sFileName: string;
- begin
- if CurProjectFrame.ProjectData.ProjProperties.PhaseCount = 0 then
- WarningMessage('未开始计量,请在开始计量后再导入分包汇总数据。')
- else if CurProjectFrame.ProjectData.StageDataReadOnly then
- WarningMessage('当前正在查看数据非最新数据,请切换至最新一期再导入分包汇总数据。')
- else if QuestMessage('导入将清空标段本期所有计量数据(合同计量),确定继续?') and SelectFile(sFileName, '.sgf') then
- CurProjectFrame.ProjectData.ImportSubTenderGather(sFileName);
- end;
- procedure TMainForm.actnImportSubTenderGatherUpdate(Sender: TObject);
- begin
- TAction(Sender).Enabled := (jtsProjects.Tabs.Count > 1) and Assigned(CurProjectFrame)
- and (CurProjectFrame.ProjectData.PhaseData.StageCount <= 1);
- end;
- procedure TMainForm.actnExportBillsJsonExecute(Sender: TObject);
- var
- sFileName: string;
- begin
- if SaveFile(sFileName, '.json') then
- CurProjectFrame.ProjectData.BillsCompileData.RecursiveExportBillsJson(sFileName);
- end;
- procedure TMainForm.actnExportBillsJsonUpdate(Sender: TObject);
- begin
- TAction(Sender).Visible := _IsDebugView;
- TAction(Sender).Enabled := jtsProjects.Tabs.Count > 1;
- end;
- procedure TMainForm.actnExportBillsPosExcelDataExecute(Sender: TObject);
- var
- sFileName: string;
- Exportor: TBillsPosExcelExportor;
- begin
- if SaveExcelFile(sFileName) then
- begin
- Exportor := TBillsPosExcelExportor.Create;
- try
- Exportor.ExportToFile(CurProjectFrame.ProjectData.BillsCompileData.BillsCompileTree, sFileName);
- finally
- Exportor.Free;
- end;
- end;
- end;
- procedure TMainForm.dxbtnGatherSubTenderGclClick(Sender: TObject);
- var
- gc: TstgGclGatherControl;
- begin
- gc := TstgGclGatherControl.Create;
- Screen.Cursor := crHourGlass;
- try
- if SelectFileForSubTenderGclGather(gc) then
- gc.Gather;
- finally
- gc.Free;
- Screen.Cursor := crDefault;
- end;
- end;
- procedure TMainForm.actnImportSubTenderGatherGclExecute(Sender: TObject);
- var
- sFileName: string;
- begin
- if CurProjectFrame.ProjectData.ProjProperties.PhaseCount = 0 then
- WarningMessage('未开始计量,请在开始计量后再导入分包汇总数据。')
- else if CurProjectFrame.ProjectData.StageDataReadOnly then
- WarningMessage('当前正在查看数据非最新数据,请切换至最新一期再导入分包汇总数据。')
- else if QuestMessage('导入将清空标段本期所有计量数据(合同计量),确定继续?') and SelectFile(sFileName, '.sgfg') then
- CurProjectFrame.ProjectData.ImportSubTenderGatherGcl(sFileName);
- end;
- procedure TMainForm.actnImportSubTenderGatherGclExcelExecute(
- Sender: TObject);
- var
- sFileName: string;
- begin
- if CurProjectFrame.ProjectData.ProjProperties.PhaseCount = 0 then
- WarningMessage('未开始计量,请在开始计量后再导入分包汇总数据。')
- else if CurProjectFrame.ProjectData.StageDataReadOnly then
- WarningMessage('当前正在查看数据非最新数据,请切换至最新一期再导入分包汇总数据。')
- else if QuestMessage('导入将清空标段本期所有计量数据(合同计量),确定继续?') and SelectExcelFile(sFileName) then
- CurProjectFrame.ProjectData.ImportSubTenderGatherGclExcel(sFileName);
- end;
- end.
|