BillsMeasureFme.pas 27 KB

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