MainFrm.pas 32 KB

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