BillsGatherFme.pas 9.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245
  1. unit BillsGatherFme;
  2. interface
  3. uses
  4. BillsGatherDm, Globals, sdDB,
  5. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  6. Dialogs, ZJGrid, ExtCtrls, ZjGridDBA, ZjGridTreeDBA, ComCtrls, ToolWin,
  7. XPMenu, sdGridDBA, JimPages, dxBar, ActnList;
  8. type
  9. TLocateBillsEvent = procedure (AID: Integer) of object;
  10. TBillsGatherFrame = class(TFrame)
  11. pnlBillsGather: TPanel;
  12. zgGclBills: TZJGrid;
  13. pnlRelaXmj: TPanel;
  14. pnlRelaXmjType: TPanel;
  15. tbToolsButton: TToolBar;
  16. tobtnDetailGcl: TToolButton;
  17. sprBillsGather: TSplitter;
  18. xpm: TXPMenu;
  19. tobtnDetailDeal: TToolButton;
  20. tobtnDetailBGL: TToolButton;
  21. jpsRela: TJimPages;
  22. jpsRelaDetailGcl: TJimPage;
  23. jpsRelaDetailDeal: TJimPage;
  24. jpsRelaDetailBGL: TJimPage;
  25. zgDetailGcl: TZJGrid;
  26. saDetailGcl: TsdGridDBA;
  27. saDetailDeal: TsdGridDBA;
  28. saDetailBGL: TsdGridDBA;
  29. zgDetailBGL: TZJGrid;
  30. zgDetailDeal: TZJGrid;
  31. saGclBills: TsdGridDBA;
  32. dxpmDetailGcl: TdxBarPopupMenu;
  33. alBillsGather: TActionList;
  34. actnLocateMeasureBills: TAction;
  35. actnLocateCompileBills: TAction;
  36. procedure zgGclBillsCellGetColor(Sender: TObject; ACoord: TPoint;
  37. var AColor: TColor);
  38. procedure tobtnDetailGclClick(Sender: TObject);
  39. procedure dxpmDetailGclPopup(Sender: TObject);
  40. procedure actnLocateMeasureBillsExecute(Sender: TObject);
  41. procedure actnLocateMeasureBillsUpdate(Sender: TObject);
  42. procedure zgDetailGclMouseDown(Sender: TObject; Button: TMouseButton;
  43. Shift: TShiftState; X, Y: Integer);
  44. procedure actnLocateCompileBillsExecute(Sender: TObject);
  45. procedure actnLocateCompileBillsUpdate(Sender: TObject);
  46. private
  47. FBillsGatherData: TBillsGatherData;
  48. FShowPhaseData: Boolean;
  49. FShowPriceChange: Boolean;
  50. FOnLocateMeasureBills: TLocateBillsEvent;
  51. FOnLocateCompileBills: TLocateBillsEvent;
  52. procedure SetColumnVisible(const AColumn: string; AVisible: Boolean);
  53. procedure SetShowPhaseData(const Value: Boolean);
  54. procedure SetShowPriceChange(const Value: Boolean);
  55. public
  56. constructor Create(AProjectFrame: TFrame; ABillsGatherData: TBillsGatherData);
  57. destructor Destroy; override;
  58. procedure RefreshBills;
  59. property ShowPriceChange: Boolean read FShowPriceChange write SetShowPriceChange;
  60. property ShowPhaseData: Boolean read FShowPhaseData write SetShowPhaseData;
  61. property OnLocateMeasureBills: TLocateBillsEvent read FOnLocateMeasureBills write FOnLocateMeasureBills;
  62. property OnLocateCompileBills: TLocateBillsEvent read FOnLocateCompileBills write FOnLocateCompileBills;
  63. end;
  64. implementation
  65. uses
  66. ProjectData, UtilMethods, CalcDecimal, MainFrm;
  67. {$R *.dfm}
  68. { TBillsGatherFrame }
  69. constructor TBillsGatherFrame.Create(AProjectFrame: TFrame;
  70. ABillsGatherData: TBillsGatherData);
  71. begin
  72. inherited Create(AProjectFrame);
  73. FBillsGatherData := ABillsGatherData;
  74. saGclBills.DataView := FBillsGatherData.sdvGclBills;
  75. saDetailGcl.DataView := FBillsGatherData.sdvDetailGclBills;
  76. saDetailDeal.DataView := FBillsGatherData.sdvDetailDealBills;
  77. saDetailBGL.DataView := FBillsGatherData.sdvDetailBGLBills;
  78. end;
  79. destructor TBillsGatherFrame.Destroy;
  80. begin
  81. inherited;
  82. end;
  83. procedure TBillsGatherFrame.RefreshBills;
  84. begin
  85. FBillsGatherData.RefreshBills;
  86. ShowPhaseData := TProjectData(FBillsGatherData.ProjectData).ProjProperties.PhaseCount > 0;
  87. end;
  88. procedure TBillsGatherFrame.SetColumnVisible(const AColumn: string;
  89. AVisible: Boolean);
  90. begin
  91. if AVisible then
  92. saGclBills.Columns.ColumnByName(AColumn).Width := 60
  93. else
  94. saGclBills.Columns.ColumnByName(AColumn).Width := 0;
  95. end;
  96. procedure TBillsGatherFrame.SetShowPhaseData(const Value: Boolean);
  97. begin
  98. FShowPhaseData := Value;
  99. SetColumnVisible('CurDealQuantity', FShowPhaseData);
  100. SetColumnVisible('CurDealTotalPrice', FShowPhaseData);
  101. SetColumnVisible('CurQcQuantity', FShowPhaseData);
  102. SetColumnVisible('CurQcTotalPrice', FShowPhaseData);
  103. SetColumnVisible('CurPcQuantity', FShowPhaseData and FShowPriceChange);
  104. SetColumnVisible('CurPcTotalPrice', FShowPhaseData and FShowPriceChange);
  105. SetColumnVisible('CurGatherQuantity', FShowPhaseData);
  106. SetColumnVisible('CurGatherTotalPrice', FShowPhaseData);
  107. SetColumnVisible('EndDealQuantity', FShowPhaseData);
  108. SetColumnVisible('EndDealTotalPrice', FShowPhaseData);
  109. SetColumnVisible('EndQcQuantity', FShowPhaseData);
  110. SetColumnVisible('EndQcTotalPrice', FShowPhaseData);
  111. SetColumnVisible('EndPcQuantity', FShowPhaseData and FShowPriceChange);
  112. SetColumnVisible('EndPcTotalPrice', FShowPhaseData and FShowPriceChange);
  113. SetColumnVisible('EndGatherQuantity', FShowPhaseData);
  114. SetColumnVisible('EndGatherTotalPrice', FShowPhaseData);
  115. end;
  116. procedure TBillsGatherFrame.SetShowPriceChange(const Value: Boolean);
  117. begin
  118. FShowPriceChange := Value;
  119. SetColumnVisible('NewPrice', FShowPriceChange);
  120. SetColumnVisible('CurPcQuantity', FShowPriceChange and FShowPhaseData);
  121. SetColumnVisible('CurPcTotalPrice', FShowPriceChange and FShowPhaseData);
  122. SetColumnVisible('EndPcQuantity', FShowPriceChange and FShowPhaseData);
  123. SetColumnVisible('EndPcTotalPrice', FShowPriceChange and FShowPhaseData);
  124. end;
  125. procedure TBillsGatherFrame.zgGclBillsCellGetColor(Sender: TObject;
  126. ACoord: TPoint; var AColor: TColor);
  127. function CheckSimilarBills(ARow1, ARow2: Integer): Boolean;
  128. var
  129. bHasSame, bHasDiffer: Boolean;
  130. begin
  131. bHasSame := SameText(zgGclBills.Cells[1, ARow1].Text, zgGclBills.Cells[1, ARow2].Text);
  132. bHasDiffer := (not SameText(zgGclBills.Cells[2, ARow1].Text, zgGclBills.Cells[2, ARow2].Text))
  133. or (not SameText(zgGclBills.Cells[3, ARow1].Text, zgGclBills.Cells[3, ARow2].Text))
  134. or (not SameText(zgGclBills.Cells[4, ARow1].Text, zgGclBills.Cells[4, ARow2].Text));
  135. Result := bHasSame and bHasDiffer;
  136. end;
  137. function CheckOverRange(ARecIndex: Integer): Boolean;
  138. var
  139. Rec: TsdDataRecord;
  140. fQuantity, fDealQuantity, fEndDealQuantity, fCompare: Double;
  141. begin
  142. Rec := saGclBills.DataView.Records[ARecIndex];
  143. Result := False;
  144. if not Assigned(Rec) then Exit;
  145. fDealQuantity := Rec.ValueByName('DealQuantity').AsFloat;
  146. fQuantity := Rec.ValueByName('Quantity').AsFloat;
  147. fEndDealQuantity := Rec.ValueByName('EndDealQuantity').AsFloat;
  148. fCompare := TProjectData(FBillsGatherData.ProjectData).ProjProperties.DecimalManager.Common.Quantity.CompareValue;
  149. case SupportManager.ConfigInfo.OverRangeType of
  150. 0: Result := QuantityRoundTo(fEndDealQuantity - fQuantity) > fCompare;
  151. 1: Result := QuantityRoundTo(fEndDealQuantity - fDealQuantity) > fCompare;
  152. 2: Result := (QuantityRoundTo(fEndDealQuantity - fQuantity) > fCompare)
  153. or (QuantityRoundTo(fEndDealQuantity - fDealQuantity) > fCompare);
  154. end;
  155. end;
  156. var
  157. bSimilarBills: Boolean;
  158. begin
  159. if (ACoord.Y >= zgGclBills.FixedRowCount) then
  160. begin
  161. if ACoord.Y = zgGclBills.FixedRowCount then
  162. bSimilarBills := CheckSimilarBills(ACoord.Y, ACoord.Y + 1)
  163. else if ACoord.Y < zgGclBills.RowCount - zgGclBills.FixedRowCount then
  164. bSimilarBills := CheckSimilarBills(ACoord.Y, ACoord.Y - 1) or
  165. CheckSimilarBills(ACoord.Y, ACoord.Y + 1)
  166. else
  167. bSimilarBills := CheckSimilarBills(ACoord.Y, ACoord.Y - 1);
  168. {if bSimilarBills then
  169. AColor := $00646AFE;}
  170. if bSimilarBills then
  171. AColor := $0000FFFF; // »ÆÉ«
  172. if TProjectData(FBillsGatherData.ProjectData).ProjProperties.ShowOverRange and CheckOverRange(ACoord.Y - zgGclBills.FixedRowCount) then
  173. AColor := $00505AFF; // ºìÉ«
  174. end;
  175. end;
  176. procedure TBillsGatherFrame.tobtnDetailGclClick(Sender: TObject);
  177. begin
  178. jpsRela.ActivePageIndex := TToolButton(Sender).Tag;
  179. tobtnDetailGcl.Down := tobtnDetailGcl.Tag = TToolButton(Sender).Tag;
  180. tobtnDetailDeal.Down := tobtnDetailDeal.Tag = TToolButton(Sender).Tag;
  181. tobtnDetailBGL.Down := tobtnDetailBGL.Tag = TToolButton(Sender).Tag;
  182. end;
  183. procedure TBillsGatherFrame.dxpmDetailGclPopup(Sender: TObject);
  184. begin
  185. SetDxBtnAction(actnLocateMeasureBills, MainForm.dxbtnLocateMeasureBills);
  186. SetDxBtnAction(actnLocateCompileBills, MainForm.dxbtnLocateCompileBills);
  187. end;
  188. procedure TBillsGatherFrame.actnLocateMeasureBillsExecute(Sender: TObject);
  189. begin
  190. if Assigned(saDetailGcl.DataView.Current) and Assigned(FOnLocateMeasureBills) then
  191. FOnLocateMeasureBills(saDetailGcl.DataView.Current.ValueByName('RelaBillsID').AsInteger);
  192. end;
  193. procedure TBillsGatherFrame.actnLocateMeasureBillsUpdate(Sender: TObject);
  194. begin
  195. TAction(Sender).Enabled := Assigned(saDetailGcl.DataView.Current) and Assigned(FOnLocateMeasureBills);
  196. end;
  197. procedure TBillsGatherFrame.zgDetailGclMouseDown(Sender: TObject;
  198. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  199. begin
  200. if Button = mbRight then
  201. dxpmDetailGcl.PopupFromCursorPos;
  202. end;
  203. procedure TBillsGatherFrame.actnLocateCompileBillsExecute(Sender: TObject);
  204. begin
  205. if Assigned(saDetailGcl.DataView.Current) and Assigned(FOnLocateCompileBills) then
  206. FOnLocateCompileBills(saDetailGcl.DataView.Current.ValueByName('RelaBillsID').AsInteger);
  207. end;
  208. procedure TBillsGatherFrame.actnLocateCompileBillsUpdate(Sender: TObject);
  209. begin
  210. TAction(Sender).Enabled := Assigned(saDetailGcl.DataView.Current) and Assigned(FOnLocateCompileBills);
  211. end;
  212. end.