12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079 |
- 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;
- ilstLarge: TImageList;
- ilstSmall: TImageList;
- ilstExpend: TImageList;
- dxbtnImportPhaseData: TdxBarButton;
- actnImportPhaseData: TAction;
- dxbtnRepairMainData: TdxBarButton;
- actnRepairMainData: TAction;
- 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);
- procedure actnImportPhaseDataUpdate(Sender: TObject);
- procedure actnImportPhaseDataExecute(Sender: TObject);
- procedure actnRepairMainDataUpdate(Sender: TObject);
- procedure actnRepairMainDataExecute(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 := True;//_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;
- procedure TMainForm.actnImportPhaseDataUpdate(Sender: TObject);
- begin
- TAction(Sender).Visible := _IsDebugView;
- end;
- procedure TMainForm.actnImportPhaseDataExecute(Sender: TObject);
- var
- sFileName: string;
- begin
- if QuestMessage('导入计量数据,请确认前后标段一致,并在新增清单前导入,对于本期新增清单,导入数据可能有误,导入后请检查。') and SelectFile(sFileName, 'mtf') then
- CurProjectFrame.ProjectData.ImportPhaseData(sFileName);
- end;
- procedure TMainForm.actnRepairMainDataUpdate(Sender: TObject);
- begin
- TAction(Sender).Visible := _IsDebugView and Assigned(CurProjectFrame);
- end;
- procedure TMainForm.actnRepairMainDataExecute(Sender: TObject);
- begin
- CurProjectFrame.ProjectData.repairMainData;
- end;
- end.
|