BillsGatherFme.pas 5.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160
  1. unit BillsGatherFme;
  2. interface
  3. uses
  4. BillsGatherDm, Globals,
  5. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  6. Dialogs, ZJGrid, ExtCtrls, ZjGridDBA, ZjGridTreeDBA, ComCtrls, ToolWin,
  7. XPMenu;
  8. type
  9. TBillsGatherFrame = class(TFrame)
  10. pnlBillsGather: TPanel;
  11. zgBillsGather: TZJGrid;
  12. zdBillsGather: TZjGridDBA;
  13. pnlRelaXmj: TPanel;
  14. pnlRelaXmjType: TPanel;
  15. tbToolsButton: TToolBar;
  16. tobtnFlatType: TToolButton;
  17. zgRelaXmj: TZJGrid;
  18. sprBillsGather: TSplitter;
  19. zaRelaXmj: TZjGridDBA;
  20. xpm: TXPMenu;
  21. procedure zgBillsGatherCellGetColor(Sender: TObject; ACoord: TPoint;
  22. var AColor: TColor);
  23. private
  24. FBillsGatherData: TBillsGatherData;
  25. FShowPhaseData: Boolean;
  26. FShowPriceChange: Boolean;
  27. procedure SetColumnVisible(const AColumn: string; AVisible: Boolean);
  28. procedure SetShowPhaseData(const Value: Boolean);
  29. procedure SetShowPriceChange(const Value: Boolean);
  30. public
  31. constructor Create(AProjectFrame: TFrame; ABillsGatherData: TBillsGatherData);
  32. destructor Destroy; override;
  33. procedure RefreshBills;
  34. property ShowPriceChange: Boolean read FShowPriceChange write SetShowPriceChange;
  35. property ShowPhaseData: Boolean read FShowPhaseData write SetShowPhaseData;
  36. end;
  37. implementation
  38. {$R *.dfm}
  39. { TBillsGatherFrame }
  40. constructor TBillsGatherFrame.Create(AProjectFrame: TFrame;
  41. ABillsGatherData: TBillsGatherData);
  42. begin
  43. inherited Create(AProjectFrame);
  44. FBillsGatherData := ABillsGatherData;
  45. zdBillsGather.DataSet := FBillsGatherData.cdsBillsGather;
  46. zaRelaXmj.DataSet := FBillsGatherData.cdsRelaXmj;
  47. end;
  48. destructor TBillsGatherFrame.Destroy;
  49. begin
  50. inherited;
  51. end;
  52. procedure TBillsGatherFrame.RefreshBills;
  53. begin
  54. FBillsGatherData.RefreshBills;
  55. end;
  56. procedure TBillsGatherFrame.SetColumnVisible(const AColumn: string;
  57. AVisible: Boolean);
  58. begin
  59. if AVisible then
  60. zdBillsGather.Column(AColumn).Width := 60
  61. else
  62. zdBillsGather.Column(AColumn).Width := 0;
  63. end;
  64. procedure TBillsGatherFrame.SetShowPhaseData(const Value: Boolean);
  65. begin
  66. FShowPhaseData := Value;
  67. SetColumnVisible('CurDealQuantity', FShowPhaseData);
  68. SetColumnVisible('CurDealTotalPrice', FShowPhaseData);
  69. SetColumnVisible('CurQcQuantity', FShowPhaseData);
  70. SetColumnVisible('CurQcTotalPrice', FShowPhaseData);
  71. SetColumnVisible('CurPcQuantity', FShowPhaseData and FShowPriceChange);
  72. SetColumnVisible('CurPcTotalPrice', FShowPhaseData and FShowPriceChange);
  73. SetColumnVisible('CurGatherQuantity', FShowPhaseData);
  74. SetColumnVisible('CurGatherTotalPrice', FShowPhaseData);
  75. SetColumnVisible('EndDealQuantity', FShowPhaseData);
  76. SetColumnVisible('EndDealTotalPrice', FShowPhaseData);
  77. SetColumnVisible('EndQcQuantity', FShowPhaseData);
  78. SetColumnVisible('EndQcTotalPrice', FShowPhaseData);
  79. SetColumnVisible('EndPcQuantity', FShowPhaseData and FShowPriceChange);
  80. SetColumnVisible('EndPcTotalPrice', FShowPhaseData and FShowPriceChange);
  81. SetColumnVisible('EndGatherQuantity', FShowPhaseData);
  82. SetColumnVisible('EndGatherTotalPrice', FShowPhaseData);
  83. end;
  84. procedure TBillsGatherFrame.SetShowPriceChange(const Value: Boolean);
  85. begin
  86. FShowPriceChange := Value;
  87. SetColumnVisible('NewPrice', FShowPriceChange);
  88. SetColumnVisible('CurPcQuantity', FShowPriceChange and FShowPhaseData);
  89. SetColumnVisible('CurPcTotalPrice', FShowPriceChange and FShowPhaseData);
  90. SetColumnVisible('EndPcQuantity', FShowPriceChange and FShowPhaseData);
  91. SetColumnVisible('EndPcTotalPrice', FShowPriceChange and FShowPhaseData);
  92. end;
  93. procedure TBillsGatherFrame.zgBillsGatherCellGetColor(Sender: TObject;
  94. ACoord: TPoint; var AColor: TColor);
  95. function CheckSimilarBills(ARow1, ARow2: Integer): Boolean;
  96. var
  97. bHasSame, bHasDiffer: Boolean;
  98. begin
  99. bHasSame := SameText(zgBillsGather.Cells[1, ARow1].Text, zgBillsGather.Cells[1, ARow2].Text);
  100. bHasDiffer := (not SameText(zgBillsGather.Cells[2, ARow1].Text, zgBillsGather.Cells[2, ARow2].Text))
  101. or (not SameText(zgBillsGather.Cells[3, ARow1].Text, zgBillsGather.Cells[3, ARow2].Text))
  102. or (not SameText(zgBillsGather.Cells[4, ARow1].Text, zgBillsGather.Cells[4, ARow2].Text));
  103. Result := bHasSame and bHasDiffer;
  104. end;
  105. function CheckOverRange(ARow: Integer): Boolean;
  106. var
  107. fQuantity, fDealQuantity, fEndDealQuantity: Double;
  108. begin
  109. fDealQuantity := StrToFloatDef(zgBillsGather.Cells[6, ARow].Text, 0);
  110. fQuantity := StrToFloatDef(zgBillsGather.Cells[8, ARow].Text, 0);
  111. fEndDealQuantity := StrToFloatDef(zgBillsGather.Cells[18, ARow].Text, 0);
  112. case SupportManager.ConfigInfo.OverRangeType of
  113. 0: Result := fEndDealQuantity > fQuantity;
  114. 1: Result := fEndDealQuantity > fDealQuantity;
  115. 2: Result := (fEndDealQuantity > fQuantity) or (fEndDealQuantity > fDealQuantity);
  116. end;
  117. end;
  118. var
  119. bSimilarBills: Boolean;
  120. begin
  121. if ACoord.Y >= zgBillsGather.FixedRowCount then
  122. begin
  123. if ACoord.Y = zgBillsGather.FixedRowCount then
  124. bSimilarBills := CheckSimilarBills(ACoord.Y, ACoord.Y + 1)
  125. else if ACoord.Y < zgBillsGather.RowCount - zgBillsGather.FixedRowCount then
  126. bSimilarBills := CheckSimilarBills(ACoord.Y, ACoord.Y - 1) or
  127. CheckSimilarBills(ACoord.Y, ACoord.Y + 1)
  128. else
  129. bSimilarBills := CheckSimilarBills(ACoord.Y, ACoord.Y - 1);
  130. {if bSimilarBills then
  131. AColor := $00646AFE;}
  132. if bSimilarBills then
  133. AColor := $0000FFFF; // »ÆÉ«
  134. if CheckOverRange(ACoord.Y) then
  135. AColor := $00505AFF; // ºìÉ«
  136. end;
  137. end;
  138. end.