123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993 |
- 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;
- 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);
- 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;
- {$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;
- end.
|