BGLSelectFrm.pas 9.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340
  1. unit BGLSelectFrm;
  2. interface
  3. uses
  4. BGLDm,
  5. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  6. Dialogs, StdCtrls, ZjGridDBA, ZJGrid, ExtCtrls, ZJCells;
  7. const
  8. sBGInfo = '当前变更清单:%s 变更数量:%s';
  9. type
  10. TBGLSelectForm = class(TForm)
  11. lblBGInfo: TLabel;
  12. lblBGLTitel: TLabel;
  13. pnlBGLBar: TPanel;
  14. zgBGL: TZJGrid;
  15. btnOk: TButton;
  16. btnCancel: TButton;
  17. cbIncludeZeroQuantity: TCheckBox;
  18. procedure zgBGLCellCanEdit(Sender: TObject; const ACoord: TPoint;
  19. var Allow: Boolean);
  20. procedure btnOkClick(Sender: TObject);
  21. procedure zgBGLCellGetColor(Sender: TObject; ACoord: TPoint;
  22. var AColor: TColor);
  23. procedure zgBGLCellTextChanging(Sender: TObject; const ACoord: TPoint;
  24. var NewValue: String; var Accept: Boolean);
  25. procedure zgBGLCellValueChanged(Sender: TObject);
  26. procedure cbIncludeZeroQuantityClick(Sender: TObject);
  27. private
  28. FOrgBGL: TBGLSelectInfo;
  29. FProjectData: TObject;
  30. FBGLData: TBGLData;
  31. FGclCode: string;
  32. FBGNum: Double;
  33. FHasBGNum: Boolean;
  34. function GetTotalBGNum: Double;
  35. procedure InitBGList;
  36. function GetIncludeZeroQuantity: Boolean;
  37. public
  38. procedure Init(AOrgBGL: TBGLSelectInfo; ProjectData: TObject; ABGNum: Double);
  39. procedure LoadCurBGL(ACurBGL: TBGLSelectInfo);
  40. property HasBGNum: Boolean read FHasBGNum write FHasBGNum;
  41. property IncludeZeroQuantity: Boolean read GetIncludeZeroQuantity;
  42. end;
  43. function SelectBGL(AOrgBGL, ACurBGL: TBGLSelectInfo; AProjectData: TObject): Boolean;
  44. function SelectBGLAndBGNum(AOrgBGL, ACurBGL: TBGLSelectInfo; AProjectData: TObject): Boolean;
  45. implementation
  46. uses
  47. Math, ProjectData, sdIDTree, UtilMethods, ZhAPI;
  48. {$R *.dfm}
  49. function SelectBGL(AOrgBGL, ACurBGL: TBGLSelectInfo; AProjectData: TObject): Boolean;
  50. var
  51. FBGLSelectForm: TBGLSelectForm;
  52. begin
  53. FBGLSelectForm := TBGLSelectForm.Create(nil);
  54. try
  55. FBGLSelectForm.HasBGNum := True;
  56. FBGLSelectForm.Init(AOrgBGL, AProjectData, ACurBGL.TotalNum);
  57. if FBGLSelectForm.ShowModal = mrOk then
  58. begin
  59. Result := True;
  60. FBGLSelectForm.LoadCurBGL(ACurBGL);
  61. end
  62. else
  63. Result := False;
  64. finally
  65. FBGLSelectForm.Free;
  66. end;
  67. end;
  68. function SelectBGLAndBGNum(AOrgBGL, ACurBGL: TBGLSelectInfo; AProjectData: TObject): Boolean;
  69. var
  70. FBGLSelectForm: TBGLSelectForm;
  71. begin
  72. FBGLSelectForm := TBGLSelectForm.Create(nil);
  73. try
  74. FBGLSelectForm.HasBGNum := False;
  75. FBGLSelectForm.Init(AOrgBGL, AProjectData, ACurBGL.TotalNum);
  76. if FBGLSelectForm.ShowModal = mrOk then
  77. begin
  78. Result := True;
  79. FBGLSelectForm.LoadCurBGL(ACurBGL);
  80. end
  81. else
  82. Result := False;
  83. finally
  84. FBGLSelectForm.Free;
  85. end;
  86. end;
  87. { TBGLSelectForm }
  88. procedure TBGLSelectForm.Init(AOrgBGL: TBGLSelectInfo;
  89. ProjectData: TObject; ABGNum: Double);
  90. begin
  91. FProjectData := ProjectData;
  92. with TProjectData(FProjectData).BillsMeasureData.BillsMeasureTree do
  93. FGclCode := Selected.Rec.ValueByName('B_Code').AsString;
  94. FBGLData := TProjectData(FProjectData).BGLData;
  95. FOrgBGL := AOrgBGL;
  96. FBGNum := ABGNum;
  97. lblBGInfo.Caption := Format(sBGInfo, [FGclCode, FloatToStr(FBGNum)]);
  98. InitBGList;
  99. end;
  100. procedure TBGLSelectForm.InitBGList;
  101. procedure InitBGListHead;
  102. begin
  103. zgBGL.ColCount := 6;
  104. zgBGL.CellClass.Cols[1] := TZjCheckBoxCell;
  105. zgBGL.Cells[1, 0].Text := '选择';
  106. zgBGL.ColWidths[1] := 35;
  107. zgBGL.Cells[2, 0].Text := '变更令号';
  108. zgBGL.ColWidths[2] := 90;
  109. zgBGL.Cells[3, 0].Text := '名称';
  110. zgBGL.ColWidths[3] := 150;
  111. zgBGL.Cells[4, 0].Text := '可变更数量';
  112. zgBGL.ColWidths[4] := 80;
  113. zgBGL.Cells[5, 0].Text := '变更数量';
  114. zgBGL.ColWidths[5] := 60;
  115. zgBGL.RowCount := 1;
  116. end;
  117. function GetOrgQuantity(const ABGLCode: string): Double;
  118. var
  119. I: Integer;
  120. begin
  121. Result := 0;
  122. for I := 0 to FOrgBGL.Count - 1 do
  123. begin
  124. if SameText(FOrgBGL.Codes[I], ABGLCode) then
  125. begin
  126. Result := StrToFloatDef(FOrgBGL.Nums[I], 0);
  127. Break;
  128. end;
  129. end;
  130. end;
  131. procedure AddBGL;
  132. var
  133. fValidQuantity: Double;
  134. begin
  135. with FBGLData do
  136. begin
  137. fValidQuantity := QuantityRoundTo(
  138. cdsBGBillsQuantity.AsFloat - cdsBGBillsUsedQuantity.AsFloat
  139. + GetOrgQuantity(cdsBGLCode.AsString));
  140. if not IncludeZeroQuantity and (fValidQuantity = 0) then Exit;
  141. zgBGL.RowCount := zgBGL.RowCount + 1;
  142. zgBGL.Cells[2, zgBGL.RowCount -1].Text := cdsBGLCode.AsString;
  143. zgBGL.Cells[3, zgBGL.RowCount -1].Text := cdsBGLName.AsString;
  144. zgBGL.Cells[4, zgBGL.RowCount -1].Text := FloatToStr(fValidQuantity);
  145. zgBGL.Rows[zgBGL.RowCount -1].Data := Pointer(cdsBGBillsID.AsInteger);
  146. end;
  147. end;
  148. begin
  149. InitBGListHead;
  150. FBGLData.cdsBGL.First;
  151. while not FBGLData.cdsBGL.Eof do
  152. begin
  153. FBGLData.cdsBGBills.Filter := 'BGID = ' + IntToStr(FBGLData.cdsBGLID.AsInteger);
  154. FBGLData.cdsBGBills.Filtered := True;
  155. try
  156. FBGLData.cdsBGBills.First;
  157. while not FBGLData.cdsBGBills.Eof do
  158. begin
  159. if SameText(FBGLData.cdsBGBillsB_Code.AsString, FOrgBGL.B_Code) and
  160. SameText(FBGLData.cdsBGBillsName.AsString, FOrgBGL.Name) and
  161. SameText(FBGLData.cdsBGBillsUnits.AsString, FOrgBGL.Units) and
  162. (PriceRoundTo(FBGLData.cdsBGBillsPrice.AsFloat - FOrgBGL.Price) = 0) then
  163. AddBGL;
  164. FBGLData.cdsBGBills.Next;
  165. end;
  166. finally
  167. FBGLData.cdsBGBills.Filtered := False;
  168. end;
  169. FBGLData.cdsBGL.Next;
  170. end;
  171. end;
  172. procedure TBGLSelectForm.LoadCurBGL(ACurBGL: TBGLSelectInfo);
  173. var
  174. iRowIndex: Integer;
  175. begin
  176. ACurBGL.TotalNum := GetTotalBGNum;
  177. for iRowIndex := 0 to zgBGL.RowCount - 1 do
  178. if zgBGL.Cells[2, iRowIndex].Text <> '' then
  179. begin
  180. if SameText(zgBGL.Cells[1, iRowIndex].Text, 'True') then
  181. begin
  182. ACurBGL.Codes.Add(zgBGL.Cells[2, iRowIndex].Text);
  183. ACurBGL.Nums.Add(zgBGL.Cells[5, iRowIndex].Text);
  184. end;
  185. end;
  186. end;
  187. procedure TBGLSelectForm.zgBGLCellCanEdit(Sender: TObject;
  188. const ACoord: TPoint; var Allow: Boolean);
  189. begin
  190. Allow := (ACoord.X = 1) or
  191. ((ACoord.X = 5) and SameText(zgBGL.Cells[1, ACoord.Y].Text, 'True'));
  192. end;
  193. procedure TBGLSelectForm.btnOkClick(Sender: TObject);
  194. function CheckSelect: Boolean;
  195. var
  196. iRowIndex: Integer;
  197. begin
  198. Result := False;
  199. for iRowIndex := 0 to zgBGL.RowCount - 1 do
  200. if zgBGL.Cells[2, iRowIndex].Text <> '' then
  201. if SameText(zgBGL.Cells[1, iRowIndex].Text, 'True') then
  202. begin
  203. Result := True;
  204. Break;
  205. end;
  206. end;
  207. begin
  208. if not CheckSelect then
  209. ErrorMessage('请选择变更令!')
  210. else if (FBGNum <> GetTotalBGNum) then
  211. ErrorMessage('所选变更令的变更数量合计必须等于清单的变更数量')
  212. else
  213. ModalResult := mrOk;
  214. end;
  215. function TBGLSelectForm.GetTotalBGNum: Double;
  216. var
  217. iRowIndex: Integer;
  218. begin
  219. Result := 0;
  220. for iRowIndex := 0 to zgBGL.RowCount - 1 do
  221. if zgBGL.Cells[2, iRowIndex].Text <> '' then
  222. if SameText(zgBGL.Cells[1, iRowIndex].Text, 'True') then
  223. Result := Result + StrToFloatDef(zgBGL.Cells[5, iRowIndex].Text, 0);
  224. end;
  225. procedure TBGLSelectForm.zgBGLCellGetColor(Sender: TObject; ACoord: TPoint;
  226. var AColor: TColor);
  227. var
  228. fValidValue, fValue: Double;
  229. begin
  230. if ACoord.X = 5 then
  231. begin
  232. fValidValue := StrToFloatDef(zgBGL.Cells[4, ACoord.Y].Text, 0);
  233. fValue := StrToFloatDef(zgBGL.Cells[5, ACoord.Y].Text, 0);
  234. if ((fValidValue > 0) and (fValue > fValidValue)) or
  235. ((fValidValue < 0) and (fValue < fValidValue)) then
  236. AColor := clRed;
  237. end;
  238. end;
  239. procedure TBGLSelectForm.zgBGLCellTextChanging(Sender: TObject;
  240. const ACoord: TPoint; var NewValue: String; var Accept: Boolean);
  241. procedure AutoGetBGNum(ARowIndex: Integer);
  242. var
  243. fAvailableNum: Double;
  244. begin
  245. if HasBGNum then
  246. fAvailableNum := FBGNum - GetTotalBGNum
  247. else
  248. fAvailableNum := StrToFloatDef(zgBGL.Cells[4, ARowIndex].Text, 0);
  249. // 当变更数量为负数时, 例如-60,但计算得到可变更数量为-80,此时应取两值中较大的-60
  250. if FBGNum < 0 then
  251. zgBGL.Cells[5, ARowIndex].Text := FloatToStr(
  252. Max(fAvailableNum, StrToFloatDef(zgBGL.Cells[4, ARowIndex].Text, 0)))
  253. else
  254. zgBGL.Cells[5, ARowIndex].Text := FloatToStr(
  255. Min(fAvailableNum, StrToFloatDef(zgBGL.Cells[4, ARowIndex].Text, 0)));
  256. end;
  257. begin
  258. if ACoord.X = 1 then
  259. if NewValue = 'True' then
  260. AutoGetBGNum(ACoord.Y)
  261. else
  262. zgBGL.Cells[5, ACoord.Y].Text := '';
  263. end;
  264. procedure TBGLSelectForm.zgBGLCellValueChanged(Sender: TObject);
  265. procedure RefreshBGNum;
  266. begin
  267. FBGNum := GetTotalBGNum;
  268. lblBGInfo.Caption := Format(sBGInfo, [FGclCode, FloatToStr(FBGNum)]);
  269. end;
  270. var
  271. fCur, fValid: Double;
  272. begin
  273. if zgBGL.CurCol = 5 then
  274. begin
  275. zgBGL.OnCellValueChanged := nil;
  276. if zgBGL.Cells[5, zgBGL.CurRow].Text <> '' then
  277. begin
  278. fCur := QuantityRoundTo(StrToFloatDef(zgBGL.Cells[5, zgBGL.CurRow].Text, 0));
  279. fValid := StrToFloatDef(zgBGL.Cells[4, zgBGL.CurRow].Text, 0);
  280. if ((fValid >= 0) and (fCur <= fValid)) or
  281. ((fValid < 0) and (fCur >= fValid)) then
  282. zgBGL.Cells[5, zgBGL.CurRow].Text := FloatToStr(fCur)
  283. else
  284. begin
  285. ErrorMessage('当前输入的变更数量大于可变更数量,请重新输入!');
  286. zgBGL.Cells[5, zgBGL.CurRow].Text := '';
  287. end;
  288. end;
  289. zgBGL.OnCellValueChanged := zgBGLCellValueChanged;
  290. end;
  291. if not HasBGNum and ((zgBGL.CurCol = 1) or (zgBGL.CurCol = 5)) then
  292. RefreshBGNum;
  293. end;
  294. procedure TBGLSelectForm.cbIncludeZeroQuantityClick(Sender: TObject);
  295. begin
  296. InitBGList;
  297. end;
  298. function TBGLSelectForm.GetIncludeZeroQuantity: Boolean;
  299. begin
  300. Result := cbIncludeZeroQuantity.Checked;
  301. end;
  302. end.