BatchInsertBillsFrm.pas 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425
  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. FBillsCompileData := ABillsCompileData;
  133. sgdDealBills.DataView := TProjectData(ABillsCompileData.ProjectData).DealBillsData.sdvDealBills;
  134. FInsertType := AInsertType;
  135. if FInsertType = itChild then
  136. Caption := '批量插入子项'
  137. else if FInsertType = itNextSibling then
  138. Caption := '批量插入后项';
  139. ResetPositionGridHead;
  140. ResetBillsGridHead;
  141. LoadParentCode;
  142. end;
  143. procedure TBatchInsertBillsForm.PasteData(AGrid: TZJGrid; ABounds: TRect;
  144. ASourSheet: TZjSheet);
  145. var
  146. iCol, iRow: Integer;
  147. begin
  148. for iRow := 0 to ASourSheet.RowCount - 1 do
  149. for iCol := 0 to ASourSheet.ColCount - 1 do
  150. begin
  151. with AGrid.Cells[iCol + ABounds.Left , iRow + ABounds.Top] do
  152. if CanEdit then Text := ASourSheet.Values[iCol, iRow];
  153. end;
  154. end;
  155. function TBatchInsertBillsForm.ReplaceLastNum(const ACode: string;
  156. ARow: Integer): string;
  157. var
  158. sgs: TStringList;
  159. begin
  160. sgs := TStringList.Create;
  161. try
  162. sgs.Delimiter := '-';
  163. sgs.DelimitedText := ACode;
  164. sgs[sgs.Count - 1] := IntToStr(StrToInt(sgs[sgs.Count - 1]) + ARow - 1);
  165. Result := sgs.DelimitedText;
  166. finally
  167. sgs.Free;
  168. end;
  169. end;
  170. procedure TBatchInsertBillsForm.ResetPositionGridHead;
  171. var
  172. iCol: Integer;
  173. begin
  174. zgPosition.Cells[1, 0].Text := '部位';
  175. zgPosition.ColWidths[1] := 120;
  176. for iCol := 2 to zgPosition.ColCount - 1 do
  177. begin
  178. zgPosition.Cells[iCol, 0].Text := '清单' + IntToStr(iCol - 1);
  179. zgPosition.ColWidths[iCol] := 50;
  180. end;
  181. end;
  182. procedure TBatchInsertBillsForm.SetRowAndColumnCount(AGrid: TZJGrid;
  183. ASourSheet: TZjSheet);
  184. begin
  185. if AGrid.ColCount < ASourSheet.ColCount + AGrid.CurCol + 1 then
  186. AGrid.ColCount := ASourSheet.ColCount + AGrid.CurCol + 1;
  187. if AGrid.RowCount < ASourSheet.RowCount + AGrid.CurRow + 1 then
  188. AGrid.RowCount := ASourSheet.RowCount + AGrid.CurRow + 1;
  189. end;
  190. procedure TBatchInsertBillsForm.zgPositionCustomPaste(Sender: TObject;
  191. ABounds: TRect; ASourSheet: TZjSheet);
  192. begin
  193. SetRowAndColumnCount(TZJGrid(Sender), ASourSheet);
  194. ResetPositionGridHead;
  195. PasteData(TZJGrid(Sender), ABounds, ASourSheet);
  196. zgBills.RowCount := zgPosition.ColCount - 1;
  197. ResetBillsGridHead;
  198. end;
  199. procedure TBatchInsertBillsForm.zgBillsCustomPaste(Sender: TObject;
  200. ABounds: TRect; ASourSheet: TZjSheet);
  201. begin
  202. SetRowAndColumnCount(TZJGrid(Sender), ASourSheet);
  203. PasteData(TZJGrid(Sender), ABounds, ASourSheet);
  204. end;
  205. procedure TBatchInsertBillsForm.AddBillsNodes(AQtyRow: Integer;
  206. AParent: TsdIDTreeNode);
  207. var
  208. iRow: Integer;
  209. begin
  210. for iRow := 1 to zgBills.RowCount - 1 do
  211. AddBillsNode(AQtyRow, iRow, AParent);
  212. end;
  213. procedure TBatchInsertBillsForm.AddBillsNode(AQtyRow, ARow: Integer;
  214. AParent: TsdIDTreeNode);
  215. var
  216. stnNode: TsdIDTreeNode;
  217. fQuantity: Double;
  218. begin
  219. if (zgBills.Cells[1, ARow].Text = '') or
  220. (zgPosition.Cells[ARow + 1, AQtyRow].Text = '') or
  221. not TryStrToFloat(zgPosition.Cells[ARow + 1, AQtyRow].Text, fQuantity) then Exit;
  222. stnNode := FBillsCompileData.BillsCompileTree.Add(AParent.ID, -1);
  223. with stnNode.Rec do
  224. begin
  225. ValueByName('B_Code').AsString := zgBills.Cells[1, ARow].Text;
  226. ValueByName('Name').AsString := zgBills.Cells[2, ARow].Text;
  227. ValueByName('Units').AsString := zgBills.Cells[3, ARow].Text;
  228. ValueByName('Price').AsFloat := StrToFloatDef(zgBills.Cells[4, ARow].Text, 0);
  229. ValueByName('OrgQuantity').AsFloat := StrToFloatDef(zgPosition.Cells[ARow + 1, AQtyRow].Text, 0);
  230. ValueByName('DrawingCode').AsString := zgBills.Cells[5, ARow].Text;
  231. end;
  232. end;
  233. procedure TBatchInsertBillsForm.ResetBillsGridHead;
  234. var
  235. iRow: Integer;
  236. begin
  237. zgBills.Cells[1, 0].Text := '编号';
  238. zgBills.ColWidths[1] := 80;
  239. zgBills.Cells[2, 0].Text := '名称';
  240. zgBills.ColWidths[2] := 120;
  241. zgBills.Cells[3, 0].Text := '单位';
  242. zgBills.ColWidths[3] := 60;
  243. zgBills.Cells[4, 0].Text := '单价';
  244. zgBills.ColWidths[4] := 60;
  245. zgBills.Cells[5, 0].Text := '图(册)号';
  246. zgBills.ColWidths[5] := 60;
  247. for iRow := 1 to zgBills.RowCount - 1 do
  248. zgBills.Cells[0, iRow].Text := '清单' + IntToStr(iRow);
  249. end;
  250. procedure TBatchInsertBillsForm.btnOKClick(Sender: TObject);
  251. function CheckGridHasData(AGrid: TZJGrid): Boolean;
  252. var
  253. iRow: Integer;
  254. begin
  255. Result := False;
  256. for iRow := 1 to AGrid.RowCount - 1 do
  257. if AGrid.Cells[1, iRow].Text <> '' then
  258. begin
  259. Result := True;
  260. Break;
  261. end;
  262. end;
  263. function CheckBeginCodeAvailable(const ACode: string): Boolean;
  264. var
  265. sgsCode: TStrings;
  266. iCode: Integer;
  267. begin
  268. sgsCode := TStringList.Create;
  269. try
  270. sgsCode.Delimiter := '-';
  271. sgsCode.DelimitedText := ACode;
  272. Result := TryStrToInt(sgsCode[sgsCode.Count - 1], iCode);
  273. finally
  274. sgsCode.Free;
  275. end;
  276. end;
  277. begin
  278. if not CheckGridHasData(zgPosition) then
  279. ErrorMessage('请输入部位数量复核数据!')
  280. else if not CheckGridHasData(zgBills) then
  281. ErrorMessage('请输入清单编号等数据!')
  282. else if leBeginCode.Text = '' then
  283. ErrorMessage('请输入起始编号!')
  284. else if not CheckBeginCodeAvailable(leBeginCode.Text) then
  285. ErrorMessage('请输入规范的起始部位编号,如1或1-1等。')
  286. else
  287. ModalResult := mrOK;
  288. end;
  289. procedure TBatchInsertBillsForm.zgPositionMouseDown(Sender: TObject;
  290. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  291. begin
  292. if Button = mbRight then
  293. dxpmInsertBills.PopupFromCursorPos;
  294. end;
  295. procedure TBatchInsertBillsForm.zgBillsCellTextChanged(Sender: TObject;
  296. Col, Row: Integer);
  297. var
  298. sB_Code: string;
  299. Rec: TsdDataRecord;
  300. begin
  301. if (Col = 1) and (Row > 0) then
  302. begin
  303. zgBills.Cells[Col, Row].Align := gaCenterLeft;
  304. sB_Code := zgBills.Cells[Col, Row].Text;
  305. if sB_Code = '' then Exit;
  306. with FBillsCompileData.BillsData do
  307. Rec := sddBills.Locate('B_Code', sB_Code);
  308. if Assigned(Rec) then
  309. begin
  310. zgBills.Cells[2, Row].Text := Rec.ValueByName('Name').AsString;
  311. zgBills.Cells[2, Row].Align := gaCenterLeft;
  312. zgBills.Cells[3, Row].Text := Rec.ValueByName('Units').AsString;
  313. zgBills.Cells[3, Row].Align := gaCenterCenter;
  314. zgBills.Cells[3, Row].Font.Name := 'smartSimSun';
  315. zgBills.Cells[4, Row].Text := Rec.ValueByName('Price').AsString;
  316. zgBills.Cells[4, Row].Align := gaCenterRight;
  317. zgBills.Cells[5, Row].Align := gaCenterLeft;
  318. end;
  319. end
  320. else if (Col = 4) and (Row > 0) then
  321. begin
  322. zgBills.Cells[Col, Row].Value := PriceRoundTo(
  323. StrToFloatDef(zgBills.Cells[Col, Row].Text, 0));
  324. zgBills.Cells[Col, Row].Align := gaCenterRight;
  325. end
  326. else if (Col = 5) and (Row > 0) then
  327. zgBills.Cells[Col, Row].Align := gaCenterLeft;
  328. end;
  329. procedure TBatchInsertBillsForm.zgDealBillsMouseDown(Sender: TObject;
  330. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  331. var
  332. i: Integer;
  333. begin
  334. if (Button = mbLeft) and (ssDouble in Shift) then
  335. for i := 1 to 4 do
  336. zgBills.Cells[i, zgBills.CurRow].Text := zgDealBills.Cells[i, zgDealBills.CurRow].Text;
  337. end;
  338. procedure TBatchInsertBillsForm.LoadParentCode;
  339. var
  340. Parent: TsdIDTreeNode;
  341. begin
  342. if FInsertType = itChild then
  343. Parent := FBillsCompileData.BillsCompileTree.Selected
  344. else if FInsertType = itNextSibling then
  345. Parent := FBillsCompileData.BillsCompileTree.Selected.Parent;
  346. FParentCode := Parent.Rec.ValueByName('Code').AsString;
  347. end;
  348. function TBatchInsertBillsForm.GetXmjCode(ARow: Integer): string;
  349. var
  350. iBeginCode: Integer;
  351. begin
  352. iBeginCode := StrToIntDef(leBeginCode.Text, 1);
  353. Result := Format('%s-%d', [FParentCode, iBeginCode + ARow - 1]);
  354. end;
  355. procedure TBatchInsertBillsForm.leBeginCodeKeyPress(Sender: TObject;
  356. var Key: Char);
  357. begin
  358. ValidInteger(Key);
  359. end;
  360. procedure TBatchInsertBillsForm.zgPositionCellTextChanged(Sender: TObject;
  361. Col, Row: Integer);
  362. begin
  363. if (Col > 1) and (Row > 0) then
  364. begin
  365. zgPosition.Cells[Col, Row].Value := QuantityRoundTo(
  366. StrToFloatDef(zgPosition.Cells[Col, Row].Text, 0));
  367. zgPosition.Cells[Col, Row].Align := gaCenterRight;
  368. end;
  369. end;
  370. procedure TBatchInsertBillsForm.dxpmInsertBillsPopup(Sender: TObject);
  371. begin
  372. SetDxBtnAction(actnInsertCol, MainForm.dxbtnInsertCol);
  373. end;
  374. procedure TBatchInsertBillsForm.actnInsertColExecute(Sender: TObject);
  375. begin
  376. zgPosition.ColCount := zgPosition.ColCount + 1;
  377. zgPosition.Cells[zgPosition.ColCount-1, 0].Text := '清单' + IntToStr(zgPosition.ColCount -1 - 1);
  378. zgPosition.ColWidths[zgPosition.ColCount-1] := 50;
  379. zgBills.RowCount := zgPosition.ColCount - 1;
  380. zgBills.Cells[0, zgBills.RowCount-1].Text := '清单' + IntToStr(zgBills.RowCount-1);
  381. end;
  382. end.