BatchInsertBillsFrm.pas 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434
  1. unit BatchInsertBillsFrm;
  2. interface
  3. uses
  4. BillsCompileDm,
  5. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  6. Dialogs, StdCtrls, ExtCtrls, ZJGrid, sdIDTree, dxBar, sdGridDBA, ComCtrls,
  7. ActnList;
  8. type
  9. TInsertType = (itChild, itNextSibling);
  10. TBatchInsertBillsForm = class(TForm)
  11. pnlButton: TPanel;
  12. btnOK: TButton;
  13. btnCancel: TButton;
  14. dxpmInsertBills: TdxBarPopupMenu;
  15. pnlAllGrid: TPanel;
  16. pnlPositon_Bills: TPanel;
  17. pnlPosition: TPanel;
  18. lblPostion: TLabel;
  19. zgPosition: TZJGrid;
  20. pnlPositionSpr: TPanel;
  21. pnlBills: TPanel;
  22. lblBills: TLabel;
  23. zgBills: TZJGrid;
  24. pnlBillsSpr: TPanel;
  25. pnlDealBills: TPanel;
  26. pnlOther: TPanel;
  27. leBeginCode: TLabeledEdit;
  28. leDrawingCode: TLabeledEdit;
  29. zgDealBills: TZJGrid;
  30. pnlDealBillsSpr: TPanel;
  31. lblDealBills: TLabel;
  32. lblHint: TLabel;
  33. sgdDealBills: TsdGridDBA;
  34. udBeginCode: TUpDown;
  35. alBatchInsertBills: TActionList;
  36. actnInsertCol: TAction;
  37. procedure zgPositionCustomPaste(Sender: TObject; ABounds: TRect;
  38. ASourSheet: TZjSheet);
  39. procedure zgBillsCustomPaste(Sender: TObject; ABounds: TRect;
  40. ASourSheet: TZjSheet);
  41. procedure btnOKClick(Sender: TObject);
  42. procedure zgPositionMouseDown(Sender: TObject; Button: TMouseButton;
  43. Shift: TShiftState; X, Y: Integer);
  44. procedure zgBillsCellTextChanged(Sender: TObject; Col, Row: Integer);
  45. procedure zgDealBillsMouseDown(Sender: TObject; Button: TMouseButton;
  46. Shift: TShiftState; X, Y: Integer);
  47. procedure leBeginCodeKeyPress(Sender: TObject; var Key: Char);
  48. procedure zgPositionCellTextChanged(Sender: TObject; Col,
  49. Row: Integer);
  50. procedure dxpmInsertBillsPopup(Sender: TObject);
  51. procedure actnInsertColExecute(Sender: TObject);
  52. private
  53. FInsertType: TInsertType;
  54. FBillsCompileData: TBillsCompileData;
  55. FParentCode: string;
  56. procedure ResetPositionGridHead;
  57. procedure ResetBillsGridHead;
  58. procedure PasteData(AGrid: TZJGrid; ABounds: TRect; ASourSheet: TZjSheet);
  59. procedure SetRowAndColumnCount(AGrid: TZJGrid; ASourSheet: TZjSheet);
  60. procedure LoadParentCode;
  61. function ReplaceLastNum(const ACode: string; ARow: Integer): string;
  62. function GetXmjCode(ARow: Integer): string;
  63. procedure AddXmjNode(ARow, AParentID, ANextSiblingID: Integer);
  64. procedure AddBillsNode(AQtyRow, ARow: Integer; AParent: TsdIDTreeNode);
  65. procedure AddBillsNodes(AQtyRow: Integer; AParent: TsdIDTreeNode);
  66. procedure BatchAddBillsNodes(AParentID, ANextSiblingID: Integer);
  67. public
  68. procedure Init(ABillsCompileData: TBillsCompileData; AInsertType: TInsertType);
  69. procedure Execute;
  70. end;
  71. procedure AddLeafBills(ABillsCompileData: TBillsCompileData; AInsertType: TInsertType);
  72. implementation
  73. uses
  74. sdDB, UtilMethods, ProjectData, MainFrm;
  75. {$R *.dfm}
  76. procedure AddLeafBills(ABillsCompileData: TBillsCompileData; AInsertType: TInsertType);
  77. var
  78. InsertBillsForm: TBatchInsertBillsForm;
  79. begin
  80. InsertBillsForm := TBatchInsertBillsForm.Create(nil);
  81. try
  82. InsertBillsForm.Init(ABillsCompileData, AInsertType);
  83. if InsertBillsForm.ShowModal = mrOK then
  84. InsertBillsForm.Execute;
  85. finally
  86. InsertBillsForm.Free;
  87. end;
  88. end;
  89. { TAddLeafBillsForm }
  90. procedure TBatchInsertBillsForm.AddXmjNode(ARow, AParentID, ANextSiblingID: Integer);
  91. var
  92. stnNode: TsdIDTreeNode;
  93. begin
  94. if zgPosition.Cells[1, ARow].Text = '' then Exit;
  95. stnNode := FBillsCompileData.BillsCompileTree.Add(AParentID, ANextSiblingID);
  96. with stnNode.Rec do
  97. begin
  98. ValueByName('Code').AsString := GetXmjCode(ARow);{ReplaceLastNum(leBeginCode.Text, ARow);}
  99. ValueByName('Name').AsString := zgPosition.Cells[1, ARow].Text;
  100. ValueByName('DrawingCode').AsString := leDrawingCode.Text;
  101. end;
  102. AddBillsNodes(ARow, stnNode);
  103. end;
  104. procedure TBatchInsertBillsForm.BatchAddBillsNodes(AParentID, ANextSiblingID: Integer);
  105. var
  106. iRow: Integer;
  107. begin
  108. for iRow := 1 to zgPosition.RowCount - 1 do
  109. AddXmjNode(iRow, AParentID, ANextSiblingID);
  110. end;
  111. procedure TBatchInsertBillsForm.Execute;
  112. begin
  113. with FBillsCompileData.BillsCompileTree do
  114. begin
  115. if FInsertType = itChild then
  116. begin
  117. if not Assigned(Selected) then Exit;
  118. BatchAddBillsNodes(Selected.ID, -1);
  119. FBillsCompileData.Calculate(Selected.ID);
  120. end
  121. else if FInsertType = itNextSibling then
  122. begin
  123. if not Assigned(Selected.Parent) then Exit;
  124. BatchAddBillsNodes(Selected.ParentID, Selected.NextSiblingID);
  125. FBillsCompileData.Calculate(Selected.ParentID);
  126. end;
  127. end;
  128. end;
  129. procedure TBatchInsertBillsForm.Init(ABillsCompileData: TBillsCompileData;
  130. AInsertType: TInsertType);
  131. begin
  132. ClientHeight := 382;
  133. ClientWidth := 779;
  134. FBillsCompileData := ABillsCompileData;
  135. sgdDealBills.DataView := TProjectData(ABillsCompileData.ProjectData).DealBillsData.sdvDealBills;
  136. FInsertType := AInsertType;
  137. if FInsertType = itChild then
  138. Caption := '批量插入子项'
  139. else if FInsertType = itNextSibling then
  140. Caption := '批量插入后项';
  141. ResetPositionGridHead;
  142. ResetBillsGridHead;
  143. LoadParentCode;
  144. end;
  145. procedure TBatchInsertBillsForm.PasteData(AGrid: TZJGrid; ABounds: TRect;
  146. ASourSheet: TZjSheet);
  147. var
  148. iCol, iRow: Integer;
  149. begin
  150. for iRow := 0 to ASourSheet.RowCount - 1 do
  151. for iCol := 0 to ASourSheet.ColCount - 1 do
  152. begin
  153. with AGrid.Cells[iCol + ABounds.Left , iRow + ABounds.Top] do
  154. if CanEdit then Text := ASourSheet.Values[iCol, iRow];
  155. end;
  156. end;
  157. function TBatchInsertBillsForm.ReplaceLastNum(const ACode: string;
  158. ARow: Integer): string;
  159. var
  160. sgs: TStringList;
  161. begin
  162. sgs := TStringList.Create;
  163. try
  164. sgs.Delimiter := '-';
  165. sgs.DelimitedText := ACode;
  166. sgs[sgs.Count - 1] := IntToStr(StrToInt(sgs[sgs.Count - 1]) + ARow - 1);
  167. Result := sgs.DelimitedText;
  168. finally
  169. sgs.Free;
  170. end;
  171. end;
  172. procedure TBatchInsertBillsForm.ResetPositionGridHead;
  173. var
  174. iCol: Integer;
  175. begin
  176. zgPosition.Cells[1, 0].Text := '部位';
  177. zgPosition.ColWidths[1] := 120;
  178. for iCol := 2 to zgPosition.ColCount - 1 do
  179. begin
  180. zgPosition.Cells[iCol, 0].Text := '清单' + IntToStr(iCol - 1);
  181. zgPosition.ColWidths[iCol] := 50;
  182. end;
  183. end;
  184. procedure TBatchInsertBillsForm.SetRowAndColumnCount(AGrid: TZJGrid;
  185. ASourSheet: TZjSheet);
  186. begin
  187. if AGrid.ColCount < ASourSheet.ColCount + AGrid.CurCol + 1 then
  188. AGrid.ColCount := ASourSheet.ColCount + AGrid.CurCol + 1;
  189. if AGrid.RowCount < ASourSheet.RowCount + AGrid.CurRow + 1 then
  190. AGrid.RowCount := ASourSheet.RowCount + AGrid.CurRow + 1;
  191. end;
  192. procedure TBatchInsertBillsForm.zgPositionCustomPaste(Sender: TObject;
  193. ABounds: TRect; ASourSheet: TZjSheet);
  194. begin
  195. SetRowAndColumnCount(TZJGrid(Sender), ASourSheet);
  196. ResetPositionGridHead;
  197. PasteData(TZJGrid(Sender), ABounds, ASourSheet);
  198. zgBills.RowCount := zgPosition.ColCount - 1;
  199. ResetBillsGridHead;
  200. end;
  201. procedure TBatchInsertBillsForm.zgBillsCustomPaste(Sender: TObject;
  202. ABounds: TRect; ASourSheet: TZjSheet);
  203. begin
  204. SetRowAndColumnCount(TZJGrid(Sender), ASourSheet);
  205. PasteData(TZJGrid(Sender), ABounds, ASourSheet);
  206. end;
  207. procedure TBatchInsertBillsForm.AddBillsNodes(AQtyRow: Integer;
  208. AParent: TsdIDTreeNode);
  209. var
  210. iRow: Integer;
  211. begin
  212. for iRow := 1 to zgBills.RowCount - 1 do
  213. AddBillsNode(AQtyRow, iRow, AParent);
  214. end;
  215. procedure TBatchInsertBillsForm.AddBillsNode(AQtyRow, ARow: Integer;
  216. AParent: TsdIDTreeNode);
  217. var
  218. stnNode: TsdIDTreeNode;
  219. fQuantity: Double;
  220. begin
  221. if (zgBills.Cells[1, ARow].Text = '') or
  222. (zgPosition.Cells[ARow + 1, AQtyRow].Text = '') or
  223. not TryStrToFloat(zgPosition.Cells[ARow + 1, AQtyRow].Text, fQuantity) then Exit;
  224. stnNode := FBillsCompileData.BillsCompileTree.Add(AParent.ID, -1);
  225. with stnNode.Rec do
  226. begin
  227. ValueByName('B_Code').AsString := zgBills.Cells[1, ARow].Text;
  228. ValueByName('Name').AsString := zgBills.Cells[2, ARow].Text;
  229. ValueByName('Units').AsString := zgBills.Cells[3, ARow].Text;
  230. ValueByName('Price').AsFloat := StrToFloatDef(zgBills.Cells[4, ARow].Text, 0);
  231. ValueByName('OrgQuantity').AsFloat := StrToFloatDef(zgPosition.Cells[ARow + 1, AQtyRow].Text, 0);
  232. ValueByName('DrawingCode').AsString := zgBills.Cells[5, ARow].Text;
  233. end;
  234. end;
  235. procedure TBatchInsertBillsForm.ResetBillsGridHead;
  236. var
  237. iRow: Integer;
  238. begin
  239. zgBills.Cells[1, 0].Text := '编号';
  240. zgBills.ColWidths[1] := 80;
  241. zgBills.Cells[2, 0].Text := '名称';
  242. zgBills.ColWidths[2] := 120;
  243. zgBills.Cells[3, 0].Text := '单位';
  244. zgBills.ColWidths[3] := 60;
  245. zgBills.Cells[4, 0].Text := '单价';
  246. zgBills.ColWidths[4] := 60;
  247. zgBills.Cells[5, 0].Text := '图(册)号';
  248. zgBills.ColWidths[5] := 60;
  249. for iRow := 1 to zgBills.RowCount - 1 do
  250. zgBills.Cells[0, iRow].Text := '清单' + IntToStr(iRow);
  251. end;
  252. procedure TBatchInsertBillsForm.btnOKClick(Sender: TObject);
  253. function CheckGridHasData(AGrid: TZJGrid): Boolean;
  254. var
  255. iRow: Integer;
  256. begin
  257. Result := False;
  258. for iRow := 1 to AGrid.RowCount - 1 do
  259. if AGrid.Cells[1, iRow].Text <> '' then
  260. begin
  261. Result := True;
  262. Break;
  263. end;
  264. end;
  265. function CheckBeginCodeAvailable(const ACode: string): Boolean;
  266. var
  267. sgsCode: TStrings;
  268. iCode: Integer;
  269. begin
  270. sgsCode := TStringList.Create;
  271. try
  272. sgsCode.Delimiter := '-';
  273. sgsCode.DelimitedText := ACode;
  274. Result := TryStrToInt(sgsCode[sgsCode.Count - 1], iCode);
  275. finally
  276. sgsCode.Free;
  277. end;
  278. end;
  279. begin
  280. if not CheckGridHasData(zgPosition) then
  281. ErrorMessage('请输入部位数量复核数据!')
  282. else if not CheckGridHasData(zgBills) then
  283. ErrorMessage('请输入清单编号等数据!')
  284. else if leBeginCode.Text = '' then
  285. ErrorMessage('请输入起始编号!')
  286. else if not CheckBeginCodeAvailable(leBeginCode.Text) then
  287. ErrorMessage('请输入规范的起始部位编号,如1或1-1等。')
  288. else
  289. ModalResult := mrOK;
  290. end;
  291. procedure TBatchInsertBillsForm.zgPositionMouseDown(Sender: TObject;
  292. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  293. begin
  294. if Button = mbRight then
  295. dxpmInsertBills.PopupFromCursorPos;
  296. end;
  297. procedure TBatchInsertBillsForm.zgBillsCellTextChanged(Sender: TObject;
  298. Col, Row: Integer);
  299. var
  300. sB_Code: string;
  301. Rec: TsdDataRecord;
  302. begin
  303. if (Col = 1) and (Row > 0) then
  304. begin
  305. zgBills.Cells[Col, Row].Align := gaCenterLeft;
  306. sB_Code := zgBills.Cells[Col, Row].Text;
  307. if sB_Code = '' then Exit;
  308. with FBillsCompileData.BillsData do
  309. Rec := sddBills.Locate('B_Code', sB_Code);
  310. if Assigned(Rec) then
  311. begin
  312. zgBills.Cells[2, Row].Text := Rec.ValueByName('Name').AsString;
  313. zgBills.Cells[2, Row].Align := gaCenterLeft;
  314. zgBills.Cells[3, Row].Text := Rec.ValueByName('Units').AsString;
  315. zgBills.Cells[3, Row].Align := gaCenterCenter;
  316. zgBills.Cells[3, Row].Font.Name := 'smartSimSun';
  317. zgBills.Cells[4, Row].Text := Rec.ValueByName('Price').AsString;
  318. zgBills.Cells[4, Row].Align := gaCenterRight;
  319. zgBills.Cells[5, Row].Align := gaCenterLeft;
  320. end;
  321. end
  322. else if (Col = 4) and (Row > 0) then
  323. begin
  324. zgBills.Cells[Col, Row].Value := PriceRoundTo(
  325. StrToFloatDef(zgBills.Cells[Col, Row].Text, 0));
  326. zgBills.Cells[Col, Row].Align := gaCenterRight;
  327. end
  328. else if (Col = 5) and (Row > 0) then
  329. zgBills.Cells[Col, Row].Align := gaCenterLeft;
  330. end;
  331. procedure TBatchInsertBillsForm.zgDealBillsMouseDown(Sender: TObject;
  332. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  333. var
  334. i: Integer;
  335. begin
  336. if (Button = mbLeft) and (ssDouble in Shift) then
  337. for i := 1 to 4 do
  338. zgBills.Cells[i, zgBills.CurRow].Text := zgDealBills.Cells[i, zgDealBills.CurRow].Text;
  339. end;
  340. procedure TBatchInsertBillsForm.LoadParentCode;
  341. var
  342. Parent: TsdIDTreeNode;
  343. begin
  344. if FInsertType = itChild then
  345. Parent := FBillsCompileData.BillsCompileTree.Selected
  346. else if FInsertType = itNextSibling then
  347. Parent := FBillsCompileData.BillsCompileTree.Selected.Parent;
  348. FParentCode := Parent.Rec.ValueByName('Code').AsString;
  349. end;
  350. function TBatchInsertBillsForm.GetXmjCode(ARow: Integer): string;
  351. var
  352. iBeginCode: Integer;
  353. begin
  354. iBeginCode := StrToIntDef(leBeginCode.Text, 1);
  355. Result := Format('%s-%d', [FParentCode, iBeginCode + ARow - 1]);
  356. end;
  357. procedure TBatchInsertBillsForm.leBeginCodeKeyPress(Sender: TObject;
  358. var Key: Char);
  359. begin
  360. ValidInteger(Key);
  361. end;
  362. procedure TBatchInsertBillsForm.zgPositionCellTextChanged(Sender: TObject;
  363. Col, Row: Integer);
  364. var
  365. value: Double;
  366. begin
  367. if (Col > 1) and (Row > 0) then
  368. begin
  369. if (TryStrToFloat(zgPosition.Cells[Col, Row].Text, value)) then
  370. begin
  371. zgPosition.Cells[Col, Row].Value := QuantityRoundTo(Value);
  372. zgPosition.Cells[Col, Row].Align := gaCenterRight;
  373. end
  374. else
  375. zgPosition.Cells[Col, Row].Value := '';
  376. end;
  377. end;
  378. procedure TBatchInsertBillsForm.dxpmInsertBillsPopup(Sender: TObject);
  379. begin
  380. SetDxBtnAction(actnInsertCol, MainForm.dxbtnInsertCol);
  381. end;
  382. procedure TBatchInsertBillsForm.actnInsertColExecute(Sender: TObject);
  383. begin
  384. zgPosition.ColCount := zgPosition.ColCount + 1;
  385. zgPosition.Cells[zgPosition.ColCount-1, 0].Text := '清单' + IntToStr(zgPosition.ColCount -1 - 1);
  386. zgPosition.ColWidths[zgPosition.ColCount-1] := 50;
  387. zgBills.RowCount := zgPosition.ColCount - 1;
  388. zgBills.Cells[0, zgBills.RowCount-1].Text := '清单' + IntToStr(zgBills.RowCount-1);
  389. end;
  390. end.