MainFrm.pas 32 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045
  1. unit MainFrm;
  2. interface
  3. uses
  4. // Uses Units Please Try This Category
  5. // View
  6. ProjectManagerFme, ProjectFme, ProjectPropertiesFrm, OptionFrm, AboutFrm,
  7. AuthFrm,
  8. // Model & Data & Data Control ...
  9. ProjectData, SupportUnit, Globals, ZhAPI, ExcelImport, ConditionalDefines,
  10. // Controls & Delphi Default ... (Almost By Add Controls)
  11. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  12. Dialogs, cxGraphics, JimPages, ComCtrls, dxStatusBar, cxControls, JimTabs,
  13. dxBar, ImgList, UtilMethods, ZjDbaActns, ActnList, XPStyleActnCtrls, ActnMan,
  14. dxBarExtItems, sdDB, ExtCtrls, jpeg, StdCtrls, CslLabel, pngimage;
  15. type
  16. TMainForm = class(TForm)
  17. dxBarManager: TdxBarManager;
  18. Images: TImageList;
  19. dxsiFile: TdxBarSubItem;
  20. jtsProjects: TJimTabSet;
  21. dxStatusBar: TdxStatusBar;
  22. dxStatusBarContainer2: TdxStatusBarContainerControl;
  23. ProgressBar: TProgressBar;
  24. jpsMain: TJimPages;
  25. jpsMainProjectsManager: TJimPage;
  26. jpsMainProjects: TJimPage;
  27. jpsProjects: TJimPages;
  28. dxsiEdit: TdxBarSubItem;
  29. dxsiHelp: TdxBarSubItem;
  30. dxbtnCopy: TdxBarButton;
  31. dxbtnPaste: TdxBarButton;
  32. dxbtnCut: TdxBarButton;
  33. dxbtnInsert: TdxBarButton;
  34. dxbtnDelete: TdxBarButton;
  35. dxbtnUpMove: TdxBarButton;
  36. dxbtnDownMove: TdxBarButton;
  37. dxbtnUpLevel: TdxBarButton;
  38. dxbtnDownLevel: TdxBarButton;
  39. dxbtnAuthorizeDog: TdxBarButton;
  40. dxbtnAbout: TdxBarButton;
  41. dxbtnNewProject: TdxBarButton;
  42. dxbtnOpenProject: TdxBarButton;
  43. dxbtnDeleteProject: TdxBarButton;
  44. ActionManager1: TActionManager;
  45. ZjDbaInsert: TZjDbaInsert;
  46. ZjDbaDelete: TZjDbaDelete;
  47. ZjDbaUpMove: TZjDbaUpMove;
  48. ZjDbaDownMove: TZjDbaDownMove;
  49. ZjTreeDbaUpLevel: TZjTreeDbaUpLevel;
  50. ZjTreeDbaDownLevel: TZjTreeDbaDownLevel;
  51. ZjGridCopy: TZjGridCopy;
  52. ZjGridPaste: TZjGridPaste;
  53. ZjGridCut: TZjGridCut;
  54. ZjGridRemapedPaste: TZjGridRemapedPaste;
  55. dxpmTabSet: TdxBarPopupMenu;
  56. dxbtnCloseProject: TdxBarButton;
  57. actnCloseProject: TAction;
  58. dxbtnNewPhase: TdxBarButton;
  59. dxbtnCalculateLedger: TdxBarButton;
  60. actnNewPhase: TAction;
  61. dxbtnProjectProperties: TdxBarButton;
  62. actnProjectProperties: TAction;
  63. dxbtnSaveProject: TdxBarButton;
  64. actnSaveProject: TAction;
  65. dxbtnRemapedPaste: TdxBarButton;
  66. dxbtnImportExcel: TdxBarButton;
  67. actnImportExcel: TAction;
  68. dxbtnNewAudit: TdxBarButton;
  69. dxbtnCopyBillsBlock: TdxBarButton;
  70. actnNewAudit: TAction;
  71. dxbtnFinalAudit: TdxBarButton;
  72. dxbtnSubmitProject: TdxBarButton;
  73. dxbtnReceiveProject: TdxBarButton;
  74. dxbtnReplyProject: TdxBarButton;
  75. dxbtnAcceptProject: TdxBarButton;
  76. dxbtnCalculateAll: TdxBarButton;
  77. dxbtnNewSubProject: TdxBarButton;
  78. dxbtnNewTender: TdxBarButton;
  79. dxbtnOptions: TdxBarButton;
  80. actnOptions: TAction;
  81. dxbtnCalculatePhasePay: TdxBarButton;
  82. actnSubmit: TAction;
  83. actnReply: TAction;
  84. dxbtnSubmit: TdxBarButton;
  85. dxbtnReply: TdxBarButton;
  86. dxbtnFirstLevel: TdxBarButton;
  87. dxbtnSecondLevel: TdxBarButton;
  88. dxbtnThirdLevel: TdxBarButton;
  89. dxbtnFourthLevel: TdxBarButton;
  90. dxbtnFifthLevel: TdxBarButton;
  91. dxbtnAllLevel: TdxBarButton;
  92. dxbtnAllXmj: TdxBarButton;
  93. dxbtnExportGridToExcel: TdxBarButton;
  94. dxbtnRefresh: TdxBarButton;
  95. dxbtnUnlockInfo: TdxBarButton;
  96. actnUnlockInfo: TAction;
  97. dxUser: TdxBarSubItem;
  98. pnlUser: TPanel;
  99. lblAccount: TLabel;
  100. lblCompany: TLabel;
  101. lblRole: TLabel;
  102. dxLoginCloud: TdxBarButton;
  103. dxManageAccount: TdxBarButton;
  104. pnl1: TPanel;
  105. imgUserImage: TImage;
  106. lblMail: TLabel;
  107. dxUserContainer: TdxBarControlContainerItem;
  108. dxbtnBatchAddChild: TdxBarButton;
  109. dxbtnBatchAddNext: TdxBarButton;
  110. dxbtnReorderChildrenCode: TdxBarButton;
  111. dxbtnImportBillsPrice: TdxBarButton;
  112. dxsiImportExcel: TdxBarSubItem;
  113. dxbtnImportDealBills: TdxBarButton;
  114. actnImportBillsPrice: TAction;
  115. actnImportDealBills: TAction;
  116. dxbtnBatchReplaceBillsInfo: TdxBarButton;
  117. tAutoSave: TTimer;
  118. dxsiExportExcel: TdxBarSubItem;
  119. dxbtnExportExcel: TdxBarButton;
  120. actnExportExcel: TAction;
  121. dxbtnCurPhase: TdxBarButton;
  122. dxSync: TdxBarButton;
  123. dxbtnBatchWritePos_Reason: TdxBarButton;
  124. dxbtnExportCloudTenderFile: TdxBarButton;
  125. actnExportCloudTenderFile: TAction;
  126. dxtbnImportCloudTenderFile: TdxBarButton;
  127. actnImportCloudTenderFile: TAction;
  128. dxbtnCheckAndClear: TdxBarButton;
  129. dxbtnModifyDealBills: TdxBarButton;
  130. dxbtnLocateBills: TdxBarButton;
  131. dxbtnOpenBackupFolder: TdxBarButton;
  132. dxbtnSetBookmark: TdxBarButton;
  133. dxbtnExportFxBillsExcel: TdxBarButton;
  134. actnExportFxBillsExcel: TAction;
  135. dxseBatchInsert: TdxBarSpinEdit;
  136. actnBatchInsert: TAction;
  137. dxbtnRename: TdxBarButton;
  138. dxbtnImportGclBillsToXmj: TdxBarButton;
  139. dxbtnChangeDealBillsMode: TdxBarButton;
  140. dxsiExpandTo: TdxBarSubItem;
  141. dxbtnLocateBookmark: TdxBarButton;
  142. dxbtnImportPlaneFxBillsToXmj: TdxBarButton;
  143. dxbtnAllPeg: TdxBarButton;
  144. dxsiData: TdxBarSubItem;
  145. dxbtnTenderPartition: TdxBarButton;
  146. dxbtnSetDealPayPlan: TdxBarButton;
  147. dxbtnAddDetailGLs: TdxBarButton;
  148. dxbtnCopyDetailGls: TdxBarButton;
  149. dxbtnApplyToSameBills: TdxBarButton;
  150. dxbtnCalculatePriceMargin: TdxBarButton;
  151. dxbtnFxZJJL: TdxBarButton;
  152. dxbtnGclZJJL: TdxBarButton;
  153. dxbtnInsertCol: TdxBarButton;
  154. dxbtnHidden: TdxBarButton;
  155. dxbtnCancelHidden: TdxBarButton;
  156. dxbtnImportDmf: TdxBarButton;
  157. actnImportDmf: TAction;
  158. dxbtnCanCalc: TdxBarButton;
  159. dxbtnWithoutCalcCurPay: TdxBarButton;
  160. dxbtnSignOnline: TdxBarButton;
  161. dxbtnExportTpExcel: TdxBarButton;
  162. dxbtnHelpCenter: TdxBarButton;
  163. dxbtnLocateMeasureBills: TdxBarButton;
  164. dxbtnGuest: TdxBarButton;
  165. dxbtnLocateZJJL: TdxBarButton;
  166. dxbtnEpure: TdxBarButton;
  167. dxbtnLocateCompileBills: TdxBarButton;
  168. dxbtnGclGatherZJJL: TdxBarButton;
  169. dxbtnExportSumBaseFile: TdxBarButton;
  170. actnExportSumBaseFile: TAction;
  171. dxbtnGatherSubTender: TdxBarButton;
  172. dxbtnExportTenderError: TdxBarButton;
  173. dxbtnExportAllError: TdxBarButton;
  174. dxbtnExportStgResultExcel: TdxBarButton;
  175. dxbtnExportStgResult: TdxBarButton;
  176. dxbtnImportSubTenderGather: TdxBarButton;
  177. actnImportSubTenderGather: TAction;
  178. dxbtnExportBillsJson: TdxBarButton;
  179. actnExportBillsJson: TAction;
  180. dxbtnExportBillsPosExcelData: TdxBarButton;
  181. actnExportBillsPosExcelData: TAction;
  182. dxbtnDeleteRow: TdxBarButton;
  183. dxbtnInsertRow: TdxBarButton;
  184. dxsiGatherSub: TdxBarSubItem;
  185. dxbtnGatherSubTenderGcl: TdxBarButton;
  186. dxsiImportSubTenderGather: TdxBarSubItem;
  187. dxbtnImportSubTenderGatherGcl: TdxBarButton;
  188. actnImportSubTenderGatherGcl: TAction;
  189. actnImportSubTenderGatherGclExcel: TAction;
  190. dxbtnImportSubTenderGatherExcel: TdxBarButton;
  191. dxbtnExportStdJson: TdxBarButton;
  192. procedure FormCreate(Sender: TObject);
  193. procedure FormDestroy(Sender: TObject);
  194. procedure jtsProjectsChange(Sender: TObject; NewTab: Integer;
  195. var AllowChange: Boolean);
  196. procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  197. procedure jtsProjectsMouseDown(Sender: TObject; Button: TMouseButton;
  198. Shift: TShiftState; X, Y: Integer);
  199. procedure actnCloseProjectExecute(Sender: TObject);
  200. procedure actnCloseProjectUpdate(Sender: TObject);
  201. procedure actnNewPhaseExecute(Sender: TObject);
  202. procedure actnProjectPropertiesUpdate(Sender: TObject);
  203. procedure actnProjectPropertiesExecute(Sender: TObject);
  204. procedure actnSaveProjectExecute(Sender: TObject);
  205. procedure actnNewAuditExecute(Sender: TObject);
  206. procedure actnNewPhaseUpdate(Sender: TObject);
  207. procedure actnOptionsExecute(Sender: TObject);
  208. procedure actnImportExcelExecute(Sender: TObject);
  209. procedure actnReplyExecute(Sender: TObject);
  210. procedure actnSubmitExecute(Sender: TObject);
  211. procedure dxBarManagerShowToolbarsPopup(Sender: TdxBarManager;
  212. PopupItemLinks: TdxBarItemLinks);
  213. procedure actnSubmitUpdate(Sender: TObject);
  214. procedure actnImportExcelUpdate(Sender: TObject);
  215. procedure actnUnlockInfoUpdate(Sender: TObject);
  216. procedure actnUnlockInfoExecute(Sender: TObject);
  217. procedure dxbtnAboutClick(Sender: TObject);
  218. procedure dxLoginCloudClick(Sender: TObject);
  219. procedure dxManageAccountClick(Sender: TObject);
  220. procedure dxbtnAuthorizeDogClick(Sender: TObject);
  221. procedure actnImportBillsPriceExecute(Sender: TObject);
  222. procedure actnImportDealBillsExecute(Sender: TObject);
  223. procedure tAutoSaveTimer(Sender: TObject);
  224. procedure actnExportExcelExecute(Sender: TObject);
  225. procedure dxSyncClick(Sender: TObject);
  226. procedure actnExportCloudTenderFileExecute(Sender: TObject);
  227. procedure actnExportCloudTenderFileUpdate(Sender: TObject);
  228. procedure actnImportCloudTenderFileExecute(Sender: TObject);
  229. procedure actnImportCloudTenderFileUpdate(Sender: TObject);
  230. procedure actnExportFxBillsExcelExecute(Sender: TObject);
  231. procedure dxseBatchInsertKeyDown(Sender: TObject; var Key: Word;
  232. Shift: TShiftState);
  233. procedure actnReplyUpdate(Sender: TObject);
  234. procedure dxbtnTenderPartitionClick(Sender: TObject);
  235. procedure actnImportDmfExecute(Sender: TObject);
  236. procedure dxbtnHelpCenterClick(Sender: TObject);
  237. procedure actnExportSumBaseFileExecute(Sender: TObject);
  238. procedure dxbtnGatherSubTenderClick(Sender: TObject);
  239. procedure actnImportSubTenderGatherExecute(Sender: TObject);
  240. procedure actnImportSubTenderGatherUpdate(Sender: TObject);
  241. procedure actnExportBillsJsonExecute(Sender: TObject);
  242. procedure actnExportBillsJsonUpdate(Sender: TObject);
  243. procedure actnExportBillsPosExcelDataExecute(Sender: TObject);
  244. procedure dxbtnGatherSubTenderGclClick(Sender: TObject);
  245. procedure actnImportSubTenderGatherGclExecute(Sender: TObject);
  246. procedure actnImportSubTenderGatherGclExcelExecute(Sender: TObject);
  247. private
  248. FProjectManagerFrame: TProjectManagerFrame;
  249. FProjectFrames: TList;
  250. procedure UpdateProgressBar(APosition: Integer);
  251. procedure UpdateProgressHint(const AHint: string);
  252. function CreateProjectView(ARec: TsdDataRecord): TProjectFrame;
  253. procedure LocateProjectView(AIndex: Integer);
  254. procedure DeleteProjectView(AIndex: Integer);
  255. procedure ResetProcessView(AIndex: Integer);
  256. procedure ChangeLeftSideGlobalView(AIndex: Integer);
  257. function GetCurProjectFrame: TProjectFrame;
  258. procedure OnError(ASender: TObject; AE: Exception);
  259. procedure ResetAutoSave;
  260. public
  261. procedure UpdateProgress(APos: Integer; const AHint: string);
  262. procedure LocateProject(AProjectID: Integer);
  263. function HasOpened(AProjectID: Integer): Boolean;
  264. function OpenProject(ARec: TsdDataRecord): TProjectFrame;
  265. property CurProjectFrame: TProjectFrame read GetCurProjectFrame;
  266. property ProjectManagerFrame: TProjectManagerFrame read FProjectManagerFrame;
  267. end;
  268. var
  269. MainForm: TMainForm;
  270. implementation
  271. uses
  272. ProjectProperty, ConstUnit, PHPWebDm, Math, ShellAPI,
  273. FindUserFrm, ImportExcelHintFrm, ConfigDoc, ExportExcel,
  274. ProjectCommands, BillsCompileDm, tpMainFrm,
  275. DealBillsExcelImport, ExcelImport_Bills, DetailExcelImport,
  276. stgGatherControl, stgSelectFileFrm, stgGclGatherControl, stgGclSelectFileFrm;
  277. {$R *.dfm}
  278. {$R MeasureIcons.RES}
  279. procedure TMainForm.FormCreate(Sender: TObject);
  280. procedure CreateProjectManagerFrame;
  281. begin
  282. FProjectManagerFrame := TProjectManagerFrame.Create(nil);
  283. AlignControl(FProjectManagerFrame, jpsMainProjectsManager, alClient);
  284. end;
  285. procedure SetHintFont;
  286. begin
  287. if G_IsCloud then
  288. begin
  289. Screen.HintFont.Size := 11;
  290. Screen.HintFont.Name := 'Microsoft YaHei';
  291. end
  292. else
  293. begin
  294. Screen.HintFont.Name := 'SmartSimSun';
  295. Screen.HintFont.Size := 9;
  296. end;
  297. end;
  298. function GetSoftName: string;
  299. begin
  300. if _ModuleType = mtCompile then
  301. Result := '纵横公路工程0号台账软件'
  302. else if _ModuleType = mtAll then
  303. Result := '纵横公路工程结算决算计量一体化软件';
  304. end;
  305. function GetVersionName: string;
  306. begin
  307. Result := '';
  308. if _IsGuangDong then
  309. Result := Result + '广东';
  310. if _ModuleType = mtAll then
  311. begin
  312. if _IsDebugView then
  313. Result := 'Debug'
  314. else if G_IsTest then
  315. Result := '测试'
  316. else if G_IsCloud then
  317. Result := Result + '云'
  318. else if _IsEncrypt then
  319. Result := Result + '专业'
  320. else
  321. Result := Result + '学习';
  322. end;
  323. if Result <> '' then
  324. Result := Result + '版';
  325. end;
  326. procedure InitialForVersions;
  327. var
  328. sPic: string;
  329. begin
  330. if G_IsCloud then
  331. begin
  332. dxbtnNewProject.Visible := ivNever;
  333. dxbtnNewSubProject.Visible := ivNever;
  334. dxbtnReceiveProject.Visible := ivNever;
  335. dxbtnNewPhase.Visible := ivNever;
  336. dxUser.Visible := ivAlways;
  337. dxUser.Caption := PHPWeb.RealName;
  338. lblAccount.Caption := PHPWeb.RealName;
  339. lblMail.Caption := Format('(%s)', [PHPWeb.Account]);
  340. if Trim(PHPWeb.Company) <> '' then
  341. lblCompany.Caption := PHPWeb.Company
  342. else
  343. lblCompany.Caption := '我的单位';
  344. if Trim(PHPWeb.Role) <> '' then
  345. lblRole.Caption := PHPWeb.Role
  346. else
  347. lblRole.Caption := '我的职称';
  348. // 每次登录都下载到本地,再从本地读入显示。以保证图片实时更新。
  349. sPic := PHPWeb.UserPath + '0_' + IntToStr(PHPWeb.UserID) + '.jpg';
  350. if PHPWeb.DownFile(PHPWeb.UserImageURL, sPic) then
  351. if FileExists(sPic) then
  352. imgUserImage.Picture.LoadFromFile(sPic);
  353. end
  354. else
  355. begin
  356. dxUser.Visible := ivNever;
  357. dxbtnReceiveProject.Visible := ivAlways;
  358. end;
  359. MainForm.Caption := GetSoftName + GetVersionName;
  360. end;
  361. begin
  362. CreateProjectManagerFrame;
  363. FProjectFrames := TList.Create;
  364. InitialForVersions;
  365. SetHintFont;
  366. ResetAutoSave;
  367. end;
  368. procedure TMainForm.UpdateProgress(APos: Integer; const AHint: string);
  369. begin
  370. UpdateProgressBar(APos);
  371. UpdateProgressHint(AHint);
  372. Application.ProcessMessages;
  373. end;
  374. procedure TMainForm.UpdateProgressBar(APosition: Integer);
  375. begin
  376. if APosition < ProgressBar.Max then
  377. ProgressBar.Position := APosition
  378. else
  379. ProgressBar.Position := ProgressBar.Min;
  380. end;
  381. procedure TMainForm.UpdateProgressHint(const AHint: string);
  382. begin
  383. dxStatusBar.Panels[0].Text := AHint;
  384. end;
  385. procedure TMainForm.FormDestroy(Sender: TObject);
  386. begin
  387. ClearObjects(FProjectFrames);
  388. FProjectFrames.Free;
  389. FProjectManagerFrame.Free;
  390. if DirectoryExists(GetAppTempPath) then
  391. DeleteFileOrFolder(GetAppTempPath);
  392. end;
  393. function TMainForm.OpenProject(ARec: TsdDataRecord): TProjectFrame;
  394. begin
  395. if not HasOpened(ARec.ValueByName('ID').AsInteger) then
  396. Result := CreateProjectView(ARec)
  397. else
  398. begin
  399. LocateProject(ARec.ValueByName('ID').AsInteger);
  400. Result := CurProjectFrame;
  401. end;
  402. end;
  403. function TMainForm.HasOpened(AProjectID: Integer): Boolean;
  404. begin
  405. Result := OpenProjectManager.ProjectIndex(AProjectID) <> -1;
  406. end;
  407. procedure TMainForm.LocateProject(AProjectID: Integer);
  408. begin
  409. jtsProjects.TabIndex := OpenProjectManager.ProjectIndex(AProjectID) + 1;
  410. if jpsMain.ActivePage <> jpsMainProjects then
  411. jpsMain.ActivePage := jpsMainProjects;
  412. end;
  413. function TMainForm.CreateProjectView(ARec: TsdDataRecord): TProjectFrame;
  414. function CreateNewProjectPage: TJimPage;
  415. begin
  416. Result := TJimPage.Create(jpsProjects);
  417. Result.Pages := jpsProjects;
  418. jpsProjects.ActivePage := Result;
  419. end;
  420. function CreateNewProjectTab(const ATabName: string; APage: TJimPage): Integer;
  421. begin
  422. Result := jtsProjects.Tabs.AddObject(ATabName, APage);
  423. jtsProjects.TabIndex := Result;
  424. end;
  425. function CreateProjectFrame(AProjectData: TProjectData; APage: TJimPage): TProjectFrame;
  426. var
  427. ProjectFrame: TProjectFrame;
  428. begin
  429. //AProjectData.IsGuest := FProjectManagerFrame.IsGuest;
  430. ProjectFrame := TProjectFrame.Create(AProjectData);
  431. FProjectFrames.Add(ProjectFrame);
  432. ProjectFrame.Parent := APage;
  433. ProjectFrame.Align := alClient;
  434. Result := ProjectFrame;
  435. end;
  436. var
  437. jimPage: TJimPage;
  438. begin
  439. jpsMain.ActivePage := jpsMainProjects;
  440. jimPage := CreateNewProjectPage;
  441. CreateNewProjectTab(ARec.ValueByName('Name').AsString, jimPage);
  442. Result := CreateProjectFrame(OpenProjectManager.Open(ARec), jimPage);
  443. ProjectManager.AddOpenTenderBackup(ARec.ValueByName('ID').AsInteger);
  444. end;
  445. procedure TMainForm.jtsProjectsChange(Sender: TObject; NewTab: Integer;
  446. var AllowChange: Boolean);
  447. begin
  448. LocateProjectView(NewTab - 1);
  449. ResetProcessView(NewTab);
  450. end;
  451. procedure TMainForm.LocateProjectView(AIndex: Integer);
  452. begin
  453. if AIndex >= 0 then
  454. begin
  455. jpsMain.ActivePage := jpsMainProjects;
  456. jpsProjects.ActivePage := TJimPage(jtsProjects.Tabs.Objects[AIndex + 1]);
  457. OpenProjectManager.CurProjectIndex := AIndex;
  458. ChangeLeftSideGlobalView(AIndex);
  459. end
  460. else
  461. jpsMain.ActivePage := jpsMainProjectsManager;
  462. end;
  463. procedure TMainForm.ChangeLeftSideGlobalView(AIndex: Integer);
  464. begin
  465. if (AIndex >= 0) and (AIndex < FProjectFrames.Count) then
  466. TProjectFrame(FProjectFrames[AIndex]).ResetAssistantView;
  467. end;
  468. procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  469. begin
  470. try
  471. OpenProjectManager.SaveAll;
  472. except
  473. end;
  474. end;
  475. procedure TMainForm.jtsProjectsMouseDown(Sender: TObject;
  476. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  477. begin
  478. if (Button = mbRight) and (jtsProjects.TabIndex > 0) then
  479. dxpmTabSet.PopupFromCursorPos;
  480. end;
  481. procedure TMainForm.actnCloseProjectExecute(Sender: TObject);
  482. begin
  483. OpenProjectManager.CurProjectData.SaveAndCheck;
  484. DeleteProjectView(jtsProjects.TabIndex - 1);
  485. LocateProjectView(jtsProjects.TabIndex - 1);
  486. ResetProcessView(jtsProjects.TabIndex);
  487. end;
  488. procedure TMainForm.actnCloseProjectUpdate(Sender: TObject);
  489. begin
  490. TAction(Sender).Enabled := jtsProjects.Tabs.Count > 1;
  491. end;
  492. procedure TMainForm.DeleteProjectView(AIndex: Integer);
  493. begin
  494. TProjectFrame(FProjectFrames[AIndex]).Free;
  495. FProjectFrames.Delete(AIndex);
  496. OpenProjectManager.Delete(AIndex);
  497. jpsProjects.Pages.Delete(AIndex);
  498. jtsProjects.Tabs.Delete(AIndex + 1);
  499. end;
  500. procedure TMainForm.actnNewPhaseExecute(Sender: TObject);
  501. begin
  502. TProjectFrame(FProjectFrames[jtsProjects.TabIndex - 1]).CreateNewPhase;
  503. end;
  504. procedure TMainForm.actnProjectPropertiesUpdate(Sender: TObject);
  505. begin
  506. TAction(Sender).Enabled := jtsProjects.TabIndex > 0;
  507. end;
  508. procedure TMainForm.actnProjectPropertiesExecute(Sender: TObject);
  509. begin
  510. ModifyProjectProperties(TProjectFrame(FProjectFrames[jtsProjects.TabIndex - 1]));
  511. end;
  512. procedure TMainForm.actnSaveProjectExecute(Sender: TObject);
  513. begin
  514. OpenProjectManager.CurProjectData.SaveAndCheck;
  515. end;
  516. procedure TMainForm.actnNewAuditExecute(Sender: TObject);
  517. begin
  518. TProjectFrame(FProjectFrames[jtsProjects.TabIndex - 1]).CreateNewAudit;
  519. end;
  520. procedure TMainForm.actnNewPhaseUpdate(Sender: TObject);
  521. begin
  522. TAction(Sender).Enabled := (jtsProjects.Tabs.Count > 1) and Assigned(CurProjectFrame);
  523. if TAction(Sender).Enabled then
  524. with CurProjectFrame.ProjectData do
  525. TAction(Sender).Enabled := TAction(Sender).Enabled and (ProjProperties.AuditStatus = -1);
  526. end;
  527. function TMainForm.GetCurProjectFrame: TProjectFrame;
  528. begin
  529. if jtsProjects.TabIndex > 0 then
  530. Result := TProjectFrame(FProjectFrames[jtsProjects.TabIndex - 1])
  531. else
  532. Result := nil;
  533. end;
  534. procedure TMainForm.actnOptionsExecute(Sender: TObject);
  535. begin
  536. ModifiedOptions;
  537. ResetAutoSave;
  538. end;
  539. procedure TMainForm.actnImportExcelExecute(Sender: TObject);
  540. var
  541. sFileName: string;
  542. Importor: Tdei_CustomBills;
  543. bWithLevelCode, bWithoutGclBills: Boolean;
  544. begin
  545. if HintAndImportTypeSelect(bWithLevelCode, bWithoutGclBills) then
  546. begin
  547. if SelectExcelFile(sFileName) then
  548. begin
  549. Importor := Tdei_CustomBills.Create(CurProjectFrame.ProjectData);
  550. try
  551. Importor.ImportFile(sFileName, bWithLevelCode, bWithoutGclBills);
  552. finally
  553. Importor.Free;
  554. end;
  555. end;
  556. end;
  557. end;
  558. procedure TMainForm.ResetProcessView(AIndex: Integer);
  559. begin
  560. dxBarManager.Bars[2].Visible := AIndex > 0;
  561. if G_IsCloud then
  562. dxBarManager.Bars[2].Visible := False;
  563. end;
  564. procedure TMainForm.actnReplyExecute(Sender: TObject); // 批复
  565. begin
  566. if not CurProjectFrame.CheckCanReport then Exit;
  567. Screen.Cursor := crHourGlass;
  568. try
  569. CurProjectFrame.ProjectData.SaveAndCheck;
  570. {$O-}
  571. // 失败后重复一次
  572. if not CurProjectFrame.ProjectData.ReplyProject then
  573. begin
  574. if not CurProjectFrame.ProjectData.ReplyProject then
  575. ErrorMessage('批复项目失败!');
  576. end;
  577. {$O+}
  578. finally
  579. Screen.Cursor := crDefault;
  580. end;
  581. end;
  582. procedure TMainForm.actnSubmitExecute(Sender: TObject); // 上报
  583. begin
  584. if not CurProjectFrame.CheckCanReport then Exit;
  585. Screen.Cursor := crHourGlass;
  586. try
  587. CurProjectFrame.ProjectData.SaveAndCheck;
  588. {$O-}
  589. // 失败后重复一次
  590. if not CurProjectFrame.ProjectData.SubmitProject then
  591. begin
  592. if not CurProjectFrame.ProjectData.SubmitProject then
  593. ErrorMessage('上报项目失败!');
  594. end;
  595. {$O+}
  596. finally
  597. Screen.Cursor := crDefault;
  598. end;
  599. end;
  600. procedure TMainForm.dxBarManagerShowToolbarsPopup(Sender: TdxBarManager;
  601. PopupItemLinks: TdxBarItemLinks);
  602. begin
  603. // 取消菜单栏右键菜单
  604. PopupItemLinks.Clear;
  605. end;
  606. procedure TMainForm.actnSubmitUpdate(Sender: TObject);
  607. begin
  608. with CurProjectFrame.ProjectData do
  609. TAction(Sender).Enabled := (ProjProperties.PhaseCount > 0) and
  610. ((ProjProperties.AuditStatus >= 0) and (ProjProperties.AuditStatus < iMaxStageCount-1));
  611. end;
  612. procedure TMainForm.actnImportExcelUpdate(Sender: TObject);
  613. begin
  614. TAction(Sender).Enabled := (jtsProjects.Tabs.Count > 1) and Assigned(CurProjectFrame);
  615. if TAction(Sender).Enabled then
  616. with CurProjectFrame.ProjectData do
  617. TAction(Sender).Enabled := TAction(Sender).Enabled and (PhaseIndex < 1);
  618. end;
  619. procedure TMainForm.actnUnlockInfoUpdate(Sender: TObject);
  620. begin
  621. TAction(Sender).Enabled := (jtsProjects.Tabs.Count > 1) and Assigned(CurProjectFrame);
  622. end;
  623. procedure TMainForm.actnUnlockInfoExecute(Sender: TObject);
  624. begin
  625. CurProjectFrame.UnLockData;
  626. end;
  627. procedure TMainForm.dxbtnAboutClick(Sender: TObject);
  628. begin
  629. ShowAboutForm;
  630. end;
  631. procedure TMainForm.dxLoginCloudClick(Sender: TObject);
  632. begin
  633. ShellExecute(Application.Handle, nil, PChar(PHPWeb.LoginCloudURL), nil, nil, SW_SHOWNORMAL);
  634. end;
  635. procedure TMainForm.dxManageAccountClick(Sender: TObject);
  636. begin
  637. ShellExecute(Application.Handle, nil, PChar(PHPWeb.PassportURL), nil, nil, SW_SHOWNORMAL);
  638. end;
  639. procedure TMainForm.dxbtnAuthorizeDogClick(Sender: TObject);
  640. begin
  641. Authorize;
  642. end;
  643. procedure TMainForm.actnImportBillsPriceExecute(Sender: TObject);
  644. var
  645. sFileName: string;
  646. Importor: TBillsPriceExcelImport;
  647. begin
  648. if SelectExcelFile(sFileName) then
  649. begin
  650. Importor := TBillsPriceExcelImport.Create(CurProjectFrame.ProjectData);
  651. try
  652. Importor.ImportFile(sFileName);
  653. finally
  654. Importor.Free;
  655. end;
  656. end;
  657. end;
  658. procedure TMainForm.actnImportDealBillsExecute(Sender: TObject);
  659. var
  660. sFileName: string;
  661. Importor: TDealBillsExcelImport;
  662. begin
  663. if SelectExcelFile(sFileName) then
  664. begin
  665. Importor := TDealBillsExcelImport.Create(CurProjectFrame.ProjectData);
  666. try
  667. Importor.ImportFile(sFileName);
  668. finally
  669. Importor.Free;
  670. end;
  671. end;
  672. end;
  673. procedure TMainForm.tAutoSaveTimer(Sender: TObject);
  674. begin
  675. Screen.Cursor := crHourGlass;
  676. try
  677. OpenProjectManager.SaveAll;
  678. finally
  679. screen.Cursor := crDefault;
  680. end;
  681. end;
  682. procedure TMainForm.ResetAutoSave;
  683. begin
  684. with SupportManager.ConfigInfo do
  685. begin
  686. tAutoSave.Interval := AutoSaveInterval * 60 * 1000;
  687. tAutoSave.Enabled := AutoSave;
  688. end;
  689. end;
  690. procedure TMainForm.actnExportExcelExecute(Sender: TObject);
  691. var
  692. sFileName: string;
  693. Exportor: TIDTreeExcelExportor;
  694. begin
  695. if SaveExcelFile(sFileName) then
  696. begin
  697. Exportor := TIDTreeExcelExportor.Create;
  698. try
  699. if SupportManager.ConfigInfo.ExcelWithMis then
  700. Exportor.DefineCol(@ciLedgerWithMis, Length(ciLedgerWithMis))
  701. else
  702. Exportor.DefineCol(@ciLedger, Length(ciLedger));
  703. Exportor.HasLevelCode := True;
  704. Exportor.ExportToFile(CurProjectFrame.ProjectData.BillsCompileData.BillsCompileTree, sFileName);
  705. finally
  706. Exportor.Free;
  707. end;
  708. end;
  709. end;
  710. procedure TMainForm.dxSyncClick(Sender: TObject);
  711. begin
  712. Screen.Cursor := crHourGlass;
  713. try
  714. FProjectManagerFrame.DoBatchReceiveAllOnline;
  715. finally
  716. Screen.Cursor := crDefault;
  717. end;
  718. end;
  719. procedure TMainForm.actnExportCloudTenderFileExecute(Sender: TObject);
  720. var
  721. sFileName: string;
  722. Exportor: TTenderExport;
  723. Rec: TsdDataRecord;
  724. begin
  725. // 导出前先保存
  726. CurProjectFrame.ProjectData.SaveAndCheck;
  727. // 导出云版专用
  728. sFileName := SupportManager.ConfigInfo.OutputPath + CurProjectFrame.ProjectData.ProjectName + '.ctf';
  729. if SaveFile(sFileName, '.ctf') then
  730. begin
  731. if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”,是否替换?', [ExtractFileName(sFileName)])) then
  732. Exit;
  733. Screen.Cursor := crHourGlass;
  734. try
  735. Rec := ProjectManagerFrame.Rec(CurProjectFrame.ProjectData.ProjectID);
  736. Exportor := TTenderExport.Create(Rec, sFileName);
  737. try
  738. Exportor.Execute;
  739. finally
  740. Exportor.Free;
  741. end;
  742. finally
  743. Screen.Cursor := crDefault;
  744. end;
  745. end;
  746. end;
  747. procedure TMainForm.actnExportCloudTenderFileUpdate(Sender: TObject);
  748. begin
  749. // 仅打开的项目可以导出云版专用格式,且该项目没有进行计量
  750. TAction(Sender).Enabled := (jtsProjects.Tabs.Count > 1) and Assigned(CurProjectFrame);
  751. if TAction(Sender).Enabled then
  752. TAction(Sender).Enabled := CurProjectFrame.ProjectData.ProjProperties.PhaseCount = 0;
  753. end;
  754. procedure TMainForm.actnImportCloudTenderFileExecute(Sender: TObject);
  755. var
  756. sFileName: string;
  757. begin
  758. if SelectFile(sFileName, '.ctf') then
  759. begin
  760. CurProjectFrame.ProjectData.ImportCloudTenderFile(sFileName);
  761. CurProjectFrame.RefreshColumnDisplay;
  762. end;
  763. end;
  764. procedure TMainForm.actnImportCloudTenderFileUpdate(Sender: TObject);
  765. begin
  766. TAction(Sender).Enabled := (jtsProjects.Tabs.Count > 1) and Assigned(CurProjectFrame);
  767. if TAction(Sender).Enabled then
  768. TAction(Sender).Enabled := CurProjectFrame.ProjectData.ProjProperties.PhaseCount = 0;
  769. end;
  770. procedure TMainForm.actnExportFxBillsExcelExecute(Sender: TObject);
  771. var
  772. sFileName: string;
  773. Exportor: TIDTreeExcelExportor;
  774. begin
  775. if SaveExcelFile(sFileName) then
  776. begin
  777. Exportor := TIDTreeExcelExportor.Create;
  778. try
  779. if SupportManager.ConfigInfo.ExcelWithMis then
  780. Exportor.DefineCol(@ciFxBillsWithMis, Length(ciFxBillsWithMis))
  781. else
  782. Exportor.DefineCol(@ciFxBills, Length(ciFxBills));
  783. Exportor.ExportToFile(CurProjectFrame.ProjectData.BillsCompileData.BillsCompileTree, sFileName);
  784. finally
  785. Exportor.Free;
  786. end;
  787. end;
  788. end;
  789. procedure TMainForm.dxseBatchInsertKeyDown(Sender: TObject; var Key: Word;
  790. Shift: TShiftState);
  791. var
  792. i: Integer;
  793. begin
  794. if Key = 13 then
  795. begin
  796. for i := 1 to dxseBatchInsert.IntValue do
  797. ZjDbaInsert.ExecuteTarget(CurProjectFrame.BillsCompileFrame.zgBillsCompile);
  798. end;
  799. end;
  800. procedure TMainForm.actnReplyUpdate(Sender: TObject);
  801. begin
  802. with CurProjectFrame.ProjectData do
  803. TAction(Sender).Enabled := (ProjProperties.PhaseCount > 0);
  804. end;
  805. procedure TMainForm.dxbtnTenderPartitionClick(Sender: TObject);
  806. begin
  807. PartTendersModel;
  808. end;
  809. procedure TMainForm.actnImportDmfExecute(Sender: TObject);
  810. var
  811. sFileName: string;
  812. begin
  813. if SelectFile(sFileName, '.dmf') then
  814. CurProjectFrame.ProjectData.ImportDmfFile(sFileName);
  815. end;
  816. procedure TMainForm.dxbtnHelpCenterClick(Sender: TObject);
  817. const
  818. sHelpUrl = 'http://help.smartcost.com.cn/hc/';
  819. begin
  820. ShellExecute(Application.Handle, nil, PChar(sHelpUrl), nil, nil, SW_SHOWNORMAL);
  821. end;
  822. procedure TMainForm.OnError(ASender: TObject; AE: Exception);
  823. begin
  824. MeasureLog.AppendLogTo(AE.Message);
  825. end;
  826. procedure TMainForm.actnExportSumBaseFileExecute(Sender: TObject);
  827. var
  828. sFileName: string;
  829. Exportor: TTenderExport;
  830. Rec: TsdDataRecord;
  831. begin
  832. // 导出前先保存
  833. CurProjectFrame.ProjectData.SaveAndCheck;
  834. // 导出云版专用
  835. sFileName := SupportManager.ConfigInfo.OutputPath + CurProjectFrame.ProjectData.ProjectName + '.sbf';
  836. if SaveFile(sFileName, '.sbf') then
  837. begin
  838. if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”,是否替换?', [ExtractFileName(sFileName)])) then
  839. Exit;
  840. Screen.Cursor := crHourGlass;
  841. try
  842. Rec := ProjectManagerFrame.Rec(CurProjectFrame.ProjectData.ProjectID);
  843. Exportor := TTenderExport.Create(Rec, sFileName);
  844. try
  845. Exportor.Execute;
  846. finally
  847. Exportor.Free;
  848. end;
  849. finally
  850. Screen.Cursor := crDefault;
  851. end;
  852. end;
  853. end;
  854. procedure TMainForm.dxbtnGatherSubTenderClick(Sender: TObject);
  855. var
  856. gc: TstgGatherControl;
  857. begin
  858. gc := TstgGatherControl.Create;
  859. Screen.Cursor := crHourGlass;
  860. try
  861. if SelectFileForSubTenderGather(gc) then
  862. gc.Gather;
  863. finally
  864. gc.Free;
  865. Screen.Cursor := crDefault;
  866. end;
  867. end;
  868. procedure TMainForm.actnImportSubTenderGatherExecute(Sender: TObject);
  869. var
  870. sFileName: string;
  871. begin
  872. if CurProjectFrame.ProjectData.ProjProperties.PhaseCount = 0 then
  873. WarningMessage('未开始计量,请在开始计量后再导入分包汇总数据。')
  874. else if CurProjectFrame.ProjectData.StageDataReadOnly then
  875. WarningMessage('当前正在查看数据非最新数据,请切换至最新一期再导入分包汇总数据。')
  876. else if QuestMessage('导入将清空标段本期所有计量数据(合同计量),确定继续?') and SelectFile(sFileName, '.sgf') then
  877. CurProjectFrame.ProjectData.ImportSubTenderGather(sFileName);
  878. end;
  879. procedure TMainForm.actnImportSubTenderGatherUpdate(Sender: TObject);
  880. begin
  881. TAction(Sender).Enabled := (jtsProjects.Tabs.Count > 1) and Assigned(CurProjectFrame)
  882. and (CurProjectFrame.ProjectData.PhaseData.StageCount <= 1);
  883. end;
  884. procedure TMainForm.actnExportBillsJsonExecute(Sender: TObject);
  885. var
  886. sFileName: string;
  887. begin
  888. if SaveFile(sFileName, '.json') then
  889. CurProjectFrame.ProjectData.BillsCompileData.RecursiveExportBillsJson(sFileName);
  890. end;
  891. procedure TMainForm.actnExportBillsJsonUpdate(Sender: TObject);
  892. begin
  893. TAction(Sender).Visible := _IsDebugView;
  894. TAction(Sender).Enabled := jtsProjects.Tabs.Count > 1;
  895. end;
  896. procedure TMainForm.actnExportBillsPosExcelDataExecute(Sender: TObject);
  897. var
  898. sFileName: string;
  899. Exportor: TBillsPosExcelExportor;
  900. begin
  901. if SaveExcelFile(sFileName) then
  902. begin
  903. Exportor := TBillsPosExcelExportor.Create;
  904. try
  905. Exportor.ExportToFile(CurProjectFrame.ProjectData.BillsCompileData.BillsCompileTree, sFileName);
  906. finally
  907. Exportor.Free;
  908. end;
  909. end;
  910. end;
  911. procedure TMainForm.dxbtnGatherSubTenderGclClick(Sender: TObject);
  912. var
  913. gc: TstgGclGatherControl;
  914. begin
  915. gc := TstgGclGatherControl.Create;
  916. Screen.Cursor := crHourGlass;
  917. try
  918. if SelectFileForSubTenderGclGather(gc) then
  919. gc.Gather;
  920. finally
  921. gc.Free;
  922. Screen.Cursor := crDefault;
  923. end;
  924. end;
  925. procedure TMainForm.actnImportSubTenderGatherGclExecute(Sender: TObject);
  926. var
  927. sFileName: string;
  928. begin
  929. if CurProjectFrame.ProjectData.ProjProperties.PhaseCount = 0 then
  930. WarningMessage('未开始计量,请在开始计量后再导入分包汇总数据。')
  931. else if CurProjectFrame.ProjectData.StageDataReadOnly then
  932. WarningMessage('当前正在查看数据非最新数据,请切换至最新一期再导入分包汇总数据。')
  933. else if QuestMessage('导入将清空标段本期所有计量数据(合同计量),确定继续?') and SelectFile(sFileName, '.sgfg') then
  934. CurProjectFrame.ProjectData.ImportSubTenderGatherGcl(sFileName);
  935. end;
  936. procedure TMainForm.actnImportSubTenderGatherGclExcelExecute(
  937. Sender: TObject);
  938. var
  939. sFileName: string;
  940. begin
  941. if CurProjectFrame.ProjectData.ProjProperties.PhaseCount = 0 then
  942. WarningMessage('未开始计量,请在开始计量后再导入分包汇总数据。')
  943. else if CurProjectFrame.ProjectData.StageDataReadOnly then
  944. WarningMessage('当前正在查看数据非最新数据,请切换至最新一期再导入分包汇总数据。')
  945. else if QuestMessage('导入将清空标段本期所有计量数据(合同计量),确定继续?') and SelectExcelFile(sFileName) then
  946. CurProjectFrame.ProjectData.ImportSubTenderGatherGclExcel(sFileName);
  947. end;
  948. end.