BillsMeasureFme.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849
  1. unit BillsMeasureFme;
  2. interface
  3. uses
  4. BillsMeasureDm, UtilMethods, BillsClipboard, sdIDTreeCells,
  5. ColVisibleManager,
  6. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7. Dialogs, ZJGrid, ComCtrls, ToolWin, StdCtrls, ExtCtrls, sdGridDBA,
  8. sdGridTreeDBA, sdDB, ActnList, dxBar, sdIDTree, JimLabels, ZJCells;
  9. type
  10. TBillsMeasureFrame = class(TFrame)
  11. pnlExprs: TPanel;
  12. laEdtExprs: TLabeledEdit;
  13. pnlBills: TPanel;
  14. zgBillsMeasure: TZJGrid;
  15. stdBillsMeasure: TsdGridTreeDBA;
  16. dxpmBills: TdxBarPopupMenu;
  17. alBills: TActionList;
  18. actnCalculateAll: TAction;
  19. actnExportGridToExcel: TAction;
  20. actnSetStageBookmark: TAction;
  21. pnlNodeDetail: TPanel;
  22. pnlDealProperty: TPanel;
  23. labDealPropertyTitle: TJimGradLabel;
  24. zgDealProperty: TZJGrid;
  25. dxpmBillsCol: TdxBarPopupMenu;
  26. actnHiddenCol: TAction;
  27. actnCancelHiddenCol: TAction;
  28. actnLocateZJJL: TAction;
  29. procedure dxpmBillsPopup(Sender: TObject);
  30. procedure zgBillsMeasureMouseDown(Sender: TObject; Button: TMouseButton;
  31. Shift: TShiftState; X, Y: Integer);
  32. procedure laEdtExprsKeyDown(Sender: TObject; var Key: Word;
  33. Shift: TShiftState);
  34. procedure laEdtExprsExit(Sender: TObject);
  35. procedure actnCalculateAllExecute(Sender: TObject);
  36. procedure zgBillsMeasureCellGetColor(Sender: TObject; ACoord: TPoint;
  37. var AColor: TColor);
  38. procedure actnExportGridToExcelExecute(Sender: TObject);
  39. procedure zgBillsMeasureCellButtonClick(Sender: TObject; Col,
  40. Row: Integer);
  41. procedure zgBillsMeasureCustomPaste(Sender: TObject; ABounds: TRect;
  42. ASourSheet: TZjSheet);
  43. procedure zgBillsMeasureKeyDown(Sender: TObject; var Key: Word;
  44. Shift: TShiftState);
  45. procedure actnSetStageBookmarkExecute(Sender: TObject);
  46. procedure zgBillsMeasureCurrentChanged(Sender: TObject; Col,
  47. Row: Integer);
  48. procedure zgDealPropertyCellGetFont(Sender: TObject; ACoord: TPoint;
  49. AFont: TFont);
  50. procedure zgDealPropertyCellTextChanged(Sender: TObject; Col,
  51. Row: Integer);
  52. procedure zgDealPropertyCellCanEdit(Sender: TObject;
  53. const ACoord: TPoint; var Allow: Boolean);
  54. procedure actnSetStageBookmarkUpdate(Sender: TObject);
  55. procedure dxpmBillsColPopup(Sender: TObject);
  56. procedure actnHiddenColExecute(Sender: TObject);
  57. procedure actnCancelHiddenColExecute(Sender: TObject);
  58. procedure actnLocateZJJLExecute(Sender: TObject);
  59. procedure actnLocateZJJLUpdate(Sender: TObject);
  60. procedure actnCalculateAllUpdate(Sender: TObject);
  61. procedure zgBillsMeasureCellCanEdit(Sender: TObject;
  62. const ACoord: TPoint; var Allow: Boolean);
  63. private
  64. FBillsMeasureData: TBillsMeasureData;
  65. FShowPriceChange: Boolean;
  66. FShowBGLCode: Boolean;
  67. FShowDesignQuantity: Boolean;
  68. FShowAddField: Boolean; // For Inner Test
  69. FShowPMField: Boolean; // For Inner Test
  70. FOnAfterSetBookmark: TBookmarkRefreshEvent;
  71. FShowAlias: Boolean;
  72. FShowApprovalCode: Boolean;
  73. FShowIsGather: Boolean;
  74. FColVisibleManager: TBM_ColVisibleManager;
  75. FOnLocateZJJL: TLocateZJJLEvent;
  76. procedure ExpandMouseDown(AGridCell: TzjCell);
  77. function GridColToDBACol(AGridCol: Integer): Integer;
  78. procedure ShowGridCols(AShow: Boolean; ALeft, ARight: Integer);
  79. function CheckExprsColumn: Boolean;
  80. function CheckMemoStrColumn: Boolean;
  81. procedure SetColumnVisible(const AColumn: string; AVisible: Boolean);
  82. procedure SetAddFieldVisible(AValue: Boolean);
  83. procedure SetPMFieldVisible(AValue: Boolean);
  84. procedure LoadDealProperty(ARec: TsdDataRecord);
  85. procedure BeginExpandNode;
  86. procedure EndExpandNode;
  87. procedure ResetPhaseDataReadOnly(AReadOnly: Boolean);
  88. procedure ResetBaseDataReadOnly(AReadOnly: Boolean);
  89. procedure ResetAllowInsert(AAllow: Boolean);
  90. procedure SetShowPriceChange(const Value: Boolean);
  91. procedure SetShowBGLCode(const Value: Boolean);
  92. procedure SetShowDesignQuantity(const Value: Boolean);
  93. procedure SetShowAlias(const Value: Boolean);
  94. procedure SetShowApprovalCode(const Value: Boolean);
  95. procedure SetShowIsGather(const Value: Boolean);
  96. procedure OnGridBeforeDelete(Sender: TObject; var CanExecute: Boolean);
  97. public
  98. constructor Create(AProjectFrame: TFrame; ABillsMeasureData: TBillsMeasureData);
  99. destructor Destroy; override;
  100. procedure ExpandNodeTo(ALevel: Integer);
  101. procedure ExpandXmjNode;
  102. procedure ExpandCurPhase;
  103. procedure RefreshPhase_Stage;
  104. property ShowPriceChange: Boolean read FShowPriceChange write SetShowPriceChange;
  105. property ShowBGLCode: Boolean read FShowBGLCode write SetShowBGLCode;
  106. property ShowDesignQuantity: Boolean read FShowDesignQuantity write SetShowDesignQuantity;
  107. property ShowAlias: Boolean read FShowAlias write SetShowAlias;
  108. property ShowApprovalCode: Boolean read FShowApprovalCode write SetShowApprovalCode;
  109. property ShowIsGather: Boolean read FShowIsGather write SetShowIsGather;
  110. property OnAfterSetBookmark: TBookmarkRefreshEvent read FOnAfterSetBookmark write FOnAfterSetBookmark;
  111. property OnLocateZJJL: TLocateZJJLEvent read FOnLocateZJJL write FOnLocateZJJL;
  112. property BillsMeasureData: TBillsMeasureData read FBillsMeasureData;
  113. end;
  114. implementation
  115. {$R *.dfm}
  116. uses
  117. MainFrm, ProjectFme, ProjectData, ExportExcel, BGLDm, BGLSelectFrm,
  118. Types, ZhAPI, BillsTree, mDataRecord, ConditionalDefines, Math;
  119. { TBillsFrame }
  120. constructor TBillsMeasureFrame.Create(AProjectFrame: TFrame;
  121. ABillsMeasureData: TBillsMeasureData);
  122. begin
  123. inherited Create(AProjectFrame);
  124. FBillsMeasureData := ABillsMeasureData;
  125. stdBillsMeasure.IDTree := FBillsMeasureData.BillsMeasureTree;
  126. zgBillsMeasure.OnExpandMouseDown := ExpandMouseDown;
  127. FColVisibleManager := TBM_ColVisibleManager.Create(stdBillsMeasure);
  128. if not _IsDebugView then
  129. zgBillsMeasure.OnKeyDown := nil;
  130. stdBillsMeasure.OnGridBeforeDelete := OnGridBeforeDelete;
  131. end;
  132. destructor TBillsMeasureFrame.Destroy;
  133. begin
  134. FColVisibleManager.Free;
  135. inherited;
  136. end;
  137. procedure TBillsMeasureFrame.dxpmBillsPopup(Sender: TObject);
  138. begin
  139. SetDxBtnAction(actnCalculateAll, MainForm.dxbtnCalculateAll);
  140. SetDxBtnAction(actnExportGridToExcel, MainForm.dxbtnExportGridToExcel);
  141. SetDxBtnAction(actnSetStageBookmark, MainForm.dxbtnSetBookmark);
  142. SetDxBtnAction(actnLocateZJJL, MainForm.dxbtnLocateZJJL);
  143. end;
  144. procedure TBillsMeasureFrame.zgBillsMeasureMouseDown(Sender: TObject;
  145. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  146. var
  147. vCol: TsdGridColumn;
  148. vViewCol: TsdViewColumn;
  149. begin
  150. if Button = mbRight then
  151. begin
  152. if _IsDebugView and (zgBillsMeasure.Selection.SelectType = stCol) and (Y < (zgBillsMeasure.RowHeights[0] + zgBillsMeasure.RowHeights[1])) then
  153. dxpmBillsCol.PopupFromCursorPos
  154. else
  155. dxpmBills.PopupFromCursorPos;
  156. end
  157. else
  158. begin
  159. if CheckExprsColumn or CheckMemoStrColumn then
  160. laEdtExprs.Text := zgBillsMeasure.CurCell.EditText
  161. else
  162. laEdtExprs.Text := '';
  163. stdBillsMeasure.FindColumn(zgBillsMeasure.CurCol, vCol);
  164. laEdtExprs.ReadOnly := vCol.ReadOnly;
  165. end;
  166. end;
  167. procedure TBillsMeasureFrame.SetShowPriceChange(const Value: Boolean);
  168. begin
  169. FShowPriceChange := Value;
  170. FColVisibleManager.ShowPriceChange(FShowPriceChange);
  171. end;
  172. procedure TBillsMeasureFrame.laEdtExprsKeyDown(Sender: TObject; var Key: Word;
  173. Shift: TShiftState);
  174. begin
  175. if Key = VK_Return then
  176. begin
  177. zgBillsMeasure.SetFocus;
  178. if not TLabeledEdit(Sender).ReadOnly then
  179. if CheckExprsColumn or CheckMemoStrColumn then
  180. zgBillsMeasure.CurCell.Text := laEdtExprs.Text;
  181. end;
  182. end;
  183. procedure TBillsMeasureFrame.laEdtExprsExit(Sender: TObject);
  184. begin
  185. if not TLabeledEdit(Sender).ReadOnly then
  186. if CheckExprsColumn or CheckMemoStrColumn then
  187. zgBillsMeasure.CurCell.Text := laEdtExprs.Text;
  188. end;
  189. procedure TBillsMeasureFrame.actnCalculateAllExecute(Sender: TObject);
  190. begin
  191. Screen.Cursor := crHourGlass;
  192. try
  193. TProjectData(FBillsMeasureData.ProjectData).CalculateAll;
  194. finally
  195. Screen.Cursor := crDefault;
  196. end;
  197. end;
  198. procedure TBillsMeasureFrame.zgBillsMeasureCellGetColor(Sender: TObject; ACoord: TPoint;
  199. var AColor: TColor);
  200. var
  201. stnNode: TMeasureBillsIDTreeNode;
  202. iCreatePhaseID: Integer;
  203. StageRec: TStageRecord;
  204. fDiffer, fCompare: Double;
  205. begin
  206. AColor := clWindow;
  207. if ACoord.Y > stdBillsMeasure.IDTree.Count + 1 then Exit;
  208. stnNode := TMeasureBillsIDTreeNode(stdBillsMeasure.IDTree.Items[ACoord.Y - 2]);
  209. if not Assigned(stnNode) then Exit;
  210. iCreatePhaseID := stnNode.Rec.CreatePhaseID.AsInteger;
  211. // 根据层次底色不同
  212. if stnNode.ParentID = 1 then
  213. AColor := $00FBCAC4
  214. else if (stnNode.Rec.B_Code.AsString = '') and (stnNode.Level > 0) then
  215. AColor := $00F9E8DF;
  216. // 书签
  217. if TProjectData(FBillsMeasureData.ProjectData).ProjProperties.PhaseCount > 0 then
  218. begin
  219. StageRec := stnNode.StageRec;
  220. if Assigned(StageRec) and StageRec.HasBookmark.AsBoolean then
  221. AColor := $00CFE2F9;
  222. end;
  223. // 根据节点创建期数底色不同
  224. if iCreatePhaseID > 0 then
  225. begin
  226. // 当前期不存在节点,底色为灰色提示用户
  227. if iCreatePhaseID > TProjectData(FBillsMeasureData.ProjectData).PhaseIndex then
  228. AColor := $00D5D5D5
  229. // 当前期新增节点,底色为黄色提示用户
  230. else if iCreatePhaseID = TProjectData(FBillsMeasureData.ProjectData).PhaseIndex then
  231. AColor := $00A7FDFD;
  232. end;
  233. // 叶子节点,累计合同计量超过0号台账,整行数据的底色变为暗红提示用户
  234. if TProjectData(FBillsMeasureData.ProjectData).ProjProperties.ShowOverRange and not stnNode.HasChildren then
  235. begin
  236. with stnNode.Rec do
  237. begin
  238. if CalcType.AsInteger = 0 then
  239. begin
  240. fDiffer := QuantityRoundTo(AddDealQuantity.AsFloat - Quantity.AsFloat);
  241. fCompare := TProjectData(FBillsMeasureData.ProjectData).ProjProperties.DecimalManager.Common.Quantity.CompareValue;
  242. end
  243. else
  244. begin
  245. fDiffer := TotalPriceRoundTo(AddDealTotalPrice.AsFloat - TotalPrice.AsFloat);
  246. fCompare := TProjectData(FBillsMeasureData.ProjectData).ProjProperties.DecimalManager.Common.TotalPrice.CompareValue;
  247. end;
  248. if fDiffer > fCompare then
  249. AColor := $00646AFE;
  250. end;
  251. end;
  252. end;
  253. procedure TBillsMeasureFrame.SetColumnVisible(const AColumn: string;
  254. AVisible: Boolean);
  255. begin
  256. if AVisible then
  257. stdBillsMeasure.Column(AColumn).Width := 60
  258. else
  259. stdBillsMeasure.Column(AColumn).Width := 0;
  260. end;
  261. procedure TBillsMeasureFrame.SetShowBGLCode(const Value: Boolean);
  262. begin
  263. FShowBGLCode := Value;
  264. FColVisibleManager.ShowBGLCode(FShowBGLCode);
  265. end;
  266. procedure TBillsMeasureFrame.actnExportGridToExcelExecute(Sender: TObject);
  267. var
  268. sFileName: string;
  269. ExcelExportor: TExcelExportor;
  270. begin
  271. if SaveExcelFile(sFileName) then
  272. begin
  273. ExcelExportor := TExcelExportor.Create;
  274. try
  275. ExcelExportor.ExportToFile(zgBillsMeasure, sFileName);
  276. finally
  277. ExcelExportor.Free;
  278. end;
  279. end;
  280. end;
  281. function TBillsMeasureFrame.CheckExprsColumn: Boolean;
  282. var
  283. iCol: Integer;
  284. begin
  285. iCol := zgBillsMeasure.CurCol - zgBillsMeasure.FixedColCount;
  286. Result := (iCol = stdBillsMeasure.VisibleCol('CurDealQuantity'))
  287. or (iCol = stdBillsMeasure.VisibleCol('CurDealTotalPrice'));
  288. //or (iCol = stdBillsMeasure.VisibleCol('CurQcQuantity'))
  289. //or (iCol = stdBillsMeasure.VisibleCol('CurQcTotalPrice'))
  290. //or (iCol = stdBillsMeasure.VisibleCol('CurPcQuantity'))
  291. //or (iCol = stdBillsMeasure.VisibleCol('CurPcTotalPrice'));
  292. end;
  293. procedure TBillsMeasureFrame.zgBillsMeasureCellButtonClick(Sender: TObject;
  294. Col, Row: Integer);
  295. procedure SelectAndUpdateBGL(const AType, AField: string; ANode: TsdIDTreeNode);
  296. var
  297. vOrgBGL, vNewBGL: TBGLSelectInfo;
  298. StageRec: TStageRecord;
  299. begin
  300. if not Assigned(ANode) then Exit;
  301. StageRec := TMeasureBillsIDTreeNode(ANode).StageRec;
  302. try
  303. if Assigned(StageRec) then
  304. begin
  305. vOrgBGL := TBGLSelectInfo.Create(ANode.Rec,
  306. StageRec.ValueByName(AType + AField).AsFloat, True);
  307. vOrgBGL.MergedCode := StageRec.ValueByName(AType + 'BGLCode').AsString;
  308. vOrgBGL.MergedNum := StageRec.ValueByName(AType + 'BGLNum').AsString;
  309. end
  310. else
  311. vOrgBGL := TBGLSelectInfo.Create(ANode.Rec, 0, True);
  312. vNewBGL := TBGLSelectInfo.Create(ANode.Rec, 0, False);
  313. if SelectBGLAndBGNum(vOrgBGL, vNewBGL, FBillsMeasureData.ProjectData) then
  314. begin
  315. if not Assigned(StageRec) then
  316. begin
  317. StageRec := FBillsMeasureData.StageData.AddStageRecord(ANode.ID);
  318. TMeasureBillsIDTreeNode(ANode).StageRec := StageRec;
  319. end;
  320. StageRec.ValueByName(AType + AField).AsFloat := vNewBGL.TotalNum;
  321. StageRec.ValueByName(AType + 'BGLCode').AsString := vNewBGL.MergedCode;
  322. StageRec.ValueByName(AType + 'BGLNum').AsString := vNewBGL.MergedNum;
  323. FBillsMeasureData.StageData.UpdateBGLInfo(StageRec, AType);
  324. FBillsMeasureData.UpdateBGLInfo(ANode.ID, StageRec, AType);
  325. TProjectData(FBillsMeasureData.ProjectData).BGLData.ApplyBGL(vOrgBGL, vNewBGL);
  326. // 重新计算合同支付所有数据
  327. TProjectData(FBillsMeasureData.ProjectData).PhaseData.PhasePayData.CalculateAll;
  328. end;
  329. finally
  330. vOrgBGL.Free;
  331. vNewBGL.Free;
  332. end;
  333. end;
  334. procedure GetTypeAndField(var AType, AField: string);
  335. begin
  336. if (Col = stdBillsMeasure.VisibleCol('CurQcQuantity') + 1) then
  337. begin
  338. AType := 'Qc';
  339. AField := 'Quantity';
  340. end
  341. else if (Col = stdBillsMeasure.VisibleCol('CurPcQuantity') + 1) then
  342. begin
  343. AType := 'Pc';
  344. AField := 'Quantity';
  345. end;
  346. end;
  347. var
  348. stnCurNode: TBillsIDTreeNode;
  349. sType, sField: string;
  350. begin
  351. stnCurNode := TBillsIDTreeNode(stdBillsMeasure.IDTree.Selected);
  352. if stnCurNode.HasChildren then Exit;
  353. with TProjectData(FBillsMeasureData.ProjectData) do
  354. if PhaseData.StageDataReadOnly then Exit;
  355. GetTypeAndField(sType, sField);
  356. if (sType = '') or (sField = '') then Exit;
  357. if stnCurNode.Rec.CalcType.AsInteger = 1 then
  358. begin
  359. WarningMessage('该清单不可输入数量单价,如需使用数量×单价计算,请先清空所有直接输入的金额!');
  360. Exit;
  361. end;
  362. SelectAndUpdateBGL(sType, sField, stnCurNode);
  363. end;
  364. procedure TBillsMeasureFrame.zgBillsMeasureCustomPaste(Sender: TObject;
  365. ABounds: TRect; ASourSheet: TZjSheet);
  366. var
  367. iRow, iCol: Integer;
  368. begin
  369. for iRow := ABounds.Top to ABounds.Bottom - 1 do
  370. begin
  371. if not zgBillsMeasure.RowVisible[iRow] then Continue;
  372. for iCol := ABounds.Left to ABounds.Right - 1 do
  373. with TZJGrid(Sender).Cells[iCol, iRow] do
  374. if CanEdit then Text := ASourSheet.Values[iCol - ABounds.Left, iRow - ABounds.Top];
  375. end;
  376. end;
  377. procedure TBillsMeasureFrame.SetShowDesignQuantity(const Value: Boolean);
  378. begin
  379. FShowDesignQuantity := Value;
  380. FColVisibleManager.ShowDesign(FShowDesignQuantity);
  381. end;
  382. procedure TBillsMeasureFrame.SetAddFieldVisible(AValue: Boolean);
  383. begin
  384. FShowAddField := AValue;
  385. stdBillsMeasure.Column('AddDealQuantity').Visible := AValue;
  386. stdBillsMeasure.Column('AddDealTotalPrice').Visible := AValue;
  387. stdBillsMeasure.Column('AddQcQuantity').Visible := AValue;
  388. stdBillsMeasure.Column('AddQcTotalPrice').Visible := AValue;
  389. stdBillsMeasure.Column('AddPcQuantity').Visible := AValue;
  390. stdBillsMeasure.Column('AddPcTotalPrice').Visible := AValue;
  391. stdBillsMeasure.Column('AddGatherQuantity').Visible := AValue;
  392. stdBillsMeasure.Column('AddGatherTotalPrice').Visible := AValue;
  393. end;
  394. procedure TBillsMeasureFrame.zgBillsMeasureKeyDown(Sender: TObject;
  395. var Key: Word; Shift: TShiftState);
  396. begin
  397. // For Inner Test
  398. if (ssCtrl in Shift) and (ssShift in Shift) and (ssAlt in Shift)
  399. and (Key in [65, 97]) // 'a', 'A'
  400. and (zgBillsMeasure.CurCol = 4) then
  401. SetAddFieldVisible(not FShowAddField);
  402. if (ssCtrl in Shift) and (ssShift in Shift) and (ssAlt in Shift)
  403. and (Key in [80, 112]) // 'p', 'P' - Parent
  404. and (zgBillsMeasure.CurCol = 5) then
  405. begin
  406. FBillsMeasureData.ShowParentData := not FBillsMeasureData.ShowParentData;
  407. zgBillsMeasure.Invalidate;
  408. end;
  409. if (ssCtrl in Shift) and (ssShift in Shift) and (ssAlt in Shift)
  410. and (Key in [77, 109]) // 'm', 'M' - PriceMargin
  411. and (zgBillsMeasure.CurCol = 5) then
  412. begin
  413. SetPMFieldVisible(not FShowPMField);
  414. end;
  415. if (ssCtrl in Shift) and (ssShift in Shift) and (ssAlt in Shift)
  416. and (Key in [67, 99]) then // 'c', 'C'
  417. begin
  418. if _IsDebugView then
  419. TProjectData(FBillsMeasureData.ProjectData).CalculateAll
  420. else
  421. actnCalculateAll.Execute;
  422. end;
  423. if (ssCtrl in Shift) and (ssShift in Shift) and (ssAlt in Shift)
  424. and (Key in [66, 98]) then
  425. ShowIsGather := not ShowIsGather;
  426. if (zgBillsMeasure.CurCol = 11) then
  427. begin
  428. if (Key in [48..57]) then
  429. zgBillsMeasureCellButtonClick(Sender, zgBillsMeasure.CurCol, zgBillsMeasure.CurRow)
  430. else if (Key in [8, 46]) then
  431. FBillsMeasureData.ClearCurQcQty(TMeasureBillsIDTreeNode(stdBillsMeasure.IDTree.Selected));
  432. end;
  433. end;
  434. procedure TBillsMeasureFrame.actnSetStageBookmarkExecute(Sender: TObject);
  435. var
  436. vNode: TMeasureBillsIDTreeNode;
  437. StageRec: TStageRecord;
  438. begin
  439. vNode := TMeasureBillsIDTreeNode(FBillsMeasureData.BillsMeasureTree.Selected);
  440. StageRec := vNode.StageRec;
  441. if not Assigned(StageRec) then
  442. begin
  443. StageRec := FBillsMeasureData.StageData.AddStageRecord(stdBillsMeasure.IDTree.Selected.ID);
  444. vNode.StageRec := StageRec;
  445. end;
  446. if StageRec.HasBookMark.AsBoolean then
  447. begin
  448. StageRec.HasBookMark.AsBoolean := False;
  449. StageRec.MarkMemo.AsString := '';
  450. end
  451. else
  452. StageRec.HasBookMark.AsBoolean := True;
  453. TProjectData(FBillsMeasureData.ProjectData).BillsBookmarkData.RefreshStageBookmark;
  454. if Assigned(FOnAfterSetBookmark) then
  455. FOnAfterSetBookmark(StageRec.HasBookMark.AsBoolean);
  456. zgBillsMeasure.InvalidateRow(zgBillsMeasure.CurRow);
  457. end;
  458. procedure TBillsMeasureFrame.zgBillsMeasureCurrentChanged(Sender: TObject;
  459. Col, Row: Integer);
  460. var
  461. stnNode: TsdIDTreeNode;
  462. bShowDealProperty: Boolean;
  463. begin
  464. stnNode := stdBillsMeasure.IDTree.Selected;
  465. bShowDealProperty := False;
  466. if Assigned(stnNode) then
  467. begin
  468. bShowDealProperty := stnNode.Rec.ValueByName('DealCode').AsString <> '';
  469. pnlNodeDetail.Visible := bShowDealProperty;
  470. LoadDealProperty(stnNode.Rec);
  471. end;
  472. end;
  473. procedure TBillsMeasureFrame.LoadDealProperty(ARec: TsdDataRecord);
  474. var
  475. fHasPay, fNotPay: Double;
  476. begin
  477. zgDealProperty.OnCellTextChanged := nil;
  478. zgDealProperty.Cells[0, 0].Text := '合同类别';
  479. zgDealProperty.Cells[0, 1].Text := ARec.ValueByName('DealType').AsString;
  480. zgDealProperty.Cells[0, 1].Align := gaCenterLeft;
  481. zgDealProperty.ColWidths[0] := 80;
  482. zgDealProperty.Cells[1, 0].Text := '累计应扣款';
  483. zgDealProperty.Cells[1, 1].Text := ARec.ValueByName('AddCutTotalPrice').AsString;
  484. zgDealProperty.Cells[1, 1].Align := gaCenterRight;
  485. zgDealProperty.ColWidths[1] := 80;
  486. zgDealProperty.Cells[2, 0].Text := '累计应支付';
  487. fHasPay := TotalPriceRoundTo(
  488. ARec.ValueByName('AddGatherTotalPrice').AsFloat - ARec.ValueByName('AddCutTotalPrice').AsFloat);
  489. zgDealProperty.Cells[2, 1].Text := FloatToStr(fHasPay);
  490. zgDealProperty.Cells[2, 1].Align := gaCenterRight;
  491. zgDealProperty.ColWidths[2] := 80;
  492. zgDealProperty.Cells[3, 0].Text := '累计已支付';
  493. zgDealProperty.Cells[3, 1].Text := ARec.ValueByName('AddPayTotalPrice').AsString;
  494. zgDealProperty.Cells[3, 1].Align := gaCenterRight;
  495. zgDealProperty.ColWidths[3] := 80;
  496. zgDealProperty.Cells[4, 0].Text := '待支付';
  497. fNotPay := TotalPriceRoundTo(fHasPay - ARec.ValueByName('AddPayTotalPrice').AsFloat);
  498. zgDealProperty.Cells[4, 1].Text := FloatToStr(fNotPay);
  499. zgDealProperty.Cells[4, 1].Align := gaCenterRight;
  500. zgDealProperty.ColWidths[4] := 80;
  501. zgDealProperty.OnCellTextChanged := zgDealPropertyCellTextChanged;
  502. end;
  503. procedure TBillsMeasureFrame.zgDealPropertyCellGetFont(Sender: TObject;
  504. ACoord: TPoint; AFont: TFont);
  505. begin
  506. if ((ACoord.X = 2) or (ACoord.X = 4)) and (ACoord.Y = 1) then
  507. AFont.Color := clGrayText;
  508. end;
  509. procedure TBillsMeasureFrame.zgDealPropertyCellTextChanged(Sender: TObject;
  510. Col, Row: Integer);
  511. procedure ModifyField(ARec: TsdDataRecord; const AField: string; ACell: TzjCell);
  512. var
  513. fValue, fHasPay, fNotPay: Double;
  514. begin
  515. if (ACell.Text = '') or TryStrToFloat(ACell.Text, fValue) then
  516. begin
  517. ARec.ValueByName(AField).AsString := ACell.Text;
  518. // 更新显示应支付&待支付数据
  519. fHasPay := TotalPriceRoundTo(
  520. ARec.ValueByName('AddGatherTotalPrice').AsFloat - ARec.ValueByName('AddCutTotalPrice').AsFloat);
  521. zgDealProperty.Cells[2, 1].Text := FloatToStr(fHasPay);
  522. fNotPay := TotalPriceRoundTo(fHasPay - ARec.ValueByName('AddPayTotalPrice').AsFloat);
  523. zgDealProperty.Cells[4, 1].Text := FloatToStr(fNotPay);
  524. end
  525. else
  526. begin
  527. ErrorMessage('只允许输入数字!!');
  528. ACell.Text := ARec.ValueByName(AField).AsString;
  529. end;
  530. end;
  531. var
  532. Rec: TsdDataRecord;
  533. begin
  534. Rec := stdBillsMeasure.IDTree.Selected.Rec;
  535. case Col of
  536. 0: Rec.ValueByName('DealType').AsString := zgDealProperty.Cells[Col, Row].Text;
  537. 1: ModifyField(Rec, 'AddCutTotalPrice', zgDealProperty.Cells[Col, Row]);
  538. 3: ModifyField(Rec, 'AddPayTotalPrice', zgDealProperty.Cells[Col, Row]);
  539. end;
  540. end;
  541. procedure TBillsMeasureFrame.zgDealPropertyCellCanEdit(Sender: TObject;
  542. const ACoord: TPoint; var Allow: Boolean);
  543. begin
  544. Allow := (ACoord.X = 0) or (ACoord.X = 1) or (ACoord.X = 3);
  545. end;
  546. procedure TBillsMeasureFrame.SetShowAlias(const Value: Boolean);
  547. begin
  548. FShowAlias := Value;
  549. FColVisibleManager.ShowAlias(FShowAlias);
  550. end;
  551. procedure TBillsMeasureFrame.actnSetStageBookmarkUpdate(Sender: TObject);
  552. begin
  553. TAction(Sender).Enabled := TProjectData(FBillsMeasureData.ProjectData).ProjProperties.PhaseCount > 0;
  554. end;
  555. procedure TBillsMeasureFrame.ExpandNodeTo(ALevel: Integer);
  556. begin
  557. BeginExpandNode;
  558. try
  559. FBillsMeasureData.ExpandNodeTo(ALevel);
  560. finally
  561. EndExpandNode;
  562. end;
  563. end;
  564. procedure TBillsMeasureFrame.ExpandXmjNode;
  565. begin
  566. BeginExpandNode;
  567. try
  568. FBillsMeasureData.ExpandXmjNode;
  569. finally
  570. EndExpandNode;
  571. end;
  572. end;
  573. procedure TBillsMeasureFrame.BeginExpandNode;
  574. begin
  575. zgBillsMeasure.BeginUpdate;
  576. zgBillsMeasure.OnCellGetColor := nil;
  577. BeginUpdateWindow(zgBillsMeasure.Handle);
  578. stdBillsMeasure.DisableControl;
  579. end;
  580. procedure TBillsMeasureFrame.EndExpandNode;
  581. begin
  582. stdBillsMeasure.EnableControl;
  583. EndUpdateWindow(zgBillsMeasure.Handle);
  584. zgBillsMeasure.OnCellGetColor := zgBillsMeasureCellGetColor;
  585. zgBillsMeasure.EndUpdate;
  586. end;
  587. procedure TBillsMeasureFrame.ExpandCurPhase;
  588. begin
  589. BeginExpandNode;
  590. try
  591. FBillsMeasureData.ExpandCurPhase;
  592. finally
  593. EndExpandNode;
  594. end;
  595. end;
  596. procedure TBillsMeasureFrame.RefreshPhase_Stage;
  597. begin
  598. with TProjectData(FBillsMeasureData.ProjectData) do
  599. begin
  600. ResetPhaseDataReadOnly(StageDataReadOnly);
  601. ResetBaseDataReadOnly(BaseDataReadOnly);
  602. ResetAllowInsert(AllowInsert);
  603. end;
  604. zgBillsMeasure.Invalidate;
  605. end;
  606. procedure TBillsMeasureFrame.ResetPhaseDataReadOnly(AReadOnly: Boolean);
  607. begin
  608. stdBillsMeasure.Column('CurDealQuantity').ReadOnly := AReadOnly;
  609. stdBillsMeasure.Column('CurDealTotalPrice').ReadOnly := AReadOnly;
  610. stdBillsMeasure.Column('CurQcQuantity').ReadOnly := AReadOnly;
  611. stdBillsMeasure.Column('CurPcQuantity').ReadOnly := AReadOnly;
  612. end;
  613. procedure TBillsMeasureFrame.ResetBaseDataReadOnly(AReadOnly: Boolean);
  614. begin
  615. stdBillsMeasure.Column('Code').ReadOnly := AReadOnly;
  616. stdBillsMeasure.Column('B_Code').ReadOnly := AReadOnly;
  617. stdBillsMeasure.Column('Name').ReadOnly := AReadOnly;
  618. stdBillsMeasure.Column('Units').ReadOnly := AReadOnly;
  619. stdBillsMeasure.Column('Price').ReadOnly := AReadOnly;
  620. stdBillsMeasure.Column('NewPrice').ReadOnly := AReadOnly;
  621. stdBillsMeasure.Column('DrawingCode').ReadOnly := AReadOnly;
  622. end;
  623. procedure TBillsMeasureFrame.ResetAllowInsert(AAllow: Boolean);
  624. begin
  625. if AAllow then
  626. stdBillsMeasure.Options := stdBillsMeasure.Options + [aoAllowInsert]
  627. else
  628. stdBillsMeasure.Options := stdBillsMeasure.Options - [aoAllowInsert];
  629. end;
  630. procedure TBillsMeasureFrame.SetPMFieldVisible(AValue: Boolean);
  631. begin
  632. FShowAddField := AValue;
  633. stdBillsMeasure.Column('PM_PreTotalPrice').Visible := AValue;
  634. stdBillsMeasure.Column('PM_TotalPrice').Visible := AValue;
  635. stdBillsMeasure.Column('PM_AddTotalPrice').Visible := AValue;
  636. end;
  637. procedure TBillsMeasureFrame.ExpandMouseDown(AGridCell: TzjCell);
  638. procedure CommonExpand(vNode: TsdIDTreeNode);
  639. begin
  640. AGridCell.Grid.BeginUpdate;
  641. vNode.Expanded := not vNode.Expanded;
  642. AGridCell.Grid.EndUpdate;
  643. AGridCell.Grid.InvalidateView(AGridCell.ViewRect);
  644. end;
  645. procedure QuikExpand(vNode: TsdIDTreeNode);
  646. begin
  647. Screen.Cursor := crHourGlass;
  648. BeginExpandNode;
  649. try
  650. vNode.Expanded := not vNode.Expanded;
  651. finally
  652. EndExpandNode;
  653. Screen.Cursor := crDefault;
  654. end;
  655. end;
  656. var
  657. stnNode: TsdIDTreeNode;
  658. begin
  659. stnNode := TsdIDTreeCell(AGridCell).TreeNode;
  660. if stnNode.PosterityCount > 10000 then
  661. QuikExpand(stnNode)
  662. else
  663. CommonExpand(stnNode);
  664. end;
  665. procedure TBillsMeasureFrame.dxpmBillsColPopup(Sender: TObject);
  666. begin
  667. SetDxBtnAction(actnHiddenCol, MainForm.dxbtnHidden);
  668. SetDxBtnAction(actnCancelHiddenCol, MainForm.dxbtnCancelHidden);
  669. end;
  670. procedure TBillsMeasureFrame.actnHiddenColExecute(Sender: TObject);
  671. begin
  672. ShowGridCols(False, zgBillsMeasure.Selection.Left, zgBillsMeasure.Selection.Right-1);
  673. end;
  674. function TBillsMeasureFrame.GridColToDBACol(AGridCol: Integer): Integer;
  675. var
  676. iCol, iVisibleCount: Integer;
  677. begin
  678. Result := -1;
  679. if AGridCol > stdBillsMeasure.VisibleColCount then Exit;
  680. iVisibleCount := 0;
  681. for iCol := 0 to stdBillsMeasure.Columns.Count - 1 do
  682. begin
  683. if stdBillsMeasure.Columns.Items[iCol].Visible then
  684. begin
  685. Inc(iVisibleCount);
  686. if iVisibleCount = AGridCol then
  687. begin
  688. Result := iCol;
  689. Break;
  690. end;
  691. end;
  692. end;
  693. end;
  694. procedure TBillsMeasureFrame.actnCancelHiddenColExecute(Sender: TObject);
  695. begin
  696. ShowGridCols(True, zgBillsMeasure.Selection.Left, zgBillsMeasure.Selection.Right-1);
  697. end;
  698. procedure TBillsMeasureFrame.ShowGridCols(AShow: Boolean; ALeft,
  699. ARight: Integer);
  700. var
  701. iCol, iBegin, iEnd: Integer;
  702. begin
  703. iBegin := GridColToDBACol(ALeft);
  704. iEnd := GridColToDBACol(ARight);
  705. FColVisibleManager.ShowGridCol(AShow, iBegin, iEnd);
  706. end;
  707. function TBillsMeasureFrame.CheckMemoStrColumn: Boolean;
  708. var
  709. iCol: Integer;
  710. begin
  711. iCol := zgBillsMeasure.CurCol - zgBillsMeasure.FixedColCount;
  712. Result := (iCol = stdBillsMeasure.VisibleCol('MemoStr'));
  713. end;
  714. procedure TBillsMeasureFrame.actnLocateZJJLExecute(Sender: TObject);
  715. var
  716. vNode: TsdIDTreeNode;
  717. begin
  718. vNode := FBillsMeasureData.FindNodeWithZJJL(FBillsMeasureData.BillsMeasureTree.Selected);
  719. if Assigned(vNode) then
  720. begin
  721. if Assigned(OnLocateZJJL) then
  722. FOnLocateZJJL(vNode.ID);
  723. end
  724. else
  725. WarningMessage('该节点及相关节点,均无中间计量数据');
  726. end;
  727. procedure TBillsMeasureFrame.actnLocateZJJLUpdate(Sender: TObject);
  728. begin
  729. TAction(Sender).Enabled := TProjectData(FBillsMeasureData.ProjectData).PhaseData.Active;
  730. end;
  731. procedure TBillsMeasureFrame.SetShowApprovalCode(const Value: Boolean);
  732. begin
  733. FShowApprovalCode := Value;
  734. FColVisibleManager.ShowApprovalCode(FShowApprovalCode);
  735. end;
  736. procedure TBillsMeasureFrame.SetShowIsGather(const Value: Boolean);
  737. begin
  738. FShowIsGather := Value;
  739. FColVisibleManager.ShowIsGather(FShowIsGather);
  740. end;
  741. procedure TBillsMeasureFrame.actnCalculateAllUpdate(Sender: TObject);
  742. begin
  743. with TProjectData(FBillsMeasureData.ProjectData) do
  744. TAction(Sender).Enabled := PhaseData.Active and not PhaseData.StageDataReadOnly;
  745. end;
  746. procedure TBillsMeasureFrame.OnGridBeforeDelete(Sender: TObject;
  747. var CanExecute: Boolean);
  748. begin
  749. CanExecute := QuestMessage('请确认是否执行删除操作');
  750. end;
  751. procedure TBillsMeasureFrame.zgBillsMeasureCellCanEdit(Sender: TObject;
  752. const ACoord: TPoint; var Allow: Boolean);
  753. begin
  754. if (ACoord.X = 11) then
  755. Allow := False;
  756. end;
  757. end.