BatchInsertBillsFrm.pas 15 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497
  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. dxpmBills: TdxBarPopupMenu;
  38. procedure zgPositionCustomPaste(Sender: TObject; ABounds: TRect;
  39. ASourSheet: TZjSheet);
  40. procedure zgBillsCustomPaste(Sender: TObject; ABounds: TRect;
  41. ASourSheet: TZjSheet);
  42. procedure btnOKClick(Sender: TObject);
  43. procedure zgPositionMouseDown(Sender: TObject; Button: TMouseButton;
  44. Shift: TShiftState; X, Y: Integer);
  45. procedure zgBillsCellTextChanged(Sender: TObject; Col, Row: Integer);
  46. procedure zgDealBillsMouseDown(Sender: TObject; Button: TMouseButton;
  47. Shift: TShiftState; X, Y: Integer);
  48. procedure leBeginCodeKeyPress(Sender: TObject; var Key: Char);
  49. procedure zgPositionCellTextChanged(Sender: TObject; Col,
  50. Row: Integer);
  51. procedure dxpmInsertBillsPopup(Sender: TObject);
  52. procedure actnInsertColExecute(Sender: TObject);
  53. procedure zgBillsMouseDown(Sender: TObject; Button: TMouseButton;
  54. Shift: TShiftState; X, Y: Integer);
  55. procedure actnInsertColUpdate(Sender: TObject);
  56. procedure FormResize(Sender: TObject);
  57. private
  58. FInsertType: TInsertType;
  59. FBillsCompileData: TBillsCompileData;
  60. FParentCode: string;
  61. procedure ResetPositionGridHead;
  62. procedure ResetBillsGridHead;
  63. procedure PasteData(AGrid: TZJGrid; ABounds: TRect; ASourSheet: TZjSheet);
  64. procedure SetRowAndColumnCount(AGrid: TZJGrid; ASourSheet: TZjSheet);
  65. procedure LoadParentCode;
  66. function ReplaceLastNum(const ACode: string; ARow: Integer): string;
  67. function GetXmjCode(ARow: Integer): string;
  68. procedure AddXmjNode(ARow, AParentID, ANextSiblingID: Integer);
  69. procedure AddBillsNode(AQtyRow, ARow: Integer; AParent: TsdIDTreeNode);
  70. procedure AddBillsNodes(AQtyRow: Integer; AParent: TsdIDTreeNode);
  71. procedure BatchAddBillsNodes(AParentID, ANextSiblingID: Integer);
  72. public
  73. procedure Init(ABillsCompileData: TBillsCompileData; AInsertType: TInsertType);
  74. procedure Execute;
  75. end;
  76. procedure AddLeafBills(ABillsCompileData: TBillsCompileData; AInsertType: TInsertType);
  77. implementation
  78. uses
  79. sdDB, UtilMethods, ProjectData, MainFrm, Globals, DealBillsDm;
  80. {$R *.dfm}
  81. const
  82. iBwNameCol = 1;
  83. iBwDrawingCodeCol = 2;
  84. iBwBillsQtyCol = 3;
  85. iGclCodeCol = 1;
  86. iGclNameCol = 2;
  87. iGclUnitsCol = 3;
  88. iGclPriceCol = 4;
  89. iGclDrawingCodeCol = 5;
  90. procedure AddLeafBills(ABillsCompileData: TBillsCompileData; AInsertType: TInsertType);
  91. var
  92. InsertBillsForm: TBatchInsertBillsForm;
  93. begin
  94. InsertBillsForm := TBatchInsertBillsForm.Create(nil);
  95. try
  96. InsertBillsForm.Init(ABillsCompileData, AInsertType);
  97. if InsertBillsForm.ShowModal = mrOK then
  98. InsertBillsForm.Execute;
  99. finally
  100. InsertBillsForm.Free;
  101. end;
  102. end;
  103. { TAddLeafBillsForm }
  104. procedure TBatchInsertBillsForm.AddXmjNode(ARow, AParentID, ANextSiblingID: Integer);
  105. var
  106. stnNode: TsdIDTreeNode;
  107. begin
  108. if zgPosition.Cells[1, ARow].Text = '' then Exit;
  109. stnNode := FBillsCompileData.BillsCompileTree.Add(AParentID, ANextSiblingID);
  110. with stnNode.Rec do
  111. begin
  112. ValueByName('Code').AsString := GetXmjCode(ARow);{ReplaceLastNum(leBeginCode.Text, ARow);}
  113. ValueByName('Name').AsString := zgPosition.Cells[iBwNameCol, ARow].Text;
  114. ValueByName('DrawingCode').AsString := zgPosition.Cells[iBwDrawingCodeCol, ARow].Text;
  115. end;
  116. AddBillsNodes(ARow, stnNode);
  117. end;
  118. procedure TBatchInsertBillsForm.BatchAddBillsNodes(AParentID, ANextSiblingID: Integer);
  119. var
  120. iRow: Integer;
  121. begin
  122. for iRow := 1 to zgPosition.RowCount - 1 do
  123. AddXmjNode(iRow, AParentID, ANextSiblingID);
  124. end;
  125. procedure TBatchInsertBillsForm.Execute;
  126. begin
  127. with FBillsCompileData.BillsCompileTree do
  128. begin
  129. if FInsertType = itChild then
  130. begin
  131. if not Assigned(Selected) then Exit;
  132. BatchAddBillsNodes(Selected.ID, -1);
  133. FBillsCompileData.Calculate(Selected.ID);
  134. end
  135. else if FInsertType = itNextSibling then
  136. begin
  137. if not Assigned(Selected.Parent) then Exit;
  138. BatchAddBillsNodes(Selected.ParentID, Selected.NextSiblingID);
  139. FBillsCompileData.Calculate(Selected.ParentID);
  140. end;
  141. end;
  142. end;
  143. procedure TBatchInsertBillsForm.Init(ABillsCompileData: TBillsCompileData;
  144. AInsertType: TInsertType);
  145. begin
  146. ClientHeight := SupportManager.ConfigInfo.BatchInsertFrmHeight;
  147. ClientWidth := SupportManager.ConfigInfo.BatchInsertFrmWidth;
  148. pnlBills.Height := Trunc((pnlPositon_Bills.Height - pnlOther.Height)/22*9);
  149. OnResize := FormResize;
  150. FBillsCompileData := ABillsCompileData;
  151. sgdDealBills.DataView := TProjectData(ABillsCompileData.ProjectData).DealBillsData.sdvDealBills;
  152. FInsertType := AInsertType;
  153. if FInsertType = itChild then
  154. Caption := '批量插入子项'
  155. else if FInsertType = itNextSibling then
  156. Caption := '批量插入后项';
  157. ResetPositionGridHead;
  158. ResetBillsGridHead;
  159. LoadParentCode;
  160. end;
  161. procedure TBatchInsertBillsForm.PasteData(AGrid: TZJGrid; ABounds: TRect;
  162. ASourSheet: TZjSheet);
  163. var
  164. iCol, iRow: Integer;
  165. begin
  166. for iRow := 0 to ASourSheet.RowCount - 1 do
  167. for iCol := 0 to ASourSheet.ColCount - 1 do
  168. begin
  169. with AGrid.Cells[iCol + ABounds.Left , iRow + ABounds.Top] do
  170. if CanEdit then Text := ASourSheet.Values[iCol, iRow];
  171. end;
  172. end;
  173. function TBatchInsertBillsForm.ReplaceLastNum(const ACode: string;
  174. ARow: Integer): string;
  175. var
  176. sgs: TStringList;
  177. begin
  178. sgs := TStringList.Create;
  179. try
  180. sgs.Delimiter := '-';
  181. sgs.DelimitedText := ACode;
  182. sgs[sgs.Count - 1] := IntToStr(StrToInt(sgs[sgs.Count - 1]) + ARow - 1);
  183. Result := sgs.DelimitedText;
  184. finally
  185. sgs.Free;
  186. end;
  187. end;
  188. procedure TBatchInsertBillsForm.ResetPositionGridHead;
  189. var
  190. iCol, iColDiff: Integer;
  191. begin
  192. zgPosition.Cells[iBwNameCol, 0].Text := '部位';
  193. zgPosition.ColWidths[iBwNameCol] := 100;
  194. zgPosition.Cells[iBwDrawingCodeCol, 0].Text := '图(册)号';
  195. zgPosition.ColWidths[iBwDrawingCodeCol] := 100;
  196. iColDiff := iBwBillsQtyCol - 1;
  197. for iCol := iBwBillsQtyCol to zgPosition.ColCount - 1 do
  198. begin
  199. zgPosition.Cells[iCol, 0].Text := '清单' + IntToStr(iCol - iColDiff);
  200. zgPosition.ColWidths[iCol] := 50;
  201. end;
  202. end;
  203. procedure TBatchInsertBillsForm.SetRowAndColumnCount(AGrid: TZJGrid;
  204. ASourSheet: TZjSheet);
  205. begin
  206. if AGrid.ColCount < ASourSheet.ColCount + AGrid.CurCol + 1 then
  207. AGrid.ColCount := ASourSheet.ColCount + AGrid.CurCol + 1;
  208. if AGrid.RowCount < ASourSheet.RowCount + AGrid.CurRow + 1 then
  209. AGrid.RowCount := ASourSheet.RowCount + AGrid.CurRow + 1;
  210. end;
  211. procedure TBatchInsertBillsForm.zgPositionCustomPaste(Sender: TObject;
  212. ABounds: TRect; ASourSheet: TZjSheet);
  213. begin
  214. SetRowAndColumnCount(TZJGrid(Sender), ASourSheet);
  215. ResetPositionGridHead;
  216. PasteData(TZJGrid(Sender), ABounds, ASourSheet);
  217. zgBills.RowCount := zgPosition.ColCount - 1;
  218. ResetBillsGridHead;
  219. end;
  220. procedure TBatchInsertBillsForm.zgBillsCustomPaste(Sender: TObject;
  221. ABounds: TRect; ASourSheet: TZjSheet);
  222. begin
  223. SetRowAndColumnCount(TZJGrid(Sender), ASourSheet);
  224. PasteData(TZJGrid(Sender), ABounds, ASourSheet);
  225. end;
  226. procedure TBatchInsertBillsForm.AddBillsNodes(AQtyRow: Integer;
  227. AParent: TsdIDTreeNode);
  228. var
  229. iRow: Integer;
  230. begin
  231. for iRow := 1 to zgBills.RowCount - 1 do
  232. AddBillsNode(AQtyRow, iRow, AParent);
  233. end;
  234. procedure TBatchInsertBillsForm.AddBillsNode(AQtyRow, ARow: Integer;
  235. AParent: TsdIDTreeNode);
  236. var
  237. stnNode: TsdIDTreeNode;
  238. fQuantity: Double;
  239. begin
  240. if (zgBills.Cells[1, ARow].Text = '') or
  241. (zgPosition.Cells[ARow + iBwBillsQtyCol - 1, AQtyRow].Text = '') or
  242. not TryStrToFloat(zgPosition.Cells[ARow + iBwBillsQtyCol - 1, AQtyRow].Text, fQuantity) then Exit;
  243. stnNode := FBillsCompileData.BillsCompileTree.Add(AParent.ID, -1);
  244. with stnNode.Rec do
  245. begin
  246. ValueByName('B_Code').AsString := zgBills.Cells[iGclCodeCol, ARow].Text;
  247. ValueByName('Name').AsString := zgBills.Cells[iGclNameCol, ARow].Text;
  248. ValueByName('Units').AsString := zgBills.Cells[iGclUnitsCol, ARow].Text;
  249. ValueByName('Price').AsFloat := StrToFloatDef(zgBills.Cells[iGclPriceCol, ARow].Text, 0);
  250. ValueByName('OrgQuantity').AsFloat := StrToFloatDef(zgPosition.Cells[ARow + iBwBillsQtyCol - 1, AQtyRow].Text, 0);
  251. ValueByName('DrawingCode').AsString := zgBills.Cells[iGclDrawingCodeCol, ARow].Text;
  252. end;
  253. end;
  254. procedure TBatchInsertBillsForm.ResetBillsGridHead;
  255. var
  256. iRow: Integer;
  257. begin
  258. zgBills.Cells[iGclCodeCol, 0].Text := '编号';
  259. zgBills.ColWidths[1] := 80;
  260. zgBills.Cells[iGclNameCol, 0].Text := '名称';
  261. zgBills.ColWidths[2] := 120;
  262. zgBills.Cells[iGclUnitsCol, 0].Text := '单位';
  263. zgBills.ColWidths[3] := 60;
  264. zgBills.Cells[iGclPriceCol, 0].Text := '单价';
  265. zgBills.ColWidths[4] := 60;
  266. zgBills.Cells[iGclDrawingCodeCol, 0].Text := '图(册)号';
  267. zgBills.ColWidths[5] := 60;
  268. for iRow := 1 to zgBills.RowCount - 1 do
  269. zgBills.Cells[0, iRow].Text := '清单' + IntToStr(iRow);
  270. end;
  271. procedure TBatchInsertBillsForm.btnOKClick(Sender: TObject);
  272. function CheckGridHasData(AGrid: TZJGrid): Boolean;
  273. var
  274. iRow: Integer;
  275. begin
  276. Result := False;
  277. for iRow := 1 to AGrid.RowCount - 1 do
  278. if AGrid.Cells[1, iRow].Text <> '' then
  279. begin
  280. Result := True;
  281. Break;
  282. end;
  283. end;
  284. function CheckBeginCodeAvailable(const ACode: string): Boolean;
  285. var
  286. sgsCode: TStrings;
  287. iCode: Integer;
  288. begin
  289. sgsCode := TStringList.Create;
  290. try
  291. sgsCode.Delimiter := '-';
  292. sgsCode.DelimitedText := ACode;
  293. Result := TryStrToInt(sgsCode[sgsCode.Count - 1], iCode);
  294. finally
  295. sgsCode.Free;
  296. end;
  297. end;
  298. begin
  299. if not CheckGridHasData(zgPosition) then
  300. ErrorMessage('请输入部位数量复核数据!')
  301. else if not CheckGridHasData(zgBills) then
  302. ErrorMessage('请输入清单编号等数据!')
  303. else if leBeginCode.Text = '' then
  304. ErrorMessage('请输入起始编号!')
  305. else if not CheckBeginCodeAvailable(leBeginCode.Text) then
  306. ErrorMessage('请输入规范的起始部位编号,如1或1-1等。')
  307. else
  308. ModalResult := mrOK;
  309. end;
  310. procedure TBatchInsertBillsForm.zgPositionMouseDown(Sender: TObject;
  311. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  312. begin
  313. if Button = mbRight then
  314. begin
  315. dxpmInsertBills.Tag := 0;
  316. dxpmInsertBills.PopupFromCursorPos;
  317. end;
  318. end;
  319. procedure TBatchInsertBillsForm.zgBillsCellTextChanged(Sender: TObject;
  320. Col, Row: Integer);
  321. var
  322. sB_Code: string;
  323. Rec: TsdDataRecord;
  324. begin
  325. if (Col = 1) and (Row > 0) then
  326. begin
  327. zgBills.Cells[Col, Row].Align := gaCenterLeft;
  328. sB_Code := zgBills.Cells[Col, Row].Text;
  329. if sB_Code = '' then Exit;
  330. with TProjectData(FBillsCompileData.ProjectData).DealBillsData do
  331. Rec := sddDealBills.Locate('B_Code', sB_Code);
  332. if not Assigned(Rec) then
  333. begin
  334. with FBillsCompileData.BillsData do
  335. Rec := sddBills.Locate('B_Code', sB_Code);
  336. end;
  337. if Assigned(Rec) then
  338. begin
  339. zgBills.Cells[iGclNameCol, Row].Text := Rec.ValueByName('Name').AsString;
  340. zgBills.Cells[iGclNameCol, Row].Align := gaCenterLeft;
  341. zgBills.Cells[iGclUnitsCol, Row].Text := Rec.ValueByName('Units').AsString;
  342. zgBills.Cells[iGclUnitsCol, Row].Align := gaCenterCenter;
  343. zgBills.Cells[iGclPriceCol, Row].Font.Name := 'smartSimSun';
  344. zgBills.Cells[iGclPriceCol, Row].Text := Rec.ValueByName('Price').AsString;
  345. zgBills.Cells[iGclPriceCol, Row].Align := gaCenterRight;
  346. zgBills.Cells[iGclDrawingCodeCol, Row].Align := gaCenterLeft;
  347. end;
  348. end
  349. else if (Col = iGclNameCol) and (Row > 0) then
  350. zgBills.Cells[iGclNameCol, Row].Align := gaCenterLeft
  351. else if (Col = iGclPriceCol) and (Row > 0) then
  352. begin
  353. zgBills.Cells[Col, Row].Value := PriceRoundTo(
  354. StrToFloatDef(zgBills.Cells[Col, Row].Text, 0));
  355. zgBills.Cells[Col, Row].Align := gaCenterRight;
  356. end
  357. else if (Col = iGclDrawingCodeCol) and (Row > 0) then
  358. zgBills.Cells[Col, Row].Align := gaCenterLeft;
  359. end;
  360. procedure TBatchInsertBillsForm.zgDealBillsMouseDown(Sender: TObject;
  361. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  362. var
  363. i: Integer;
  364. begin
  365. if (Button = mbLeft) and (ssDouble in Shift) then
  366. for i := 1 to 4 do
  367. zgBills.Cells[i, zgBills.CurRow].Text := zgDealBills.Cells[i, zgDealBills.CurRow].Text;
  368. end;
  369. procedure TBatchInsertBillsForm.LoadParentCode;
  370. var
  371. Parent: TsdIDTreeNode;
  372. begin
  373. if FInsertType = itChild then
  374. Parent := FBillsCompileData.BillsCompileTree.Selected
  375. else if FInsertType = itNextSibling then
  376. Parent := FBillsCompileData.BillsCompileTree.Selected.Parent;
  377. FParentCode := Parent.Rec.ValueByName('Code').AsString;
  378. end;
  379. function TBatchInsertBillsForm.GetXmjCode(ARow: Integer): string;
  380. var
  381. iBeginCode: Integer;
  382. begin
  383. iBeginCode := StrToIntDef(leBeginCode.Text, 1);
  384. Result := Format('%s-%d', [FParentCode, iBeginCode + ARow - 1]);
  385. end;
  386. procedure TBatchInsertBillsForm.leBeginCodeKeyPress(Sender: TObject;
  387. var Key: Char);
  388. begin
  389. ValidInteger(Key);
  390. end;
  391. procedure TBatchInsertBillsForm.zgPositionCellTextChanged(Sender: TObject;
  392. Col, Row: Integer);
  393. var
  394. value: Double;
  395. begin
  396. if (Row > 0) then
  397. begin
  398. if (Col >= iBwBillsQtyCol) then
  399. begin
  400. if (TryStrToFloat(zgPosition.Cells[Col, Row].Text, value)) then
  401. begin
  402. zgPosition.Cells[Col, Row].Value := QuantityRoundTo(Value);
  403. zgPosition.Cells[Col, Row].Align := gaCenterRight;
  404. end
  405. else
  406. zgPosition.Cells[Col, Row].Value := '';
  407. end
  408. else if (Col > zgPosition.FixedColCount) then
  409. zgPosition.Cells[Col, Row].Align := gaCenterLeft;
  410. end;
  411. end;
  412. procedure TBatchInsertBillsForm.dxpmInsertBillsPopup(Sender: TObject);
  413. begin
  414. SetDxBtnAction(actnInsertCol, MainForm.dxbtnInsertCol);
  415. end;
  416. procedure TBatchInsertBillsForm.actnInsertColExecute(Sender: TObject);
  417. begin
  418. zgPosition.ColCount := zgPosition.ColCount + 1;
  419. zgPosition.Cells[zgPosition.ColCount-1, 0].Text := '清单' + IntToStr(zgPosition.ColCount - iBwBillsQtyCol);
  420. zgPosition.ColWidths[zgPosition.ColCount-1] := 50;
  421. zgBills.RowCount := zgPosition.ColCount - (iBwBillsQtyCol - 1);
  422. zgBills.Cells[0, zgBills.RowCount-1].Text := '清单' + IntToStr(zgBills.RowCount-1);
  423. end;
  424. procedure TBatchInsertBillsForm.zgBillsMouseDown(Sender: TObject;
  425. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  426. begin
  427. if Button = mbRight then
  428. begin
  429. dxpmInsertBills.Tag := 1;
  430. dxpmInsertBills.PopupFromCursorPos;
  431. end;
  432. end;
  433. procedure TBatchInsertBillsForm.actnInsertColUpdate(Sender: TObject);
  434. begin
  435. if dxpmInsertBills.Tag = 0 then
  436. TAction(Sender).Caption := '插入一列'
  437. else
  438. TAction(Sender).Caption := '插入一行';
  439. end;
  440. procedure TBatchInsertBillsForm.FormResize(Sender: TObject);
  441. begin
  442. SupportManager.ConfigInfo.BatchInsertFrmHeight := ClientHeight;
  443. SupportManager.ConfigInfo.BatchInsertFrmWidth := ClientWidth;
  444. pnlBills.Height := Trunc((pnlPositon_Bills.Height - pnlOther.Height)/22*9);
  445. end;
  446. end.