BillsGatherFme.pas 8.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228
  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. procedure zgGclBillsCellGetColor(Sender: TObject; ACoord: TPoint;
  36. var AColor: TColor);
  37. procedure tobtnDetailGclClick(Sender: TObject);
  38. procedure dxpmDetailGclPopup(Sender: TObject);
  39. procedure actnLocateMeasureBillsExecute(Sender: TObject);
  40. procedure actnLocateMeasureBillsUpdate(Sender: TObject);
  41. procedure zgDetailGclMouseDown(Sender: TObject; Button: TMouseButton;
  42. Shift: TShiftState; X, Y: Integer);
  43. private
  44. FBillsGatherData: TBillsGatherData;
  45. FShowPhaseData: Boolean;
  46. FShowPriceChange: Boolean;
  47. FOnLocateMeasureBills: TLocateBillsEvent;
  48. procedure SetColumnVisible(const AColumn: string; AVisible: Boolean);
  49. procedure SetShowPhaseData(const Value: Boolean);
  50. procedure SetShowPriceChange(const Value: Boolean);
  51. public
  52. constructor Create(AProjectFrame: TFrame; ABillsGatherData: TBillsGatherData);
  53. destructor Destroy; override;
  54. procedure RefreshBills;
  55. property ShowPriceChange: Boolean read FShowPriceChange write SetShowPriceChange;
  56. property ShowPhaseData: Boolean read FShowPhaseData write SetShowPhaseData;
  57. property OnLocateMeasureBills: TLocateBillsEvent read FOnLocateMeasureBills write FOnLocateMeasureBills;
  58. end;
  59. implementation
  60. uses
  61. ProjectData, UtilMethods, CalcDecimal, MainFrm;
  62. {$R *.dfm}
  63. { TBillsGatherFrame }
  64. constructor TBillsGatherFrame.Create(AProjectFrame: TFrame;
  65. ABillsGatherData: TBillsGatherData);
  66. begin
  67. inherited Create(AProjectFrame);
  68. FBillsGatherData := ABillsGatherData;
  69. saGclBills.DataView := FBillsGatherData.sdvGclBills;
  70. saDetailGcl.DataView := FBillsGatherData.sdvDetailGclBills;
  71. saDetailDeal.DataView := FBillsGatherData.sdvDetailDealBills;
  72. saDetailBGL.DataView := FBillsGatherData.sdvDetailBGLBills;
  73. end;
  74. destructor TBillsGatherFrame.Destroy;
  75. begin
  76. inherited;
  77. end;
  78. procedure TBillsGatherFrame.RefreshBills;
  79. begin
  80. FBillsGatherData.RefreshBills;
  81. ShowPhaseData := TProjectData(FBillsGatherData.ProjectData).ProjProperties.PhaseCount > 0;
  82. end;
  83. procedure TBillsGatherFrame.SetColumnVisible(const AColumn: string;
  84. AVisible: Boolean);
  85. begin
  86. if AVisible then
  87. saGclBills.Columns.ColumnByName(AColumn).Width := 60
  88. else
  89. saGclBills.Columns.ColumnByName(AColumn).Width := 0;
  90. end;
  91. procedure TBillsGatherFrame.SetShowPhaseData(const Value: Boolean);
  92. begin
  93. FShowPhaseData := Value;
  94. SetColumnVisible('CurDealQuantity', FShowPhaseData);
  95. SetColumnVisible('CurDealTotalPrice', FShowPhaseData);
  96. SetColumnVisible('CurQcQuantity', FShowPhaseData);
  97. SetColumnVisible('CurQcTotalPrice', FShowPhaseData);
  98. SetColumnVisible('CurPcQuantity', FShowPhaseData and FShowPriceChange);
  99. SetColumnVisible('CurPcTotalPrice', FShowPhaseData and FShowPriceChange);
  100. SetColumnVisible('CurGatherQuantity', FShowPhaseData);
  101. SetColumnVisible('CurGatherTotalPrice', FShowPhaseData);
  102. SetColumnVisible('EndDealQuantity', FShowPhaseData);
  103. SetColumnVisible('EndDealTotalPrice', FShowPhaseData);
  104. SetColumnVisible('EndQcQuantity', FShowPhaseData);
  105. SetColumnVisible('EndQcTotalPrice', FShowPhaseData);
  106. SetColumnVisible('EndPcQuantity', FShowPhaseData and FShowPriceChange);
  107. SetColumnVisible('EndPcTotalPrice', FShowPhaseData and FShowPriceChange);
  108. SetColumnVisible('EndGatherQuantity', FShowPhaseData);
  109. SetColumnVisible('EndGatherTotalPrice', FShowPhaseData);
  110. end;
  111. procedure TBillsGatherFrame.SetShowPriceChange(const Value: Boolean);
  112. begin
  113. FShowPriceChange := Value;
  114. SetColumnVisible('NewPrice', FShowPriceChange);
  115. SetColumnVisible('CurPcQuantity', FShowPriceChange and FShowPhaseData);
  116. SetColumnVisible('CurPcTotalPrice', FShowPriceChange and FShowPhaseData);
  117. SetColumnVisible('EndPcQuantity', FShowPriceChange and FShowPhaseData);
  118. SetColumnVisible('EndPcTotalPrice', FShowPriceChange and FShowPhaseData);
  119. end;
  120. procedure TBillsGatherFrame.zgGclBillsCellGetColor(Sender: TObject;
  121. ACoord: TPoint; var AColor: TColor);
  122. function CheckSimilarBills(ARow1, ARow2: Integer): Boolean;
  123. var
  124. bHasSame, bHasDiffer: Boolean;
  125. begin
  126. bHasSame := SameText(zgGclBills.Cells[1, ARow1].Text, zgGclBills.Cells[1, ARow2].Text);
  127. bHasDiffer := (not SameText(zgGclBills.Cells[2, ARow1].Text, zgGclBills.Cells[2, ARow2].Text))
  128. or (not SameText(zgGclBills.Cells[3, ARow1].Text, zgGclBills.Cells[3, ARow2].Text))
  129. or (not SameText(zgGclBills.Cells[4, ARow1].Text, zgGclBills.Cells[4, ARow2].Text));
  130. Result := bHasSame and bHasDiffer;
  131. end;
  132. function CheckOverRange(ARecIndex: Integer): Boolean;
  133. var
  134. Rec: TsdDataRecord;
  135. fQuantity, fDealQuantity, fEndDealQuantity, fCompare: Double;
  136. begin
  137. Rec := saGclBills.DataView.Records[ARecIndex];
  138. Result := False;
  139. if not Assigned(Rec) then Exit;
  140. fDealQuantity := Rec.ValueByName('DealQuantity').AsFloat;
  141. fQuantity := Rec.ValueByName('Quantity').AsFloat;
  142. fEndDealQuantity := Rec.ValueByName('EndDealQuantity').AsFloat;
  143. fCompare := TProjectData(FBillsGatherData.ProjectData).ProjProperties.DecimalManager.Common.Quantity.CompareValue;
  144. case SupportManager.ConfigInfo.OverRangeType of
  145. 0: Result := QuantityRoundTo(fEndDealQuantity - fQuantity) > fCompare;
  146. 1: Result := QuantityRoundTo(fEndDealQuantity - fDealQuantity) > fCompare;
  147. 2: Result := (QuantityRoundTo(fEndDealQuantity - fQuantity) > fCompare)
  148. or (QuantityRoundTo(fEndDealQuantity - fDealQuantity) > fCompare);
  149. end;
  150. end;
  151. var
  152. bSimilarBills: Boolean;
  153. begin
  154. if (ACoord.Y >= zgGclBills.FixedRowCount) then
  155. begin
  156. if ACoord.Y = zgGclBills.FixedRowCount then
  157. bSimilarBills := CheckSimilarBills(ACoord.Y, ACoord.Y + 1)
  158. else if ACoord.Y < zgGclBills.RowCount - zgGclBills.FixedRowCount then
  159. bSimilarBills := CheckSimilarBills(ACoord.Y, ACoord.Y - 1) or
  160. CheckSimilarBills(ACoord.Y, ACoord.Y + 1)
  161. else
  162. bSimilarBills := CheckSimilarBills(ACoord.Y, ACoord.Y - 1);
  163. {if bSimilarBills then
  164. AColor := $00646AFE;}
  165. if bSimilarBills then
  166. AColor := $0000FFFF; // »ÆÉ«
  167. if CheckOverRange(ACoord.Y - zgGclBills.FixedRowCount) then
  168. AColor := $00505AFF; // ºìÉ«
  169. end;
  170. end;
  171. procedure TBillsGatherFrame.tobtnDetailGclClick(Sender: TObject);
  172. begin
  173. jpsRela.ActivePageIndex := TToolButton(Sender).Tag;
  174. tobtnDetailGcl.Down := tobtnDetailGcl.Tag = TToolButton(Sender).Tag;
  175. tobtnDetailDeal.Down := tobtnDetailDeal.Tag = TToolButton(Sender).Tag;
  176. tobtnDetailBGL.Down := tobtnDetailBGL.Tag = TToolButton(Sender).Tag;
  177. end;
  178. procedure TBillsGatherFrame.dxpmDetailGclPopup(Sender: TObject);
  179. begin
  180. SetDxBtnAction(actnLocateMeasureBills, MainForm.dxbtnLocateMeasureBills);
  181. end;
  182. procedure TBillsGatherFrame.actnLocateMeasureBillsExecute(Sender: TObject);
  183. begin
  184. if Assigned(saDetailGcl.DataView.Current) and Assigned(FOnLocateMeasureBills) then
  185. FOnLocateMeasureBills(saDetailGcl.DataView.Current.ValueByName('RelaBillsID').AsInteger);
  186. end;
  187. procedure TBillsGatherFrame.actnLocateMeasureBillsUpdate(Sender: TObject);
  188. begin
  189. TAction(Sender).Enabled := Assigned(saDetailGcl.DataView.Current) and Assigned(FOnLocateMeasureBills);
  190. end;
  191. procedure TBillsGatherFrame.zgDetailGclMouseDown(Sender: TObject;
  192. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  193. begin
  194. if Button = mbRight then
  195. dxpmDetailGcl.PopupFromCursorPos;
  196. end;
  197. end.