MainFrm.pas 32 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044
  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. procedure FormCreate(Sender: TObject);
  192. procedure FormDestroy(Sender: TObject);
  193. procedure jtsProjectsChange(Sender: TObject; NewTab: Integer;
  194. var AllowChange: Boolean);
  195. procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  196. procedure jtsProjectsMouseDown(Sender: TObject; Button: TMouseButton;
  197. Shift: TShiftState; X, Y: Integer);
  198. procedure actnCloseProjectExecute(Sender: TObject);
  199. procedure actnCloseProjectUpdate(Sender: TObject);
  200. procedure actnNewPhaseExecute(Sender: TObject);
  201. procedure actnProjectPropertiesUpdate(Sender: TObject);
  202. procedure actnProjectPropertiesExecute(Sender: TObject);
  203. procedure actnSaveProjectExecute(Sender: TObject);
  204. procedure actnNewAuditExecute(Sender: TObject);
  205. procedure actnNewPhaseUpdate(Sender: TObject);
  206. procedure actnOptionsExecute(Sender: TObject);
  207. procedure actnImportExcelExecute(Sender: TObject);
  208. procedure actnReplyExecute(Sender: TObject);
  209. procedure actnSubmitExecute(Sender: TObject);
  210. procedure dxBarManagerShowToolbarsPopup(Sender: TdxBarManager;
  211. PopupItemLinks: TdxBarItemLinks);
  212. procedure actnSubmitUpdate(Sender: TObject);
  213. procedure actnImportExcelUpdate(Sender: TObject);
  214. procedure actnUnlockInfoUpdate(Sender: TObject);
  215. procedure actnUnlockInfoExecute(Sender: TObject);
  216. procedure dxbtnAboutClick(Sender: TObject);
  217. procedure dxLoginCloudClick(Sender: TObject);
  218. procedure dxManageAccountClick(Sender: TObject);
  219. procedure dxbtnAuthorizeDogClick(Sender: TObject);
  220. procedure actnImportBillsPriceExecute(Sender: TObject);
  221. procedure actnImportDealBillsExecute(Sender: TObject);
  222. procedure tAutoSaveTimer(Sender: TObject);
  223. procedure actnExportExcelExecute(Sender: TObject);
  224. procedure dxSyncClick(Sender: TObject);
  225. procedure actnExportCloudTenderFileExecute(Sender: TObject);
  226. procedure actnExportCloudTenderFileUpdate(Sender: TObject);
  227. procedure actnImportCloudTenderFileExecute(Sender: TObject);
  228. procedure actnImportCloudTenderFileUpdate(Sender: TObject);
  229. procedure actnExportFxBillsExcelExecute(Sender: TObject);
  230. procedure dxseBatchInsertKeyDown(Sender: TObject; var Key: Word;
  231. Shift: TShiftState);
  232. procedure actnReplyUpdate(Sender: TObject);
  233. procedure dxbtnTenderPartitionClick(Sender: TObject);
  234. procedure actnImportDmfExecute(Sender: TObject);
  235. procedure dxbtnHelpCenterClick(Sender: TObject);
  236. procedure actnExportSumBaseFileExecute(Sender: TObject);
  237. procedure dxbtnGatherSubTenderClick(Sender: TObject);
  238. procedure actnImportSubTenderGatherExecute(Sender: TObject);
  239. procedure actnImportSubTenderGatherUpdate(Sender: TObject);
  240. procedure actnExportBillsJsonExecute(Sender: TObject);
  241. procedure actnExportBillsJsonUpdate(Sender: TObject);
  242. procedure actnExportBillsPosExcelDataExecute(Sender: TObject);
  243. procedure dxbtnGatherSubTenderGclClick(Sender: TObject);
  244. procedure actnImportSubTenderGatherGclExecute(Sender: TObject);
  245. procedure actnImportSubTenderGatherGclExcelExecute(Sender: TObject);
  246. private
  247. FProjectManagerFrame: TProjectManagerFrame;
  248. FProjectFrames: TList;
  249. procedure UpdateProgressBar(APosition: Integer);
  250. procedure UpdateProgressHint(const AHint: string);
  251. function CreateProjectView(ARec: TsdDataRecord): TProjectFrame;
  252. procedure LocateProjectView(AIndex: Integer);
  253. procedure DeleteProjectView(AIndex: Integer);
  254. procedure ResetProcessView(AIndex: Integer);
  255. procedure ChangeLeftSideGlobalView(AIndex: Integer);
  256. function GetCurProjectFrame: TProjectFrame;
  257. procedure OnError(ASender: TObject; AE: Exception);
  258. procedure ResetAutoSave;
  259. public
  260. procedure UpdateProgress(APos: Integer; const AHint: string);
  261. procedure LocateProject(AProjectID: Integer);
  262. function HasOpened(AProjectID: Integer): Boolean;
  263. function OpenProject(ARec: TsdDataRecord): TProjectFrame;
  264. property CurProjectFrame: TProjectFrame read GetCurProjectFrame;
  265. property ProjectManagerFrame: TProjectManagerFrame read FProjectManagerFrame;
  266. end;
  267. var
  268. MainForm: TMainForm;
  269. implementation
  270. uses
  271. ProjectProperty, ConstUnit, PHPWebDm, Math, ShellAPI,
  272. FindUserFrm, ImportExcelHintFrm, ConfigDoc, ExportExcel,
  273. ProjectCommands, BillsCompileDm, tpMainFrm,
  274. DealBillsExcelImport, ExcelImport_Bills, DetailExcelImport,
  275. stgGatherControl, stgSelectFileFrm, stgGclGatherControl, stgGclSelectFileFrm;
  276. {$R *.dfm}
  277. {$R MeasureIcons.RES}
  278. procedure TMainForm.FormCreate(Sender: TObject);
  279. procedure CreateProjectManagerFrame;
  280. begin
  281. FProjectManagerFrame := TProjectManagerFrame.Create(nil);
  282. AlignControl(FProjectManagerFrame, jpsMainProjectsManager, alClient);
  283. end;
  284. procedure SetHintFont;
  285. begin
  286. if G_IsCloud then
  287. begin
  288. Screen.HintFont.Size := 11;
  289. Screen.HintFont.Name := 'Microsoft YaHei';
  290. end
  291. else
  292. begin
  293. Screen.HintFont.Name := 'SmartSimSun';
  294. Screen.HintFont.Size := 9;
  295. end;
  296. end;
  297. function GetSoftName: string;
  298. begin
  299. if _ModuleType = mtCompile then
  300. Result := '纵横公路工程0号台账软件'
  301. else if _ModuleType = mtAll then
  302. Result := '纵横公路工程结算决算计量一体化软件';
  303. end;
  304. function GetVersionName: string;
  305. begin
  306. Result := '';
  307. if _IsGuangDong then
  308. Result := Result + '广东';
  309. if _ModuleType = mtAll then
  310. begin
  311. if _IsDebugView then
  312. Result := 'Debug'
  313. else if G_IsTest then
  314. Result := '测试'
  315. else if G_IsCloud then
  316. Result := Result + '云'
  317. else if _IsEncrypt then
  318. Result := Result + '专业'
  319. else
  320. Result := Result + '学习';
  321. end;
  322. if Result <> '' then
  323. Result := Result + '版';
  324. end;
  325. procedure InitialForVersions;
  326. var
  327. sPic: string;
  328. begin
  329. if G_IsCloud then
  330. begin
  331. dxbtnNewProject.Visible := ivNever;
  332. dxbtnNewSubProject.Visible := ivNever;
  333. dxbtnReceiveProject.Visible := ivNever;
  334. dxbtnNewPhase.Visible := ivNever;
  335. dxUser.Visible := ivAlways;
  336. dxUser.Caption := PHPWeb.RealName;
  337. lblAccount.Caption := PHPWeb.RealName;
  338. lblMail.Caption := Format('(%s)', [PHPWeb.Account]);
  339. if Trim(PHPWeb.Company) <> '' then
  340. lblCompany.Caption := PHPWeb.Company
  341. else
  342. lblCompany.Caption := '我的单位';
  343. if Trim(PHPWeb.Role) <> '' then
  344. lblRole.Caption := PHPWeb.Role
  345. else
  346. lblRole.Caption := '我的职称';
  347. // 每次登录都下载到本地,再从本地读入显示。以保证图片实时更新。
  348. sPic := PHPWeb.UserPath + '0_' + IntToStr(PHPWeb.UserID) + '.jpg';
  349. if PHPWeb.DownFile(PHPWeb.UserImageURL, sPic) then
  350. if FileExists(sPic) then
  351. imgUserImage.Picture.LoadFromFile(sPic);
  352. end
  353. else
  354. begin
  355. dxUser.Visible := ivNever;
  356. dxbtnReceiveProject.Visible := ivAlways;
  357. end;
  358. MainForm.Caption := GetSoftName + GetVersionName;
  359. end;
  360. begin
  361. CreateProjectManagerFrame;
  362. FProjectFrames := TList.Create;
  363. InitialForVersions;
  364. SetHintFont;
  365. ResetAutoSave;
  366. end;
  367. procedure TMainForm.UpdateProgress(APos: Integer; const AHint: string);
  368. begin
  369. UpdateProgressBar(APos);
  370. UpdateProgressHint(AHint);
  371. Application.ProcessMessages;
  372. end;
  373. procedure TMainForm.UpdateProgressBar(APosition: Integer);
  374. begin
  375. if APosition < ProgressBar.Max then
  376. ProgressBar.Position := APosition
  377. else
  378. ProgressBar.Position := ProgressBar.Min;
  379. end;
  380. procedure TMainForm.UpdateProgressHint(const AHint: string);
  381. begin
  382. dxStatusBar.Panels[0].Text := AHint;
  383. end;
  384. procedure TMainForm.FormDestroy(Sender: TObject);
  385. begin
  386. ClearObjects(FProjectFrames);
  387. FProjectFrames.Free;
  388. FProjectManagerFrame.Free;
  389. if DirectoryExists(GetAppTempPath) then
  390. DeleteFileOrFolder(GetAppTempPath);
  391. end;
  392. function TMainForm.OpenProject(ARec: TsdDataRecord): TProjectFrame;
  393. begin
  394. if not HasOpened(ARec.ValueByName('ID').AsInteger) then
  395. Result := CreateProjectView(ARec)
  396. else
  397. begin
  398. LocateProject(ARec.ValueByName('ID').AsInteger);
  399. Result := CurProjectFrame;
  400. end;
  401. end;
  402. function TMainForm.HasOpened(AProjectID: Integer): Boolean;
  403. begin
  404. Result := OpenProjectManager.ProjectIndex(AProjectID) <> -1;
  405. end;
  406. procedure TMainForm.LocateProject(AProjectID: Integer);
  407. begin
  408. jtsProjects.TabIndex := OpenProjectManager.ProjectIndex(AProjectID) + 1;
  409. if jpsMain.ActivePage <> jpsMainProjects then
  410. jpsMain.ActivePage := jpsMainProjects;
  411. end;
  412. function TMainForm.CreateProjectView(ARec: TsdDataRecord): TProjectFrame;
  413. function CreateNewProjectPage: TJimPage;
  414. begin
  415. Result := TJimPage.Create(jpsProjects);
  416. Result.Pages := jpsProjects;
  417. jpsProjects.ActivePage := Result;
  418. end;
  419. function CreateNewProjectTab(const ATabName: string; APage: TJimPage): Integer;
  420. begin
  421. Result := jtsProjects.Tabs.AddObject(ATabName, APage);
  422. jtsProjects.TabIndex := Result;
  423. end;
  424. function CreateProjectFrame(AProjectData: TProjectData; APage: TJimPage): TProjectFrame;
  425. var
  426. ProjectFrame: TProjectFrame;
  427. begin
  428. //AProjectData.IsGuest := FProjectManagerFrame.IsGuest;
  429. ProjectFrame := TProjectFrame.Create(AProjectData);
  430. FProjectFrames.Add(ProjectFrame);
  431. ProjectFrame.Parent := APage;
  432. ProjectFrame.Align := alClient;
  433. Result := ProjectFrame;
  434. end;
  435. var
  436. jimPage: TJimPage;
  437. begin
  438. jpsMain.ActivePage := jpsMainProjects;
  439. jimPage := CreateNewProjectPage;
  440. CreateNewProjectTab(ARec.ValueByName('Name').AsString, jimPage);
  441. Result := CreateProjectFrame(OpenProjectManager.Open(ARec), jimPage);
  442. ProjectManager.AddOpenTenderBackup(ARec.ValueByName('ID').AsInteger);
  443. end;
  444. procedure TMainForm.jtsProjectsChange(Sender: TObject; NewTab: Integer;
  445. var AllowChange: Boolean);
  446. begin
  447. LocateProjectView(NewTab - 1);
  448. ResetProcessView(NewTab);
  449. end;
  450. procedure TMainForm.LocateProjectView(AIndex: Integer);
  451. begin
  452. if AIndex >= 0 then
  453. begin
  454. jpsMain.ActivePage := jpsMainProjects;
  455. jpsProjects.ActivePage := TJimPage(jtsProjects.Tabs.Objects[AIndex + 1]);
  456. OpenProjectManager.CurProjectIndex := AIndex;
  457. ChangeLeftSideGlobalView(AIndex);
  458. end
  459. else
  460. jpsMain.ActivePage := jpsMainProjectsManager;
  461. end;
  462. procedure TMainForm.ChangeLeftSideGlobalView(AIndex: Integer);
  463. begin
  464. if (AIndex >= 0) and (AIndex < FProjectFrames.Count) then
  465. TProjectFrame(FProjectFrames[AIndex]).ResetAssistantView;
  466. end;
  467. procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  468. begin
  469. try
  470. OpenProjectManager.SaveAll;
  471. except
  472. end;
  473. end;
  474. procedure TMainForm.jtsProjectsMouseDown(Sender: TObject;
  475. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  476. begin
  477. if (Button = mbRight) and (jtsProjects.TabIndex > 0) then
  478. dxpmTabSet.PopupFromCursorPos;
  479. end;
  480. procedure TMainForm.actnCloseProjectExecute(Sender: TObject);
  481. begin
  482. OpenProjectManager.CurProjectData.SaveAndCheck;
  483. DeleteProjectView(jtsProjects.TabIndex - 1);
  484. LocateProjectView(jtsProjects.TabIndex - 1);
  485. ResetProcessView(jtsProjects.TabIndex);
  486. end;
  487. procedure TMainForm.actnCloseProjectUpdate(Sender: TObject);
  488. begin
  489. TAction(Sender).Enabled := jtsProjects.Tabs.Count > 1;
  490. end;
  491. procedure TMainForm.DeleteProjectView(AIndex: Integer);
  492. begin
  493. TProjectFrame(FProjectFrames[AIndex]).Free;
  494. FProjectFrames.Delete(AIndex);
  495. OpenProjectManager.Delete(AIndex);
  496. jpsProjects.Pages.Delete(AIndex);
  497. jtsProjects.Tabs.Delete(AIndex + 1);
  498. end;
  499. procedure TMainForm.actnNewPhaseExecute(Sender: TObject);
  500. begin
  501. TProjectFrame(FProjectFrames[jtsProjects.TabIndex - 1]).CreateNewPhase;
  502. end;
  503. procedure TMainForm.actnProjectPropertiesUpdate(Sender: TObject);
  504. begin
  505. TAction(Sender).Enabled := jtsProjects.TabIndex > 0;
  506. end;
  507. procedure TMainForm.actnProjectPropertiesExecute(Sender: TObject);
  508. begin
  509. ModifyProjectProperties(TProjectFrame(FProjectFrames[jtsProjects.TabIndex - 1]));
  510. end;
  511. procedure TMainForm.actnSaveProjectExecute(Sender: TObject);
  512. begin
  513. OpenProjectManager.CurProjectData.SaveAndCheck;
  514. end;
  515. procedure TMainForm.actnNewAuditExecute(Sender: TObject);
  516. begin
  517. TProjectFrame(FProjectFrames[jtsProjects.TabIndex - 1]).CreateNewAudit;
  518. end;
  519. procedure TMainForm.actnNewPhaseUpdate(Sender: TObject);
  520. begin
  521. TAction(Sender).Enabled := (jtsProjects.Tabs.Count > 1) and Assigned(CurProjectFrame);
  522. if TAction(Sender).Enabled then
  523. with CurProjectFrame.ProjectData do
  524. TAction(Sender).Enabled := TAction(Sender).Enabled and (ProjProperties.AuditStatus = -1);
  525. end;
  526. function TMainForm.GetCurProjectFrame: TProjectFrame;
  527. begin
  528. if jtsProjects.TabIndex > 0 then
  529. Result := TProjectFrame(FProjectFrames[jtsProjects.TabIndex - 1])
  530. else
  531. Result := nil;
  532. end;
  533. procedure TMainForm.actnOptionsExecute(Sender: TObject);
  534. begin
  535. ModifiedOptions;
  536. ResetAutoSave;
  537. end;
  538. procedure TMainForm.actnImportExcelExecute(Sender: TObject);
  539. var
  540. sFileName: string;
  541. Importor: Tdei_CustomBills;
  542. bWithLevelCode, bWithoutGclBills: Boolean;
  543. begin
  544. if HintAndImportTypeSelect(bWithLevelCode, bWithoutGclBills) then
  545. begin
  546. if SelectExcelFile(sFileName) then
  547. begin
  548. Importor := Tdei_CustomBills.Create(CurProjectFrame.ProjectData);
  549. try
  550. Importor.ImportFile(sFileName, bWithLevelCode, bWithoutGclBills);
  551. finally
  552. Importor.Free;
  553. end;
  554. end;
  555. end;
  556. end;
  557. procedure TMainForm.ResetProcessView(AIndex: Integer);
  558. begin
  559. dxBarManager.Bars[2].Visible := AIndex > 0;
  560. if G_IsCloud then
  561. dxBarManager.Bars[2].Visible := False;
  562. end;
  563. procedure TMainForm.actnReplyExecute(Sender: TObject); // 批复
  564. begin
  565. if not CurProjectFrame.CheckCanReport then Exit;
  566. Screen.Cursor := crHourGlass;
  567. try
  568. CurProjectFrame.ProjectData.SaveAndCheck;
  569. {$O-}
  570. // 失败后重复一次
  571. if not CurProjectFrame.ProjectData.ReplyProject then
  572. begin
  573. if not CurProjectFrame.ProjectData.ReplyProject then
  574. ErrorMessage('批复项目失败!');
  575. end;
  576. {$O+}
  577. finally
  578. Screen.Cursor := crDefault;
  579. end;
  580. end;
  581. procedure TMainForm.actnSubmitExecute(Sender: TObject); // 上报
  582. begin
  583. if not CurProjectFrame.CheckCanReport then Exit;
  584. Screen.Cursor := crHourGlass;
  585. try
  586. CurProjectFrame.ProjectData.SaveAndCheck;
  587. {$O-}
  588. // 失败后重复一次
  589. if not CurProjectFrame.ProjectData.SubmitProject then
  590. begin
  591. if not CurProjectFrame.ProjectData.SubmitProject then
  592. ErrorMessage('上报项目失败!');
  593. end;
  594. {$O+}
  595. finally
  596. Screen.Cursor := crDefault;
  597. end;
  598. end;
  599. procedure TMainForm.dxBarManagerShowToolbarsPopup(Sender: TdxBarManager;
  600. PopupItemLinks: TdxBarItemLinks);
  601. begin
  602. // 取消菜单栏右键菜单
  603. PopupItemLinks.Clear;
  604. end;
  605. procedure TMainForm.actnSubmitUpdate(Sender: TObject);
  606. begin
  607. with CurProjectFrame.ProjectData do
  608. TAction(Sender).Enabled := (ProjProperties.PhaseCount > 0) and
  609. ((ProjProperties.AuditStatus >= 0) and (ProjProperties.AuditStatus < iMaxStageCount-1));
  610. end;
  611. procedure TMainForm.actnImportExcelUpdate(Sender: TObject);
  612. begin
  613. TAction(Sender).Enabled := (jtsProjects.Tabs.Count > 1) and Assigned(CurProjectFrame);
  614. if TAction(Sender).Enabled then
  615. with CurProjectFrame.ProjectData do
  616. TAction(Sender).Enabled := TAction(Sender).Enabled and (PhaseIndex < 1);
  617. end;
  618. procedure TMainForm.actnUnlockInfoUpdate(Sender: TObject);
  619. begin
  620. TAction(Sender).Enabled := (jtsProjects.Tabs.Count > 1) and Assigned(CurProjectFrame);
  621. end;
  622. procedure TMainForm.actnUnlockInfoExecute(Sender: TObject);
  623. begin
  624. CurProjectFrame.UnLockData;
  625. end;
  626. procedure TMainForm.dxbtnAboutClick(Sender: TObject);
  627. begin
  628. ShowAboutForm;
  629. end;
  630. procedure TMainForm.dxLoginCloudClick(Sender: TObject);
  631. begin
  632. ShellExecute(Application.Handle, nil, PChar(PHPWeb.LoginCloudURL), nil, nil, SW_SHOWNORMAL);
  633. end;
  634. procedure TMainForm.dxManageAccountClick(Sender: TObject);
  635. begin
  636. ShellExecute(Application.Handle, nil, PChar(PHPWeb.PassportURL), nil, nil, SW_SHOWNORMAL);
  637. end;
  638. procedure TMainForm.dxbtnAuthorizeDogClick(Sender: TObject);
  639. begin
  640. Authorize;
  641. end;
  642. procedure TMainForm.actnImportBillsPriceExecute(Sender: TObject);
  643. var
  644. sFileName: string;
  645. Importor: TBillsPriceExcelImport;
  646. begin
  647. if SelectExcelFile(sFileName) then
  648. begin
  649. Importor := TBillsPriceExcelImport.Create(CurProjectFrame.ProjectData);
  650. try
  651. Importor.ImportFile(sFileName);
  652. finally
  653. Importor.Free;
  654. end;
  655. end;
  656. end;
  657. procedure TMainForm.actnImportDealBillsExecute(Sender: TObject);
  658. var
  659. sFileName: string;
  660. Importor: TDealBillsExcelImport;
  661. begin
  662. if SelectExcelFile(sFileName) then
  663. begin
  664. Importor := TDealBillsExcelImport.Create(CurProjectFrame.ProjectData);
  665. try
  666. Importor.ImportFile(sFileName);
  667. finally
  668. Importor.Free;
  669. end;
  670. end;
  671. end;
  672. procedure TMainForm.tAutoSaveTimer(Sender: TObject);
  673. begin
  674. Screen.Cursor := crHourGlass;
  675. try
  676. OpenProjectManager.SaveAll;
  677. finally
  678. screen.Cursor := crDefault;
  679. end;
  680. end;
  681. procedure TMainForm.ResetAutoSave;
  682. begin
  683. with SupportManager.ConfigInfo do
  684. begin
  685. tAutoSave.Interval := AutoSaveInterval * 60 * 1000;
  686. tAutoSave.Enabled := AutoSave;
  687. end;
  688. end;
  689. procedure TMainForm.actnExportExcelExecute(Sender: TObject);
  690. var
  691. sFileName: string;
  692. Exportor: TIDTreeExcelExportor;
  693. begin
  694. if SaveExcelFile(sFileName) then
  695. begin
  696. Exportor := TIDTreeExcelExportor.Create;
  697. try
  698. if SupportManager.ConfigInfo.ExcelWithMis then
  699. Exportor.DefineCol(@ciLedgerWithMis, Length(ciLedgerWithMis))
  700. else
  701. Exportor.DefineCol(@ciLedger, Length(ciLedger));
  702. Exportor.HasLevelCode := True;
  703. Exportor.ExportToFile(CurProjectFrame.ProjectData.BillsCompileData.BillsCompileTree, sFileName);
  704. finally
  705. Exportor.Free;
  706. end;
  707. end;
  708. end;
  709. procedure TMainForm.dxSyncClick(Sender: TObject);
  710. begin
  711. Screen.Cursor := crHourGlass;
  712. try
  713. FProjectManagerFrame.DoBatchReceiveAllOnline;
  714. finally
  715. Screen.Cursor := crDefault;
  716. end;
  717. end;
  718. procedure TMainForm.actnExportCloudTenderFileExecute(Sender: TObject);
  719. var
  720. sFileName: string;
  721. Exportor: TTenderExport;
  722. Rec: TsdDataRecord;
  723. begin
  724. // 导出前先保存
  725. CurProjectFrame.ProjectData.SaveAndCheck;
  726. // 导出云版专用
  727. sFileName := SupportManager.ConfigInfo.OutputPath + CurProjectFrame.ProjectData.ProjectName + '.ctf';
  728. if SaveFile(sFileName, '.ctf') then
  729. begin
  730. if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”,是否替换?', [ExtractFileName(sFileName)])) then
  731. Exit;
  732. Screen.Cursor := crHourGlass;
  733. try
  734. Rec := ProjectManagerFrame.Rec(CurProjectFrame.ProjectData.ProjectID);
  735. Exportor := TTenderExport.Create(Rec, sFileName);
  736. try
  737. Exportor.Execute;
  738. finally
  739. Exportor.Free;
  740. end;
  741. finally
  742. Screen.Cursor := crDefault;
  743. end;
  744. end;
  745. end;
  746. procedure TMainForm.actnExportCloudTenderFileUpdate(Sender: TObject);
  747. begin
  748. // 仅打开的项目可以导出云版专用格式,且该项目没有进行计量
  749. TAction(Sender).Enabled := (jtsProjects.Tabs.Count > 1) and Assigned(CurProjectFrame);
  750. if TAction(Sender).Enabled then
  751. TAction(Sender).Enabled := CurProjectFrame.ProjectData.ProjProperties.PhaseCount = 0;
  752. end;
  753. procedure TMainForm.actnImportCloudTenderFileExecute(Sender: TObject);
  754. var
  755. sFileName: string;
  756. begin
  757. if SelectFile(sFileName, '.ctf') then
  758. begin
  759. CurProjectFrame.ProjectData.ImportCloudTenderFile(sFileName);
  760. CurProjectFrame.RefreshColumnDisplay;
  761. end;
  762. end;
  763. procedure TMainForm.actnImportCloudTenderFileUpdate(Sender: TObject);
  764. begin
  765. TAction(Sender).Enabled := (jtsProjects.Tabs.Count > 1) and Assigned(CurProjectFrame);
  766. if TAction(Sender).Enabled then
  767. TAction(Sender).Enabled := CurProjectFrame.ProjectData.ProjProperties.PhaseCount = 0;
  768. end;
  769. procedure TMainForm.actnExportFxBillsExcelExecute(Sender: TObject);
  770. var
  771. sFileName: string;
  772. Exportor: TIDTreeExcelExportor;
  773. begin
  774. if SaveExcelFile(sFileName) then
  775. begin
  776. Exportor := TIDTreeExcelExportor.Create;
  777. try
  778. if SupportManager.ConfigInfo.ExcelWithMis then
  779. Exportor.DefineCol(@ciFxBillsWithMis, Length(ciFxBillsWithMis))
  780. else
  781. Exportor.DefineCol(@ciFxBills, Length(ciFxBills));
  782. Exportor.ExportToFile(CurProjectFrame.ProjectData.BillsCompileData.BillsCompileTree, sFileName);
  783. finally
  784. Exportor.Free;
  785. end;
  786. end;
  787. end;
  788. procedure TMainForm.dxseBatchInsertKeyDown(Sender: TObject; var Key: Word;
  789. Shift: TShiftState);
  790. var
  791. i: Integer;
  792. begin
  793. if Key = 13 then
  794. begin
  795. for i := 1 to dxseBatchInsert.IntValue do
  796. ZjDbaInsert.ExecuteTarget(CurProjectFrame.BillsCompileFrame.zgBillsCompile);
  797. end;
  798. end;
  799. procedure TMainForm.actnReplyUpdate(Sender: TObject);
  800. begin
  801. with CurProjectFrame.ProjectData do
  802. TAction(Sender).Enabled := (ProjProperties.PhaseCount > 0);
  803. end;
  804. procedure TMainForm.dxbtnTenderPartitionClick(Sender: TObject);
  805. begin
  806. PartTendersModel;
  807. end;
  808. procedure TMainForm.actnImportDmfExecute(Sender: TObject);
  809. var
  810. sFileName: string;
  811. begin
  812. if SelectFile(sFileName, '.dmf') then
  813. CurProjectFrame.ProjectData.ImportDmfFile(sFileName);
  814. end;
  815. procedure TMainForm.dxbtnHelpCenterClick(Sender: TObject);
  816. const
  817. sHelpUrl = 'http://help.smartcost.com.cn/hc/';
  818. begin
  819. ShellExecute(Application.Handle, nil, PChar(sHelpUrl), nil, nil, SW_SHOWNORMAL);
  820. end;
  821. procedure TMainForm.OnError(ASender: TObject; AE: Exception);
  822. begin
  823. MeasureLog.AppendLogTo(AE.Message);
  824. end;
  825. procedure TMainForm.actnExportSumBaseFileExecute(Sender: TObject);
  826. var
  827. sFileName: string;
  828. Exportor: TTenderExport;
  829. Rec: TsdDataRecord;
  830. begin
  831. // 导出前先保存
  832. CurProjectFrame.ProjectData.SaveAndCheck;
  833. // 导出云版专用
  834. sFileName := SupportManager.ConfigInfo.OutputPath + CurProjectFrame.ProjectData.ProjectName + '.sbf';
  835. if SaveFile(sFileName, '.sbf') then
  836. begin
  837. if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”,是否替换?', [ExtractFileName(sFileName)])) then
  838. Exit;
  839. Screen.Cursor := crHourGlass;
  840. try
  841. Rec := ProjectManagerFrame.Rec(CurProjectFrame.ProjectData.ProjectID);
  842. Exportor := TTenderExport.Create(Rec, sFileName);
  843. try
  844. Exportor.Execute;
  845. finally
  846. Exportor.Free;
  847. end;
  848. finally
  849. Screen.Cursor := crDefault;
  850. end;
  851. end;
  852. end;
  853. procedure TMainForm.dxbtnGatherSubTenderClick(Sender: TObject);
  854. var
  855. gc: TstgGatherControl;
  856. begin
  857. gc := TstgGatherControl.Create;
  858. Screen.Cursor := crHourGlass;
  859. try
  860. if SelectFileForSubTenderGather(gc) then
  861. gc.Gather;
  862. finally
  863. gc.Free;
  864. Screen.Cursor := crDefault;
  865. end;
  866. end;
  867. procedure TMainForm.actnImportSubTenderGatherExecute(Sender: TObject);
  868. var
  869. sFileName: string;
  870. begin
  871. if CurProjectFrame.ProjectData.ProjProperties.PhaseCount = 0 then
  872. WarningMessage('未开始计量,请在开始计量后再导入分包汇总数据。')
  873. else if CurProjectFrame.ProjectData.StageDataReadOnly then
  874. WarningMessage('当前正在查看数据非最新数据,请切换至最新一期再导入分包汇总数据。')
  875. else if QuestMessage('导入将清空标段本期所有计量数据(合同计量),确定继续?') and SelectFile(sFileName, '.sgf') then
  876. CurProjectFrame.ProjectData.ImportSubTenderGather(sFileName);
  877. end;
  878. procedure TMainForm.actnImportSubTenderGatherUpdate(Sender: TObject);
  879. begin
  880. TAction(Sender).Enabled := (jtsProjects.Tabs.Count > 1) and Assigned(CurProjectFrame)
  881. and (CurProjectFrame.ProjectData.PhaseData.StageCount <= 1);
  882. end;
  883. procedure TMainForm.actnExportBillsJsonExecute(Sender: TObject);
  884. var
  885. sFileName: string;
  886. begin
  887. if SaveFile(sFileName, '.json') then
  888. CurProjectFrame.ProjectData.BillsCompileData.RecursiveExportBillsJson(sFileName);
  889. end;
  890. procedure TMainForm.actnExportBillsJsonUpdate(Sender: TObject);
  891. begin
  892. TAction(Sender).Visible := _IsDebugView;
  893. TAction(Sender).Enabled := jtsProjects.Tabs.Count > 1;
  894. end;
  895. procedure TMainForm.actnExportBillsPosExcelDataExecute(Sender: TObject);
  896. var
  897. sFileName: string;
  898. Exportor: TBillsPosExcelExportor;
  899. begin
  900. if SaveExcelFile(sFileName) then
  901. begin
  902. Exportor := TBillsPosExcelExportor.Create;
  903. try
  904. Exportor.ExportToFile(CurProjectFrame.ProjectData.BillsCompileData.BillsCompileTree, sFileName);
  905. finally
  906. Exportor.Free;
  907. end;
  908. end;
  909. end;
  910. procedure TMainForm.dxbtnGatherSubTenderGclClick(Sender: TObject);
  911. var
  912. gc: TstgGclGatherControl;
  913. begin
  914. gc := TstgGclGatherControl.Create;
  915. Screen.Cursor := crHourGlass;
  916. try
  917. if SelectFileForSubTenderGclGather(gc) then
  918. gc.Gather;
  919. finally
  920. gc.Free;
  921. Screen.Cursor := crDefault;
  922. end;
  923. end;
  924. procedure TMainForm.actnImportSubTenderGatherGclExecute(Sender: TObject);
  925. var
  926. sFileName: string;
  927. begin
  928. if CurProjectFrame.ProjectData.ProjProperties.PhaseCount = 0 then
  929. WarningMessage('未开始计量,请在开始计量后再导入分包汇总数据。')
  930. else if CurProjectFrame.ProjectData.StageDataReadOnly then
  931. WarningMessage('当前正在查看数据非最新数据,请切换至最新一期再导入分包汇总数据。')
  932. else if QuestMessage('导入将清空标段本期所有计量数据(合同计量),确定继续?') and SelectFile(sFileName, '.sgfg') then
  933. CurProjectFrame.ProjectData.ImportSubTenderGatherGcl(sFileName);
  934. end;
  935. procedure TMainForm.actnImportSubTenderGatherGclExcelExecute(
  936. Sender: TObject);
  937. var
  938. sFileName: string;
  939. begin
  940. if CurProjectFrame.ProjectData.ProjProperties.PhaseCount = 0 then
  941. WarningMessage('未开始计量,请在开始计量后再导入分包汇总数据。')
  942. else if CurProjectFrame.ProjectData.StageDataReadOnly then
  943. WarningMessage('当前正在查看数据非最新数据,请切换至最新一期再导入分包汇总数据。')
  944. else if QuestMessage('导入将清空标段本期所有计量数据(合同计量),确定继续?') and SelectExcelFile(sFileName) then
  945. CurProjectFrame.ProjectData.ImportSubTenderGatherGclExcel(sFileName);
  946. end;
  947. end.