BillsMeasureFme.pas 28 KB

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